From f7aaec6245aea5a59e33b8e4f3aeb11375ef23b0 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 20 Jun 2019 19:02:39 +0200 Subject: openieee: use .vhdl extension --- Makefile.in | 6 +- libraries/Makefile.inc | 16 +- libraries/openieee/build_1164.py | 14 +- libraries/openieee/build_numeric.py | 6 +- libraries/openieee/numeric_bit-body.v87 | 2333 ----------------- libraries/openieee/numeric_bit-body.v93 | 2505 ------------------ libraries/openieee/numeric_bit.v87 | 211 -- libraries/openieee/numeric_bit.v93 | 211 -- libraries/openieee/numeric_std-body.v87 | 2899 --------------------- libraries/openieee/numeric_std-body.v93 | 3071 ----------------------- libraries/openieee/numeric_std.v87 | 225 -- libraries/openieee/numeric_std.v93 | 225 -- libraries/openieee/std_logic_1164-body.v08 | 1383 ---------- libraries/openieee/std_logic_1164-body.v87 | 713 ------ libraries/openieee/std_logic_1164-body.v93 | 769 ------ libraries/openieee/std_logic_1164.proto | 274 ++ libraries/openieee/std_logic_1164.v08 | 257 -- libraries/openieee/std_logic_1164.v87 | 138 - libraries/openieee/std_logic_1164.v93 | 141 -- libraries/openieee/std_logic_1164.vhdl | 274 -- libraries/openieee/v08/std_logic_1164-body.vhdl | 1383 ++++++++++ libraries/openieee/v08/std_logic_1164.vhdl | 257 ++ libraries/openieee/v87/numeric_bit-body.vhdl | 2333 +++++++++++++++++ libraries/openieee/v87/numeric_bit.vhdl | 211 ++ libraries/openieee/v87/numeric_std-body.vhdl | 2899 +++++++++++++++++++++ libraries/openieee/v87/numeric_std.vhdl | 225 ++ libraries/openieee/v87/std_logic_1164-body.vhdl | 713 ++++++ libraries/openieee/v87/std_logic_1164.vhdl | 138 + libraries/openieee/v93/numeric_bit-body.vhdl | 2505 ++++++++++++++++++ libraries/openieee/v93/numeric_bit.vhdl | 211 ++ libraries/openieee/v93/numeric_std-body.vhdl | 3071 +++++++++++++++++++++++ libraries/openieee/v93/numeric_std.vhdl | 225 ++ libraries/openieee/v93/std_logic_1164-body.vhdl | 769 ++++++ libraries/openieee/v93/std_logic_1164.vhdl | 141 ++ 34 files changed, 15376 insertions(+), 15376 deletions(-) delete mode 100644 libraries/openieee/numeric_bit-body.v87 delete mode 100644 libraries/openieee/numeric_bit-body.v93 delete mode 100644 libraries/openieee/numeric_bit.v87 delete mode 100644 libraries/openieee/numeric_bit.v93 delete mode 100644 libraries/openieee/numeric_std-body.v87 delete mode 100644 libraries/openieee/numeric_std-body.v93 delete mode 100644 libraries/openieee/numeric_std.v87 delete mode 100644 libraries/openieee/numeric_std.v93 delete mode 100644 libraries/openieee/std_logic_1164-body.v08 delete mode 100644 libraries/openieee/std_logic_1164-body.v87 delete mode 100644 libraries/openieee/std_logic_1164-body.v93 create mode 100644 libraries/openieee/std_logic_1164.proto delete mode 100644 libraries/openieee/std_logic_1164.v08 delete mode 100644 libraries/openieee/std_logic_1164.v87 delete mode 100644 libraries/openieee/std_logic_1164.v93 delete mode 100644 libraries/openieee/std_logic_1164.vhdl create mode 100644 libraries/openieee/v08/std_logic_1164-body.vhdl create mode 100644 libraries/openieee/v08/std_logic_1164.vhdl create mode 100644 libraries/openieee/v87/numeric_bit-body.vhdl create mode 100644 libraries/openieee/v87/numeric_bit.vhdl create mode 100644 libraries/openieee/v87/numeric_std-body.vhdl create mode 100644 libraries/openieee/v87/numeric_std.vhdl create mode 100644 libraries/openieee/v87/std_logic_1164-body.vhdl create mode 100644 libraries/openieee/v87/std_logic_1164.vhdl create mode 100644 libraries/openieee/v93/numeric_bit-body.vhdl create mode 100644 libraries/openieee/v93/numeric_bit.vhdl create mode 100644 libraries/openieee/v93/numeric_std-body.vhdl create mode 100644 libraries/openieee/v93/numeric_std.vhdl create mode 100644 libraries/openieee/v93/std_logic_1164-body.vhdl create mode 100644 libraries/openieee/v93/std_logic_1164.vhdl diff --git a/Makefile.in b/Makefile.in index f467c7351..83ee2f38c 100644 --- a/Makefile.in +++ b/Makefile.in @@ -457,20 +457,20 @@ LIBSRC_DIR:=$(srcdir)/libraries LIBDST_DIR:=$(libdirsuffix) VHDLLIB_SUBDIRS_COMMON= src/std src/std/v87 src/std/v93 src/std/v08 \ - src/ieee/v87 src/ieee/v93 \ src/synopsys src/synopsys/v08 \ std/v87 ieee/v87 synopsys/v87 \ std/v93 ieee/v93 synopsys/v93 \ std/v08 ieee/v08 VHDLLIB_SUBDIRS_FULL= src/ieee src/vital95 src/vital2000 src/mentor \ - src/ieee2008 \ + src/ieee/v87 src/ieee/v93 src/ieee2008 \ mentor/v93 synopsys/v08 ifeq ($(enable_openieee),false) VHDLLIB_SUBDIRS=$(VHDLLIB_SUBDIRS_COMMON) $(VHDLLIB_SUBDIRS_FULL) else -VHDLLIB_SUBDIRS=$(VHDLLIB_SUBDIRS_COMMON) src/openieee +VHDLLIB_SUBDIRS=$(VHDLLIB_SUBDIRS_COMMON) \ + src/openieee/v87 src/openieee/v93 src/openieee/v08 endif install.dirs: diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc index 0f0615d0b..f8a0f09d7 100644 --- a/libraries/Makefile.inc +++ b/libraries/Makefile.inc @@ -77,7 +77,7 @@ IEEE08_BSRCS := \ ieee2008/ieee_bit_context.vhdl ieee2008/ieee_std_context.vhdl IEEE87_BSRCS := $(addprefix ieee/v87/,$(IEEE_SRCS)) -IEEE93_BSRCS := $(addprefix ieee/v93/,$(IEEE_SRCS) $(MATH_SRCS)) +IEEE93_BSRCS := $(addprefix ieee/v93/,$(IEEE_SRCS)) $(addprefix ieee/,$(MATH_SRCS)) else IEEE_SRCS := std_logic_1164.vhdl std_logic_1164-body.vhdl \ @@ -86,12 +86,12 @@ IEEE_SRCS := std_logic_1164.vhdl std_logic_1164-body.vhdl \ MATH_SRCS := math_real.vhdl math_real-body.vhdl VITAL95_BSRCS := VITAL2000_BSRCS := -IEEE08_BSRCS := openieee/std_logic_1164.v08 openieee/std_logic_1164-body.v08 \ - openieee/math_real.vhdl openieee/math_real-body.vhdl +IEEE08_BSRCS := v08/std_logic_1164.vhdl v08/std_logic_1164-body.vhdl \ + math_real.vhdl math_real-body.vhdl IEEE87_BSRCS := $(addprefix openieee/v87/,$(IEEE_SRCS)) -IEEE93_BSRCS := $(addprefix openieee/v93/,$(IEEE_SRCS) $(MATH_SRCS)) - +IEEE93_BSRCS := $(addprefix openieee/v93/,$(IEEE_SRCS)) $(addprefix openieee/,$(MATH_SRCS)) +IEEE08_BSRCS := $(addprefix openieee/,$(IEEE08_BSRCS)) endif ANALYZE=$(GHDL) -a $(GHDL_FLAGS) @@ -165,7 +165,7 @@ $(STD87_DIR)/std-obj87.cf: $(ANALYZE_DEP) $(STD87_SRCS) $(LIBDST_DIR)/src/ieee/v87/%.vhdl: $(LIBSRC_DIR)/ieee/%.vhdl $(SED_V87) < $< > $@ -$(LIBDST_DIR)/src/openieee/v87/%.vhdl: $(LIBSRC_DIR)/openieee/%.v87 +$(LIBDST_DIR)/src/openieee/v87/%.vhdl: $(LIBSRC_DIR)/openieee/v87/%.vhdl $(CP) $< $@ $(LIBDST_DIR)/src/vital95/%.vhdl: $(LIBSRC_DIR)/vital95/%.vhdl @@ -229,7 +229,7 @@ $(LIBDST_DIR)/src/ieee/%.vhdl: $(LIBSRC_DIR)/ieee/%.vhdl $(LIBDST_DIR)/src/openieee/%.vhdl: $(LIBSRC_DIR)/openieee/%.vhdl $(CP) $< $@ -$(LIBDST_DIR)/src/openieee/v93/%.vhdl: $(LIBSRC_DIR)/openieee/%.v93 +$(LIBDST_DIR)/src/openieee/v93/%.vhdl: $(LIBSRC_DIR)/openieee/v93/%.vhdl $(CP) $< $@ $(LIBDST_DIR)/src/vital2000/%.vhdl: $(LIBSRC_DIR)/vital2000/%.vhdl @@ -307,7 +307,7 @@ $(STD08_DIR)/std-obj08.cf: $(ANALYZE_DEP) $(STD08_SRCS) $(LIBDST_DIR)/src/ieee2008/%.vhdl: $(LIBSRC_DIR)/ieee2008/%.vhdl $(CP) $< $@ -$(LIBDST_DIR)/src/openieee/v08/%.vhdl: $(LIBSRC_DIR)/openieee/%.v08 +$(LIBDST_DIR)/src/openieee/v08/%.vhdl: $(LIBSRC_DIR)/openieee/v08/%.vhdl $(CP) $< $@ ANALYZE_IEEE08=$(ANALYZE08) -P../.. --work=ieee diff --git a/libraries/openieee/build_1164.py b/libraries/openieee/build_1164.py index 042620d2f..36739f1ca 100755 --- a/libraries/openieee/build_1164.py +++ b/libraries/openieee/build_1164.py @@ -506,7 +506,7 @@ pats = {' @TAB\n' : disp_tables, ' @NORM\n': disp_all_norm_funcs, ' @ISX\n' : disp_all_isx_funcs } -spec_file='std_logic_1164.vhdl' +spec_file='std_logic_1164.proto' proto_file='std_logic_1164-body.proto' def gen_body(filename, version): @@ -553,15 +553,15 @@ def copy_spec(dest, version): out.close() # Copy spec -copy_spec('std_logic_1164.v87', V87) -copy_spec('std_logic_1164.v93', V93) -copy_spec('std_logic_1164.v08', V08) +copy_spec('v87/std_logic_1164.vhdl', V87) +copy_spec('v93/std_logic_1164.vhdl', V93) +copy_spec('v08/std_logic_1164.vhdl', V08) # Generate bodies -gen_body('std_logic_1164-body.v87', V87) +gen_body('v87/std_logic_1164-body.vhdl', V87) binary_funcs.append("xnor") -gen_body('std_logic_1164-body.v93', V93) +gen_body('v93/std_logic_1164-body.vhdl', V93) vec_types = ['ulogic'] -gen_body('std_logic_1164-body.v08', V08) +gen_body('v08/std_logic_1164-body.vhdl', V08) diff --git a/libraries/openieee/build_numeric.py b/libraries/openieee/build_numeric.py index c00e74e5c..43bb04b67 100755 --- a/libraries/openieee/build_numeric.py +++ b/libraries/openieee/build_numeric.py @@ -1125,7 +1125,7 @@ def gen_body(proto_file): # Copy spec for log in logics: for std in ['87', '93']: - out=open('numeric_' + log + '.v' + std, 'w') + out=open('v' + std + '/numeric_' + log + '.vhdl', 'w') for line in open('numeric_' + log + '.proto'): if line == ' @COMMON\n': for lcom in open('numeric_common.proto'): @@ -1147,7 +1147,7 @@ for log in logics: v93=False for l in logics: logic = l - out=open('numeric_{0}-body.v87'.format(l), 'w') + out=open('v87/numeric_{0}-body.vhdl'.format(l), 'w') gen_body('numeric_{0}-body.proto'.format(l)) out.close() @@ -1155,6 +1155,6 @@ v93=True binary_funcs.append("xnor") for l in logics: logic = l - out=open('numeric_{0}-body.v93'.format(l), 'w') + out=open('v93/numeric_{0}-body.vhdl'.format(l), 'w') gen_body('numeric_{0}-body.proto'.format(l)) out.close() diff --git a/libraries/openieee/numeric_bit-body.v87 b/libraries/openieee/numeric_bit-body.v87 deleted file mode 100644 index 3bdc634ac..000000000 --- a/libraries/openieee/numeric_bit-body.v87 +++ /dev/null @@ -1,2333 +0,0 @@ --- This -*- vhdl -*- file was generated from numeric_bit-body.proto --- This -*- vhdl -*- file is part of GHDL. --- IEEE 1076.3 compliant numeric bit 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 --- . - -package body NUMERIC_BIT 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 bit; - constant nat1_to_01 : nat1_to_sl_type := (0 => '0', 1 => '1'); - - subtype sl_01 is bit; - - 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 compare_type is (compare_unknown, - compare_lt, - compare_eq, - compare_gt); - - 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 res : natural := 0; - begin - if arg'length = 0 then - assert NO_WARNING - report "NUMERIC_BIT.TO_INTEGER: null array detected, returning 0" - severity warning; - return 0; - end if; - - for i in arg'range loop - res := res + res; - if arg (i) = '1' then - res := res + 1; - end if; - end loop; - - return res; - end TO_INTEGER; - - function TO_INTEGER (ARG : SIGNED) return INTEGER - is - alias argn : SIGNED (ARG'Length -1 downto 0) is arg; - variable res : integer := 0; - variable b : bit; - begin - if argn'length = 0 then - assert NO_WARNING - report "NUMERIC_BIT.TO_INTEGER: null array 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_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_BIT.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 : bit; - 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_BIT.TO_SIGNED: vector is truncated" - severity warning; - end if; - return res; - end TO_SIGNED; - - - function "+" (l, 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 : bit; - 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 := la (i); - end if; - if i > ra'left then - rb := '0'; - else - rb := ra (i); - end if; - res (i) := compute_sum (carry, rb, lb); - carry := compute_carry (carry, rb, lb); - end loop; - return res; - end "+"; - - function "+" (l, 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 : bit; - 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 := la (i); - end if; - if i > ra'left then - rb := r (r'left); - else - rb := ra (i); - 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 : bit; - begin - if res'length < 0 then - return null_UNSIGNED; - end if; - carry := '0'; - r1 := r; - for i in res'reverse_range loop - lb := la (i); - - r2 := r1 / 2; - rd := r1 - 2 * r2; - r1 := r2; - rb := nat1_to_01 (rd); - 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 : bit; - begin - if res'length < 0 then - return null_UNSIGNED; - end if; - carry := '0'; - l1 := l; - for i in res'reverse_range loop - rb := ra (i); - - l2 := l1 / 2; - ld := l1 - 2 * l2; - l1 := l2; - lb := nat1_to_01 (ld); - 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 : bit; - begin - if res'length < 0 then - return null_SIGNED; - end if; - carry := '0'; - r1 := r; - for i in res'reverse_range loop - lb := 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); - 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 : bit; - begin - if res'length < 0 then - return null_SIGNED; - end if; - carry := '0'; - l1 := l; - for i in res'reverse_range loop - rb := 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); - 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, 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 : bit; - 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 := la (i); - end if; - if i > ra'left then - rb := '0'; - else - rb := ra (i); - 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, 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 : bit; - 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 := la (i); - end if; - if i > ra'left then - rb := r (r'left); - else - rb := ra (i); - 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 : bit; - begin - if res'length < 0 then - return null_UNSIGNED; - end if; - carry := '1'; - r1 := r; - for i in res'reverse_range loop - lb := la (i); - - r2 := r1 / 2; - rd := r1 - 2 * r2; - r1 := r2; - rb := nat1_to_01 (rd); - 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 : bit; - begin - if res'length < 0 then - return null_UNSIGNED; - end if; - carry := '1'; - l1 := l; - for i in res'reverse_range loop - rb := ra (i); - - l2 := l1 / 2; - ld := l1 - 2 * l2; - l1 := l2; - lb := nat1_to_01 (ld); - 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 : bit; - begin - if res'length < 0 then - return null_SIGNED; - end if; - carry := '1'; - r1 := r; - for i in res'reverse_range loop - lb := 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); - 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 : bit; - begin - if res'length < 0 then - return null_SIGNED; - end if; - carry := '1'; - l1 := l; - for i in res'reverse_range loop - rb := 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); - 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, 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 : bit; - 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 := 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; - end if; - end loop; - return res; - end "*"; - - function "*" (L, 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 : bit; - 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 := 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; - 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 bit - is - variable res : bit := '0'; - begin - for i in a'range loop - 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 : bit; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_unsigned; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_unsigned; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_unsigned; - 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 bit - is - variable res : bit := '0'; - begin - for i in a'range loop - 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 : bit; - begin - if arga'length = 0 then - return null_signed; - 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 : bit; - begin - if arga'length = 0 then - return null_signed; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_signed; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_signed; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_signed; - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - else - for I in res_type'range loop - res (I) := la (I) xor ra (I); - end loop; - end if; - return res; - end "xor"; - - function ucompare (l, 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 : bit; - variable res : compare_type; - begin - res := compare_eq; - for i in 0 to sz loop - if i > la'left then - lb := '0'; - else - lb := la (i); - end if; - if i > ra'left then - rb := '0'; - else - rb := ra (i); - 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, 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 : bit; - variable res : compare_type; - begin - -- Consider sign bit as S * -(2**N). - lb := la (la'left); - rb := 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 := la (i); - end if; - if i > ra'left then - rb := r (r'left); - else - rb := ra (i); - 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 : bit; - variable res : compare_type; - begin - res := compare_eq; - r1 := r; - for i in la'reverse_range loop - lb := la (i); - r2 := r1 / 2; - rd := r1 - 2 * r2; - r1 := r2; - rb := nat1_to_01 (rd); - 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 : bit; - variable res : compare_type; - begin - res := compare_eq; - r1 := r; - for i in la'reverse_range loop - lb := 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 = '1' and rb = '0' then - res := compare_gt; - elsif lb = '0' and rb = '1' then - res := compare_lt; - end if; - end loop; - if 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, 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); - return res = compare_eq; - end "="; - - function "=" (l, 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); - 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); - 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); - 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); - 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); - return compare_eq = res; - end "="; - - function "/=" (l, 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); - return res /= compare_eq; - end "/="; - - function "/=" (l, 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); - 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); - 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); - 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); - 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); - return compare_eq /= res; - end "/="; - - function ">" (l, 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); - return res > compare_eq; - end ">"; - - function ">" (l, 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); - 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); - 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); - 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); - 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); - return compare_eq > res; - end ">"; - - function ">=" (l, 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); - return res >= compare_eq; - end ">="; - - function ">=" (l, 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); - 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); - 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); - 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); - 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); - return compare_eq >= res; - end ">="; - - function "<" (l, 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); - return res < compare_eq; - end "<"; - - function "<" (l, 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); - 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); - 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); - 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); - 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); - return compare_eq < res; - end "<"; - - function "<=" (l, 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); - return res <= compare_eq; - end "<="; - - function "<=" (l, 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); - 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); - 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); - 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); - 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); - 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; - - function rising_edge (signal s : bit) return boolean is - begin - return s'event and s = '1'; - end rising_edge; - - function falling_edge (signal s : bit) return boolean is - begin - return s'event and s = '0'; - end falling_edge; -end NUMERIC_BIT; diff --git a/libraries/openieee/numeric_bit-body.v93 b/libraries/openieee/numeric_bit-body.v93 deleted file mode 100644 index 869b0d2b2..000000000 --- a/libraries/openieee/numeric_bit-body.v93 +++ /dev/null @@ -1,2505 +0,0 @@ --- This -*- vhdl -*- file was generated from numeric_bit-body.proto --- This -*- vhdl -*- file is part of GHDL. --- IEEE 1076.3 compliant numeric bit 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 --- . - -package body NUMERIC_BIT 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 bit; - constant nat1_to_01 : nat1_to_sl_type := (0 => '0', 1 => '1'); - - subtype sl_01 is bit; - - 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 compare_type is (compare_unknown, - compare_lt, - compare_eq, - compare_gt); - - 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 res : natural := 0; - begin - if arg'length = 0 then - assert NO_WARNING - report "NUMERIC_BIT.TO_INTEGER: null array detected, returning 0" - severity warning; - return 0; - end if; - - for i in arg'range loop - res := res + res; - if arg (i) = '1' then - res := res + 1; - end if; - end loop; - - return res; - end TO_INTEGER; - - function TO_INTEGER (ARG : SIGNED) return INTEGER - is - alias argn : SIGNED (ARG'Length -1 downto 0) is arg; - variable res : integer := 0; - variable b : bit; - begin - if argn'length = 0 then - assert NO_WARNING - report "NUMERIC_BIT.TO_INTEGER: null array 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_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_BIT.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 : bit; - 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_BIT.TO_SIGNED: vector is truncated" - severity warning; - end if; - return res; - end TO_SIGNED; - - - function "+" (l, 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 : bit; - 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 := la (i); - end if; - if i > ra'left then - rb := '0'; - else - rb := ra (i); - end if; - res (i) := compute_sum (carry, rb, lb); - carry := compute_carry (carry, rb, lb); - end loop; - return res; - end "+"; - - function "+" (l, 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 : bit; - 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 := la (i); - end if; - if i > ra'left then - rb := r (r'left); - else - rb := ra (i); - 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 : bit; - begin - if res'length < 0 then - return null_UNSIGNED; - end if; - carry := '0'; - r1 := r; - for i in res'reverse_range loop - lb := la (i); - - r2 := r1 / 2; - rd := r1 - 2 * r2; - r1 := r2; - rb := nat1_to_01 (rd); - 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 : bit; - begin - if res'length < 0 then - return null_UNSIGNED; - end if; - carry := '0'; - l1 := l; - for i in res'reverse_range loop - rb := ra (i); - - l2 := l1 / 2; - ld := l1 - 2 * l2; - l1 := l2; - lb := nat1_to_01 (ld); - 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 : bit; - begin - if res'length < 0 then - return null_SIGNED; - end if; - carry := '0'; - r1 := r; - for i in res'reverse_range loop - lb := 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); - 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 : bit; - begin - if res'length < 0 then - return null_SIGNED; - end if; - carry := '0'; - l1 := l; - for i in res'reverse_range loop - rb := 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); - 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, 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 : bit; - 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 := la (i); - end if; - if i > ra'left then - rb := '0'; - else - rb := ra (i); - 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, 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 : bit; - 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 := la (i); - end if; - if i > ra'left then - rb := r (r'left); - else - rb := ra (i); - 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 : bit; - begin - if res'length < 0 then - return null_UNSIGNED; - end if; - carry := '1'; - r1 := r; - for i in res'reverse_range loop - lb := la (i); - - r2 := r1 / 2; - rd := r1 - 2 * r2; - r1 := r2; - rb := nat1_to_01 (rd); - 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 : bit; - begin - if res'length < 0 then - return null_UNSIGNED; - end if; - carry := '1'; - l1 := l; - for i in res'reverse_range loop - rb := ra (i); - - l2 := l1 / 2; - ld := l1 - 2 * l2; - l1 := l2; - lb := nat1_to_01 (ld); - 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 : bit; - begin - if res'length < 0 then - return null_SIGNED; - end if; - carry := '1'; - r1 := r; - for i in res'reverse_range loop - lb := 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); - 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 : bit; - begin - if res'length < 0 then - return null_SIGNED; - end if; - carry := '1'; - l1 := l; - for i in res'reverse_range loop - rb := 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); - 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, 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 : bit; - 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 := 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; - end if; - end loop; - return res; - end "*"; - - function "*" (L, 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 : bit; - 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 := 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; - 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 bit - is - variable res : bit := '0'; - begin - for i in a'range loop - 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 : bit; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_unsigned; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_unsigned; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_unsigned; - 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 bit - is - variable res : bit := '0'; - begin - for i in a'range loop - 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 : bit; - begin - if arga'length = 0 then - return null_signed; - 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 : bit; - begin - if arga'length = 0 then - return null_signed; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_signed; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_signed; - 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, 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 : bit := has_0x (r); - begin - if la'length = 0 or ra'length = 0 then - return null_signed; - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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 => '0'); - 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, 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 : bit; - variable res : compare_type; - begin - res := compare_eq; - for i in 0 to sz loop - if i > la'left then - lb := '0'; - else - lb := la (i); - end if; - if i > ra'left then - rb := '0'; - else - rb := ra (i); - 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, 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 : bit; - variable res : compare_type; - begin - -- Consider sign bit as S * -(2**N). - lb := la (la'left); - rb := 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 := la (i); - end if; - if i > ra'left then - rb := r (r'left); - else - rb := ra (i); - 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 : bit; - variable res : compare_type; - begin - res := compare_eq; - r1 := r; - for i in la'reverse_range loop - lb := la (i); - r2 := r1 / 2; - rd := r1 - 2 * r2; - r1 := r2; - rb := nat1_to_01 (rd); - 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 : bit; - variable res : compare_type; - begin - res := compare_eq; - r1 := r; - for i in la'reverse_range loop - lb := 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 = '1' and rb = '0' then - res := compare_gt; - elsif lb = '0' and rb = '1' then - res := compare_lt; - end if; - end loop; - if 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, 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); - return res = compare_eq; - end "="; - - function "=" (l, 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); - 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); - 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); - 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); - 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); - return compare_eq = res; - end "="; - - function "/=" (l, 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); - return res /= compare_eq; - end "/="; - - function "/=" (l, 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); - 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); - 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); - 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); - 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); - return compare_eq /= res; - end "/="; - - function ">" (l, 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); - return res > compare_eq; - end ">"; - - function ">" (l, 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); - 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); - 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); - 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); - 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); - return compare_eq > res; - end ">"; - - function ">=" (l, 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); - return res >= compare_eq; - end ">="; - - function ">=" (l, 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); - 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); - 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); - 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); - 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); - return compare_eq >= res; - end ">="; - - function "<" (l, 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); - return res < compare_eq; - end "<"; - - function "<" (l, 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); - 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); - 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); - 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); - 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); - return compare_eq < res; - end "<"; - - function "<=" (l, 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); - return res <= compare_eq; - end "<="; - - function "<=" (l, 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); - 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); - 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); - 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); - 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); - 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 "sll" (ARG : UNSIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then - res (res'left downto count) := arg1 (arg1'left - count downto 0); - elsif count < 0 and count >= -arg1'left then - res (res'left + count downto 0) := arg1 (arg1'left downto -count); - end if; - return res; - end "sll"; - - function "srl" (ARG : UNSIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then - res (res'left - count downto 0) := arg1 (arg1'left downto count); - elsif count < 0 and count >= -arg1'left then - res (res'left downto -count) := arg1 (arg1'left + count downto 0); - end if; - return res; - end "srl"; - - function "rol" (ARG : UNSIGNED; COUNT: integer) 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 mod 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 "rol"; - - function "ror" (ARG : UNSIGNED; COUNT: integer) 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 mod 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 "ror"; - - 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; - - function "sll" (ARG : SIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then - res (res'left downto count) := arg1 (arg1'left - count downto 0); - elsif count < 0 and count >= -arg1'left then - res (res'left + count downto 0) := arg1 (arg1'left downto -count); - end if; - return res; - end "sll"; - - function "srl" (ARG : SIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then - res (res'left - count downto 0) := arg1 (arg1'left downto count); - elsif count < 0 and count >= -arg1'left then - res (res'left downto -count) := arg1 (arg1'left + count downto 0); - end if; - return res; - end "srl"; - - function "rol" (ARG : SIGNED; COUNT: integer) 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 mod 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 "rol"; - - function "ror" (ARG : SIGNED; COUNT: integer) 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 mod 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 "ror"; - - function rising_edge (signal s : bit) return boolean is - begin - return s'event and s = '1'; - end rising_edge; - - function falling_edge (signal s : bit) return boolean is - begin - return s'event and s = '0'; - end falling_edge; -end NUMERIC_BIT; diff --git a/libraries/openieee/numeric_bit.v87 b/libraries/openieee/numeric_bit.v87 deleted file mode 100644 index 6a6dcc393..000000000 --- a/libraries/openieee/numeric_bit.v87 +++ /dev/null @@ -1,211 +0,0 @@ --- This -*- vhdl -*- file is part of GHDL. --- IEEE 1076.3 compliant numeric bit package. --- 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 --- . - -package NUMERIC_BIT is - type UNSIGNED is array (natural range <>) of BIT; - type SIGNED is array (natural range <>) of BIT; - - - function TO_INTEGER (ARG : UNSIGNED) return NATURAL; - function TO_INTEGER (ARG : SIGNED) return INTEGER; - -- Convert ARG to an integer. - -- Simulation is aborted in case of overflow. - -- Issue a warning in case of non-logical value. - - function TO_UNSIGNED (ARG, SIZE : NATURAL) return UNSIGNED; - -- Convert ARG to unsigned. - -- Result index range is SIZE - 1 downto 0. - -- Issue a warning if value is truncated. - - function TO_SIGNED (ARG : INTEGER; SIZE : NATURAL) return SIGNED; - -- Convert ARG to signed. - -- Result index range is SIZE - 1 downto 0. - -- Issue a warning if value is truncated. - - function resize (ARG : UNSIGNED; NEW_SIZE: natural) return UNSIGNED; - function resize (ARG : SIGNED; NEW_SIZE: natural) return SIGNED; - -- Result index range is NEW_SIZE - 1 downto 0 (unless null array). - -- For SIGNED, the sign of the result is the sign of ARG. - - function "=" (L, R : UNSIGNED) return BOOLEAN; - function "=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "/=" (L, R : UNSIGNED) return BOOLEAN; - function "/=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "/=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "<" (L, R : UNSIGNED) return BOOLEAN; - function "<" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "<" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "<=" (L, R : UNSIGNED) return BOOLEAN; - function "<=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "<=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function ">" (L, R : UNSIGNED) return BOOLEAN; - function ">" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function ">" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function ">=" (L, R : UNSIGNED) return BOOLEAN; - function ">=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function ">=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - - function "=" (L, R : SIGNED) return BOOLEAN; - function "=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "/=" (L, R : SIGNED) return BOOLEAN; - function "/=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "/=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "<" (L, R : SIGNED) return BOOLEAN; - function "<" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "<" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "<=" (L, R : SIGNED) return BOOLEAN; - function "<=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "<=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function ">" (L, R : SIGNED) return BOOLEAN; - function ">" (L : SIGNED; R : INTEGER) return BOOLEAN; - function ">" (L : INTEGER; R : SIGNED) return BOOLEAN; - function ">=" (L, R : SIGNED) return BOOLEAN; - function ">=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function ">=" (L : INTEGER; R : SIGNED) return BOOLEAN; - -- Issue a warning in case of non-logical value. - - function "-" (ARG : SIGNED) return SIGNED; - -- Compute -ARG. - -- Result index range is Arg'length - 1 downto 0. - - function "abs" (ARG : SIGNED) return SIGNED; - -- Compute abs ARG. - -- Result index range is Arg'length - 1 downto 0. - - function "+" (L, R : UNSIGNED) return UNSIGNED; - function "+" (L, R : SIGNED) return SIGNED; - function "-" (L, R : UNSIGNED) return UNSIGNED; - function "-" (L, R : SIGNED) return SIGNED; - -- Compute L +/- R. - -- Result index range is max (L'Length, R'Length) - 1 downto 0. - -- Issue a warning in case of non-logical value. - - function "+" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "+" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "+" (L : SIGNED; R : INTEGER) return SIGNED; - function "+" (L : INTEGER; R : SIGNED) return SIGNED; - function "-" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "-" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "-" (L : SIGNED; R : INTEGER) return SIGNED; - function "-" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L +/- R. - -- Result index range is V'Length - 1 downto 0, where V is the vector - -- parameter. - -- Issue a warning in case of non-logical value. - -- Issue a warning if value is truncated. - - function "*" (L, R : UNSIGNED) return UNSIGNED; - function "*" (L, R : SIGNED) return SIGNED; - -- Compute L * R - -- Result index range is L'Length + R'Length - 1 downto 0. - - function "*" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "*" (L : SIGNED; R : INTEGER) return SIGNED; - -- Compute L * R - -- R is converted to a vector of length L'length - - function "*" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "*" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L * R - -- L is converted to a vector of length R'length - - function "/" (L, R : UNSIGNED) return UNSIGNED; - function "/" (L, R : SIGNED) return SIGNED; - function "rem" (L, R : UNSIGNED) return UNSIGNED; - function "rem" (L, R : SIGNED) return SIGNED; - function "mod" (L, R : UNSIGNED) return UNSIGNED; - function "mod" (L, R : SIGNED) return SIGNED; - -- Compute L op R - -- Result index range is L'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - - function "/" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "/" (L : SIGNED; R : INTEGER) return SIGNED; - function "rem" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "rem" (L : SIGNED; R : INTEGER) return SIGNED; - function "mod" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "mod" (L : SIGNED; R : INTEGER) return SIGNED; - -- Compute L op R. - -- Result index range is L'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - - function "/" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "/" (L : INTEGER; R : SIGNED) return SIGNED; - function "rem" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "rem" (L : INTEGER; R : SIGNED) return SIGNED; - function "mod" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "mod" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L op R. - -- Result index range is R'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - -- Result may be truncated. - - function "not" (l : UNSIGNED) return UNSIGNED; - function "not" (l : SIGNED) return SIGNED; - function "and" (l, r : UNSIGNED) return UNSIGNED; - function "and" (l, r : SIGNED) return SIGNED; - function "nand" (l, r : UNSIGNED) return UNSIGNED; - function "nand" (l, r : SIGNED) return SIGNED; - function "or" (l, r : UNSIGNED) return UNSIGNED; - function "or" (l, r : SIGNED) return SIGNED; - function "nor" (l, r : UNSIGNED) return UNSIGNED; - function "nor" (l, r : SIGNED) return SIGNED; - function "xor" (l, r : UNSIGNED) return UNSIGNED; - function "xor" (l, r : SIGNED) return SIGNED; ---function "xnor" (l, r : UNSIGNED) return UNSIGNED; ---function "xnor" (l, r : SIGNED) return SIGNED; - -- Compute L OP R. - -- Result index range is L'Length - 1 downto 0. - -- No specific handling of null array: the index range of the result - -- would be -1 downto 0 (without warning). This it not what is specified - -- in 1076.3, but corresponds to the standard implementation. - -- No specific handling of non-logical values. Behaviour is compatible - -- with std_logic_1164. - - function shift_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function shift_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - function shift_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function shift_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - - function rotate_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function rotate_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - function rotate_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function rotate_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - ---function "sll" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; ---function "sll" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; ---function "srl" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; ---function "srl" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - ---function "rol" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; ---function "rol" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; ---function "ror" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; ---function "ror" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - - function rising_edge (signal s : bit) return boolean; - function falling_edge (signal s : bit) return boolean; -end NUMERIC_BIT; diff --git a/libraries/openieee/numeric_bit.v93 b/libraries/openieee/numeric_bit.v93 deleted file mode 100644 index eb21bbc2f..000000000 --- a/libraries/openieee/numeric_bit.v93 +++ /dev/null @@ -1,211 +0,0 @@ --- This -*- vhdl -*- file is part of GHDL. --- IEEE 1076.3 compliant numeric bit package. --- 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 --- . - -package NUMERIC_BIT is - type UNSIGNED is array (natural range <>) of BIT; - type SIGNED is array (natural range <>) of BIT; - - - function TO_INTEGER (ARG : UNSIGNED) return NATURAL; - function TO_INTEGER (ARG : SIGNED) return INTEGER; - -- Convert ARG to an integer. - -- Simulation is aborted in case of overflow. - -- Issue a warning in case of non-logical value. - - function TO_UNSIGNED (ARG, SIZE : NATURAL) return UNSIGNED; - -- Convert ARG to unsigned. - -- Result index range is SIZE - 1 downto 0. - -- Issue a warning if value is truncated. - - function TO_SIGNED (ARG : INTEGER; SIZE : NATURAL) return SIGNED; - -- Convert ARG to signed. - -- Result index range is SIZE - 1 downto 0. - -- Issue a warning if value is truncated. - - function resize (ARG : UNSIGNED; NEW_SIZE: natural) return UNSIGNED; - function resize (ARG : SIGNED; NEW_SIZE: natural) return SIGNED; - -- Result index range is NEW_SIZE - 1 downto 0 (unless null array). - -- For SIGNED, the sign of the result is the sign of ARG. - - function "=" (L, R : UNSIGNED) return BOOLEAN; - function "=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "/=" (L, R : UNSIGNED) return BOOLEAN; - function "/=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "/=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "<" (L, R : UNSIGNED) return BOOLEAN; - function "<" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "<" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "<=" (L, R : UNSIGNED) return BOOLEAN; - function "<=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "<=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function ">" (L, R : UNSIGNED) return BOOLEAN; - function ">" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function ">" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function ">=" (L, R : UNSIGNED) return BOOLEAN; - function ">=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function ">=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - - function "=" (L, R : SIGNED) return BOOLEAN; - function "=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "/=" (L, R : SIGNED) return BOOLEAN; - function "/=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "/=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "<" (L, R : SIGNED) return BOOLEAN; - function "<" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "<" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "<=" (L, R : SIGNED) return BOOLEAN; - function "<=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "<=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function ">" (L, R : SIGNED) return BOOLEAN; - function ">" (L : SIGNED; R : INTEGER) return BOOLEAN; - function ">" (L : INTEGER; R : SIGNED) return BOOLEAN; - function ">=" (L, R : SIGNED) return BOOLEAN; - function ">=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function ">=" (L : INTEGER; R : SIGNED) return BOOLEAN; - -- Issue a warning in case of non-logical value. - - function "-" (ARG : SIGNED) return SIGNED; - -- Compute -ARG. - -- Result index range is Arg'length - 1 downto 0. - - function "abs" (ARG : SIGNED) return SIGNED; - -- Compute abs ARG. - -- Result index range is Arg'length - 1 downto 0. - - function "+" (L, R : UNSIGNED) return UNSIGNED; - function "+" (L, R : SIGNED) return SIGNED; - function "-" (L, R : UNSIGNED) return UNSIGNED; - function "-" (L, R : SIGNED) return SIGNED; - -- Compute L +/- R. - -- Result index range is max (L'Length, R'Length) - 1 downto 0. - -- Issue a warning in case of non-logical value. - - function "+" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "+" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "+" (L : SIGNED; R : INTEGER) return SIGNED; - function "+" (L : INTEGER; R : SIGNED) return SIGNED; - function "-" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "-" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "-" (L : SIGNED; R : INTEGER) return SIGNED; - function "-" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L +/- R. - -- Result index range is V'Length - 1 downto 0, where V is the vector - -- parameter. - -- Issue a warning in case of non-logical value. - -- Issue a warning if value is truncated. - - function "*" (L, R : UNSIGNED) return UNSIGNED; - function "*" (L, R : SIGNED) return SIGNED; - -- Compute L * R - -- Result index range is L'Length + R'Length - 1 downto 0. - - function "*" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "*" (L : SIGNED; R : INTEGER) return SIGNED; - -- Compute L * R - -- R is converted to a vector of length L'length - - function "*" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "*" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L * R - -- L is converted to a vector of length R'length - - function "/" (L, R : UNSIGNED) return UNSIGNED; - function "/" (L, R : SIGNED) return SIGNED; - function "rem" (L, R : UNSIGNED) return UNSIGNED; - function "rem" (L, R : SIGNED) return SIGNED; - function "mod" (L, R : UNSIGNED) return UNSIGNED; - function "mod" (L, R : SIGNED) return SIGNED; - -- Compute L op R - -- Result index range is L'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - - function "/" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "/" (L : SIGNED; R : INTEGER) return SIGNED; - function "rem" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "rem" (L : SIGNED; R : INTEGER) return SIGNED; - function "mod" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "mod" (L : SIGNED; R : INTEGER) return SIGNED; - -- Compute L op R. - -- Result index range is L'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - - function "/" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "/" (L : INTEGER; R : SIGNED) return SIGNED; - function "rem" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "rem" (L : INTEGER; R : SIGNED) return SIGNED; - function "mod" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "mod" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L op R. - -- Result index range is R'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - -- Result may be truncated. - - function "not" (l : UNSIGNED) return UNSIGNED; - function "not" (l : SIGNED) return SIGNED; - function "and" (l, r : UNSIGNED) return UNSIGNED; - function "and" (l, r : SIGNED) return SIGNED; - function "nand" (l, r : UNSIGNED) return UNSIGNED; - function "nand" (l, r : SIGNED) return SIGNED; - function "or" (l, r : UNSIGNED) return UNSIGNED; - function "or" (l, r : SIGNED) return SIGNED; - function "nor" (l, r : UNSIGNED) return UNSIGNED; - function "nor" (l, r : SIGNED) return SIGNED; - function "xor" (l, r : UNSIGNED) return UNSIGNED; - function "xor" (l, r : SIGNED) return SIGNED; - function "xnor" (l, r : UNSIGNED) return UNSIGNED; - function "xnor" (l, r : SIGNED) return SIGNED; - -- Compute L OP R. - -- Result index range is L'Length - 1 downto 0. - -- No specific handling of null array: the index range of the result - -- would be -1 downto 0 (without warning). This it not what is specified - -- in 1076.3, but corresponds to the standard implementation. - -- No specific handling of non-logical values. Behaviour is compatible - -- with std_logic_1164. - - function shift_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function shift_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - function shift_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function shift_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - - function rotate_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function rotate_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - function rotate_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function rotate_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - - function "sll" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; - function "sll" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - function "srl" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; - function "srl" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - - function "rol" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; - function "rol" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - function "ror" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; - function "ror" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - - function rising_edge (signal s : bit) return boolean; - function falling_edge (signal s : bit) return boolean; -end NUMERIC_BIT; diff --git a/libraries/openieee/numeric_std-body.v87 b/libraries/openieee/numeric_std-body.v87 deleted file mode 100644 index c716b19f3..000000000 --- a/libraries/openieee/numeric_std-body.v87 +++ /dev/null @@ -1,2899 +0,0 @@ --- 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 --- . - -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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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 ucompare (l, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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; diff --git a/libraries/openieee/numeric_std-body.v93 b/libraries/openieee/numeric_std-body.v93 deleted file mode 100644 index 0625a49f0..000000000 --- a/libraries/openieee/numeric_std-body.v93 +++ /dev/null @@ -1,3071 +0,0 @@ --- 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 --- . - -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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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 "sll" (ARG : UNSIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then - res (res'left downto count) := arg1 (arg1'left - count downto 0); - elsif count < 0 and count >= -arg1'left then - res (res'left + count downto 0) := arg1 (arg1'left downto -count); - end if; - return res; - end "sll"; - - function "srl" (ARG : UNSIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then - res (res'left - count downto 0) := arg1 (arg1'left downto count); - elsif count < 0 and count >= -arg1'left then - res (res'left downto -count) := arg1 (arg1'left + count downto 0); - end if; - return res; - end "srl"; - - function "rol" (ARG : UNSIGNED; COUNT: integer) 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 mod 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 "rol"; - - function "ror" (ARG : UNSIGNED; COUNT: integer) 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 mod 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 "ror"; - - 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; - - function "sll" (ARG : SIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then - res (res'left downto count) := arg1 (arg1'left - count downto 0); - elsif count < 0 and count >= -arg1'left then - res (res'left + count downto 0) := arg1 (arg1'left downto -count); - end if; - return res; - end "sll"; - - function "srl" (ARG : SIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then - res (res'left - count downto 0) := arg1 (arg1'left downto count); - elsif count < 0 and count >= -arg1'left then - res (res'left downto -count) := arg1 (arg1'left + count downto 0); - end if; - return res; - end "srl"; - - function "rol" (ARG : SIGNED; COUNT: integer) 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 mod 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 "rol"; - - function "ror" (ARG : SIGNED; COUNT: integer) 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 mod 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 "ror"; -end NUMERIC_STD; diff --git a/libraries/openieee/numeric_std.v87 b/libraries/openieee/numeric_std.v87 deleted file mode 100644 index e1fa946ca..000000000 --- a/libraries/openieee/numeric_std.v87 +++ /dev/null @@ -1,225 +0,0 @@ --- This -*- vhdl -*- file is part of GHDL. --- IEEE 1076.3 compliant numeric std package. --- 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 --- . - -library IEEE; -use IEEE.STD_LOGIC_1164.all; - -package NUMERIC_STD is - type UNSIGNED is array (natural range <>) of STD_LOGIC; - type SIGNED is array (natural range <>) of STD_LOGIC; - - function TO_01 (S : SIGNED; XMAP : STD_LOGIC := '0') return SIGNED; - function TO_01 (S : UNSIGNED; XMAP : STD_LOGIC := '0') return UNSIGNED; - -- Convert 'H' and '1' to '1', 'L' and '0' to '0'. - -- If any other value is present, return (others => XMAP) - -- Issue a warning in that case, and if S is a null array. - -- Result index range is S'Length - 1 downto 0. - - function std_match (l, r : std_ulogic) return boolean; - function std_match (l, r : std_ulogic_vector) return boolean; - function std_match (l, r : std_logic_vector) return boolean; - function std_match (l, r : UNSIGNED) return boolean; - function std_match (l, r : SIGNED) return boolean; - -- Return True iff L and R matches. - - - function TO_INTEGER (ARG : UNSIGNED) return NATURAL; - function TO_INTEGER (ARG : SIGNED) return INTEGER; - -- Convert ARG to an integer. - -- Simulation is aborted in case of overflow. - -- Issue a warning in case of non-logical value. - - function TO_UNSIGNED (ARG, SIZE : NATURAL) return UNSIGNED; - -- Convert ARG to unsigned. - -- Result index range is SIZE - 1 downto 0. - -- Issue a warning if value is truncated. - - function TO_SIGNED (ARG : INTEGER; SIZE : NATURAL) return SIGNED; - -- Convert ARG to signed. - -- Result index range is SIZE - 1 downto 0. - -- Issue a warning if value is truncated. - - function resize (ARG : UNSIGNED; NEW_SIZE: natural) return UNSIGNED; - function resize (ARG : SIGNED; NEW_SIZE: natural) return SIGNED; - -- Result index range is NEW_SIZE - 1 downto 0 (unless null array). - -- For SIGNED, the sign of the result is the sign of ARG. - - function "=" (L, R : UNSIGNED) return BOOLEAN; - function "=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "/=" (L, R : UNSIGNED) return BOOLEAN; - function "/=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "/=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "<" (L, R : UNSIGNED) return BOOLEAN; - function "<" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "<" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "<=" (L, R : UNSIGNED) return BOOLEAN; - function "<=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "<=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function ">" (L, R : UNSIGNED) return BOOLEAN; - function ">" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function ">" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function ">=" (L, R : UNSIGNED) return BOOLEAN; - function ">=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function ">=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - - function "=" (L, R : SIGNED) return BOOLEAN; - function "=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "/=" (L, R : SIGNED) return BOOLEAN; - function "/=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "/=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "<" (L, R : SIGNED) return BOOLEAN; - function "<" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "<" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "<=" (L, R : SIGNED) return BOOLEAN; - function "<=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "<=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function ">" (L, R : SIGNED) return BOOLEAN; - function ">" (L : SIGNED; R : INTEGER) return BOOLEAN; - function ">" (L : INTEGER; R : SIGNED) return BOOLEAN; - function ">=" (L, R : SIGNED) return BOOLEAN; - function ">=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function ">=" (L : INTEGER; R : SIGNED) return BOOLEAN; - -- Issue a warning in case of non-logical value. - - function "-" (ARG : SIGNED) return SIGNED; - -- Compute -ARG. - -- Result index range is Arg'length - 1 downto 0. - - function "abs" (ARG : SIGNED) return SIGNED; - -- Compute abs ARG. - -- Result index range is Arg'length - 1 downto 0. - - function "+" (L, R : UNSIGNED) return UNSIGNED; - function "+" (L, R : SIGNED) return SIGNED; - function "-" (L, R : UNSIGNED) return UNSIGNED; - function "-" (L, R : SIGNED) return SIGNED; - -- Compute L +/- R. - -- Result index range is max (L'Length, R'Length) - 1 downto 0. - -- Issue a warning in case of non-logical value. - - function "+" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "+" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "+" (L : SIGNED; R : INTEGER) return SIGNED; - function "+" (L : INTEGER; R : SIGNED) return SIGNED; - function "-" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "-" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "-" (L : SIGNED; R : INTEGER) return SIGNED; - function "-" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L +/- R. - -- Result index range is V'Length - 1 downto 0, where V is the vector - -- parameter. - -- Issue a warning in case of non-logical value. - -- Issue a warning if value is truncated. - - function "*" (L, R : UNSIGNED) return UNSIGNED; - function "*" (L, R : SIGNED) return SIGNED; - -- Compute L * R - -- Result index range is L'Length + R'Length - 1 downto 0. - - function "*" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "*" (L : SIGNED; R : INTEGER) return SIGNED; - -- Compute L * R - -- R is converted to a vector of length L'length - - function "*" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "*" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L * R - -- L is converted to a vector of length R'length - - function "/" (L, R : UNSIGNED) return UNSIGNED; - function "/" (L, R : SIGNED) return SIGNED; - function "rem" (L, R : UNSIGNED) return UNSIGNED; - function "rem" (L, R : SIGNED) return SIGNED; - function "mod" (L, R : UNSIGNED) return UNSIGNED; - function "mod" (L, R : SIGNED) return SIGNED; - -- Compute L op R - -- Result index range is L'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - - function "/" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "/" (L : SIGNED; R : INTEGER) return SIGNED; - function "rem" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "rem" (L : SIGNED; R : INTEGER) return SIGNED; - function "mod" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "mod" (L : SIGNED; R : INTEGER) return SIGNED; - -- Compute L op R. - -- Result index range is L'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - - function "/" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "/" (L : INTEGER; R : SIGNED) return SIGNED; - function "rem" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "rem" (L : INTEGER; R : SIGNED) return SIGNED; - function "mod" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "mod" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L op R. - -- Result index range is R'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - -- Result may be truncated. - - function "not" (l : UNSIGNED) return UNSIGNED; - function "not" (l : SIGNED) return SIGNED; - function "and" (l, r : UNSIGNED) return UNSIGNED; - function "and" (l, r : SIGNED) return SIGNED; - function "nand" (l, r : UNSIGNED) return UNSIGNED; - function "nand" (l, r : SIGNED) return SIGNED; - function "or" (l, r : UNSIGNED) return UNSIGNED; - function "or" (l, r : SIGNED) return SIGNED; - function "nor" (l, r : UNSIGNED) return UNSIGNED; - function "nor" (l, r : SIGNED) return SIGNED; - function "xor" (l, r : UNSIGNED) return UNSIGNED; - function "xor" (l, r : SIGNED) return SIGNED; ---function "xnor" (l, r : UNSIGNED) return UNSIGNED; ---function "xnor" (l, r : SIGNED) return SIGNED; - -- Compute L OP R. - -- Result index range is L'Length - 1 downto 0. - -- No specific handling of null array: the index range of the result - -- would be -1 downto 0 (without warning). This it not what is specified - -- in 1076.3, but corresponds to the standard implementation. - -- No specific handling of non-logical values. Behaviour is compatible - -- with std_logic_1164. - - function shift_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function shift_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - function shift_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function shift_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - - function rotate_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function rotate_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - function rotate_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function rotate_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - ---function "sll" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; ---function "sll" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; ---function "srl" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; ---function "srl" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - ---function "rol" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; ---function "rol" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; ---function "ror" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; ---function "ror" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. -end NUMERIC_STD; diff --git a/libraries/openieee/numeric_std.v93 b/libraries/openieee/numeric_std.v93 deleted file mode 100644 index 8f58221ee..000000000 --- a/libraries/openieee/numeric_std.v93 +++ /dev/null @@ -1,225 +0,0 @@ --- This -*- vhdl -*- file is part of GHDL. --- IEEE 1076.3 compliant numeric std package. --- 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 --- . - -library IEEE; -use IEEE.STD_LOGIC_1164.all; - -package NUMERIC_STD is - type UNSIGNED is array (natural range <>) of STD_LOGIC; - type SIGNED is array (natural range <>) of STD_LOGIC; - - function TO_01 (S : SIGNED; XMAP : STD_LOGIC := '0') return SIGNED; - function TO_01 (S : UNSIGNED; XMAP : STD_LOGIC := '0') return UNSIGNED; - -- Convert 'H' and '1' to '1', 'L' and '0' to '0'. - -- If any other value is present, return (others => XMAP) - -- Issue a warning in that case, and if S is a null array. - -- Result index range is S'Length - 1 downto 0. - - function std_match (l, r : std_ulogic) return boolean; - function std_match (l, r : std_ulogic_vector) return boolean; - function std_match (l, r : std_logic_vector) return boolean; - function std_match (l, r : UNSIGNED) return boolean; - function std_match (l, r : SIGNED) return boolean; - -- Return True iff L and R matches. - - - function TO_INTEGER (ARG : UNSIGNED) return NATURAL; - function TO_INTEGER (ARG : SIGNED) return INTEGER; - -- Convert ARG to an integer. - -- Simulation is aborted in case of overflow. - -- Issue a warning in case of non-logical value. - - function TO_UNSIGNED (ARG, SIZE : NATURAL) return UNSIGNED; - -- Convert ARG to unsigned. - -- Result index range is SIZE - 1 downto 0. - -- Issue a warning if value is truncated. - - function TO_SIGNED (ARG : INTEGER; SIZE : NATURAL) return SIGNED; - -- Convert ARG to signed. - -- Result index range is SIZE - 1 downto 0. - -- Issue a warning if value is truncated. - - function resize (ARG : UNSIGNED; NEW_SIZE: natural) return UNSIGNED; - function resize (ARG : SIGNED; NEW_SIZE: natural) return SIGNED; - -- Result index range is NEW_SIZE - 1 downto 0 (unless null array). - -- For SIGNED, the sign of the result is the sign of ARG. - - function "=" (L, R : UNSIGNED) return BOOLEAN; - function "=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "/=" (L, R : UNSIGNED) return BOOLEAN; - function "/=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "/=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "<" (L, R : UNSIGNED) return BOOLEAN; - function "<" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "<" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function "<=" (L, R : UNSIGNED) return BOOLEAN; - function "<=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function "<=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function ">" (L, R : UNSIGNED) return BOOLEAN; - function ">" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function ">" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - function ">=" (L, R : UNSIGNED) return BOOLEAN; - function ">=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; - function ">=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; - - function "=" (L, R : SIGNED) return BOOLEAN; - function "=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "/=" (L, R : SIGNED) return BOOLEAN; - function "/=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "/=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "<" (L, R : SIGNED) return BOOLEAN; - function "<" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "<" (L : INTEGER; R : SIGNED) return BOOLEAN; - function "<=" (L, R : SIGNED) return BOOLEAN; - function "<=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function "<=" (L : INTEGER; R : SIGNED) return BOOLEAN; - function ">" (L, R : SIGNED) return BOOLEAN; - function ">" (L : SIGNED; R : INTEGER) return BOOLEAN; - function ">" (L : INTEGER; R : SIGNED) return BOOLEAN; - function ">=" (L, R : SIGNED) return BOOLEAN; - function ">=" (L : SIGNED; R : INTEGER) return BOOLEAN; - function ">=" (L : INTEGER; R : SIGNED) return BOOLEAN; - -- Issue a warning in case of non-logical value. - - function "-" (ARG : SIGNED) return SIGNED; - -- Compute -ARG. - -- Result index range is Arg'length - 1 downto 0. - - function "abs" (ARG : SIGNED) return SIGNED; - -- Compute abs ARG. - -- Result index range is Arg'length - 1 downto 0. - - function "+" (L, R : UNSIGNED) return UNSIGNED; - function "+" (L, R : SIGNED) return SIGNED; - function "-" (L, R : UNSIGNED) return UNSIGNED; - function "-" (L, R : SIGNED) return SIGNED; - -- Compute L +/- R. - -- Result index range is max (L'Length, R'Length) - 1 downto 0. - -- Issue a warning in case of non-logical value. - - function "+" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "+" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "+" (L : SIGNED; R : INTEGER) return SIGNED; - function "+" (L : INTEGER; R : SIGNED) return SIGNED; - function "-" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "-" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "-" (L : SIGNED; R : INTEGER) return SIGNED; - function "-" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L +/- R. - -- Result index range is V'Length - 1 downto 0, where V is the vector - -- parameter. - -- Issue a warning in case of non-logical value. - -- Issue a warning if value is truncated. - - function "*" (L, R : UNSIGNED) return UNSIGNED; - function "*" (L, R : SIGNED) return SIGNED; - -- Compute L * R - -- Result index range is L'Length + R'Length - 1 downto 0. - - function "*" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "*" (L : SIGNED; R : INTEGER) return SIGNED; - -- Compute L * R - -- R is converted to a vector of length L'length - - function "*" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "*" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L * R - -- L is converted to a vector of length R'length - - function "/" (L, R : UNSIGNED) return UNSIGNED; - function "/" (L, R : SIGNED) return SIGNED; - function "rem" (L, R : UNSIGNED) return UNSIGNED; - function "rem" (L, R : SIGNED) return SIGNED; - function "mod" (L, R : UNSIGNED) return UNSIGNED; - function "mod" (L, R : SIGNED) return SIGNED; - -- Compute L op R - -- Result index range is L'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - - function "/" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "/" (L : SIGNED; R : INTEGER) return SIGNED; - function "rem" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "rem" (L : SIGNED; R : INTEGER) return SIGNED; - function "mod" (L : UNSIGNED; R : NATURAL) return UNSIGNED; - function "mod" (L : SIGNED; R : INTEGER) return SIGNED; - -- Compute L op R. - -- Result index range is L'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - - function "/" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "/" (L : INTEGER; R : SIGNED) return SIGNED; - function "rem" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "rem" (L : INTEGER; R : SIGNED) return SIGNED; - function "mod" (L : NATURAL; R : UNSIGNED) return UNSIGNED; - function "mod" (L : INTEGER; R : SIGNED) return SIGNED; - -- Compute L op R. - -- Result index range is R'Length - 1 downto 0. - -- Issue a warning in case of non-logical value. - -- Issue an error if R is 0. - -- Result may be truncated. - - function "not" (l : UNSIGNED) return UNSIGNED; - function "not" (l : SIGNED) return SIGNED; - function "and" (l, r : UNSIGNED) return UNSIGNED; - function "and" (l, r : SIGNED) return SIGNED; - function "nand" (l, r : UNSIGNED) return UNSIGNED; - function "nand" (l, r : SIGNED) return SIGNED; - function "or" (l, r : UNSIGNED) return UNSIGNED; - function "or" (l, r : SIGNED) return SIGNED; - function "nor" (l, r : UNSIGNED) return UNSIGNED; - function "nor" (l, r : SIGNED) return SIGNED; - function "xor" (l, r : UNSIGNED) return UNSIGNED; - function "xor" (l, r : SIGNED) return SIGNED; - function "xnor" (l, r : UNSIGNED) return UNSIGNED; - function "xnor" (l, r : SIGNED) return SIGNED; - -- Compute L OP R. - -- Result index range is L'Length - 1 downto 0. - -- No specific handling of null array: the index range of the result - -- would be -1 downto 0 (without warning). This it not what is specified - -- in 1076.3, but corresponds to the standard implementation. - -- No specific handling of non-logical values. Behaviour is compatible - -- with std_logic_1164. - - function shift_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function shift_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - function shift_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function shift_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - - function rotate_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function rotate_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - function rotate_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; - function rotate_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - - function "sll" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; - function "sll" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - function "srl" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; - function "srl" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. - - function "rol" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; - function "rol" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - function "ror" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; - function "ror" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; - -- Result index range is ARG'Length - 1 downto 0. -end NUMERIC_STD; diff --git a/libraries/openieee/std_logic_1164-body.v08 b/libraries/openieee/std_logic_1164-body.v08 deleted file mode 100644 index 25e219c2e..000000000 --- a/libraries/openieee/std_logic_1164-body.v08 +++ /dev/null @@ -1,1383 +0,0 @@ --- This -*- vhdl -*- file was generated from std_logic_1164-body.proto --- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only --- on the specifications. This file is part of GHDL. --- 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 --- . - --- This is a template file. To avoid errors and duplication, the python --- script build.py generate most of the bodies. - -package body std_logic_1164 is - - type table_1d is array (std_ulogic) of std_ulogic; - type table_2d is array (std_ulogic, std_ulogic) of std_ulogic; - - constant resolution : table_2d := - -- UX01ZWLH- - ("UUUUUUUUU", -- U - "UXXXXXXXX", -- X - "UX0X0000X", -- 0 - "UXX11111X", -- 1 - "UX01ZWLHX", -- Z - "UX01WWWWX", -- W - "UX01LWLWX", -- L - "UX01HWWHX", -- H - "UXXXXXXXX" -- - - ); - - function resolved (s : std_ulogic_vector) return std_ulogic - is - variable res : std_ulogic := 'Z'; - begin - for I in s'range loop - res := resolution (res, s (I)); - end loop; - return res; - end resolved; - - - constant and_table : table_2d := - -- UX01ZWLH- - ("UU0UUU0UU", -- U - "UX0XXX0XX", -- X - "000000000", -- 0 - "UX01XX01X", -- 1 - "UX0XXX0XX", -- Z - "UX0XXX0XX", -- W - "000000000", -- L - "UX01XX01X", -- H - "UX0XXX0XX" -- - - ); - - constant nand_table : table_2d := - -- UX01ZWLH- - ("UU1UUU1UU", -- U - "UX1XXX1XX", -- X - "111111111", -- 0 - "UX10XX10X", -- 1 - "UX1XXX1XX", -- Z - "UX1XXX1XX", -- W - "111111111", -- L - "UX10XX10X", -- H - "UX1XXX1XX" -- - - ); - - constant or_table : table_2d := - -- UX01ZWLH- - ("UUU1UUU1U", -- U - "UXX1XXX1X", -- X - "UX01XX01X", -- 0 - "111111111", -- 1 - "UXX1XXX1X", -- Z - "UXX1XXX1X", -- W - "UX01XX01X", -- L - "111111111", -- H - "UXX1XXX1X" -- - - ); - - constant nor_table : table_2d := - -- UX01ZWLH- - ("UUU0UUU0U", -- U - "UXX0XXX0X", -- X - "UX10XX10X", -- 0 - "000000000", -- 1 - "UXX0XXX0X", -- Z - "UXX0XXX0X", -- W - "UX10XX10X", -- L - "000000000", -- H - "UXX0XXX0X" -- - - ); - - constant xor_table : table_2d := - -- UX01ZWLH- - ("UUUUUUUUU", -- U - "UXXXXXXXX", -- X - "UX01XX01X", -- 0 - "UX10XX10X", -- 1 - "UXXXXXXXX", -- Z - "UXXXXXXXX", -- W - "UX01XX01X", -- L - "UX10XX10X", -- H - "UXXXXXXXX" -- - - ); - - constant xnor_table : table_2d := - -- UX01ZWLH- - ("UUUUUUUUU", -- U - "UXXXXXXXX", -- X - "UX10XX10X", -- 0 - "UX01XX01X", -- 1 - "UXXXXXXXX", -- Z - "UXXXXXXXX", -- W - "UX10XX10X", -- L - "UX01XX01X", -- H - "UXXXXXXXX" -- - - ); - - constant not_table : table_1d := - -- UX01ZWLH- - "UX10XX10X"; - - - function "and" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return and_table (l, r); - end "and"; - - function "nand" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return nand_table (l, r); - end "nand"; - - function "or" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return or_table (l, r); - end "or"; - - function "nor" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return nor_table (l, r); - end "nor"; - - function "xor" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return xor_table (l, r); - end "xor"; - - function "xnor" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return xnor_table (l, r); - end "xnor"; - - function "not" (l : std_ulogic) return UX01 is - begin - return not_table (l); - end "not"; - - function "and" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'and' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := and_table (la (I), ra (I)); - end loop; - end if; - return res; - end "and"; - - function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'nand' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := nand_table (la (I), ra (I)); - end loop; - end if; - return res; - end "nand"; - - function "or" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'or' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := or_table (la (I), ra (I)); - end loop; - end if; - return res; - end "or"; - - function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'nor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := nor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "nor"; - - function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'xor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := xor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "xor"; - - function "xnor" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'xnor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := xnor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "xnor"; - - function "not" (l : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := not_table (la (I)); - end loop; - return res; - end "not"; - - function "and" (l : std_ulogic_vector; r : std_ulogic) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := and_table (la (I), r); - end loop; - return res; - end "and"; - - function "and" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to r'length); - alias ra : res_type is r; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := and_table (l, ra (I)); - end loop; - return res; - end "and"; - - function "nand" (l : std_ulogic_vector; r : std_ulogic) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := nand_table (la (I), r); - end loop; - return res; - end "nand"; - - function "nand" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to r'length); - alias ra : res_type is r; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := nand_table (l, ra (I)); - end loop; - return res; - end "nand"; - - function "or" (l : std_ulogic_vector; r : std_ulogic) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := or_table (la (I), r); - end loop; - return res; - end "or"; - - function "or" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to r'length); - alias ra : res_type is r; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := or_table (l, ra (I)); - end loop; - return res; - end "or"; - - function "nor" (l : std_ulogic_vector; r : std_ulogic) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := nor_table (la (I), r); - end loop; - return res; - end "nor"; - - function "nor" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to r'length); - alias ra : res_type is r; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := nor_table (l, ra (I)); - end loop; - return res; - end "nor"; - - function "xor" (l : std_ulogic_vector; r : std_ulogic) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := xor_table (la (I), r); - end loop; - return res; - end "xor"; - - function "xor" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to r'length); - alias ra : res_type is r; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := xor_table (l, ra (I)); - end loop; - return res; - end "xor"; - - function "xnor" (l : std_ulogic_vector; r : std_ulogic) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := xnor_table (la (I), r); - end loop; - return res; - end "xnor"; - - function "xnor" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to r'length); - alias ra : res_type is r; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := xnor_table (l, ra (I)); - end loop; - return res; - end "xnor"; - - function "and" (l : std_ulogic_vector) return std_ulogic - is - variable res : std_ulogic := '1'; - begin - for I in l'range loop - res := and_table (l(I), res); - end loop; - return res; - end "and"; - - function "nand" (l : std_ulogic_vector) return std_ulogic - is - variable res : std_ulogic := '1'; - begin - for I in l'range loop - res := nand_table (l(I), res); - end loop; - return res; - end "nand"; - - function "or" (l : std_ulogic_vector) return std_ulogic - is - variable res : std_ulogic := '0'; - begin - for I in l'range loop - res := or_table (l(I), res); - end loop; - return res; - end "or"; - - function "nor" (l : std_ulogic_vector) return std_ulogic - is - variable res : std_ulogic := '0'; - begin - for I in l'range loop - res := nor_table (l(I), res); - end loop; - return res; - end "nor"; - - function "xor" (l : std_ulogic_vector) return std_ulogic - is - variable res : std_ulogic := '0'; - begin - for I in l'range loop - res := xor_table (l(I), res); - end loop; - return res; - end "xor"; - - function "xnor" (l : std_ulogic_vector) return std_ulogic - is - variable res : std_ulogic := '0'; - begin - for I in l'range loop - res := xnor_table (l(I), res); - end loop; - return res; - end "xnor"; - - function "sll" (l : std_ulogic_vector; r : integer) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type := (others => '0'); - begin - if r >= 0 then - res (1 to l'length - r) := la (r + 1 to res'right); - else - res (1 - r to res'right) := la (1 to l'length + r); - end if; - return res; - end "sll"; - - function "srl" (l : std_ulogic_vector; r : integer) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type := (others => '0'); - begin - if r >= 0 then - res (1 + r to res'right) := la (1 to l'length - r); - else - res (1 to l'length + r) := la (r - 1 to res'right); - end if; - return res; - end "srl"; - - function "rol" (l : std_ulogic_vector; r : integer) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - constant rm : integer := r mod l'length; - begin - if r >= 0 then - res (1 to res'right - rm) := la (rm + 1 to la'right); - res (res'right - rm + 1 to res'right) := la (1 to rm); - else - res (1 - rm to res'right) := la (1 to la'right + r); - res (1 to rm) := la (la'right + rm + 1 to la'right); - end if; - return res; - end "rol"; - - function "ror" (l : std_ulogic_vector; r : integer) - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - constant rm : integer := r mod l'length; - begin - if r >= 0 then - res (1 + rm to res'right) := la (1 to la'right - r); - res (1 to rm) := la (la'right - rm + 1 to la'right); - else - res (1 to res'right + rm) := la (rm - 1 to la'right); - res (res'right + rm + 1 to res'right) := la (1 to rm); - end if; - return res; - end "ror"; - - -- Conversion functions. - -- The result range (for vectors) is S'Length - 1 downto 0. - -- XMAP is return for values not in '0', '1', 'L', 'H'. - function to_bit (s : std_ulogic; xmap : bit := '0') return bit is - begin - case s is - when '0' | 'L' => - return '0'; - when '1' | 'H' => - return '1'; - when others => - return xmap; - end case; - end to_bit; - - type bit_to_std_table is array (bit) of std_ulogic; - constant bit_to_std : bit_to_std_table := "01"; - - - function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') - return bit_vector - is - subtype res_range is natural range s'length - 1 downto 0; - alias as : std_ulogic_vector (res_range) is s; - variable res : bit_vector (res_range); - variable b : bit; - begin - for I in res_range loop - -- Inline for efficiency. - case as (I) is - when '0' | 'L' => - b := '0'; - when '1' | 'H' => - b := '1'; - when others => - b := xmap; - end case; - res (I) := b; - end loop; - return res; - end to_bitvector; - - function to_stdulogicvector (b : bit_vector) return std_ulogic_vector is - subtype res_range is natural range b'length - 1 downto 0; - alias ab : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for I in res_range loop - res (I) := bit_to_std (ab (I)); - end loop; - return res; - end to_stdulogicvector; - - function to_stdlogicvector (b : bit_vector) return std_logic_vector is - subtype res_range is natural range b'length - 1 downto 0; - alias ab : bit_vector (res_range) is b; - variable res : std_logic_vector (res_range); - begin - for I in res_range loop - res (I) := bit_to_std (ab (I)); - end loop; - return res; - end to_stdlogicvector; - - function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (s'length - 1 downto 0); - begin - return res_type (s); - end to_stdulogicvector; - - function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (s'length - 1 downto 0); - begin - return res_type (s); - end to_stdlogicvector; - - function to_stdulogic (b : bit) return std_ulogic is - begin - return bit_to_std (b); - end to_stdulogic; - - -- Normalization. - type table_std_x01 is array (std_ulogic) of X01; - constant std_to_x01 : table_std_x01 := ('U' | 'X' | 'Z' | 'W' | '-' => 'X', - '0' | 'L' => '0', - '1' | 'H' => '1'); - - type table_bit_x01 is array (bit) of X01; - constant bit_to_x01 : table_bit_x01 := ('0' => '0', - '1' => '1'); - - - type table_std_x01z is array (std_ulogic) of X01Z; - constant std_to_x01z : table_std_x01z := ('U' | 'X' | 'W' | '-' => 'X', - '0' | 'L' => '0', - '1' | 'H' => '1', - 'Z' => 'Z'); - - type table_std_ux01 is array (std_ulogic) of UX01; - constant std_to_ux01 : table_std_ux01 := ('U' => 'U', - 'X' | 'Z' | 'W' | '-' => 'X', - '0' | 'L' => '0', - '1' | 'H' => '1'); - - - function to_01 (s : std_ulogic_vector; xmap : std_ulogic := '0') - return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (s'length - 1 downto 0); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - case sa(i) is - when '0' | 'L' => res (i) := '0'; - when '1' | 'H' => res (i) := '1'; - when others => return res_type'(others => xmap); - end case; - end loop; - return res; - end to_01; - - function to_01 (s : std_ulogic; xmap : std_ulogic := '0') - return std_ulogic is - begin - case s is - when '0' | 'L' => return '0'; - when '1' | 'H' => return '1'; - when others => return xmap; - end case; - end to_01; - - function to_01 (s : bit_vector; xmap : std_ulogic := '0') - return std_ulogic_vector - is - alias sa : bit_vector(s'length - 1 downto 0) is s; - variable res : std_ulogic_vector (s'length - 1 downto 0); - begin - for i in sa'range loop - res (i) := bit_to_std (sa (i)); - end loop; - return res; - end to_01; - - function to_01 (s : bit; xmap : std_ulogic := '0') - return std_ulogic is - begin - return bit_to_std(s); - end to_01; - - function to_X01 (s : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_x01 (sa (i)); - end loop; - return res; - end to_X01; - - function to_X01 (s : std_ulogic) return X01 is - begin - return std_to_x01 (s); - end to_X01; - - function to_X01 (b : bit_vector) return std_ulogic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_X01; - - function to_X01 (b : bit) return X01 is - begin - return bit_to_x01 (b); - end to_X01; - - function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_x01z (sa (i)); - end loop; - return res; - end to_X01Z; - - function to_X01Z (s : std_ulogic) return X01Z is - begin - return std_to_x01z (s); - end to_X01Z; - - function to_X01Z (b : bit_vector) return std_ulogic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_X01Z; - - function to_X01Z (b : bit) return X01Z is - begin - return bit_to_x01 (b); - end to_X01Z; - - function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_ux01 (sa (i)); - end loop; - return res; - end to_UX01; - - function to_UX01 (s : std_ulogic) return UX01 is - begin - return std_to_ux01 (s); - end to_UX01; - - function to_UX01 (b : bit_vector) return std_ulogic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_UX01; - - function to_UX01 (b : bit) return UX01 is - begin - return bit_to_x01 (b); - end to_UX01; - - function "??" (l : std_ulogic) return boolean is - begin - return l = '1' or l = 'H'; - end "??"; - - function rising_edge (signal s : std_ulogic) return boolean is - begin - return s'event - and to_x01 (s'last_value) = '0' - and to_x01 (s) = '1'; - end rising_edge; - - function falling_edge (signal s : std_ulogic) return boolean is - begin - return s'event - and to_x01 (s'last_value) = '1' - and to_x01 (s) = '0'; - end falling_edge; - - type std_x_array is array (std_ulogic) of boolean; - constant std_x : std_x_array := ('U' | 'X' | 'Z' | 'W' | '-' => true, - '0' | '1' | 'L' | 'H' => false); - - - function is_X (s : std_ulogic_vector) return boolean is - begin - for i in s'range loop - if std_x (s (i)) then - return true; - end if; - end loop; - return false; - end is_X; - - function is_X (s : std_ulogic) return boolean is - begin - return std_x (s); - end is_X; - - function to_ostring (value : std_ulogic_vector) return string - is - alias avalue : std_ulogic_vector(value'length downto 1) is value; - constant len : natural := (value'length + 2) / 3; - variable padded : std_ulogic_vector (len * 3 downto 1); - variable pad : std_ulogic; - variable res : string (len downto 1); - variable c : character; - subtype res_type is string (1 to len); - begin - pad := 'Z' when value (value'left) = 'Z' else '0'; - padded (avalue'range) := to_x01z (value); - padded (padded'left downto avalue'left + 1) := (others => pad); - for i in res'range loop - case padded(i * 3 downto i * 3 - 2) is - when "000" => c := '0'; - when "001" => c := '1'; - when "010" => c := '2'; - when "011" => c := '3'; - when "100" => c := '4'; - when "101" => c := '5'; - when "110" => c := '6'; - when "111" => c := '7'; - when "ZZZ" => c := 'Z'; - when others => c := 'X'; - end case; - res (i) := c; - end loop; - return res_type (res); - end to_ostring; - - function to_hstring (value : std_ulogic_vector) return string - is - alias avalue : std_ulogic_vector(value'length downto 1) is value; - constant len : natural := (value'length + 3) / 4; - variable padded : std_ulogic_vector (len * 4 downto 1); - variable pad : std_ulogic; - variable res : string (len downto 1); - variable c : character; - subtype res_type is string (1 to len); - begin - pad := 'Z' when value (value'left) = 'Z' else '0'; - padded (avalue'range) := to_x01z (value); - padded (padded'left downto avalue'left + 1) := (others => pad); - for i in res'range loop - case padded(i * 4 downto i * 4 - 3) is - when "0000" => c := '0'; - when "0001" => c := '1'; - when "0010" => c := '2'; - when "0011" => c := '3'; - when "0100" => c := '4'; - when "0101" => c := '5'; - when "0110" => c := '6'; - when "0111" => c := '7'; - when "1000" => c := '8'; - when "1001" => c := '9'; - when "1010" => c := 'A'; - when "1011" => c := 'B'; - when "1100" => c := 'C'; - when "1101" => c := 'D'; - when "1110" => c := 'E'; - when "1111" => c := 'F'; - when "ZZZZ" => c := 'Z'; - when others => c := 'X'; - end case; - res (i) := c; - end loop; - return res_type (res); - end to_hstring; - - type sl_to_char_array is array (std_ulogic) of character; - constant sl_to_char : sl_to_char_array := "UX01ZWLH-"; - - procedure write (l : inout line; value : std_ulogic; - justified : side := right; field : width := 0) is - begin - write (l, sl_to_char (value), justified, field); - end write; - - procedure write (l : inout line; value : std_ulogic_vector; - justified : side := right; field : width := 0) is - begin - write (l, to_string (value), justified, field); - end write; - - procedure owrite (l : inout line; value : std_ulogic_vector; - justified : side := right; field : width := 0) is - begin - write (l, to_ostring (value), justified, field); - end owrite; - - procedure hwrite (l : inout line; value : std_ulogic_vector; - justified : side := right; field : width := 0) is - begin - write (l, to_hstring (value), justified, field); - end hwrite; - - constant nbsp : character := character'val (160); - - procedure trim (l : inout line; left : natural) - is - variable nl : line; - begin - if l'ascending then - nl := new string(left to l'right); - nl.all := l(left to l'right); - else - nl := new string(left downto l'right); - nl.all := l(left downto l'right); - end if; - deallocate(l); - l := nl; - end trim; - - procedure read (l: inout line; value: out std_ulogic; good: out boolean) - is - variable p : positive; - variable dir : integer; - begin - good := false; - value := 'U'; - if l = null or l'length = 0 then - -- Return now for empty line. - return; - end if; - - if l'ascending then - dir := 1; - else - dir := -1; - end if; - p := l'left; - loop - case l(p) is - when ' ' | NBSP | HT => - -- Skip blanks. - null; - when 'U' => value := 'U'; exit; - when 'X' => value := 'X'; exit; - when '0' => value := '0'; exit; - when '1' => value := '1'; exit; - when 'Z' => value := 'Z'; exit; - when 'W' => value := 'W'; exit; - when 'L' => value := 'L'; exit; - when 'H' => value := 'H'; exit; - when '-' => value := '-'; exit; - when others => - trim (l, p); - return; - end case; - if p = l'right then - -- End of string. - deallocate(l); - l := new string'(""); - return; - end if; - p := p + dir; - end loop; - - good := true; - trim (l, p + dir); - end read; - - procedure read (l : inout line; value : out std_ulogic) - is - variable good : boolean; - begin - read (l, value, good); - assert good report "std_logic_1164.read(std_ulogic) cannot read value" - severity error; - end read; - - procedure read (l : inout line; - value : out std_ulogic_vector; good : out boolean) - is - variable p : positive; - variable i : natural; - variable dir : integer; - alias av : std_ulogic_vector(1 to value'length) is value; - variable allow_underscore : boolean; - variable c : character; - variable d : std_ulogic; - begin - good := value'length = 0; - value := (value'range => 'U'); - if l = null or l'length = 0 then - -- Return now for empty line. - return; - end if; - - if l'ascending then - dir := 1; - else - dir := -1; - end if; - p := l'left; - - -- Skip blanks. - p := l'left; - loop - case l(p) is - when ' ' | NBSP | HT => - null; - when others => - exit; - end case; - if p = l'right then - -- End of string. - deallocate(l); - l := new string'(""); - return; - end if; - p := p + dir; - end loop; - - if value'length = 0 then - -- Nothing to read. - trim (l, p); - return; - end if; - - -- Extract value - i := 1; - allow_underscore := False; - good := false; - loop - c := l(p); - case c is - when 'U' => d := 'U'; - when 'X' => d := 'X'; - when '0' => d := '0'; - when '1' => d := '1'; - when 'Z' => d := 'Z'; - when 'W' => d := 'W'; - when 'L' => d := 'L'; - when 'H' => d := 'H'; - when '-' => d := '-'; - when others => - if c = '_' and allow_underscore then - allow_underscore := false; - else - -- Invalid character, double or leading '_'. - trim (l, p); - value := (value'range => 'U'); - return; - end if; - end case; - if c /= '_' then - av (i) := d; - allow_underscore := true; - if i = av'right then - -- Done. - good := true; - trim (l, p + dir); - return; - end if; - i := i + 1; - end if; - if p = l'right then - -- End of string. - trim (l, p + dir); - deallocate(l); - l := new string'(""); - value := (value'range => 'U'); - return; - end if; - p := p + dir; - end loop; - end read; - - procedure read (l : inout line; value : out std_ulogic_vector) - is - variable good : boolean; - begin - read (l, value, good); - assert good - report "std_logic_1164.read(std_ulogic_vector) cannot read value" - severity error; - end read; - - procedure hread (l : inout line; - value : out std_ulogic_vector; good : out boolean) - is - variable p : positive; - variable i : natural; - variable dir : integer; - constant ndigits : natural := (value'length + 3) / 4; - variable v : std_ulogic_vector(1 to ndigits * 4); - variable allow_underscore : boolean; - variable c : character; - variable d : std_ulogic_vector (3 downto 0); - begin - good := value'length = 0; - value := (value'range => 'U'); - if l = null or l'length = 0 then - -- Return now for empty line. - return; - end if; - - if l'ascending then - dir := 1; - else - dir := -1; - end if; - p := l'left; - - -- Skip blanks. - p := l'left; - loop - case l(p) is - when ' ' | NBSP | HT => - null; - when others => - exit; - end case; - if p = l'right then - -- End of string. - deallocate(l); - l := new string'(""); - return; - end if; - p := p + dir; - end loop; - - if value'length = 0 then - -- Nothing to read. - trim (l, p); - return; - end if; - - -- Extract value - i := 0; - allow_underscore := False; - good := false; - loop - c := l(p); - case c is - when '0' => d := "0000"; - when '1' => d := "0001"; - when '2' => d := "0010"; - when '3' => d := "0011"; - when '4' => d := "0100"; - when '5' => d := "0101"; - when '6' => d := "0110"; - when '7' => d := "0111"; - when '8' => d := "1000"; - when '9' => d := "1001"; - when 'A' | 'a' => d := "1010"; - when 'B' | 'b' => d := "1011"; - when 'C' | 'c' => d := "1100"; - when 'D' | 'd' => d := "1101"; - when 'E' | 'e' => d := "1110"; - when 'F' | 'f' => d := "1111"; - when 'Z' => d := "ZZZZ"; - when 'X' => d := "XXXX"; - when others => - if c = '_' and allow_underscore then - allow_underscore := false; - else - -- Invalid character, double or leading '_'. - trim (l, p); - return; - end if; - end case; - if c /= '_' then - allow_underscore := true; - v (i * 4 + 1 to i * 4 + 4) := d; - i := i + 1; - if i = ndigits then - -- Done. - if or (v(1 to ndigits * 4 - value'length)) /= '1' then - -- No truncated digit is a '1'. - value := v (ndigits * 4 - value'length + 1 to v'right); - good := true; - end if; - trim (l, p + dir); - return; - end if; - end if; - if p = l'right then - -- End of string. - trim (l, p + dir); - deallocate(l); - l := new string'(""); - return; - end if; - p := p + dir; - end loop; - end hread; - - procedure hread (l : inout line; value : out std_ulogic_vector) - is - variable good : boolean; - begin - hread (l, value, good); - assert good - report "std_logic_1164.hread(std_ulogic_vector) cannot read value" - severity error; - end hread; - - procedure oread (l : inout line; - value : out std_ulogic_vector; good : out boolean) - is - variable p : positive; - variable i : natural; - variable dir : integer; - constant ndigits : natural := (value'length + 2) / 3; - variable v : std_ulogic_vector(1 to ndigits * 3); - variable allow_underscore : boolean; - variable c : character; - variable d : std_ulogic_vector (2 downto 0); - begin - good := value'length = 0; - value := (value'range => 'U'); - if l = null or l'length = 0 then - -- Return now for empty line. - return; - end if; - - if l'ascending then - dir := 1; - else - dir := -1; - end if; - p := l'left; - - -- Skip blanks. - p := l'left; - loop - case l(p) is - when ' ' | NBSP | HT => - null; - when others => - exit; - end case; - if p = l'right then - -- End of string. - deallocate(l); - l := new string'(""); - return; - end if; - p := p + dir; - end loop; - - if value'length = 0 then - -- Nothing to read. - trim (l, p); - return; - end if; - - -- Extract value - i := 0; - allow_underscore := False; - good := false; - loop - c := l(p); - case c is - when '0' => d := "000"; - when '1' => d := "001"; - when '2' => d := "010"; - when '3' => d := "011"; - when '4' => d := "100"; - when '5' => d := "101"; - when '6' => d := "110"; - when '7' => d := "111"; - when 'Z' => d := "ZZZ"; - when 'X' => d := "XXX"; - when others => - if c = '_' and allow_underscore then - allow_underscore := false; - else - -- Invalid character, double or leading '_'. - trim (l, p); - return; - end if; - end case; - if c /= '_' then - allow_underscore := true; - v (i * 3 + 1 to i * 3 + 3) := d; - i := i + 1; - if i = ndigits then - -- Done. - if or (v(1 to ndigits * 3 - value'length)) /= '1' then - -- No truncated digit is a '1'. - value := v (ndigits * 3 - value'length + 1 to v'right); - good := true; - end if; - trim (l, p + dir); - return; - end if; - end if; - if p = l'right then - -- End of string. - trim (l, p + dir); - deallocate(l); - l := new string'(""); - return; - end if; - p := p + dir; - end loop; - end oread; - - procedure oread (l : inout line; value : out std_ulogic_vector) - is - variable good : boolean; - begin - oread (l, value, good); - assert good - report "std_logic_1164.oread(std_ulogic_vector) cannot read value" - severity error; - end oread; - -end std_logic_1164; diff --git a/libraries/openieee/std_logic_1164-body.v87 b/libraries/openieee/std_logic_1164-body.v87 deleted file mode 100644 index b6dd265d0..000000000 --- a/libraries/openieee/std_logic_1164-body.v87 +++ /dev/null @@ -1,713 +0,0 @@ --- This -*- vhdl -*- file was generated from std_logic_1164-body.proto --- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only --- on the specifications. This file is part of GHDL. --- 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 --- . - --- This is a template file. To avoid errors and duplication, the python --- script build.py generate most of the bodies. - -package body std_logic_1164 is - - type table_1d is array (std_ulogic) of std_ulogic; - type table_2d is array (std_ulogic, std_ulogic) of std_ulogic; - - constant resolution : table_2d := - -- UX01ZWLH- - ("UUUUUUUUU", -- U - "UXXXXXXXX", -- X - "UX0X0000X", -- 0 - "UXX11111X", -- 1 - "UX01ZWLHX", -- Z - "UX01WWWWX", -- W - "UX01LWLWX", -- L - "UX01HWWHX", -- H - "UXXXXXXXX" -- - - ); - - function resolved (s : std_ulogic_vector) return std_ulogic - is - variable res : std_ulogic := 'Z'; - begin - for I in s'range loop - res := resolution (res, s (I)); - end loop; - return res; - end resolved; - - - constant and_table : table_2d := - -- UX01ZWLH- - ("UU0UUU0UU", -- U - "UX0XXX0XX", -- X - "000000000", -- 0 - "UX01XX01X", -- 1 - "UX0XXX0XX", -- Z - "UX0XXX0XX", -- W - "000000000", -- L - "UX01XX01X", -- H - "UX0XXX0XX" -- - - ); - - constant nand_table : table_2d := - -- UX01ZWLH- - ("UU1UUU1UU", -- U - "UX1XXX1XX", -- X - "111111111", -- 0 - "UX10XX10X", -- 1 - "UX1XXX1XX", -- Z - "UX1XXX1XX", -- W - "111111111", -- L - "UX10XX10X", -- H - "UX1XXX1XX" -- - - ); - - constant or_table : table_2d := - -- UX01ZWLH- - ("UUU1UUU1U", -- U - "UXX1XXX1X", -- X - "UX01XX01X", -- 0 - "111111111", -- 1 - "UXX1XXX1X", -- Z - "UXX1XXX1X", -- W - "UX01XX01X", -- L - "111111111", -- H - "UXX1XXX1X" -- - - ); - - constant nor_table : table_2d := - -- UX01ZWLH- - ("UUU0UUU0U", -- U - "UXX0XXX0X", -- X - "UX10XX10X", -- 0 - "000000000", -- 1 - "UXX0XXX0X", -- Z - "UXX0XXX0X", -- W - "UX10XX10X", -- L - "000000000", -- H - "UXX0XXX0X" -- - - ); - - constant xor_table : table_2d := - -- UX01ZWLH- - ("UUUUUUUUU", -- U - "UXXXXXXXX", -- X - "UX01XX01X", -- 0 - "UX10XX10X", -- 1 - "UXXXXXXXX", -- Z - "UXXXXXXXX", -- W - "UX01XX01X", -- L - "UX10XX10X", -- H - "UXXXXXXXX" -- - - ); - - constant not_table : table_1d := - -- UX01ZWLH- - "UX10XX10X"; - - - function "and" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return and_table (l, r); - end "and"; - - function "nand" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return nand_table (l, r); - end "nand"; - - function "or" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return or_table (l, r); - end "or"; - - function "nor" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return nor_table (l, r); - end "nor"; - - function "xor" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return xor_table (l, r); - end "xor"; - - function "not" (l : std_ulogic) return UX01 is - begin - return not_table (l); - end "not"; - - function "and" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'and' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := and_table (la (I), ra (I)); - end loop; - end if; - return res; - end "and"; - - function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'nand' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := nand_table (la (I), ra (I)); - end loop; - end if; - return res; - end "nand"; - - function "or" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'or' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := or_table (la (I), ra (I)); - end loop; - end if; - return res; - end "or"; - - function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'nor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := nor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "nor"; - - function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'xor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := xor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "xor"; - - function "not" (l : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := not_table (la (I)); - end loop; - return res; - end "not"; - - function "and" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'and' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := and_table (la (I), ra (I)); - end loop; - end if; - return res; - end "and"; - - function "nand" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'nand' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := nand_table (la (I), ra (I)); - end loop; - end if; - return res; - end "nand"; - - function "or" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'or' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := or_table (la (I), ra (I)); - end loop; - end if; - return res; - end "or"; - - function "nor" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'nor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := nor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "nor"; - - function "xor" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'xor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := xor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "xor"; - - function "not" (l : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := not_table (la (I)); - end loop; - return res; - end "not"; - - -- Conversion functions. - -- The result range (for vectors) is S'Length - 1 downto 0. - -- XMAP is return for values not in '0', '1', 'L', 'H'. - function to_bit (s : std_ulogic; xmap : bit := '0') return bit is - begin - case s is - when '0' | 'L' => - return '0'; - when '1' | 'H' => - return '1'; - when others => - return xmap; - end case; - end to_bit; - - type bit_to_std_table is array (bit) of std_ulogic; - constant bit_to_std : bit_to_std_table := "01"; - - - function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') - return bit_vector - is - subtype res_range is natural range s'length - 1 downto 0; - alias as : std_ulogic_vector (res_range) is s; - variable res : bit_vector (res_range); - variable b : bit; - begin - for I in res_range loop - -- Inline for efficiency. - case as (I) is - when '0' | 'L' => - b := '0'; - when '1' | 'H' => - b := '1'; - when others => - b := xmap; - end case; - res (I) := b; - end loop; - return res; - end to_bitvector; - - function to_bitvector (s : std_logic_vector; xmap : bit := '0') - return bit_vector - is - subtype res_range is natural range s'length - 1 downto 0; - alias as : std_logic_vector (res_range) is s; - variable res : bit_vector (res_range); - variable b : bit; - begin - for I in res_range loop - -- Inline for efficiency. - case as (I) is - when '0' | 'L' => - b := '0'; - when '1' | 'H' => - b := '1'; - when others => - b := xmap; - end case; - res (I) := b; - end loop; - return res; - end to_bitvector; - - function to_stdulogicvector (b : bit_vector) return std_ulogic_vector is - subtype res_range is natural range b'length - 1 downto 0; - alias ab : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for I in res_range loop - res (I) := bit_to_std (ab (I)); - end loop; - return res; - end to_stdulogicvector; - - function to_stdlogicvector (b : bit_vector) return std_logic_vector is - subtype res_range is natural range b'length - 1 downto 0; - alias ab : bit_vector (res_range) is b; - variable res : std_logic_vector (res_range); - begin - for I in res_range loop - res (I) := bit_to_std (ab (I)); - end loop; - return res; - end to_stdlogicvector; - - function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (s'length - 1 downto 0); - begin - return res_type (s); - end to_stdulogicvector; - - function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (s'length - 1 downto 0); - begin - return res_type (s); - end to_stdlogicvector; - - function to_stdulogic (b : bit) return std_ulogic is - begin - return bit_to_std (b); - end to_stdulogic; - - -- Normalization. - type table_std_x01 is array (std_ulogic) of X01; - constant std_to_x01 : table_std_x01 := ('U' | 'X' | 'Z' | 'W' | '-' => 'X', - '0' | 'L' => '0', - '1' | 'H' => '1'); - - type table_bit_x01 is array (bit) of X01; - constant bit_to_x01 : table_bit_x01 := ('0' => '0', - '1' => '1'); - - - type table_std_x01z is array (std_ulogic) of X01Z; - constant std_to_x01z : table_std_x01z := ('U' | 'X' | 'W' | '-' => 'X', - '0' | 'L' => '0', - '1' | 'H' => '1', - 'Z' => 'Z'); - - type table_std_ux01 is array (std_ulogic) of UX01; - constant std_to_ux01 : table_std_ux01 := ('U' => 'U', - 'X' | 'Z' | 'W' | '-' => 'X', - '0' | 'L' => '0', - '1' | 'H' => '1'); - - - function to_X01 (s : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_x01 (sa (i)); - end loop; - return res; - end to_X01; - - function to_X01 (s : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_x01 (sa (i)); - end loop; - return res; - end to_X01; - - function to_X01 (s : std_ulogic) return X01 is - begin - return std_to_x01 (s); - end to_X01; - - function to_X01 (b : bit_vector) return std_ulogic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_X01; - - function to_X01 (b : bit_vector) return std_logic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_logic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_X01; - - function to_X01 (b : bit) return X01 is - begin - return bit_to_x01 (b); - end to_X01; - - function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_x01z (sa (i)); - end loop; - return res; - end to_X01Z; - - function to_X01Z (s : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_x01z (sa (i)); - end loop; - return res; - end to_X01Z; - - function to_X01Z (s : std_ulogic) return X01Z is - begin - return std_to_x01z (s); - end to_X01Z; - - function to_X01Z (b : bit_vector) return std_ulogic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_X01Z; - - function to_X01Z (b : bit_vector) return std_logic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_logic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_X01Z; - - function to_X01Z (b : bit) return X01Z is - begin - return bit_to_x01 (b); - end to_X01Z; - - function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_ux01 (sa (i)); - end loop; - return res; - end to_UX01; - - function to_UX01 (s : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_ux01 (sa (i)); - end loop; - return res; - end to_UX01; - - function to_UX01 (s : std_ulogic) return UX01 is - begin - return std_to_ux01 (s); - end to_UX01; - - function to_UX01 (b : bit_vector) return std_ulogic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_UX01; - - function to_UX01 (b : bit_vector) return std_logic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_logic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_UX01; - - function to_UX01 (b : bit) return UX01 is - begin - return bit_to_x01 (b); - end to_UX01; - - function rising_edge (signal s : std_ulogic) return boolean is - begin - return s'event - and to_x01 (s'last_value) = '0' - and to_x01 (s) = '1'; - end rising_edge; - - function falling_edge (signal s : std_ulogic) return boolean is - begin - return s'event - and to_x01 (s'last_value) = '1' - and to_x01 (s) = '0'; - end falling_edge; - - type std_x_array is array (std_ulogic) of boolean; - constant std_x : std_x_array := ('U' | 'X' | 'Z' | 'W' | '-' => true, - '0' | '1' | 'L' | 'H' => false); - - - function is_X (s : std_ulogic_vector) return boolean is - begin - for i in s'range loop - if std_x (s (i)) then - return true; - end if; - end loop; - return false; - end is_X; - - function is_X (s : std_logic_vector) return boolean is - begin - for i in s'range loop - if std_x (s (i)) then - return true; - end if; - end loop; - return false; - end is_X; - - function is_X (s : std_ulogic) return boolean is - begin - return std_x (s); - end is_X; -end std_logic_1164; diff --git a/libraries/openieee/std_logic_1164-body.v93 b/libraries/openieee/std_logic_1164-body.v93 deleted file mode 100644 index af43ba306..000000000 --- a/libraries/openieee/std_logic_1164-body.v93 +++ /dev/null @@ -1,769 +0,0 @@ --- This -*- vhdl -*- file was generated from std_logic_1164-body.proto --- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only --- on the specifications. This file is part of GHDL. --- 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 --- . - --- This is a template file. To avoid errors and duplication, the python --- script build.py generate most of the bodies. - -package body std_logic_1164 is - - type table_1d is array (std_ulogic) of std_ulogic; - type table_2d is array (std_ulogic, std_ulogic) of std_ulogic; - - constant resolution : table_2d := - -- UX01ZWLH- - ("UUUUUUUUU", -- U - "UXXXXXXXX", -- X - "UX0X0000X", -- 0 - "UXX11111X", -- 1 - "UX01ZWLHX", -- Z - "UX01WWWWX", -- W - "UX01LWLWX", -- L - "UX01HWWHX", -- H - "UXXXXXXXX" -- - - ); - - function resolved (s : std_ulogic_vector) return std_ulogic - is - variable res : std_ulogic := 'Z'; - begin - for I in s'range loop - res := resolution (res, s (I)); - end loop; - return res; - end resolved; - - - constant and_table : table_2d := - -- UX01ZWLH- - ("UU0UUU0UU", -- U - "UX0XXX0XX", -- X - "000000000", -- 0 - "UX01XX01X", -- 1 - "UX0XXX0XX", -- Z - "UX0XXX0XX", -- W - "000000000", -- L - "UX01XX01X", -- H - "UX0XXX0XX" -- - - ); - - constant nand_table : table_2d := - -- UX01ZWLH- - ("UU1UUU1UU", -- U - "UX1XXX1XX", -- X - "111111111", -- 0 - "UX10XX10X", -- 1 - "UX1XXX1XX", -- Z - "UX1XXX1XX", -- W - "111111111", -- L - "UX10XX10X", -- H - "UX1XXX1XX" -- - - ); - - constant or_table : table_2d := - -- UX01ZWLH- - ("UUU1UUU1U", -- U - "UXX1XXX1X", -- X - "UX01XX01X", -- 0 - "111111111", -- 1 - "UXX1XXX1X", -- Z - "UXX1XXX1X", -- W - "UX01XX01X", -- L - "111111111", -- H - "UXX1XXX1X" -- - - ); - - constant nor_table : table_2d := - -- UX01ZWLH- - ("UUU0UUU0U", -- U - "UXX0XXX0X", -- X - "UX10XX10X", -- 0 - "000000000", -- 1 - "UXX0XXX0X", -- Z - "UXX0XXX0X", -- W - "UX10XX10X", -- L - "000000000", -- H - "UXX0XXX0X" -- - - ); - - constant xor_table : table_2d := - -- UX01ZWLH- - ("UUUUUUUUU", -- U - "UXXXXXXXX", -- X - "UX01XX01X", -- 0 - "UX10XX10X", -- 1 - "UXXXXXXXX", -- Z - "UXXXXXXXX", -- W - "UX01XX01X", -- L - "UX10XX10X", -- H - "UXXXXXXXX" -- - - ); - - constant xnor_table : table_2d := - -- UX01ZWLH- - ("UUUUUUUUU", -- U - "UXXXXXXXX", -- X - "UX10XX10X", -- 0 - "UX01XX01X", -- 1 - "UXXXXXXXX", -- Z - "UXXXXXXXX", -- W - "UX10XX10X", -- L - "UX01XX01X", -- H - "UXXXXXXXX" -- - - ); - - constant not_table : table_1d := - -- UX01ZWLH- - "UX10XX10X"; - - - function "and" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return and_table (l, r); - end "and"; - - function "nand" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return nand_table (l, r); - end "nand"; - - function "or" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return or_table (l, r); - end "or"; - - function "nor" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return nor_table (l, r); - end "nor"; - - function "xor" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return xor_table (l, r); - end "xor"; - - function "xnor" (l : std_ulogic; r : std_ulogic) return UX01 is - begin - return xnor_table (l, r); - end "xnor"; - - function "not" (l : std_ulogic) return UX01 is - begin - return not_table (l); - end "not"; - - function "and" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'and' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := and_table (la (I), ra (I)); - end loop; - end if; - return res; - end "and"; - - function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'nand' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := nand_table (la (I), ra (I)); - end loop; - end if; - return res; - end "nand"; - - function "or" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'or' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := or_table (la (I), ra (I)); - end loop; - end if; - return res; - end "or"; - - function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'nor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := nor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "nor"; - - function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'xor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := xor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "xor"; - - function "xnor" (l, r : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_ulogic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'xnor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := xnor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "xnor"; - - function "not" (l : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := not_table (la (I)); - end loop; - return res; - end "not"; - - function "and" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'and' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := and_table (la (I), ra (I)); - end loop; - end if; - return res; - end "and"; - - function "nand" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'nand' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := nand_table (la (I), ra (I)); - end loop; - end if; - return res; - end "nand"; - - function "or" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'or' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := or_table (la (I), ra (I)); - end loop; - end if; - return res; - end "or"; - - function "nor" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'nor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := nor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "nor"; - - function "xor" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'xor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := xor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "xor"; - - function "xnor" (l, r : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - alias ra : std_logic_vector (1 to r'length) is r; - variable res : res_type; - begin - if la'length /= ra'length then - assert false - report "arguments of overloaded 'xnor' operator are not of the same length" - severity failure; - else - for I in res_type'range loop - res (I) := xnor_table (la (I), ra (I)); - end loop; - end if; - return res; - end "xnor"; - - function "not" (l : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to l'length); - alias la : res_type is l; - variable res : res_type; - begin - for I in res_type'range loop - res (I) := not_table (la (I)); - end loop; - return res; - end "not"; - - -- Conversion functions. - -- The result range (for vectors) is S'Length - 1 downto 0. - -- XMAP is return for values not in '0', '1', 'L', 'H'. - function to_bit (s : std_ulogic; xmap : bit := '0') return bit is - begin - case s is - when '0' | 'L' => - return '0'; - when '1' | 'H' => - return '1'; - when others => - return xmap; - end case; - end to_bit; - - type bit_to_std_table is array (bit) of std_ulogic; - constant bit_to_std : bit_to_std_table := "01"; - - - function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') - return bit_vector - is - subtype res_range is natural range s'length - 1 downto 0; - alias as : std_ulogic_vector (res_range) is s; - variable res : bit_vector (res_range); - variable b : bit; - begin - for I in res_range loop - -- Inline for efficiency. - case as (I) is - when '0' | 'L' => - b := '0'; - when '1' | 'H' => - b := '1'; - when others => - b := xmap; - end case; - res (I) := b; - end loop; - return res; - end to_bitvector; - - function to_bitvector (s : std_logic_vector; xmap : bit := '0') - return bit_vector - is - subtype res_range is natural range s'length - 1 downto 0; - alias as : std_logic_vector (res_range) is s; - variable res : bit_vector (res_range); - variable b : bit; - begin - for I in res_range loop - -- Inline for efficiency. - case as (I) is - when '0' | 'L' => - b := '0'; - when '1' | 'H' => - b := '1'; - when others => - b := xmap; - end case; - res (I) := b; - end loop; - return res; - end to_bitvector; - - function to_stdulogicvector (b : bit_vector) return std_ulogic_vector is - subtype res_range is natural range b'length - 1 downto 0; - alias ab : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for I in res_range loop - res (I) := bit_to_std (ab (I)); - end loop; - return res; - end to_stdulogicvector; - - function to_stdlogicvector (b : bit_vector) return std_logic_vector is - subtype res_range is natural range b'length - 1 downto 0; - alias ab : bit_vector (res_range) is b; - variable res : std_logic_vector (res_range); - begin - for I in res_range loop - res (I) := bit_to_std (ab (I)); - end loop; - return res; - end to_stdlogicvector; - - function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (s'length - 1 downto 0); - begin - return res_type (s); - end to_stdulogicvector; - - function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (s'length - 1 downto 0); - begin - return res_type (s); - end to_stdlogicvector; - - function to_stdulogic (b : bit) return std_ulogic is - begin - return bit_to_std (b); - end to_stdulogic; - - -- Normalization. - type table_std_x01 is array (std_ulogic) of X01; - constant std_to_x01 : table_std_x01 := ('U' | 'X' | 'Z' | 'W' | '-' => 'X', - '0' | 'L' => '0', - '1' | 'H' => '1'); - - type table_bit_x01 is array (bit) of X01; - constant bit_to_x01 : table_bit_x01 := ('0' => '0', - '1' => '1'); - - - type table_std_x01z is array (std_ulogic) of X01Z; - constant std_to_x01z : table_std_x01z := ('U' | 'X' | 'W' | '-' => 'X', - '0' | 'L' => '0', - '1' | 'H' => '1', - 'Z' => 'Z'); - - type table_std_ux01 is array (std_ulogic) of UX01; - constant std_to_ux01 : table_std_ux01 := ('U' => 'U', - 'X' | 'Z' | 'W' | '-' => 'X', - '0' | 'L' => '0', - '1' | 'H' => '1'); - - - function to_X01 (s : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_x01 (sa (i)); - end loop; - return res; - end to_X01; - - function to_X01 (s : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_x01 (sa (i)); - end loop; - return res; - end to_X01; - - function to_X01 (s : std_ulogic) return X01 is - begin - return std_to_x01 (s); - end to_X01; - - function to_X01 (b : bit_vector) return std_ulogic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_X01; - - function to_X01 (b : bit_vector) return std_logic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_logic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_X01; - - function to_X01 (b : bit) return X01 is - begin - return bit_to_x01 (b); - end to_X01; - - function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_x01z (sa (i)); - end loop; - return res; - end to_X01Z; - - function to_X01Z (s : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_x01z (sa (i)); - end loop; - return res; - end to_X01Z; - - function to_X01Z (s : std_ulogic) return X01Z is - begin - return std_to_x01z (s); - end to_X01Z; - - function to_X01Z (b : bit_vector) return std_ulogic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_X01Z; - - function to_X01Z (b : bit_vector) return std_logic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_logic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_X01Z; - - function to_X01Z (b : bit) return X01Z is - begin - return bit_to_x01 (b); - end to_X01Z; - - function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector - is - subtype res_type is std_ulogic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_ux01 (sa (i)); - end loop; - return res; - end to_UX01; - - function to_UX01 (s : std_logic_vector) return std_logic_vector - is - subtype res_type is std_logic_vector (1 to s'length); - alias sa : res_type is s; - variable res : res_type; - begin - for i in res_type'range loop - res (i) := std_to_ux01 (sa (i)); - end loop; - return res; - end to_UX01; - - function to_UX01 (s : std_ulogic) return UX01 is - begin - return std_to_ux01 (s); - end to_UX01; - - function to_UX01 (b : bit_vector) return std_ulogic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_ulogic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_UX01; - - function to_UX01 (b : bit_vector) return std_logic_vector - is - subtype res_range is natural range 1 to b'length; - alias ba : bit_vector (res_range) is b; - variable res : std_logic_vector (res_range); - begin - for i in res_range loop - res (i) := bit_to_x01 (ba (i)); - end loop; - return res; - end to_UX01; - - function to_UX01 (b : bit) return UX01 is - begin - return bit_to_x01 (b); - end to_UX01; - - function rising_edge (signal s : std_ulogic) return boolean is - begin - return s'event - and to_x01 (s'last_value) = '0' - and to_x01 (s) = '1'; - end rising_edge; - - function falling_edge (signal s : std_ulogic) return boolean is - begin - return s'event - and to_x01 (s'last_value) = '1' - and to_x01 (s) = '0'; - end falling_edge; - - type std_x_array is array (std_ulogic) of boolean; - constant std_x : std_x_array := ('U' | 'X' | 'Z' | 'W' | '-' => true, - '0' | '1' | 'L' | 'H' => false); - - - function is_X (s : std_ulogic_vector) return boolean is - begin - for i in s'range loop - if std_x (s (i)) then - return true; - end if; - end loop; - return false; - end is_X; - - function is_X (s : std_logic_vector) return boolean is - begin - for i in s'range loop - if std_x (s (i)) then - return true; - end if; - end loop; - return false; - end is_X; - - function is_X (s : std_ulogic) return boolean is - begin - return std_x (s); - end is_X; -end std_logic_1164; diff --git a/libraries/openieee/std_logic_1164.proto b/libraries/openieee/std_logic_1164.proto new file mode 100644 index 000000000..f5828ec6e --- /dev/null +++ b/libraries/openieee/std_logic_1164.proto @@ -0,0 +1,274 @@ +-- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only +-- on the specifications. This file is part of GHDL. +-- 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 +-- . + +use std.textio.all; --V08 + --V08 +package std_logic_1164 is + + -- Unresolved logic state. + type std_ulogic is + ( + 'U', -- Uninitialized, this is also the default value. + 'X', -- Unknown / conflict value (forcing level). + '0', -- 0 (forcing level). + '1', -- 1 (forcing level). + 'Z', -- High impedance. + 'W', -- Unknown / conflict (weak level). + 'L', -- 0 (weak level). + 'H', -- 1 (weak level). + '-' -- Don't care. + ); + + -- Vector of logic state. + type std_ulogic_vector is array (natural range <>) of std_ulogic; + + -- Resolution function. + -- If S is empty, returns 'Z'. + -- If S has one element, return the element. + -- Otherwise, 'U' is the strongest. + -- then 'X' + -- then '0' and '1' + -- then 'W' + -- then 'H' and 'L' + -- then 'Z'. + function resolved (s : std_ulogic_vector) return std_ulogic; + + -- Resolved logic state. + subtype std_logic is resolved std_ulogic; + + -- Vector of std_logic. + type std_logic_vector is array (natural range <>) of std_logic; --!V08 + subtype std_logic_vector is (resolved) std_ulogic_vector; --V08 + + -- Subtypes of std_ulogic. The names give the values. + subtype X01 is resolved std_ulogic range 'X' to '1'; + subtype X01Z is resolved std_ulogic range 'X' to 'Z'; + subtype UX01 is resolved std_ulogic range 'U' to '1'; + subtype UX01Z is resolved std_ulogic range 'U' to 'Z'; + + -- Logical operators. + -- For logical operations, the inputs are first normalized to UX01: + -- 0 and L are normalized to 0, 1 and 1 are normalized to 1, U isnt changed, + -- all other states are normalized to X. + -- Then the classical electric rules are followed. + function "and" (l : std_ulogic; r : std_ulogic) return UX01; + function "nand" (l : std_ulogic; r : std_ulogic) return UX01; + function "or" (l : std_ulogic; r : std_ulogic) return UX01; + function "nor" (l : std_ulogic; r : std_ulogic) return UX01; + function "xor" (l : std_ulogic; r : std_ulogic) return UX01; + function "xnor" (l : std_ulogic; r : std_ulogic) return UX01; --!V87 + function "not" (l : std_ulogic) return UX01; + + -- Logical operators for vectors. + -- An assertion of severity failure fails if the length of L and R aren't + -- equal. The result range is 1 to L'Length. + function "and" (l, r : std_logic_vector) return std_logic_vector; --!V08 + function "nand" (l, r : std_logic_vector) return std_logic_vector; --!V08 + function "or" (l, r : std_logic_vector) return std_logic_vector; --!V08 + function "nor" (l, r : std_logic_vector) return std_logic_vector; --!V08 + function "xor" (l, r : std_logic_vector) return std_logic_vector; --!V08 + function "xnor" (l, r : std_logic_vector) return std_logic_vector; --V93 + function "not" (l : std_logic_vector) return std_logic_vector; --!V08 + + function "and" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "or" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "xnor" (l, r : std_ulogic_vector) return std_ulogic_vector; --!V87 + function "not" (l : std_ulogic_vector) return std_ulogic_vector; + --V08 + function "and" (l : std_ulogic_vector; r : std_ulogic ) --V08 + return std_ulogic_vector; --V08 + function "and" (l : std_ulogic; r : std_ulogic_vector) --V08 + return std_ulogic_vector; --V08 + function "nand" (l : std_ulogic_vector; r : std_ulogic ) --V08 + return std_ulogic_vector; --V08 + function "nand" (l : std_ulogic; r : std_ulogic_vector) --V08 + return std_ulogic_vector; --V08 + function "or" (l : std_ulogic_vector; r : std_ulogic ) --V08 + return std_ulogic_vector; --V08 + function "or" (l : std_ulogic; r : std_ulogic_vector) --V08 + return std_ulogic_vector; --V08 + function "nor" (l : std_ulogic_vector; r : std_ulogic ) --V08 + return std_ulogic_vector; --V08 + function "nor" (l : std_ulogic; r : std_ulogic_vector) --V08 + return std_ulogic_vector; --V08 + function "xor" (l : std_ulogic_vector; r : std_ulogic ) --V08 + return std_ulogic_vector; --V08 + function "xor" (l : std_ulogic; r : std_ulogic_vector) --V08 + return std_ulogic_vector; --V08 + function "xnor" (l : std_ulogic_vector; r : std_ulogic ) --V08 + return std_ulogic_vector; --V08 + function "xnor" (l : std_ulogic; r : std_ulogic_vector) --V08 + return std_ulogic_vector; --V08 + --V08 + function "and" (l : std_ulogic_vector) return std_ulogic; --V08 + function "nand" (l : std_ulogic_vector) return std_ulogic; --V08 + function "or" (l : std_ulogic_vector) return std_ulogic; --V08 + function "nor" (l : std_ulogic_vector) return std_ulogic; --V08 + function "xor" (l : std_ulogic_vector) return std_ulogic; --V08 + function "xnor" (l : std_ulogic_vector) return std_ulogic; --V08 + --V08 + function "sll" (l : std_ulogic_vector; r : integer) --V08 + return std_ulogic_vector; --V08 + function "srl" (l : std_ulogic_vector; r : integer) --V08 + return std_ulogic_vector; --V08 + function "rol" (l : std_ulogic_vector; r : integer) --V08 + return std_ulogic_vector; --V08 + function "ror" (l : std_ulogic_vector; r : integer) --V08 + return std_ulogic_vector; --V08 + + -- Conversion functions. + -- The result range (for vectors) is S'Length - 1 downto 0. + -- XMAP is return for values not in '0', '1', 'L', 'H'. + function to_bit (s : std_ulogic; xmap : bit := '0') return bit; + function to_bitvector (s : std_logic_vector; xmap : bit := '0') --!V08 + return bit_vector; --!V08 + function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') + return bit_vector; + + function to_stdulogic (b : bit) return std_ulogic; + function to_stdlogicvector (b : bit_vector) return std_logic_vector; + function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector; + function to_stdulogicvector (b : bit_vector) return std_ulogic_vector; + function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector; + + alias to_bit_vector is --V08 + to_bitvector[std_ulogic_vector, bit return bit_vector]; --V08 + alias to_bv is --V08 + to_bitvector[std_ulogic_vector, bit return bit_vector]; --V08 + --V08 + alias to_std_logic_vector is --V08 + to_stdlogicvector[bit_vector return std_logic_vector]; --V08 + alias to_slv is --V08 + to_stdlogicvector[bit_vector return std_logic_vector]; --V08 + --V08 + alias to_std_logic_vector is --V08 + to_stdlogicvector[std_ulogic_vector return std_logic_vector]; --V08 + alias to_slv is --V08 + to_stdlogicvector[std_ulogic_vector return std_logic_vector]; --V08 + --V08 + alias to_std_ulogic_vector is --V08 + to_stdulogicvector[bit_vector return std_ulogic_vector]; --V08 + alias to_sulv is --V08 + to_stdulogicvector[bit_vector return std_ulogic_vector]; --V08 + --V08 + alias to_std_ulogic_vector is --V08 + to_stdulogicvector[std_logic_vector return std_ulogic_vector]; --V08 + alias to_sulv is --V08 + to_stdulogicvector[std_logic_vector return std_ulogic_vector]; --V08 + --V08 + -- Normalization. + -- The result range (for vectors) is 1 to S'Length. + function to_01 (s : std_ulogic_vector; xmap : std_ulogic := '0') --V08 + return std_ulogic_vector; --V08 + function to_01 (s : std_ulogic; xmap : std_ulogic := '0') --V08 + return std_ulogic; --V08 + function to_01 (s : bit_vector; xmap : std_ulogic := '0') --V08 + return std_ulogic_vector; --V08 + function to_01 (s : bit; xmap : std_ulogic := '0') --V08 + return std_ulogic; --V08 + --V08 + function to_X01 (s : std_logic_vector) return std_logic_vector; --!V08 + function to_X01 (s : std_ulogic_vector) return std_ulogic_vector; + function to_X01 (s : std_ulogic) return X01; + function to_X01 (b : bit_vector) return std_logic_vector; --!V08 + function to_X01 (b : bit_vector) return std_ulogic_vector; + function to_X01 (b : bit) return X01; + + function to_X01Z (s : std_logic_vector) return std_logic_vector; --!V08 + function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector; + function to_X01Z (s : std_ulogic) return X01Z; + function to_X01Z (b : bit_vector) return std_logic_vector; --!V08 + function to_X01Z (b : bit_vector) return std_ulogic_vector; + function to_X01Z (b : bit) return X01Z; + + function to_UX01 (s : std_logic_vector) return std_logic_vector; --!V08 + function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector; + function to_UX01 (s : std_ulogic) return UX01; + function to_UX01 (b : bit_vector) return std_logic_vector; --!V08 + function to_UX01 (b : bit_vector) return std_ulogic_vector; + function to_UX01 (b : bit) return UX01; + + function "??" (l : std_ulogic) return boolean; --V08 + --V08 + -- Edge detection. + -- An edge is detected in case of event on s, and X01 normalized value + -- rises from 0 to 1 or falls from 1 to 0. + function rising_edge (signal s : std_ulogic) return boolean; + function falling_edge (signal s : std_ulogic) return boolean; + + -- Test for unknown. Only 0, 1, L and H are known values. + function is_X (s : std_ulogic_vector) return boolean; + function is_X (s : std_logic_vector) return boolean; --!V08 + function is_X (s : std_ulogic) return boolean; + --V08 + -- String conversion --V08 + --V08 + alias to_bstring is to_string [std_ulogic_vector return string]; --V08 + alias to_binary_string is to_string [std_ulogic_vector return string]; --V08 + --V08 + function to_ostring (value : std_ulogic_vector) return string; --V08 + alias to_octal_string is to_ostring [std_ulogic_vector return string]; --V08 + --V08 + function to_hstring (value : std_ulogic_vector) return string; --V08 + alias to_hex_string is to_hstring [std_ulogic_vector return string]; --V08 + --V08 + -- Input/output --V08 + --V08 + procedure write (l : inout line; value : std_ulogic; --V08 + justified : side := right; field : width := 0); --V08 + --V08 + procedure write (l : inout line; value : std_ulogic_vector; --V08 + justified : side := right; field : width := 0); --V08 + alias bwrite is write [line, std_ulogic_vector, side, width]; --V08 + alias binary_write is write [line, std_ulogic_vector, side, width]; --V08 + --V08 + procedure owrite (l : inout line; value : std_ulogic_vector; --V08 + justified : side := right; field : width := 0); --V08 + alias octal_write is owrite [line, std_ulogic_vector, side, width]; --V08 + --V08 + procedure hwrite (l : inout line; value : std_ulogic_vector; --V08 + justified : side := right; field : width := 0); --V08 + alias hex_write is hwrite [line, std_ulogic_vector, side, width]; --V08 + --V08 + procedure read (l : inout line; --V08 + value : out std_ulogic; good : out boolean); --V08 + procedure read (l : inout line; value : out std_ulogic); --V08 + --V08 + procedure read (l : inout line; --V08 + value : out std_ulogic_vector; good : out boolean); --V08 + procedure read (l : inout line; value : out std_ulogic_vector); --V08 + alias bread is read [line, std_ulogic_vector, boolean]; --V08 + alias bread is read [line, std_ulogic_vector]; --V08 + alias binary_read is read [line, std_ulogic_vector, boolean]; --V08 + alias binary_read is read [line, std_ulogic_vector]; --V08 + --V08 + procedure hread (l : inout line; --V08 + value : out std_ulogic_vector; good : out boolean); --V08 + procedure hread (l : inout line; value : out std_ulogic_vector); --V08 + alias hex_read is read [line, std_ulogic_vector, boolean]; --V08 + alias hex_read is read [line, std_ulogic_vector]; --V08 + --V08 + procedure oread (l : inout line; --V08 + value : out std_ulogic_vector; good : out boolean); --V08 + procedure oread (l : inout line; value : out std_ulogic_vector); --V08 + alias octal_read is read [line, std_ulogic_vector, boolean]; --V08 + alias octal_read is read [line, std_ulogic_vector]; --V08 +end std_logic_1164; diff --git a/libraries/openieee/std_logic_1164.v08 b/libraries/openieee/std_logic_1164.v08 deleted file mode 100644 index 8271b1b93..000000000 --- a/libraries/openieee/std_logic_1164.v08 +++ /dev/null @@ -1,257 +0,0 @@ --- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only --- on the specifications. This file is part of GHDL. --- 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 --- . - -use std.textio.all; - -package std_logic_1164 is - - -- Unresolved logic state. - type std_ulogic is - ( - 'U', -- Uninitialized, this is also the default value. - 'X', -- Unknown / conflict value (forcing level). - '0', -- 0 (forcing level). - '1', -- 1 (forcing level). - 'Z', -- High impedance. - 'W', -- Unknown / conflict (weak level). - 'L', -- 0 (weak level). - 'H', -- 1 (weak level). - '-' -- Don't care. - ); - - -- Vector of logic state. - type std_ulogic_vector is array (natural range <>) of std_ulogic; - - -- Resolution function. - -- If S is empty, returns 'Z'. - -- If S has one element, return the element. - -- Otherwise, 'U' is the strongest. - -- then 'X' - -- then '0' and '1' - -- then 'W' - -- then 'H' and 'L' - -- then 'Z'. - function resolved (s : std_ulogic_vector) return std_ulogic; - - -- Resolved logic state. - subtype std_logic is resolved std_ulogic; - - -- Vector of std_logic. - subtype std_logic_vector is (resolved) std_ulogic_vector; - - -- Subtypes of std_ulogic. The names give the values. - subtype X01 is resolved std_ulogic range 'X' to '1'; - subtype X01Z is resolved std_ulogic range 'X' to 'Z'; - subtype UX01 is resolved std_ulogic range 'U' to '1'; - subtype UX01Z is resolved std_ulogic range 'U' to 'Z'; - - -- Logical operators. - -- For logical operations, the inputs are first normalized to UX01: - -- 0 and L are normalized to 0, 1 and 1 are normalized to 1, U isnt changed, - -- all other states are normalized to X. - -- Then the classical electric rules are followed. - function "and" (l : std_ulogic; r : std_ulogic) return UX01; - function "nand" (l : std_ulogic; r : std_ulogic) return UX01; - function "or" (l : std_ulogic; r : std_ulogic) return UX01; - function "nor" (l : std_ulogic; r : std_ulogic) return UX01; - function "xor" (l : std_ulogic; r : std_ulogic) return UX01; - function "xnor" (l : std_ulogic; r : std_ulogic) return UX01; - function "not" (l : std_ulogic) return UX01; - - -- Logical operators for vectors. - -- An assertion of severity failure fails if the length of L and R aren't - -- equal. The result range is 1 to L'Length. - - function "and" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "or" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "xnor" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "not" (l : std_ulogic_vector) return std_ulogic_vector; - - function "and" (l : std_ulogic_vector; r : std_ulogic ) - return std_ulogic_vector; - function "and" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector; - function "nand" (l : std_ulogic_vector; r : std_ulogic ) - return std_ulogic_vector; - function "nand" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector; - function "or" (l : std_ulogic_vector; r : std_ulogic ) - return std_ulogic_vector; - function "or" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector; - function "nor" (l : std_ulogic_vector; r : std_ulogic ) - return std_ulogic_vector; - function "nor" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector; - function "xor" (l : std_ulogic_vector; r : std_ulogic ) - return std_ulogic_vector; - function "xor" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector; - function "xnor" (l : std_ulogic_vector; r : std_ulogic ) - return std_ulogic_vector; - function "xnor" (l : std_ulogic; r : std_ulogic_vector) - return std_ulogic_vector; - - function "and" (l : std_ulogic_vector) return std_ulogic; - function "nand" (l : std_ulogic_vector) return std_ulogic; - function "or" (l : std_ulogic_vector) return std_ulogic; - function "nor" (l : std_ulogic_vector) return std_ulogic; - function "xor" (l : std_ulogic_vector) return std_ulogic; - function "xnor" (l : std_ulogic_vector) return std_ulogic; - - function "sll" (l : std_ulogic_vector; r : integer) - return std_ulogic_vector; - function "srl" (l : std_ulogic_vector; r : integer) - return std_ulogic_vector; - function "rol" (l : std_ulogic_vector; r : integer) - return std_ulogic_vector; - function "ror" (l : std_ulogic_vector; r : integer) - return std_ulogic_vector; - - -- Conversion functions. - -- The result range (for vectors) is S'Length - 1 downto 0. - -- XMAP is return for values not in '0', '1', 'L', 'H'. - function to_bit (s : std_ulogic; xmap : bit := '0') return bit; - function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') - return bit_vector; - - function to_stdulogic (b : bit) return std_ulogic; - function to_stdlogicvector (b : bit_vector) return std_logic_vector; - function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector; - function to_stdulogicvector (b : bit_vector) return std_ulogic_vector; - function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector; - - alias to_bit_vector is - to_bitvector[std_ulogic_vector, bit return bit_vector]; - alias to_bv is - to_bitvector[std_ulogic_vector, bit return bit_vector]; - - alias to_std_logic_vector is - to_stdlogicvector[bit_vector return std_logic_vector]; - alias to_slv is - to_stdlogicvector[bit_vector return std_logic_vector]; - - alias to_std_logic_vector is - to_stdlogicvector[std_ulogic_vector return std_logic_vector]; - alias to_slv is - to_stdlogicvector[std_ulogic_vector return std_logic_vector]; - - alias to_std_ulogic_vector is - to_stdulogicvector[bit_vector return std_ulogic_vector]; - alias to_sulv is - to_stdulogicvector[bit_vector return std_ulogic_vector]; - - alias to_std_ulogic_vector is - to_stdulogicvector[std_logic_vector return std_ulogic_vector]; - alias to_sulv is - to_stdulogicvector[std_logic_vector return std_ulogic_vector]; - - -- Normalization. - -- The result range (for vectors) is 1 to S'Length. - function to_01 (s : std_ulogic_vector; xmap : std_ulogic := '0') - return std_ulogic_vector; - function to_01 (s : std_ulogic; xmap : std_ulogic := '0') - return std_ulogic; - function to_01 (s : bit_vector; xmap : std_ulogic := '0') - return std_ulogic_vector; - function to_01 (s : bit; xmap : std_ulogic := '0') - return std_ulogic; - - function to_X01 (s : std_ulogic_vector) return std_ulogic_vector; - function to_X01 (s : std_ulogic) return X01; - function to_X01 (b : bit_vector) return std_ulogic_vector; - function to_X01 (b : bit) return X01; - - function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector; - function to_X01Z (s : std_ulogic) return X01Z; - function to_X01Z (b : bit_vector) return std_ulogic_vector; - function to_X01Z (b : bit) return X01Z; - - function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector; - function to_UX01 (s : std_ulogic) return UX01; - function to_UX01 (b : bit_vector) return std_ulogic_vector; - function to_UX01 (b : bit) return UX01; - - function "??" (l : std_ulogic) return boolean; - - -- Edge detection. - -- An edge is detected in case of event on s, and X01 normalized value - -- rises from 0 to 1 or falls from 1 to 0. - function rising_edge (signal s : std_ulogic) return boolean; - function falling_edge (signal s : std_ulogic) return boolean; - - -- Test for unknown. Only 0, 1, L and H are known values. - function is_X (s : std_ulogic_vector) return boolean; - function is_X (s : std_ulogic) return boolean; - - -- String conversion - - alias to_bstring is to_string [std_ulogic_vector return string]; - alias to_binary_string is to_string [std_ulogic_vector return string]; - - function to_ostring (value : std_ulogic_vector) return string; - alias to_octal_string is to_ostring [std_ulogic_vector return string]; - - function to_hstring (value : std_ulogic_vector) return string; - alias to_hex_string is to_hstring [std_ulogic_vector return string]; - - -- Input/output - - procedure write (l : inout line; value : std_ulogic; - justified : side := right; field : width := 0); - - procedure write (l : inout line; value : std_ulogic_vector; - justified : side := right; field : width := 0); - alias bwrite is write [line, std_ulogic_vector, side, width]; - alias binary_write is write [line, std_ulogic_vector, side, width]; - - procedure owrite (l : inout line; value : std_ulogic_vector; - justified : side := right; field : width := 0); - alias octal_write is owrite [line, std_ulogic_vector, side, width]; - - procedure hwrite (l : inout line; value : std_ulogic_vector; - justified : side := right; field : width := 0); - alias hex_write is hwrite [line, std_ulogic_vector, side, width]; - - procedure read (l : inout line; - value : out std_ulogic; good : out boolean); - procedure read (l : inout line; value : out std_ulogic); - - procedure read (l : inout line; - value : out std_ulogic_vector; good : out boolean); - procedure read (l : inout line; value : out std_ulogic_vector); - alias bread is read [line, std_ulogic_vector, boolean]; - alias bread is read [line, std_ulogic_vector]; - alias binary_read is read [line, std_ulogic_vector, boolean]; - alias binary_read is read [line, std_ulogic_vector]; - - procedure hread (l : inout line; - value : out std_ulogic_vector; good : out boolean); - procedure hread (l : inout line; value : out std_ulogic_vector); - alias hex_read is read [line, std_ulogic_vector, boolean]; - alias hex_read is read [line, std_ulogic_vector]; - - procedure oread (l : inout line; - value : out std_ulogic_vector; good : out boolean); - procedure oread (l : inout line; value : out std_ulogic_vector); - alias octal_read is read [line, std_ulogic_vector, boolean]; - alias octal_read is read [line, std_ulogic_vector]; -end std_logic_1164; diff --git a/libraries/openieee/std_logic_1164.v87 b/libraries/openieee/std_logic_1164.v87 deleted file mode 100644 index 67e63dac5..000000000 --- a/libraries/openieee/std_logic_1164.v87 +++ /dev/null @@ -1,138 +0,0 @@ --- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only --- on the specifications. This file is part of GHDL. --- 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 --- . - -package std_logic_1164 is - - -- Unresolved logic state. - type std_ulogic is - ( - 'U', -- Uninitialized, this is also the default value. - 'X', -- Unknown / conflict value (forcing level). - '0', -- 0 (forcing level). - '1', -- 1 (forcing level). - 'Z', -- High impedance. - 'W', -- Unknown / conflict (weak level). - 'L', -- 0 (weak level). - 'H', -- 1 (weak level). - '-' -- Don't care. - ); - - -- Vector of logic state. - type std_ulogic_vector is array (natural range <>) of std_ulogic; - - -- Resolution function. - -- If S is empty, returns 'Z'. - -- If S has one element, return the element. - -- Otherwise, 'U' is the strongest. - -- then 'X' - -- then '0' and '1' - -- then 'W' - -- then 'H' and 'L' - -- then 'Z'. - function resolved (s : std_ulogic_vector) return std_ulogic; - - -- Resolved logic state. - subtype std_logic is resolved std_ulogic; - - -- Vector of std_logic. - type std_logic_vector is array (natural range <>) of std_logic; - - -- Subtypes of std_ulogic. The names give the values. - subtype X01 is resolved std_ulogic range 'X' to '1'; - subtype X01Z is resolved std_ulogic range 'X' to 'Z'; - subtype UX01 is resolved std_ulogic range 'U' to '1'; - subtype UX01Z is resolved std_ulogic range 'U' to 'Z'; - - -- Logical operators. - -- For logical operations, the inputs are first normalized to UX01: - -- 0 and L are normalized to 0, 1 and 1 are normalized to 1, U isnt changed, - -- all other states are normalized to X. - -- Then the classical electric rules are followed. - function "and" (l : std_ulogic; r : std_ulogic) return UX01; - function "nand" (l : std_ulogic; r : std_ulogic) return UX01; - function "or" (l : std_ulogic; r : std_ulogic) return UX01; - function "nor" (l : std_ulogic; r : std_ulogic) return UX01; - function "xor" (l : std_ulogic; r : std_ulogic) return UX01; - function "not" (l : std_ulogic) return UX01; - - -- Logical operators for vectors. - -- An assertion of severity failure fails if the length of L and R aren't - -- equal. The result range is 1 to L'Length. - function "and" (l, r : std_logic_vector) return std_logic_vector; - function "nand" (l, r : std_logic_vector) return std_logic_vector; - function "or" (l, r : std_logic_vector) return std_logic_vector; - function "nor" (l, r : std_logic_vector) return std_logic_vector; - function "xor" (l, r : std_logic_vector) return std_logic_vector; - function "not" (l : std_logic_vector) return std_logic_vector; - - function "and" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "or" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "not" (l : std_ulogic_vector) return std_ulogic_vector; - - -- Conversion functions. - -- The result range (for vectors) is S'Length - 1 downto 0. - -- XMAP is return for values not in '0', '1', 'L', 'H'. - function to_bit (s : std_ulogic; xmap : bit := '0') return bit; - function to_bitvector (s : std_logic_vector; xmap : bit := '0') - return bit_vector; - function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') - return bit_vector; - - function to_stdulogic (b : bit) return std_ulogic; - function to_stdlogicvector (b : bit_vector) return std_logic_vector; - function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector; - function to_stdulogicvector (b : bit_vector) return std_ulogic_vector; - function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector; - - -- Normalization. - -- The result range (for vectors) is 1 to S'Length. - function to_X01 (s : std_logic_vector) return std_logic_vector; - function to_X01 (s : std_ulogic_vector) return std_ulogic_vector; - function to_X01 (s : std_ulogic) return X01; - function to_X01 (b : bit_vector) return std_logic_vector; - function to_X01 (b : bit_vector) return std_ulogic_vector; - function to_X01 (b : bit) return X01; - - function to_X01Z (s : std_logic_vector) return std_logic_vector; - function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector; - function to_X01Z (s : std_ulogic) return X01Z; - function to_X01Z (b : bit_vector) return std_logic_vector; - function to_X01Z (b : bit_vector) return std_ulogic_vector; - function to_X01Z (b : bit) return X01Z; - - function to_UX01 (s : std_logic_vector) return std_logic_vector; - function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector; - function to_UX01 (s : std_ulogic) return UX01; - function to_UX01 (b : bit_vector) return std_logic_vector; - function to_UX01 (b : bit_vector) return std_ulogic_vector; - function to_UX01 (b : bit) return UX01; - - -- Edge detection. - -- An edge is detected in case of event on s, and X01 normalized value - -- rises from 0 to 1 or falls from 1 to 0. - function rising_edge (signal s : std_ulogic) return boolean; - function falling_edge (signal s : std_ulogic) return boolean; - - -- Test for unknown. Only 0, 1, L and H are known values. - function is_X (s : std_ulogic_vector) return boolean; - function is_X (s : std_logic_vector) return boolean; - function is_X (s : std_ulogic) return boolean; -end std_logic_1164; diff --git a/libraries/openieee/std_logic_1164.v93 b/libraries/openieee/std_logic_1164.v93 deleted file mode 100644 index 879a7870b..000000000 --- a/libraries/openieee/std_logic_1164.v93 +++ /dev/null @@ -1,141 +0,0 @@ --- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only --- on the specifications. This file is part of GHDL. --- 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 --- . - -package std_logic_1164 is - - -- Unresolved logic state. - type std_ulogic is - ( - 'U', -- Uninitialized, this is also the default value. - 'X', -- Unknown / conflict value (forcing level). - '0', -- 0 (forcing level). - '1', -- 1 (forcing level). - 'Z', -- High impedance. - 'W', -- Unknown / conflict (weak level). - 'L', -- 0 (weak level). - 'H', -- 1 (weak level). - '-' -- Don't care. - ); - - -- Vector of logic state. - type std_ulogic_vector is array (natural range <>) of std_ulogic; - - -- Resolution function. - -- If S is empty, returns 'Z'. - -- If S has one element, return the element. - -- Otherwise, 'U' is the strongest. - -- then 'X' - -- then '0' and '1' - -- then 'W' - -- then 'H' and 'L' - -- then 'Z'. - function resolved (s : std_ulogic_vector) return std_ulogic; - - -- Resolved logic state. - subtype std_logic is resolved std_ulogic; - - -- Vector of std_logic. - type std_logic_vector is array (natural range <>) of std_logic; - - -- Subtypes of std_ulogic. The names give the values. - subtype X01 is resolved std_ulogic range 'X' to '1'; - subtype X01Z is resolved std_ulogic range 'X' to 'Z'; - subtype UX01 is resolved std_ulogic range 'U' to '1'; - subtype UX01Z is resolved std_ulogic range 'U' to 'Z'; - - -- Logical operators. - -- For logical operations, the inputs are first normalized to UX01: - -- 0 and L are normalized to 0, 1 and 1 are normalized to 1, U isnt changed, - -- all other states are normalized to X. - -- Then the classical electric rules are followed. - function "and" (l : std_ulogic; r : std_ulogic) return UX01; - function "nand" (l : std_ulogic; r : std_ulogic) return UX01; - function "or" (l : std_ulogic; r : std_ulogic) return UX01; - function "nor" (l : std_ulogic; r : std_ulogic) return UX01; - function "xor" (l : std_ulogic; r : std_ulogic) return UX01; - function "xnor" (l : std_ulogic; r : std_ulogic) return UX01; - function "not" (l : std_ulogic) return UX01; - - -- Logical operators for vectors. - -- An assertion of severity failure fails if the length of L and R aren't - -- equal. The result range is 1 to L'Length. - function "and" (l, r : std_logic_vector) return std_logic_vector; - function "nand" (l, r : std_logic_vector) return std_logic_vector; - function "or" (l, r : std_logic_vector) return std_logic_vector; - function "nor" (l, r : std_logic_vector) return std_logic_vector; - function "xor" (l, r : std_logic_vector) return std_logic_vector; - function "xnor" (l, r : std_logic_vector) return std_logic_vector; - function "not" (l : std_logic_vector) return std_logic_vector; - - function "and" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "or" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "xnor" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "not" (l : std_ulogic_vector) return std_ulogic_vector; - - -- Conversion functions. - -- The result range (for vectors) is S'Length - 1 downto 0. - -- XMAP is return for values not in '0', '1', 'L', 'H'. - function to_bit (s : std_ulogic; xmap : bit := '0') return bit; - function to_bitvector (s : std_logic_vector; xmap : bit := '0') - return bit_vector; - function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') - return bit_vector; - - function to_stdulogic (b : bit) return std_ulogic; - function to_stdlogicvector (b : bit_vector) return std_logic_vector; - function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector; - function to_stdulogicvector (b : bit_vector) return std_ulogic_vector; - function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector; - - -- Normalization. - -- The result range (for vectors) is 1 to S'Length. - function to_X01 (s : std_logic_vector) return std_logic_vector; - function to_X01 (s : std_ulogic_vector) return std_ulogic_vector; - function to_X01 (s : std_ulogic) return X01; - function to_X01 (b : bit_vector) return std_logic_vector; - function to_X01 (b : bit_vector) return std_ulogic_vector; - function to_X01 (b : bit) return X01; - - function to_X01Z (s : std_logic_vector) return std_logic_vector; - function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector; - function to_X01Z (s : std_ulogic) return X01Z; - function to_X01Z (b : bit_vector) return std_logic_vector; - function to_X01Z (b : bit_vector) return std_ulogic_vector; - function to_X01Z (b : bit) return X01Z; - - function to_UX01 (s : std_logic_vector) return std_logic_vector; - function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector; - function to_UX01 (s : std_ulogic) return UX01; - function to_UX01 (b : bit_vector) return std_logic_vector; - function to_UX01 (b : bit_vector) return std_ulogic_vector; - function to_UX01 (b : bit) return UX01; - - -- Edge detection. - -- An edge is detected in case of event on s, and X01 normalized value - -- rises from 0 to 1 or falls from 1 to 0. - function rising_edge (signal s : std_ulogic) return boolean; - function falling_edge (signal s : std_ulogic) return boolean; - - -- Test for unknown. Only 0, 1, L and H are known values. - function is_X (s : std_ulogic_vector) return boolean; - function is_X (s : std_logic_vector) return boolean; - function is_X (s : std_ulogic) return boolean; -end std_logic_1164; diff --git a/libraries/openieee/std_logic_1164.vhdl b/libraries/openieee/std_logic_1164.vhdl deleted file mode 100644 index f5828ec6e..000000000 --- a/libraries/openieee/std_logic_1164.vhdl +++ /dev/null @@ -1,274 +0,0 @@ --- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only --- on the specifications. This file is part of GHDL. --- 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 --- . - -use std.textio.all; --V08 - --V08 -package std_logic_1164 is - - -- Unresolved logic state. - type std_ulogic is - ( - 'U', -- Uninitialized, this is also the default value. - 'X', -- Unknown / conflict value (forcing level). - '0', -- 0 (forcing level). - '1', -- 1 (forcing level). - 'Z', -- High impedance. - 'W', -- Unknown / conflict (weak level). - 'L', -- 0 (weak level). - 'H', -- 1 (weak level). - '-' -- Don't care. - ); - - -- Vector of logic state. - type std_ulogic_vector is array (natural range <>) of std_ulogic; - - -- Resolution function. - -- If S is empty, returns 'Z'. - -- If S has one element, return the element. - -- Otherwise, 'U' is the strongest. - -- then 'X' - -- then '0' and '1' - -- then 'W' - -- then 'H' and 'L' - -- then 'Z'. - function resolved (s : std_ulogic_vector) return std_ulogic; - - -- Resolved logic state. - subtype std_logic is resolved std_ulogic; - - -- Vector of std_logic. - type std_logic_vector is array (natural range <>) of std_logic; --!V08 - subtype std_logic_vector is (resolved) std_ulogic_vector; --V08 - - -- Subtypes of std_ulogic. The names give the values. - subtype X01 is resolved std_ulogic range 'X' to '1'; - subtype X01Z is resolved std_ulogic range 'X' to 'Z'; - subtype UX01 is resolved std_ulogic range 'U' to '1'; - subtype UX01Z is resolved std_ulogic range 'U' to 'Z'; - - -- Logical operators. - -- For logical operations, the inputs are first normalized to UX01: - -- 0 and L are normalized to 0, 1 and 1 are normalized to 1, U isnt changed, - -- all other states are normalized to X. - -- Then the classical electric rules are followed. - function "and" (l : std_ulogic; r : std_ulogic) return UX01; - function "nand" (l : std_ulogic; r : std_ulogic) return UX01; - function "or" (l : std_ulogic; r : std_ulogic) return UX01; - function "nor" (l : std_ulogic; r : std_ulogic) return UX01; - function "xor" (l : std_ulogic; r : std_ulogic) return UX01; - function "xnor" (l : std_ulogic; r : std_ulogic) return UX01; --!V87 - function "not" (l : std_ulogic) return UX01; - - -- Logical operators for vectors. - -- An assertion of severity failure fails if the length of L and R aren't - -- equal. The result range is 1 to L'Length. - function "and" (l, r : std_logic_vector) return std_logic_vector; --!V08 - function "nand" (l, r : std_logic_vector) return std_logic_vector; --!V08 - function "or" (l, r : std_logic_vector) return std_logic_vector; --!V08 - function "nor" (l, r : std_logic_vector) return std_logic_vector; --!V08 - function "xor" (l, r : std_logic_vector) return std_logic_vector; --!V08 - function "xnor" (l, r : std_logic_vector) return std_logic_vector; --V93 - function "not" (l : std_logic_vector) return std_logic_vector; --!V08 - - function "and" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "or" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector; - function "xnor" (l, r : std_ulogic_vector) return std_ulogic_vector; --!V87 - function "not" (l : std_ulogic_vector) return std_ulogic_vector; - --V08 - function "and" (l : std_ulogic_vector; r : std_ulogic ) --V08 - return std_ulogic_vector; --V08 - function "and" (l : std_ulogic; r : std_ulogic_vector) --V08 - return std_ulogic_vector; --V08 - function "nand" (l : std_ulogic_vector; r : std_ulogic ) --V08 - return std_ulogic_vector; --V08 - function "nand" (l : std_ulogic; r : std_ulogic_vector) --V08 - return std_ulogic_vector; --V08 - function "or" (l : std_ulogic_vector; r : std_ulogic ) --V08 - return std_ulogic_vector; --V08 - function "or" (l : std_ulogic; r : std_ulogic_vector) --V08 - return std_ulogic_vector; --V08 - function "nor" (l : std_ulogic_vector; r : std_ulogic ) --V08 - return std_ulogic_vector; --V08 - function "nor" (l : std_ulogic; r : std_ulogic_vector) --V08 - return std_ulogic_vector; --V08 - function "xor" (l : std_ulogic_vector; r : std_ulogic ) --V08 - return std_ulogic_vector; --V08 - function "xor" (l : std_ulogic; r : std_ulogic_vector) --V08 - return std_ulogic_vector; --V08 - function "xnor" (l : std_ulogic_vector; r : std_ulogic ) --V08 - return std_ulogic_vector; --V08 - function "xnor" (l : std_ulogic; r : std_ulogic_vector) --V08 - return std_ulogic_vector; --V08 - --V08 - function "and" (l : std_ulogic_vector) return std_ulogic; --V08 - function "nand" (l : std_ulogic_vector) return std_ulogic; --V08 - function "or" (l : std_ulogic_vector) return std_ulogic; --V08 - function "nor" (l : std_ulogic_vector) return std_ulogic; --V08 - function "xor" (l : std_ulogic_vector) return std_ulogic; --V08 - function "xnor" (l : std_ulogic_vector) return std_ulogic; --V08 - --V08 - function "sll" (l : std_ulogic_vector; r : integer) --V08 - return std_ulogic_vector; --V08 - function "srl" (l : std_ulogic_vector; r : integer) --V08 - return std_ulogic_vector; --V08 - function "rol" (l : std_ulogic_vector; r : integer) --V08 - return std_ulogic_vector; --V08 - function "ror" (l : std_ulogic_vector; r : integer) --V08 - return std_ulogic_vector; --V08 - - -- Conversion functions. - -- The result range (for vectors) is S'Length - 1 downto 0. - -- XMAP is return for values not in '0', '1', 'L', 'H'. - function to_bit (s : std_ulogic; xmap : bit := '0') return bit; - function to_bitvector (s : std_logic_vector; xmap : bit := '0') --!V08 - return bit_vector; --!V08 - function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') - return bit_vector; - - function to_stdulogic (b : bit) return std_ulogic; - function to_stdlogicvector (b : bit_vector) return std_logic_vector; - function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector; - function to_stdulogicvector (b : bit_vector) return std_ulogic_vector; - function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector; - - alias to_bit_vector is --V08 - to_bitvector[std_ulogic_vector, bit return bit_vector]; --V08 - alias to_bv is --V08 - to_bitvector[std_ulogic_vector, bit return bit_vector]; --V08 - --V08 - alias to_std_logic_vector is --V08 - to_stdlogicvector[bit_vector return std_logic_vector]; --V08 - alias to_slv is --V08 - to_stdlogicvector[bit_vector return std_logic_vector]; --V08 - --V08 - alias to_std_logic_vector is --V08 - to_stdlogicvector[std_ulogic_vector return std_logic_vector]; --V08 - alias to_slv is --V08 - to_stdlogicvector[std_ulogic_vector return std_logic_vector]; --V08 - --V08 - alias to_std_ulogic_vector is --V08 - to_stdulogicvector[bit_vector return std_ulogic_vector]; --V08 - alias to_sulv is --V08 - to_stdulogicvector[bit_vector return std_ulogic_vector]; --V08 - --V08 - alias to_std_ulogic_vector is --V08 - to_stdulogicvector[std_logic_vector return std_ulogic_vector]; --V08 - alias to_sulv is --V08 - to_stdulogicvector[std_logic_vector return std_ulogic_vector]; --V08 - --V08 - -- Normalization. - -- The result range (for vectors) is 1 to S'Length. - function to_01 (s : std_ulogic_vector; xmap : std_ulogic := '0') --V08 - return std_ulogic_vector; --V08 - function to_01 (s : std_ulogic; xmap : std_ulogic := '0') --V08 - return std_ulogic; --V08 - function to_01 (s : bit_vector; xmap : std_ulogic := '0') --V08 - return std_ulogic_vector; --V08 - function to_01 (s : bit; xmap : std_ulogic := '0') --V08 - return std_ulogic; --V08 - --V08 - function to_X01 (s : std_logic_vector) return std_logic_vector; --!V08 - function to_X01 (s : std_ulogic_vector) return std_ulogic_vector; - function to_X01 (s : std_ulogic) return X01; - function to_X01 (b : bit_vector) return std_logic_vector; --!V08 - function to_X01 (b : bit_vector) return std_ulogic_vector; - function to_X01 (b : bit) return X01; - - function to_X01Z (s : std_logic_vector) return std_logic_vector; --!V08 - function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector; - function to_X01Z (s : std_ulogic) return X01Z; - function to_X01Z (b : bit_vector) return std_logic_vector; --!V08 - function to_X01Z (b : bit_vector) return std_ulogic_vector; - function to_X01Z (b : bit) return X01Z; - - function to_UX01 (s : std_logic_vector) return std_logic_vector; --!V08 - function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector; - function to_UX01 (s : std_ulogic) return UX01; - function to_UX01 (b : bit_vector) return std_logic_vector; --!V08 - function to_UX01 (b : bit_vector) return std_ulogic_vector; - function to_UX01 (b : bit) return UX01; - - function "??" (l : std_ulogic) return boolean; --V08 - --V08 - -- Edge detection. - -- An edge is detected in case of event on s, and X01 normalized value - -- rises from 0 to 1 or falls from 1 to 0. - function rising_edge (signal s : std_ulogic) return boolean; - function falling_edge (signal s : std_ulogic) return boolean; - - -- Test for unknown. Only 0, 1, L and H are known values. - function is_X (s : std_ulogic_vector) return boolean; - function is_X (s : std_logic_vector) return boolean; --!V08 - function is_X (s : std_ulogic) return boolean; - --V08 - -- String conversion --V08 - --V08 - alias to_bstring is to_string [std_ulogic_vector return string]; --V08 - alias to_binary_string is to_string [std_ulogic_vector return string]; --V08 - --V08 - function to_ostring (value : std_ulogic_vector) return string; --V08 - alias to_octal_string is to_ostring [std_ulogic_vector return string]; --V08 - --V08 - function to_hstring (value : std_ulogic_vector) return string; --V08 - alias to_hex_string is to_hstring [std_ulogic_vector return string]; --V08 - --V08 - -- Input/output --V08 - --V08 - procedure write (l : inout line; value : std_ulogic; --V08 - justified : side := right; field : width := 0); --V08 - --V08 - procedure write (l : inout line; value : std_ulogic_vector; --V08 - justified : side := right; field : width := 0); --V08 - alias bwrite is write [line, std_ulogic_vector, side, width]; --V08 - alias binary_write is write [line, std_ulogic_vector, side, width]; --V08 - --V08 - procedure owrite (l : inout line; value : std_ulogic_vector; --V08 - justified : side := right; field : width := 0); --V08 - alias octal_write is owrite [line, std_ulogic_vector, side, width]; --V08 - --V08 - procedure hwrite (l : inout line; value : std_ulogic_vector; --V08 - justified : side := right; field : width := 0); --V08 - alias hex_write is hwrite [line, std_ulogic_vector, side, width]; --V08 - --V08 - procedure read (l : inout line; --V08 - value : out std_ulogic; good : out boolean); --V08 - procedure read (l : inout line; value : out std_ulogic); --V08 - --V08 - procedure read (l : inout line; --V08 - value : out std_ulogic_vector; good : out boolean); --V08 - procedure read (l : inout line; value : out std_ulogic_vector); --V08 - alias bread is read [line, std_ulogic_vector, boolean]; --V08 - alias bread is read [line, std_ulogic_vector]; --V08 - alias binary_read is read [line, std_ulogic_vector, boolean]; --V08 - alias binary_read is read [line, std_ulogic_vector]; --V08 - --V08 - procedure hread (l : inout line; --V08 - value : out std_ulogic_vector; good : out boolean); --V08 - procedure hread (l : inout line; value : out std_ulogic_vector); --V08 - alias hex_read is read [line, std_ulogic_vector, boolean]; --V08 - alias hex_read is read [line, std_ulogic_vector]; --V08 - --V08 - procedure oread (l : inout line; --V08 - value : out std_ulogic_vector; good : out boolean); --V08 - procedure oread (l : inout line; value : out std_ulogic_vector); --V08 - alias octal_read is read [line, std_ulogic_vector, boolean]; --V08 - alias octal_read is read [line, std_ulogic_vector]; --V08 -end std_logic_1164; diff --git a/libraries/openieee/v08/std_logic_1164-body.vhdl b/libraries/openieee/v08/std_logic_1164-body.vhdl new file mode 100644 index 000000000..25e219c2e --- /dev/null +++ b/libraries/openieee/v08/std_logic_1164-body.vhdl @@ -0,0 +1,1383 @@ +-- This -*- vhdl -*- file was generated from std_logic_1164-body.proto +-- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only +-- on the specifications. This file is part of GHDL. +-- 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 +-- . + +-- This is a template file. To avoid errors and duplication, the python +-- script build.py generate most of the bodies. + +package body std_logic_1164 is + + type table_1d is array (std_ulogic) of std_ulogic; + type table_2d is array (std_ulogic, std_ulogic) of std_ulogic; + + constant resolution : table_2d := + -- UX01ZWLH- + ("UUUUUUUUU", -- U + "UXXXXXXXX", -- X + "UX0X0000X", -- 0 + "UXX11111X", -- 1 + "UX01ZWLHX", -- Z + "UX01WWWWX", -- W + "UX01LWLWX", -- L + "UX01HWWHX", -- H + "UXXXXXXXX" -- - + ); + + function resolved (s : std_ulogic_vector) return std_ulogic + is + variable res : std_ulogic := 'Z'; + begin + for I in s'range loop + res := resolution (res, s (I)); + end loop; + return res; + end resolved; + + + constant and_table : table_2d := + -- UX01ZWLH- + ("UU0UUU0UU", -- U + "UX0XXX0XX", -- X + "000000000", -- 0 + "UX01XX01X", -- 1 + "UX0XXX0XX", -- Z + "UX0XXX0XX", -- W + "000000000", -- L + "UX01XX01X", -- H + "UX0XXX0XX" -- - + ); + + constant nand_table : table_2d := + -- UX01ZWLH- + ("UU1UUU1UU", -- U + "UX1XXX1XX", -- X + "111111111", -- 0 + "UX10XX10X", -- 1 + "UX1XXX1XX", -- Z + "UX1XXX1XX", -- W + "111111111", -- L + "UX10XX10X", -- H + "UX1XXX1XX" -- - + ); + + constant or_table : table_2d := + -- UX01ZWLH- + ("UUU1UUU1U", -- U + "UXX1XXX1X", -- X + "UX01XX01X", -- 0 + "111111111", -- 1 + "UXX1XXX1X", -- Z + "UXX1XXX1X", -- W + "UX01XX01X", -- L + "111111111", -- H + "UXX1XXX1X" -- - + ); + + constant nor_table : table_2d := + -- UX01ZWLH- + ("UUU0UUU0U", -- U + "UXX0XXX0X", -- X + "UX10XX10X", -- 0 + "000000000", -- 1 + "UXX0XXX0X", -- Z + "UXX0XXX0X", -- W + "UX10XX10X", -- L + "000000000", -- H + "UXX0XXX0X" -- - + ); + + constant xor_table : table_2d := + -- UX01ZWLH- + ("UUUUUUUUU", -- U + "UXXXXXXXX", -- X + "UX01XX01X", -- 0 + "UX10XX10X", -- 1 + "UXXXXXXXX", -- Z + "UXXXXXXXX", -- W + "UX01XX01X", -- L + "UX10XX10X", -- H + "UXXXXXXXX" -- - + ); + + constant xnor_table : table_2d := + -- UX01ZWLH- + ("UUUUUUUUU", -- U + "UXXXXXXXX", -- X + "UX10XX10X", -- 0 + "UX01XX01X", -- 1 + "UXXXXXXXX", -- Z + "UXXXXXXXX", -- W + "UX10XX10X", -- L + "UX01XX01X", -- H + "UXXXXXXXX" -- - + ); + + constant not_table : table_1d := + -- UX01ZWLH- + "UX10XX10X"; + + + function "and" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return and_table (l, r); + end "and"; + + function "nand" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return nand_table (l, r); + end "nand"; + + function "or" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return or_table (l, r); + end "or"; + + function "nor" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return nor_table (l, r); + end "nor"; + + function "xor" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return xor_table (l, r); + end "xor"; + + function "xnor" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return xnor_table (l, r); + end "xnor"; + + function "not" (l : std_ulogic) return UX01 is + begin + return not_table (l); + end "not"; + + function "and" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'and' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := and_table (la (I), ra (I)); + end loop; + end if; + return res; + end "and"; + + function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'nand' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := nand_table (la (I), ra (I)); + end loop; + end if; + return res; + end "nand"; + + function "or" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'or' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := or_table (la (I), ra (I)); + end loop; + end if; + return res; + end "or"; + + function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'nor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := nor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "nor"; + + function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'xor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := xor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "xor"; + + function "xnor" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'xnor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := xnor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "xnor"; + + function "not" (l : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := not_table (la (I)); + end loop; + return res; + end "not"; + + function "and" (l : std_ulogic_vector; r : std_ulogic) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := and_table (la (I), r); + end loop; + return res; + end "and"; + + function "and" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to r'length); + alias ra : res_type is r; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := and_table (l, ra (I)); + end loop; + return res; + end "and"; + + function "nand" (l : std_ulogic_vector; r : std_ulogic) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := nand_table (la (I), r); + end loop; + return res; + end "nand"; + + function "nand" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to r'length); + alias ra : res_type is r; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := nand_table (l, ra (I)); + end loop; + return res; + end "nand"; + + function "or" (l : std_ulogic_vector; r : std_ulogic) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := or_table (la (I), r); + end loop; + return res; + end "or"; + + function "or" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to r'length); + alias ra : res_type is r; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := or_table (l, ra (I)); + end loop; + return res; + end "or"; + + function "nor" (l : std_ulogic_vector; r : std_ulogic) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := nor_table (la (I), r); + end loop; + return res; + end "nor"; + + function "nor" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to r'length); + alias ra : res_type is r; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := nor_table (l, ra (I)); + end loop; + return res; + end "nor"; + + function "xor" (l : std_ulogic_vector; r : std_ulogic) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := xor_table (la (I), r); + end loop; + return res; + end "xor"; + + function "xor" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to r'length); + alias ra : res_type is r; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := xor_table (l, ra (I)); + end loop; + return res; + end "xor"; + + function "xnor" (l : std_ulogic_vector; r : std_ulogic) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := xnor_table (la (I), r); + end loop; + return res; + end "xnor"; + + function "xnor" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to r'length); + alias ra : res_type is r; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := xnor_table (l, ra (I)); + end loop; + return res; + end "xnor"; + + function "and" (l : std_ulogic_vector) return std_ulogic + is + variable res : std_ulogic := '1'; + begin + for I in l'range loop + res := and_table (l(I), res); + end loop; + return res; + end "and"; + + function "nand" (l : std_ulogic_vector) return std_ulogic + is + variable res : std_ulogic := '1'; + begin + for I in l'range loop + res := nand_table (l(I), res); + end loop; + return res; + end "nand"; + + function "or" (l : std_ulogic_vector) return std_ulogic + is + variable res : std_ulogic := '0'; + begin + for I in l'range loop + res := or_table (l(I), res); + end loop; + return res; + end "or"; + + function "nor" (l : std_ulogic_vector) return std_ulogic + is + variable res : std_ulogic := '0'; + begin + for I in l'range loop + res := nor_table (l(I), res); + end loop; + return res; + end "nor"; + + function "xor" (l : std_ulogic_vector) return std_ulogic + is + variable res : std_ulogic := '0'; + begin + for I in l'range loop + res := xor_table (l(I), res); + end loop; + return res; + end "xor"; + + function "xnor" (l : std_ulogic_vector) return std_ulogic + is + variable res : std_ulogic := '0'; + begin + for I in l'range loop + res := xnor_table (l(I), res); + end loop; + return res; + end "xnor"; + + function "sll" (l : std_ulogic_vector; r : integer) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type := (others => '0'); + begin + if r >= 0 then + res (1 to l'length - r) := la (r + 1 to res'right); + else + res (1 - r to res'right) := la (1 to l'length + r); + end if; + return res; + end "sll"; + + function "srl" (l : std_ulogic_vector; r : integer) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type := (others => '0'); + begin + if r >= 0 then + res (1 + r to res'right) := la (1 to l'length - r); + else + res (1 to l'length + r) := la (r - 1 to res'right); + end if; + return res; + end "srl"; + + function "rol" (l : std_ulogic_vector; r : integer) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + constant rm : integer := r mod l'length; + begin + if r >= 0 then + res (1 to res'right - rm) := la (rm + 1 to la'right); + res (res'right - rm + 1 to res'right) := la (1 to rm); + else + res (1 - rm to res'right) := la (1 to la'right + r); + res (1 to rm) := la (la'right + rm + 1 to la'right); + end if; + return res; + end "rol"; + + function "ror" (l : std_ulogic_vector; r : integer) + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + constant rm : integer := r mod l'length; + begin + if r >= 0 then + res (1 + rm to res'right) := la (1 to la'right - r); + res (1 to rm) := la (la'right - rm + 1 to la'right); + else + res (1 to res'right + rm) := la (rm - 1 to la'right); + res (res'right + rm + 1 to res'right) := la (1 to rm); + end if; + return res; + end "ror"; + + -- Conversion functions. + -- The result range (for vectors) is S'Length - 1 downto 0. + -- XMAP is return for values not in '0', '1', 'L', 'H'. + function to_bit (s : std_ulogic; xmap : bit := '0') return bit is + begin + case s is + when '0' | 'L' => + return '0'; + when '1' | 'H' => + return '1'; + when others => + return xmap; + end case; + end to_bit; + + type bit_to_std_table is array (bit) of std_ulogic; + constant bit_to_std : bit_to_std_table := "01"; + + + function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') + return bit_vector + is + subtype res_range is natural range s'length - 1 downto 0; + alias as : std_ulogic_vector (res_range) is s; + variable res : bit_vector (res_range); + variable b : bit; + begin + for I in res_range loop + -- Inline for efficiency. + case as (I) is + when '0' | 'L' => + b := '0'; + when '1' | 'H' => + b := '1'; + when others => + b := xmap; + end case; + res (I) := b; + end loop; + return res; + end to_bitvector; + + function to_stdulogicvector (b : bit_vector) return std_ulogic_vector is + subtype res_range is natural range b'length - 1 downto 0; + alias ab : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for I in res_range loop + res (I) := bit_to_std (ab (I)); + end loop; + return res; + end to_stdulogicvector; + + function to_stdlogicvector (b : bit_vector) return std_logic_vector is + subtype res_range is natural range b'length - 1 downto 0; + alias ab : bit_vector (res_range) is b; + variable res : std_logic_vector (res_range); + begin + for I in res_range loop + res (I) := bit_to_std (ab (I)); + end loop; + return res; + end to_stdlogicvector; + + function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (s'length - 1 downto 0); + begin + return res_type (s); + end to_stdulogicvector; + + function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (s'length - 1 downto 0); + begin + return res_type (s); + end to_stdlogicvector; + + function to_stdulogic (b : bit) return std_ulogic is + begin + return bit_to_std (b); + end to_stdulogic; + + -- Normalization. + type table_std_x01 is array (std_ulogic) of X01; + constant std_to_x01 : table_std_x01 := ('U' | 'X' | 'Z' | 'W' | '-' => 'X', + '0' | 'L' => '0', + '1' | 'H' => '1'); + + type table_bit_x01 is array (bit) of X01; + constant bit_to_x01 : table_bit_x01 := ('0' => '0', + '1' => '1'); + + + type table_std_x01z is array (std_ulogic) of X01Z; + constant std_to_x01z : table_std_x01z := ('U' | 'X' | 'W' | '-' => 'X', + '0' | 'L' => '0', + '1' | 'H' => '1', + 'Z' => 'Z'); + + type table_std_ux01 is array (std_ulogic) of UX01; + constant std_to_ux01 : table_std_ux01 := ('U' => 'U', + 'X' | 'Z' | 'W' | '-' => 'X', + '0' | 'L' => '0', + '1' | 'H' => '1'); + + + function to_01 (s : std_ulogic_vector; xmap : std_ulogic := '0') + return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (s'length - 1 downto 0); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + case sa(i) is + when '0' | 'L' => res (i) := '0'; + when '1' | 'H' => res (i) := '1'; + when others => return res_type'(others => xmap); + end case; + end loop; + return res; + end to_01; + + function to_01 (s : std_ulogic; xmap : std_ulogic := '0') + return std_ulogic is + begin + case s is + when '0' | 'L' => return '0'; + when '1' | 'H' => return '1'; + when others => return xmap; + end case; + end to_01; + + function to_01 (s : bit_vector; xmap : std_ulogic := '0') + return std_ulogic_vector + is + alias sa : bit_vector(s'length - 1 downto 0) is s; + variable res : std_ulogic_vector (s'length - 1 downto 0); + begin + for i in sa'range loop + res (i) := bit_to_std (sa (i)); + end loop; + return res; + end to_01; + + function to_01 (s : bit; xmap : std_ulogic := '0') + return std_ulogic is + begin + return bit_to_std(s); + end to_01; + + function to_X01 (s : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_x01 (sa (i)); + end loop; + return res; + end to_X01; + + function to_X01 (s : std_ulogic) return X01 is + begin + return std_to_x01 (s); + end to_X01; + + function to_X01 (b : bit_vector) return std_ulogic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_X01; + + function to_X01 (b : bit) return X01 is + begin + return bit_to_x01 (b); + end to_X01; + + function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_x01z (sa (i)); + end loop; + return res; + end to_X01Z; + + function to_X01Z (s : std_ulogic) return X01Z is + begin + return std_to_x01z (s); + end to_X01Z; + + function to_X01Z (b : bit_vector) return std_ulogic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_X01Z; + + function to_X01Z (b : bit) return X01Z is + begin + return bit_to_x01 (b); + end to_X01Z; + + function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_ux01 (sa (i)); + end loop; + return res; + end to_UX01; + + function to_UX01 (s : std_ulogic) return UX01 is + begin + return std_to_ux01 (s); + end to_UX01; + + function to_UX01 (b : bit_vector) return std_ulogic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_UX01; + + function to_UX01 (b : bit) return UX01 is + begin + return bit_to_x01 (b); + end to_UX01; + + function "??" (l : std_ulogic) return boolean is + begin + return l = '1' or l = 'H'; + end "??"; + + function rising_edge (signal s : std_ulogic) return boolean is + begin + return s'event + and to_x01 (s'last_value) = '0' + and to_x01 (s) = '1'; + end rising_edge; + + function falling_edge (signal s : std_ulogic) return boolean is + begin + return s'event + and to_x01 (s'last_value) = '1' + and to_x01 (s) = '0'; + end falling_edge; + + type std_x_array is array (std_ulogic) of boolean; + constant std_x : std_x_array := ('U' | 'X' | 'Z' | 'W' | '-' => true, + '0' | '1' | 'L' | 'H' => false); + + + function is_X (s : std_ulogic_vector) return boolean is + begin + for i in s'range loop + if std_x (s (i)) then + return true; + end if; + end loop; + return false; + end is_X; + + function is_X (s : std_ulogic) return boolean is + begin + return std_x (s); + end is_X; + + function to_ostring (value : std_ulogic_vector) return string + is + alias avalue : std_ulogic_vector(value'length downto 1) is value; + constant len : natural := (value'length + 2) / 3; + variable padded : std_ulogic_vector (len * 3 downto 1); + variable pad : std_ulogic; + variable res : string (len downto 1); + variable c : character; + subtype res_type is string (1 to len); + begin + pad := 'Z' when value (value'left) = 'Z' else '0'; + padded (avalue'range) := to_x01z (value); + padded (padded'left downto avalue'left + 1) := (others => pad); + for i in res'range loop + case padded(i * 3 downto i * 3 - 2) is + when "000" => c := '0'; + when "001" => c := '1'; + when "010" => c := '2'; + when "011" => c := '3'; + when "100" => c := '4'; + when "101" => c := '5'; + when "110" => c := '6'; + when "111" => c := '7'; + when "ZZZ" => c := 'Z'; + when others => c := 'X'; + end case; + res (i) := c; + end loop; + return res_type (res); + end to_ostring; + + function to_hstring (value : std_ulogic_vector) return string + is + alias avalue : std_ulogic_vector(value'length downto 1) is value; + constant len : natural := (value'length + 3) / 4; + variable padded : std_ulogic_vector (len * 4 downto 1); + variable pad : std_ulogic; + variable res : string (len downto 1); + variable c : character; + subtype res_type is string (1 to len); + begin + pad := 'Z' when value (value'left) = 'Z' else '0'; + padded (avalue'range) := to_x01z (value); + padded (padded'left downto avalue'left + 1) := (others => pad); + for i in res'range loop + case padded(i * 4 downto i * 4 - 3) is + when "0000" => c := '0'; + when "0001" => c := '1'; + when "0010" => c := '2'; + when "0011" => c := '3'; + when "0100" => c := '4'; + when "0101" => c := '5'; + when "0110" => c := '6'; + when "0111" => c := '7'; + when "1000" => c := '8'; + when "1001" => c := '9'; + when "1010" => c := 'A'; + when "1011" => c := 'B'; + when "1100" => c := 'C'; + when "1101" => c := 'D'; + when "1110" => c := 'E'; + when "1111" => c := 'F'; + when "ZZZZ" => c := 'Z'; + when others => c := 'X'; + end case; + res (i) := c; + end loop; + return res_type (res); + end to_hstring; + + type sl_to_char_array is array (std_ulogic) of character; + constant sl_to_char : sl_to_char_array := "UX01ZWLH-"; + + procedure write (l : inout line; value : std_ulogic; + justified : side := right; field : width := 0) is + begin + write (l, sl_to_char (value), justified, field); + end write; + + procedure write (l : inout line; value : std_ulogic_vector; + justified : side := right; field : width := 0) is + begin + write (l, to_string (value), justified, field); + end write; + + procedure owrite (l : inout line; value : std_ulogic_vector; + justified : side := right; field : width := 0) is + begin + write (l, to_ostring (value), justified, field); + end owrite; + + procedure hwrite (l : inout line; value : std_ulogic_vector; + justified : side := right; field : width := 0) is + begin + write (l, to_hstring (value), justified, field); + end hwrite; + + constant nbsp : character := character'val (160); + + procedure trim (l : inout line; left : natural) + is + variable nl : line; + begin + if l'ascending then + nl := new string(left to l'right); + nl.all := l(left to l'right); + else + nl := new string(left downto l'right); + nl.all := l(left downto l'right); + end if; + deallocate(l); + l := nl; + end trim; + + procedure read (l: inout line; value: out std_ulogic; good: out boolean) + is + variable p : positive; + variable dir : integer; + begin + good := false; + value := 'U'; + if l = null or l'length = 0 then + -- Return now for empty line. + return; + end if; + + if l'ascending then + dir := 1; + else + dir := -1; + end if; + p := l'left; + loop + case l(p) is + when ' ' | NBSP | HT => + -- Skip blanks. + null; + when 'U' => value := 'U'; exit; + when 'X' => value := 'X'; exit; + when '0' => value := '0'; exit; + when '1' => value := '1'; exit; + when 'Z' => value := 'Z'; exit; + when 'W' => value := 'W'; exit; + when 'L' => value := 'L'; exit; + when 'H' => value := 'H'; exit; + when '-' => value := '-'; exit; + when others => + trim (l, p); + return; + end case; + if p = l'right then + -- End of string. + deallocate(l); + l := new string'(""); + return; + end if; + p := p + dir; + end loop; + + good := true; + trim (l, p + dir); + end read; + + procedure read (l : inout line; value : out std_ulogic) + is + variable good : boolean; + begin + read (l, value, good); + assert good report "std_logic_1164.read(std_ulogic) cannot read value" + severity error; + end read; + + procedure read (l : inout line; + value : out std_ulogic_vector; good : out boolean) + is + variable p : positive; + variable i : natural; + variable dir : integer; + alias av : std_ulogic_vector(1 to value'length) is value; + variable allow_underscore : boolean; + variable c : character; + variable d : std_ulogic; + begin + good := value'length = 0; + value := (value'range => 'U'); + if l = null or l'length = 0 then + -- Return now for empty line. + return; + end if; + + if l'ascending then + dir := 1; + else + dir := -1; + end if; + p := l'left; + + -- Skip blanks. + p := l'left; + loop + case l(p) is + when ' ' | NBSP | HT => + null; + when others => + exit; + end case; + if p = l'right then + -- End of string. + deallocate(l); + l := new string'(""); + return; + end if; + p := p + dir; + end loop; + + if value'length = 0 then + -- Nothing to read. + trim (l, p); + return; + end if; + + -- Extract value + i := 1; + allow_underscore := False; + good := false; + loop + c := l(p); + case c is + when 'U' => d := 'U'; + when 'X' => d := 'X'; + when '0' => d := '0'; + when '1' => d := '1'; + when 'Z' => d := 'Z'; + when 'W' => d := 'W'; + when 'L' => d := 'L'; + when 'H' => d := 'H'; + when '-' => d := '-'; + when others => + if c = '_' and allow_underscore then + allow_underscore := false; + else + -- Invalid character, double or leading '_'. + trim (l, p); + value := (value'range => 'U'); + return; + end if; + end case; + if c /= '_' then + av (i) := d; + allow_underscore := true; + if i = av'right then + -- Done. + good := true; + trim (l, p + dir); + return; + end if; + i := i + 1; + end if; + if p = l'right then + -- End of string. + trim (l, p + dir); + deallocate(l); + l := new string'(""); + value := (value'range => 'U'); + return; + end if; + p := p + dir; + end loop; + end read; + + procedure read (l : inout line; value : out std_ulogic_vector) + is + variable good : boolean; + begin + read (l, value, good); + assert good + report "std_logic_1164.read(std_ulogic_vector) cannot read value" + severity error; + end read; + + procedure hread (l : inout line; + value : out std_ulogic_vector; good : out boolean) + is + variable p : positive; + variable i : natural; + variable dir : integer; + constant ndigits : natural := (value'length + 3) / 4; + variable v : std_ulogic_vector(1 to ndigits * 4); + variable allow_underscore : boolean; + variable c : character; + variable d : std_ulogic_vector (3 downto 0); + begin + good := value'length = 0; + value := (value'range => 'U'); + if l = null or l'length = 0 then + -- Return now for empty line. + return; + end if; + + if l'ascending then + dir := 1; + else + dir := -1; + end if; + p := l'left; + + -- Skip blanks. + p := l'left; + loop + case l(p) is + when ' ' | NBSP | HT => + null; + when others => + exit; + end case; + if p = l'right then + -- End of string. + deallocate(l); + l := new string'(""); + return; + end if; + p := p + dir; + end loop; + + if value'length = 0 then + -- Nothing to read. + trim (l, p); + return; + end if; + + -- Extract value + i := 0; + allow_underscore := False; + good := false; + loop + c := l(p); + case c is + when '0' => d := "0000"; + when '1' => d := "0001"; + when '2' => d := "0010"; + when '3' => d := "0011"; + when '4' => d := "0100"; + when '5' => d := "0101"; + when '6' => d := "0110"; + when '7' => d := "0111"; + when '8' => d := "1000"; + when '9' => d := "1001"; + when 'A' | 'a' => d := "1010"; + when 'B' | 'b' => d := "1011"; + when 'C' | 'c' => d := "1100"; + when 'D' | 'd' => d := "1101"; + when 'E' | 'e' => d := "1110"; + when 'F' | 'f' => d := "1111"; + when 'Z' => d := "ZZZZ"; + when 'X' => d := "XXXX"; + when others => + if c = '_' and allow_underscore then + allow_underscore := false; + else + -- Invalid character, double or leading '_'. + trim (l, p); + return; + end if; + end case; + if c /= '_' then + allow_underscore := true; + v (i * 4 + 1 to i * 4 + 4) := d; + i := i + 1; + if i = ndigits then + -- Done. + if or (v(1 to ndigits * 4 - value'length)) /= '1' then + -- No truncated digit is a '1'. + value := v (ndigits * 4 - value'length + 1 to v'right); + good := true; + end if; + trim (l, p + dir); + return; + end if; + end if; + if p = l'right then + -- End of string. + trim (l, p + dir); + deallocate(l); + l := new string'(""); + return; + end if; + p := p + dir; + end loop; + end hread; + + procedure hread (l : inout line; value : out std_ulogic_vector) + is + variable good : boolean; + begin + hread (l, value, good); + assert good + report "std_logic_1164.hread(std_ulogic_vector) cannot read value" + severity error; + end hread; + + procedure oread (l : inout line; + value : out std_ulogic_vector; good : out boolean) + is + variable p : positive; + variable i : natural; + variable dir : integer; + constant ndigits : natural := (value'length + 2) / 3; + variable v : std_ulogic_vector(1 to ndigits * 3); + variable allow_underscore : boolean; + variable c : character; + variable d : std_ulogic_vector (2 downto 0); + begin + good := value'length = 0; + value := (value'range => 'U'); + if l = null or l'length = 0 then + -- Return now for empty line. + return; + end if; + + if l'ascending then + dir := 1; + else + dir := -1; + end if; + p := l'left; + + -- Skip blanks. + p := l'left; + loop + case l(p) is + when ' ' | NBSP | HT => + null; + when others => + exit; + end case; + if p = l'right then + -- End of string. + deallocate(l); + l := new string'(""); + return; + end if; + p := p + dir; + end loop; + + if value'length = 0 then + -- Nothing to read. + trim (l, p); + return; + end if; + + -- Extract value + i := 0; + allow_underscore := False; + good := false; + loop + c := l(p); + case c is + when '0' => d := "000"; + when '1' => d := "001"; + when '2' => d := "010"; + when '3' => d := "011"; + when '4' => d := "100"; + when '5' => d := "101"; + when '6' => d := "110"; + when '7' => d := "111"; + when 'Z' => d := "ZZZ"; + when 'X' => d := "XXX"; + when others => + if c = '_' and allow_underscore then + allow_underscore := false; + else + -- Invalid character, double or leading '_'. + trim (l, p); + return; + end if; + end case; + if c /= '_' then + allow_underscore := true; + v (i * 3 + 1 to i * 3 + 3) := d; + i := i + 1; + if i = ndigits then + -- Done. + if or (v(1 to ndigits * 3 - value'length)) /= '1' then + -- No truncated digit is a '1'. + value := v (ndigits * 3 - value'length + 1 to v'right); + good := true; + end if; + trim (l, p + dir); + return; + end if; + end if; + if p = l'right then + -- End of string. + trim (l, p + dir); + deallocate(l); + l := new string'(""); + return; + end if; + p := p + dir; + end loop; + end oread; + + procedure oread (l : inout line; value : out std_ulogic_vector) + is + variable good : boolean; + begin + oread (l, value, good); + assert good + report "std_logic_1164.oread(std_ulogic_vector) cannot read value" + severity error; + end oread; + +end std_logic_1164; diff --git a/libraries/openieee/v08/std_logic_1164.vhdl b/libraries/openieee/v08/std_logic_1164.vhdl new file mode 100644 index 000000000..8271b1b93 --- /dev/null +++ b/libraries/openieee/v08/std_logic_1164.vhdl @@ -0,0 +1,257 @@ +-- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only +-- on the specifications. This file is part of GHDL. +-- 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 +-- . + +use std.textio.all; + +package std_logic_1164 is + + -- Unresolved logic state. + type std_ulogic is + ( + 'U', -- Uninitialized, this is also the default value. + 'X', -- Unknown / conflict value (forcing level). + '0', -- 0 (forcing level). + '1', -- 1 (forcing level). + 'Z', -- High impedance. + 'W', -- Unknown / conflict (weak level). + 'L', -- 0 (weak level). + 'H', -- 1 (weak level). + '-' -- Don't care. + ); + + -- Vector of logic state. + type std_ulogic_vector is array (natural range <>) of std_ulogic; + + -- Resolution function. + -- If S is empty, returns 'Z'. + -- If S has one element, return the element. + -- Otherwise, 'U' is the strongest. + -- then 'X' + -- then '0' and '1' + -- then 'W' + -- then 'H' and 'L' + -- then 'Z'. + function resolved (s : std_ulogic_vector) return std_ulogic; + + -- Resolved logic state. + subtype std_logic is resolved std_ulogic; + + -- Vector of std_logic. + subtype std_logic_vector is (resolved) std_ulogic_vector; + + -- Subtypes of std_ulogic. The names give the values. + subtype X01 is resolved std_ulogic range 'X' to '1'; + subtype X01Z is resolved std_ulogic range 'X' to 'Z'; + subtype UX01 is resolved std_ulogic range 'U' to '1'; + subtype UX01Z is resolved std_ulogic range 'U' to 'Z'; + + -- Logical operators. + -- For logical operations, the inputs are first normalized to UX01: + -- 0 and L are normalized to 0, 1 and 1 are normalized to 1, U isnt changed, + -- all other states are normalized to X. + -- Then the classical electric rules are followed. + function "and" (l : std_ulogic; r : std_ulogic) return UX01; + function "nand" (l : std_ulogic; r : std_ulogic) return UX01; + function "or" (l : std_ulogic; r : std_ulogic) return UX01; + function "nor" (l : std_ulogic; r : std_ulogic) return UX01; + function "xor" (l : std_ulogic; r : std_ulogic) return UX01; + function "xnor" (l : std_ulogic; r : std_ulogic) return UX01; + function "not" (l : std_ulogic) return UX01; + + -- Logical operators for vectors. + -- An assertion of severity failure fails if the length of L and R aren't + -- equal. The result range is 1 to L'Length. + + function "and" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "or" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "xnor" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "not" (l : std_ulogic_vector) return std_ulogic_vector; + + function "and" (l : std_ulogic_vector; r : std_ulogic ) + return std_ulogic_vector; + function "and" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector; + function "nand" (l : std_ulogic_vector; r : std_ulogic ) + return std_ulogic_vector; + function "nand" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector; + function "or" (l : std_ulogic_vector; r : std_ulogic ) + return std_ulogic_vector; + function "or" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector; + function "nor" (l : std_ulogic_vector; r : std_ulogic ) + return std_ulogic_vector; + function "nor" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector; + function "xor" (l : std_ulogic_vector; r : std_ulogic ) + return std_ulogic_vector; + function "xor" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector; + function "xnor" (l : std_ulogic_vector; r : std_ulogic ) + return std_ulogic_vector; + function "xnor" (l : std_ulogic; r : std_ulogic_vector) + return std_ulogic_vector; + + function "and" (l : std_ulogic_vector) return std_ulogic; + function "nand" (l : std_ulogic_vector) return std_ulogic; + function "or" (l : std_ulogic_vector) return std_ulogic; + function "nor" (l : std_ulogic_vector) return std_ulogic; + function "xor" (l : std_ulogic_vector) return std_ulogic; + function "xnor" (l : std_ulogic_vector) return std_ulogic; + + function "sll" (l : std_ulogic_vector; r : integer) + return std_ulogic_vector; + function "srl" (l : std_ulogic_vector; r : integer) + return std_ulogic_vector; + function "rol" (l : std_ulogic_vector; r : integer) + return std_ulogic_vector; + function "ror" (l : std_ulogic_vector; r : integer) + return std_ulogic_vector; + + -- Conversion functions. + -- The result range (for vectors) is S'Length - 1 downto 0. + -- XMAP is return for values not in '0', '1', 'L', 'H'. + function to_bit (s : std_ulogic; xmap : bit := '0') return bit; + function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') + return bit_vector; + + function to_stdulogic (b : bit) return std_ulogic; + function to_stdlogicvector (b : bit_vector) return std_logic_vector; + function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector; + function to_stdulogicvector (b : bit_vector) return std_ulogic_vector; + function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector; + + alias to_bit_vector is + to_bitvector[std_ulogic_vector, bit return bit_vector]; + alias to_bv is + to_bitvector[std_ulogic_vector, bit return bit_vector]; + + alias to_std_logic_vector is + to_stdlogicvector[bit_vector return std_logic_vector]; + alias to_slv is + to_stdlogicvector[bit_vector return std_logic_vector]; + + alias to_std_logic_vector is + to_stdlogicvector[std_ulogic_vector return std_logic_vector]; + alias to_slv is + to_stdlogicvector[std_ulogic_vector return std_logic_vector]; + + alias to_std_ulogic_vector is + to_stdulogicvector[bit_vector return std_ulogic_vector]; + alias to_sulv is + to_stdulogicvector[bit_vector return std_ulogic_vector]; + + alias to_std_ulogic_vector is + to_stdulogicvector[std_logic_vector return std_ulogic_vector]; + alias to_sulv is + to_stdulogicvector[std_logic_vector return std_ulogic_vector]; + + -- Normalization. + -- The result range (for vectors) is 1 to S'Length. + function to_01 (s : std_ulogic_vector; xmap : std_ulogic := '0') + return std_ulogic_vector; + function to_01 (s : std_ulogic; xmap : std_ulogic := '0') + return std_ulogic; + function to_01 (s : bit_vector; xmap : std_ulogic := '0') + return std_ulogic_vector; + function to_01 (s : bit; xmap : std_ulogic := '0') + return std_ulogic; + + function to_X01 (s : std_ulogic_vector) return std_ulogic_vector; + function to_X01 (s : std_ulogic) return X01; + function to_X01 (b : bit_vector) return std_ulogic_vector; + function to_X01 (b : bit) return X01; + + function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector; + function to_X01Z (s : std_ulogic) return X01Z; + function to_X01Z (b : bit_vector) return std_ulogic_vector; + function to_X01Z (b : bit) return X01Z; + + function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector; + function to_UX01 (s : std_ulogic) return UX01; + function to_UX01 (b : bit_vector) return std_ulogic_vector; + function to_UX01 (b : bit) return UX01; + + function "??" (l : std_ulogic) return boolean; + + -- Edge detection. + -- An edge is detected in case of event on s, and X01 normalized value + -- rises from 0 to 1 or falls from 1 to 0. + function rising_edge (signal s : std_ulogic) return boolean; + function falling_edge (signal s : std_ulogic) return boolean; + + -- Test for unknown. Only 0, 1, L and H are known values. + function is_X (s : std_ulogic_vector) return boolean; + function is_X (s : std_ulogic) return boolean; + + -- String conversion + + alias to_bstring is to_string [std_ulogic_vector return string]; + alias to_binary_string is to_string [std_ulogic_vector return string]; + + function to_ostring (value : std_ulogic_vector) return string; + alias to_octal_string is to_ostring [std_ulogic_vector return string]; + + function to_hstring (value : std_ulogic_vector) return string; + alias to_hex_string is to_hstring [std_ulogic_vector return string]; + + -- Input/output + + procedure write (l : inout line; value : std_ulogic; + justified : side := right; field : width := 0); + + procedure write (l : inout line; value : std_ulogic_vector; + justified : side := right; field : width := 0); + alias bwrite is write [line, std_ulogic_vector, side, width]; + alias binary_write is write [line, std_ulogic_vector, side, width]; + + procedure owrite (l : inout line; value : std_ulogic_vector; + justified : side := right; field : width := 0); + alias octal_write is owrite [line, std_ulogic_vector, side, width]; + + procedure hwrite (l : inout line; value : std_ulogic_vector; + justified : side := right; field : width := 0); + alias hex_write is hwrite [line, std_ulogic_vector, side, width]; + + procedure read (l : inout line; + value : out std_ulogic; good : out boolean); + procedure read (l : inout line; value : out std_ulogic); + + procedure read (l : inout line; + value : out std_ulogic_vector; good : out boolean); + procedure read (l : inout line; value : out std_ulogic_vector); + alias bread is read [line, std_ulogic_vector, boolean]; + alias bread is read [line, std_ulogic_vector]; + alias binary_read is read [line, std_ulogic_vector, boolean]; + alias binary_read is read [line, std_ulogic_vector]; + + procedure hread (l : inout line; + value : out std_ulogic_vector; good : out boolean); + procedure hread (l : inout line; value : out std_ulogic_vector); + alias hex_read is read [line, std_ulogic_vector, boolean]; + alias hex_read is read [line, std_ulogic_vector]; + + procedure oread (l : inout line; + value : out std_ulogic_vector; good : out boolean); + procedure oread (l : inout line; value : out std_ulogic_vector); + alias octal_read is read [line, std_ulogic_vector, boolean]; + alias octal_read is read [line, std_ulogic_vector]; +end std_logic_1164; diff --git a/libraries/openieee/v87/numeric_bit-body.vhdl b/libraries/openieee/v87/numeric_bit-body.vhdl new file mode 100644 index 000000000..3bdc634ac --- /dev/null +++ b/libraries/openieee/v87/numeric_bit-body.vhdl @@ -0,0 +1,2333 @@ +-- This -*- vhdl -*- file was generated from numeric_bit-body.proto +-- This -*- vhdl -*- file is part of GHDL. +-- IEEE 1076.3 compliant numeric bit 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 +-- . + +package body NUMERIC_BIT 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 bit; + constant nat1_to_01 : nat1_to_sl_type := (0 => '0', 1 => '1'); + + subtype sl_01 is bit; + + 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 compare_type is (compare_unknown, + compare_lt, + compare_eq, + compare_gt); + + 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 res : natural := 0; + begin + if arg'length = 0 then + assert NO_WARNING + report "NUMERIC_BIT.TO_INTEGER: null array detected, returning 0" + severity warning; + return 0; + end if; + + for i in arg'range loop + res := res + res; + if arg (i) = '1' then + res := res + 1; + end if; + end loop; + + return res; + end TO_INTEGER; + + function TO_INTEGER (ARG : SIGNED) return INTEGER + is + alias argn : SIGNED (ARG'Length -1 downto 0) is arg; + variable res : integer := 0; + variable b : bit; + begin + if argn'length = 0 then + assert NO_WARNING + report "NUMERIC_BIT.TO_INTEGER: null array 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_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_BIT.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 : bit; + 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_BIT.TO_SIGNED: vector is truncated" + severity warning; + end if; + return res; + end TO_SIGNED; + + + function "+" (l, 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 : bit; + 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 := la (i); + end if; + if i > ra'left then + rb := '0'; + else + rb := ra (i); + end if; + res (i) := compute_sum (carry, rb, lb); + carry := compute_carry (carry, rb, lb); + end loop; + return res; + end "+"; + + function "+" (l, 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 : bit; + 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 := la (i); + end if; + if i > ra'left then + rb := r (r'left); + else + rb := ra (i); + 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 : bit; + begin + if res'length < 0 then + return null_UNSIGNED; + end if; + carry := '0'; + r1 := r; + for i in res'reverse_range loop + lb := la (i); + + r2 := r1 / 2; + rd := r1 - 2 * r2; + r1 := r2; + rb := nat1_to_01 (rd); + 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 : bit; + begin + if res'length < 0 then + return null_UNSIGNED; + end if; + carry := '0'; + l1 := l; + for i in res'reverse_range loop + rb := ra (i); + + l2 := l1 / 2; + ld := l1 - 2 * l2; + l1 := l2; + lb := nat1_to_01 (ld); + 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 : bit; + begin + if res'length < 0 then + return null_SIGNED; + end if; + carry := '0'; + r1 := r; + for i in res'reverse_range loop + lb := 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); + 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 : bit; + begin + if res'length < 0 then + return null_SIGNED; + end if; + carry := '0'; + l1 := l; + for i in res'reverse_range loop + rb := 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); + 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, 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 : bit; + 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 := la (i); + end if; + if i > ra'left then + rb := '0'; + else + rb := ra (i); + 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, 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 : bit; + 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 := la (i); + end if; + if i > ra'left then + rb := r (r'left); + else + rb := ra (i); + 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 : bit; + begin + if res'length < 0 then + return null_UNSIGNED; + end if; + carry := '1'; + r1 := r; + for i in res'reverse_range loop + lb := la (i); + + r2 := r1 / 2; + rd := r1 - 2 * r2; + r1 := r2; + rb := nat1_to_01 (rd); + 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 : bit; + begin + if res'length < 0 then + return null_UNSIGNED; + end if; + carry := '1'; + l1 := l; + for i in res'reverse_range loop + rb := ra (i); + + l2 := l1 / 2; + ld := l1 - 2 * l2; + l1 := l2; + lb := nat1_to_01 (ld); + 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 : bit; + begin + if res'length < 0 then + return null_SIGNED; + end if; + carry := '1'; + r1 := r; + for i in res'reverse_range loop + lb := 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); + 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 : bit; + begin + if res'length < 0 then + return null_SIGNED; + end if; + carry := '1'; + l1 := l; + for i in res'reverse_range loop + rb := 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); + 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, 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 : bit; + 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 := 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; + end if; + end loop; + return res; + end "*"; + + function "*" (L, 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 : bit; + 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 := 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; + 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 bit + is + variable res : bit := '0'; + begin + for i in a'range loop + 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 : bit; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_unsigned; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_unsigned; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_unsigned; + 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 bit + is + variable res : bit := '0'; + begin + for i in a'range loop + 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 : bit; + begin + if arga'length = 0 then + return null_signed; + 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 : bit; + begin + if arga'length = 0 then + return null_signed; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_signed; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_signed; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_signed; + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + else + for I in res_type'range loop + res (I) := la (I) xor ra (I); + end loop; + end if; + return res; + end "xor"; + + function ucompare (l, 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 : bit; + variable res : compare_type; + begin + res := compare_eq; + for i in 0 to sz loop + if i > la'left then + lb := '0'; + else + lb := la (i); + end if; + if i > ra'left then + rb := '0'; + else + rb := ra (i); + 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, 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 : bit; + variable res : compare_type; + begin + -- Consider sign bit as S * -(2**N). + lb := la (la'left); + rb := 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 := la (i); + end if; + if i > ra'left then + rb := r (r'left); + else + rb := ra (i); + 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 : bit; + variable res : compare_type; + begin + res := compare_eq; + r1 := r; + for i in la'reverse_range loop + lb := la (i); + r2 := r1 / 2; + rd := r1 - 2 * r2; + r1 := r2; + rb := nat1_to_01 (rd); + 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 : bit; + variable res : compare_type; + begin + res := compare_eq; + r1 := r; + for i in la'reverse_range loop + lb := 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 = '1' and rb = '0' then + res := compare_gt; + elsif lb = '0' and rb = '1' then + res := compare_lt; + end if; + end loop; + if 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, 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); + return res = compare_eq; + end "="; + + function "=" (l, 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); + 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); + 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); + 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); + 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); + return compare_eq = res; + end "="; + + function "/=" (l, 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); + return res /= compare_eq; + end "/="; + + function "/=" (l, 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); + 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); + 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); + 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); + 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); + return compare_eq /= res; + end "/="; + + function ">" (l, 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); + return res > compare_eq; + end ">"; + + function ">" (l, 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); + 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); + 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); + 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); + 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); + return compare_eq > res; + end ">"; + + function ">=" (l, 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); + return res >= compare_eq; + end ">="; + + function ">=" (l, 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); + 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); + 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); + 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); + 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); + return compare_eq >= res; + end ">="; + + function "<" (l, 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); + return res < compare_eq; + end "<"; + + function "<" (l, 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); + 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); + 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); + 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); + 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); + return compare_eq < res; + end "<"; + + function "<=" (l, 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); + return res <= compare_eq; + end "<="; + + function "<=" (l, 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); + 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); + 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); + 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); + 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); + 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; + + function rising_edge (signal s : bit) return boolean is + begin + return s'event and s = '1'; + end rising_edge; + + function falling_edge (signal s : bit) return boolean is + begin + return s'event and s = '0'; + end falling_edge; +end NUMERIC_BIT; diff --git a/libraries/openieee/v87/numeric_bit.vhdl b/libraries/openieee/v87/numeric_bit.vhdl new file mode 100644 index 000000000..6a6dcc393 --- /dev/null +++ b/libraries/openieee/v87/numeric_bit.vhdl @@ -0,0 +1,211 @@ +-- This -*- vhdl -*- file is part of GHDL. +-- IEEE 1076.3 compliant numeric bit package. +-- 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 +-- . + +package NUMERIC_BIT is + type UNSIGNED is array (natural range <>) of BIT; + type SIGNED is array (natural range <>) of BIT; + + + function TO_INTEGER (ARG : UNSIGNED) return NATURAL; + function TO_INTEGER (ARG : SIGNED) return INTEGER; + -- Convert ARG to an integer. + -- Simulation is aborted in case of overflow. + -- Issue a warning in case of non-logical value. + + function TO_UNSIGNED (ARG, SIZE : NATURAL) return UNSIGNED; + -- Convert ARG to unsigned. + -- Result index range is SIZE - 1 downto 0. + -- Issue a warning if value is truncated. + + function TO_SIGNED (ARG : INTEGER; SIZE : NATURAL) return SIGNED; + -- Convert ARG to signed. + -- Result index range is SIZE - 1 downto 0. + -- Issue a warning if value is truncated. + + function resize (ARG : UNSIGNED; NEW_SIZE: natural) return UNSIGNED; + function resize (ARG : SIGNED; NEW_SIZE: natural) return SIGNED; + -- Result index range is NEW_SIZE - 1 downto 0 (unless null array). + -- For SIGNED, the sign of the result is the sign of ARG. + + function "=" (L, R : UNSIGNED) return BOOLEAN; + function "=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "/=" (L, R : UNSIGNED) return BOOLEAN; + function "/=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "/=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "<" (L, R : UNSIGNED) return BOOLEAN; + function "<" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "<" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "<=" (L, R : UNSIGNED) return BOOLEAN; + function "<=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "<=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function ">" (L, R : UNSIGNED) return BOOLEAN; + function ">" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function ">" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function ">=" (L, R : UNSIGNED) return BOOLEAN; + function ">=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function ">=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + + function "=" (L, R : SIGNED) return BOOLEAN; + function "=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "/=" (L, R : SIGNED) return BOOLEAN; + function "/=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "/=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "<" (L, R : SIGNED) return BOOLEAN; + function "<" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "<" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "<=" (L, R : SIGNED) return BOOLEAN; + function "<=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "<=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function ">" (L, R : SIGNED) return BOOLEAN; + function ">" (L : SIGNED; R : INTEGER) return BOOLEAN; + function ">" (L : INTEGER; R : SIGNED) return BOOLEAN; + function ">=" (L, R : SIGNED) return BOOLEAN; + function ">=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function ">=" (L : INTEGER; R : SIGNED) return BOOLEAN; + -- Issue a warning in case of non-logical value. + + function "-" (ARG : SIGNED) return SIGNED; + -- Compute -ARG. + -- Result index range is Arg'length - 1 downto 0. + + function "abs" (ARG : SIGNED) return SIGNED; + -- Compute abs ARG. + -- Result index range is Arg'length - 1 downto 0. + + function "+" (L, R : UNSIGNED) return UNSIGNED; + function "+" (L, R : SIGNED) return SIGNED; + function "-" (L, R : UNSIGNED) return UNSIGNED; + function "-" (L, R : SIGNED) return SIGNED; + -- Compute L +/- R. + -- Result index range is max (L'Length, R'Length) - 1 downto 0. + -- Issue a warning in case of non-logical value. + + function "+" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "+" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "+" (L : SIGNED; R : INTEGER) return SIGNED; + function "+" (L : INTEGER; R : SIGNED) return SIGNED; + function "-" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "-" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "-" (L : SIGNED; R : INTEGER) return SIGNED; + function "-" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L +/- R. + -- Result index range is V'Length - 1 downto 0, where V is the vector + -- parameter. + -- Issue a warning in case of non-logical value. + -- Issue a warning if value is truncated. + + function "*" (L, R : UNSIGNED) return UNSIGNED; + function "*" (L, R : SIGNED) return SIGNED; + -- Compute L * R + -- Result index range is L'Length + R'Length - 1 downto 0. + + function "*" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "*" (L : SIGNED; R : INTEGER) return SIGNED; + -- Compute L * R + -- R is converted to a vector of length L'length + + function "*" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "*" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L * R + -- L is converted to a vector of length R'length + + function "/" (L, R : UNSIGNED) return UNSIGNED; + function "/" (L, R : SIGNED) return SIGNED; + function "rem" (L, R : UNSIGNED) return UNSIGNED; + function "rem" (L, R : SIGNED) return SIGNED; + function "mod" (L, R : UNSIGNED) return UNSIGNED; + function "mod" (L, R : SIGNED) return SIGNED; + -- Compute L op R + -- Result index range is L'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + + function "/" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "/" (L : SIGNED; R : INTEGER) return SIGNED; + function "rem" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "rem" (L : SIGNED; R : INTEGER) return SIGNED; + function "mod" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "mod" (L : SIGNED; R : INTEGER) return SIGNED; + -- Compute L op R. + -- Result index range is L'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + + function "/" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "/" (L : INTEGER; R : SIGNED) return SIGNED; + function "rem" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "rem" (L : INTEGER; R : SIGNED) return SIGNED; + function "mod" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "mod" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L op R. + -- Result index range is R'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + -- Result may be truncated. + + function "not" (l : UNSIGNED) return UNSIGNED; + function "not" (l : SIGNED) return SIGNED; + function "and" (l, r : UNSIGNED) return UNSIGNED; + function "and" (l, r : SIGNED) return SIGNED; + function "nand" (l, r : UNSIGNED) return UNSIGNED; + function "nand" (l, r : SIGNED) return SIGNED; + function "or" (l, r : UNSIGNED) return UNSIGNED; + function "or" (l, r : SIGNED) return SIGNED; + function "nor" (l, r : UNSIGNED) return UNSIGNED; + function "nor" (l, r : SIGNED) return SIGNED; + function "xor" (l, r : UNSIGNED) return UNSIGNED; + function "xor" (l, r : SIGNED) return SIGNED; +--function "xnor" (l, r : UNSIGNED) return UNSIGNED; +--function "xnor" (l, r : SIGNED) return SIGNED; + -- Compute L OP R. + -- Result index range is L'Length - 1 downto 0. + -- No specific handling of null array: the index range of the result + -- would be -1 downto 0 (without warning). This it not what is specified + -- in 1076.3, but corresponds to the standard implementation. + -- No specific handling of non-logical values. Behaviour is compatible + -- with std_logic_1164. + + function shift_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function shift_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + function shift_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function shift_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + + function rotate_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function rotate_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + function rotate_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function rotate_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + +--function "sll" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; +--function "sll" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; +--function "srl" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; +--function "srl" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + +--function "rol" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; +--function "rol" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; +--function "ror" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; +--function "ror" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + + function rising_edge (signal s : bit) return boolean; + function falling_edge (signal s : bit) return boolean; +end NUMERIC_BIT; diff --git a/libraries/openieee/v87/numeric_std-body.vhdl b/libraries/openieee/v87/numeric_std-body.vhdl new file mode 100644 index 000000000..c716b19f3 --- /dev/null +++ b/libraries/openieee/v87/numeric_std-body.vhdl @@ -0,0 +1,2899 @@ +-- 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 +-- . + +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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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 ucompare (l, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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; diff --git a/libraries/openieee/v87/numeric_std.vhdl b/libraries/openieee/v87/numeric_std.vhdl new file mode 100644 index 000000000..e1fa946ca --- /dev/null +++ b/libraries/openieee/v87/numeric_std.vhdl @@ -0,0 +1,225 @@ +-- This -*- vhdl -*- file is part of GHDL. +-- IEEE 1076.3 compliant numeric std package. +-- 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 +-- . + +library IEEE; +use IEEE.STD_LOGIC_1164.all; + +package NUMERIC_STD is + type UNSIGNED is array (natural range <>) of STD_LOGIC; + type SIGNED is array (natural range <>) of STD_LOGIC; + + function TO_01 (S : SIGNED; XMAP : STD_LOGIC := '0') return SIGNED; + function TO_01 (S : UNSIGNED; XMAP : STD_LOGIC := '0') return UNSIGNED; + -- Convert 'H' and '1' to '1', 'L' and '0' to '0'. + -- If any other value is present, return (others => XMAP) + -- Issue a warning in that case, and if S is a null array. + -- Result index range is S'Length - 1 downto 0. + + function std_match (l, r : std_ulogic) return boolean; + function std_match (l, r : std_ulogic_vector) return boolean; + function std_match (l, r : std_logic_vector) return boolean; + function std_match (l, r : UNSIGNED) return boolean; + function std_match (l, r : SIGNED) return boolean; + -- Return True iff L and R matches. + + + function TO_INTEGER (ARG : UNSIGNED) return NATURAL; + function TO_INTEGER (ARG : SIGNED) return INTEGER; + -- Convert ARG to an integer. + -- Simulation is aborted in case of overflow. + -- Issue a warning in case of non-logical value. + + function TO_UNSIGNED (ARG, SIZE : NATURAL) return UNSIGNED; + -- Convert ARG to unsigned. + -- Result index range is SIZE - 1 downto 0. + -- Issue a warning if value is truncated. + + function TO_SIGNED (ARG : INTEGER; SIZE : NATURAL) return SIGNED; + -- Convert ARG to signed. + -- Result index range is SIZE - 1 downto 0. + -- Issue a warning if value is truncated. + + function resize (ARG : UNSIGNED; NEW_SIZE: natural) return UNSIGNED; + function resize (ARG : SIGNED; NEW_SIZE: natural) return SIGNED; + -- Result index range is NEW_SIZE - 1 downto 0 (unless null array). + -- For SIGNED, the sign of the result is the sign of ARG. + + function "=" (L, R : UNSIGNED) return BOOLEAN; + function "=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "/=" (L, R : UNSIGNED) return BOOLEAN; + function "/=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "/=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "<" (L, R : UNSIGNED) return BOOLEAN; + function "<" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "<" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "<=" (L, R : UNSIGNED) return BOOLEAN; + function "<=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "<=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function ">" (L, R : UNSIGNED) return BOOLEAN; + function ">" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function ">" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function ">=" (L, R : UNSIGNED) return BOOLEAN; + function ">=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function ">=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + + function "=" (L, R : SIGNED) return BOOLEAN; + function "=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "/=" (L, R : SIGNED) return BOOLEAN; + function "/=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "/=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "<" (L, R : SIGNED) return BOOLEAN; + function "<" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "<" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "<=" (L, R : SIGNED) return BOOLEAN; + function "<=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "<=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function ">" (L, R : SIGNED) return BOOLEAN; + function ">" (L : SIGNED; R : INTEGER) return BOOLEAN; + function ">" (L : INTEGER; R : SIGNED) return BOOLEAN; + function ">=" (L, R : SIGNED) return BOOLEAN; + function ">=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function ">=" (L : INTEGER; R : SIGNED) return BOOLEAN; + -- Issue a warning in case of non-logical value. + + function "-" (ARG : SIGNED) return SIGNED; + -- Compute -ARG. + -- Result index range is Arg'length - 1 downto 0. + + function "abs" (ARG : SIGNED) return SIGNED; + -- Compute abs ARG. + -- Result index range is Arg'length - 1 downto 0. + + function "+" (L, R : UNSIGNED) return UNSIGNED; + function "+" (L, R : SIGNED) return SIGNED; + function "-" (L, R : UNSIGNED) return UNSIGNED; + function "-" (L, R : SIGNED) return SIGNED; + -- Compute L +/- R. + -- Result index range is max (L'Length, R'Length) - 1 downto 0. + -- Issue a warning in case of non-logical value. + + function "+" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "+" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "+" (L : SIGNED; R : INTEGER) return SIGNED; + function "+" (L : INTEGER; R : SIGNED) return SIGNED; + function "-" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "-" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "-" (L : SIGNED; R : INTEGER) return SIGNED; + function "-" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L +/- R. + -- Result index range is V'Length - 1 downto 0, where V is the vector + -- parameter. + -- Issue a warning in case of non-logical value. + -- Issue a warning if value is truncated. + + function "*" (L, R : UNSIGNED) return UNSIGNED; + function "*" (L, R : SIGNED) return SIGNED; + -- Compute L * R + -- Result index range is L'Length + R'Length - 1 downto 0. + + function "*" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "*" (L : SIGNED; R : INTEGER) return SIGNED; + -- Compute L * R + -- R is converted to a vector of length L'length + + function "*" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "*" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L * R + -- L is converted to a vector of length R'length + + function "/" (L, R : UNSIGNED) return UNSIGNED; + function "/" (L, R : SIGNED) return SIGNED; + function "rem" (L, R : UNSIGNED) return UNSIGNED; + function "rem" (L, R : SIGNED) return SIGNED; + function "mod" (L, R : UNSIGNED) return UNSIGNED; + function "mod" (L, R : SIGNED) return SIGNED; + -- Compute L op R + -- Result index range is L'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + + function "/" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "/" (L : SIGNED; R : INTEGER) return SIGNED; + function "rem" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "rem" (L : SIGNED; R : INTEGER) return SIGNED; + function "mod" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "mod" (L : SIGNED; R : INTEGER) return SIGNED; + -- Compute L op R. + -- Result index range is L'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + + function "/" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "/" (L : INTEGER; R : SIGNED) return SIGNED; + function "rem" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "rem" (L : INTEGER; R : SIGNED) return SIGNED; + function "mod" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "mod" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L op R. + -- Result index range is R'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + -- Result may be truncated. + + function "not" (l : UNSIGNED) return UNSIGNED; + function "not" (l : SIGNED) return SIGNED; + function "and" (l, r : UNSIGNED) return UNSIGNED; + function "and" (l, r : SIGNED) return SIGNED; + function "nand" (l, r : UNSIGNED) return UNSIGNED; + function "nand" (l, r : SIGNED) return SIGNED; + function "or" (l, r : UNSIGNED) return UNSIGNED; + function "or" (l, r : SIGNED) return SIGNED; + function "nor" (l, r : UNSIGNED) return UNSIGNED; + function "nor" (l, r : SIGNED) return SIGNED; + function "xor" (l, r : UNSIGNED) return UNSIGNED; + function "xor" (l, r : SIGNED) return SIGNED; +--function "xnor" (l, r : UNSIGNED) return UNSIGNED; +--function "xnor" (l, r : SIGNED) return SIGNED; + -- Compute L OP R. + -- Result index range is L'Length - 1 downto 0. + -- No specific handling of null array: the index range of the result + -- would be -1 downto 0 (without warning). This it not what is specified + -- in 1076.3, but corresponds to the standard implementation. + -- No specific handling of non-logical values. Behaviour is compatible + -- with std_logic_1164. + + function shift_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function shift_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + function shift_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function shift_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + + function rotate_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function rotate_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + function rotate_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function rotate_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + +--function "sll" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; +--function "sll" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; +--function "srl" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; +--function "srl" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + +--function "rol" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; +--function "rol" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; +--function "ror" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; +--function "ror" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. +end NUMERIC_STD; diff --git a/libraries/openieee/v87/std_logic_1164-body.vhdl b/libraries/openieee/v87/std_logic_1164-body.vhdl new file mode 100644 index 000000000..b6dd265d0 --- /dev/null +++ b/libraries/openieee/v87/std_logic_1164-body.vhdl @@ -0,0 +1,713 @@ +-- This -*- vhdl -*- file was generated from std_logic_1164-body.proto +-- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only +-- on the specifications. This file is part of GHDL. +-- 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 +-- . + +-- This is a template file. To avoid errors and duplication, the python +-- script build.py generate most of the bodies. + +package body std_logic_1164 is + + type table_1d is array (std_ulogic) of std_ulogic; + type table_2d is array (std_ulogic, std_ulogic) of std_ulogic; + + constant resolution : table_2d := + -- UX01ZWLH- + ("UUUUUUUUU", -- U + "UXXXXXXXX", -- X + "UX0X0000X", -- 0 + "UXX11111X", -- 1 + "UX01ZWLHX", -- Z + "UX01WWWWX", -- W + "UX01LWLWX", -- L + "UX01HWWHX", -- H + "UXXXXXXXX" -- - + ); + + function resolved (s : std_ulogic_vector) return std_ulogic + is + variable res : std_ulogic := 'Z'; + begin + for I in s'range loop + res := resolution (res, s (I)); + end loop; + return res; + end resolved; + + + constant and_table : table_2d := + -- UX01ZWLH- + ("UU0UUU0UU", -- U + "UX0XXX0XX", -- X + "000000000", -- 0 + "UX01XX01X", -- 1 + "UX0XXX0XX", -- Z + "UX0XXX0XX", -- W + "000000000", -- L + "UX01XX01X", -- H + "UX0XXX0XX" -- - + ); + + constant nand_table : table_2d := + -- UX01ZWLH- + ("UU1UUU1UU", -- U + "UX1XXX1XX", -- X + "111111111", -- 0 + "UX10XX10X", -- 1 + "UX1XXX1XX", -- Z + "UX1XXX1XX", -- W + "111111111", -- L + "UX10XX10X", -- H + "UX1XXX1XX" -- - + ); + + constant or_table : table_2d := + -- UX01ZWLH- + ("UUU1UUU1U", -- U + "UXX1XXX1X", -- X + "UX01XX01X", -- 0 + "111111111", -- 1 + "UXX1XXX1X", -- Z + "UXX1XXX1X", -- W + "UX01XX01X", -- L + "111111111", -- H + "UXX1XXX1X" -- - + ); + + constant nor_table : table_2d := + -- UX01ZWLH- + ("UUU0UUU0U", -- U + "UXX0XXX0X", -- X + "UX10XX10X", -- 0 + "000000000", -- 1 + "UXX0XXX0X", -- Z + "UXX0XXX0X", -- W + "UX10XX10X", -- L + "000000000", -- H + "UXX0XXX0X" -- - + ); + + constant xor_table : table_2d := + -- UX01ZWLH- + ("UUUUUUUUU", -- U + "UXXXXXXXX", -- X + "UX01XX01X", -- 0 + "UX10XX10X", -- 1 + "UXXXXXXXX", -- Z + "UXXXXXXXX", -- W + "UX01XX01X", -- L + "UX10XX10X", -- H + "UXXXXXXXX" -- - + ); + + constant not_table : table_1d := + -- UX01ZWLH- + "UX10XX10X"; + + + function "and" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return and_table (l, r); + end "and"; + + function "nand" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return nand_table (l, r); + end "nand"; + + function "or" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return or_table (l, r); + end "or"; + + function "nor" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return nor_table (l, r); + end "nor"; + + function "xor" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return xor_table (l, r); + end "xor"; + + function "not" (l : std_ulogic) return UX01 is + begin + return not_table (l); + end "not"; + + function "and" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'and' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := and_table (la (I), ra (I)); + end loop; + end if; + return res; + end "and"; + + function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'nand' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := nand_table (la (I), ra (I)); + end loop; + end if; + return res; + end "nand"; + + function "or" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'or' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := or_table (la (I), ra (I)); + end loop; + end if; + return res; + end "or"; + + function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'nor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := nor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "nor"; + + function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'xor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := xor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "xor"; + + function "not" (l : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := not_table (la (I)); + end loop; + return res; + end "not"; + + function "and" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'and' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := and_table (la (I), ra (I)); + end loop; + end if; + return res; + end "and"; + + function "nand" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'nand' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := nand_table (la (I), ra (I)); + end loop; + end if; + return res; + end "nand"; + + function "or" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'or' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := or_table (la (I), ra (I)); + end loop; + end if; + return res; + end "or"; + + function "nor" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'nor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := nor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "nor"; + + function "xor" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'xor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := xor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "xor"; + + function "not" (l : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := not_table (la (I)); + end loop; + return res; + end "not"; + + -- Conversion functions. + -- The result range (for vectors) is S'Length - 1 downto 0. + -- XMAP is return for values not in '0', '1', 'L', 'H'. + function to_bit (s : std_ulogic; xmap : bit := '0') return bit is + begin + case s is + when '0' | 'L' => + return '0'; + when '1' | 'H' => + return '1'; + when others => + return xmap; + end case; + end to_bit; + + type bit_to_std_table is array (bit) of std_ulogic; + constant bit_to_std : bit_to_std_table := "01"; + + + function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') + return bit_vector + is + subtype res_range is natural range s'length - 1 downto 0; + alias as : std_ulogic_vector (res_range) is s; + variable res : bit_vector (res_range); + variable b : bit; + begin + for I in res_range loop + -- Inline for efficiency. + case as (I) is + when '0' | 'L' => + b := '0'; + when '1' | 'H' => + b := '1'; + when others => + b := xmap; + end case; + res (I) := b; + end loop; + return res; + end to_bitvector; + + function to_bitvector (s : std_logic_vector; xmap : bit := '0') + return bit_vector + is + subtype res_range is natural range s'length - 1 downto 0; + alias as : std_logic_vector (res_range) is s; + variable res : bit_vector (res_range); + variable b : bit; + begin + for I in res_range loop + -- Inline for efficiency. + case as (I) is + when '0' | 'L' => + b := '0'; + when '1' | 'H' => + b := '1'; + when others => + b := xmap; + end case; + res (I) := b; + end loop; + return res; + end to_bitvector; + + function to_stdulogicvector (b : bit_vector) return std_ulogic_vector is + subtype res_range is natural range b'length - 1 downto 0; + alias ab : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for I in res_range loop + res (I) := bit_to_std (ab (I)); + end loop; + return res; + end to_stdulogicvector; + + function to_stdlogicvector (b : bit_vector) return std_logic_vector is + subtype res_range is natural range b'length - 1 downto 0; + alias ab : bit_vector (res_range) is b; + variable res : std_logic_vector (res_range); + begin + for I in res_range loop + res (I) := bit_to_std (ab (I)); + end loop; + return res; + end to_stdlogicvector; + + function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (s'length - 1 downto 0); + begin + return res_type (s); + end to_stdulogicvector; + + function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (s'length - 1 downto 0); + begin + return res_type (s); + end to_stdlogicvector; + + function to_stdulogic (b : bit) return std_ulogic is + begin + return bit_to_std (b); + end to_stdulogic; + + -- Normalization. + type table_std_x01 is array (std_ulogic) of X01; + constant std_to_x01 : table_std_x01 := ('U' | 'X' | 'Z' | 'W' | '-' => 'X', + '0' | 'L' => '0', + '1' | 'H' => '1'); + + type table_bit_x01 is array (bit) of X01; + constant bit_to_x01 : table_bit_x01 := ('0' => '0', + '1' => '1'); + + + type table_std_x01z is array (std_ulogic) of X01Z; + constant std_to_x01z : table_std_x01z := ('U' | 'X' | 'W' | '-' => 'X', + '0' | 'L' => '0', + '1' | 'H' => '1', + 'Z' => 'Z'); + + type table_std_ux01 is array (std_ulogic) of UX01; + constant std_to_ux01 : table_std_ux01 := ('U' => 'U', + 'X' | 'Z' | 'W' | '-' => 'X', + '0' | 'L' => '0', + '1' | 'H' => '1'); + + + function to_X01 (s : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_x01 (sa (i)); + end loop; + return res; + end to_X01; + + function to_X01 (s : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_x01 (sa (i)); + end loop; + return res; + end to_X01; + + function to_X01 (s : std_ulogic) return X01 is + begin + return std_to_x01 (s); + end to_X01; + + function to_X01 (b : bit_vector) return std_ulogic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_X01; + + function to_X01 (b : bit_vector) return std_logic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_logic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_X01; + + function to_X01 (b : bit) return X01 is + begin + return bit_to_x01 (b); + end to_X01; + + function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_x01z (sa (i)); + end loop; + return res; + end to_X01Z; + + function to_X01Z (s : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_x01z (sa (i)); + end loop; + return res; + end to_X01Z; + + function to_X01Z (s : std_ulogic) return X01Z is + begin + return std_to_x01z (s); + end to_X01Z; + + function to_X01Z (b : bit_vector) return std_ulogic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_X01Z; + + function to_X01Z (b : bit_vector) return std_logic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_logic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_X01Z; + + function to_X01Z (b : bit) return X01Z is + begin + return bit_to_x01 (b); + end to_X01Z; + + function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_ux01 (sa (i)); + end loop; + return res; + end to_UX01; + + function to_UX01 (s : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_ux01 (sa (i)); + end loop; + return res; + end to_UX01; + + function to_UX01 (s : std_ulogic) return UX01 is + begin + return std_to_ux01 (s); + end to_UX01; + + function to_UX01 (b : bit_vector) return std_ulogic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_UX01; + + function to_UX01 (b : bit_vector) return std_logic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_logic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_UX01; + + function to_UX01 (b : bit) return UX01 is + begin + return bit_to_x01 (b); + end to_UX01; + + function rising_edge (signal s : std_ulogic) return boolean is + begin + return s'event + and to_x01 (s'last_value) = '0' + and to_x01 (s) = '1'; + end rising_edge; + + function falling_edge (signal s : std_ulogic) return boolean is + begin + return s'event + and to_x01 (s'last_value) = '1' + and to_x01 (s) = '0'; + end falling_edge; + + type std_x_array is array (std_ulogic) of boolean; + constant std_x : std_x_array := ('U' | 'X' | 'Z' | 'W' | '-' => true, + '0' | '1' | 'L' | 'H' => false); + + + function is_X (s : std_ulogic_vector) return boolean is + begin + for i in s'range loop + if std_x (s (i)) then + return true; + end if; + end loop; + return false; + end is_X; + + function is_X (s : std_logic_vector) return boolean is + begin + for i in s'range loop + if std_x (s (i)) then + return true; + end if; + end loop; + return false; + end is_X; + + function is_X (s : std_ulogic) return boolean is + begin + return std_x (s); + end is_X; +end std_logic_1164; diff --git a/libraries/openieee/v87/std_logic_1164.vhdl b/libraries/openieee/v87/std_logic_1164.vhdl new file mode 100644 index 000000000..67e63dac5 --- /dev/null +++ b/libraries/openieee/v87/std_logic_1164.vhdl @@ -0,0 +1,138 @@ +-- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only +-- on the specifications. This file is part of GHDL. +-- 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 +-- . + +package std_logic_1164 is + + -- Unresolved logic state. + type std_ulogic is + ( + 'U', -- Uninitialized, this is also the default value. + 'X', -- Unknown / conflict value (forcing level). + '0', -- 0 (forcing level). + '1', -- 1 (forcing level). + 'Z', -- High impedance. + 'W', -- Unknown / conflict (weak level). + 'L', -- 0 (weak level). + 'H', -- 1 (weak level). + '-' -- Don't care. + ); + + -- Vector of logic state. + type std_ulogic_vector is array (natural range <>) of std_ulogic; + + -- Resolution function. + -- If S is empty, returns 'Z'. + -- If S has one element, return the element. + -- Otherwise, 'U' is the strongest. + -- then 'X' + -- then '0' and '1' + -- then 'W' + -- then 'H' and 'L' + -- then 'Z'. + function resolved (s : std_ulogic_vector) return std_ulogic; + + -- Resolved logic state. + subtype std_logic is resolved std_ulogic; + + -- Vector of std_logic. + type std_logic_vector is array (natural range <>) of std_logic; + + -- Subtypes of std_ulogic. The names give the values. + subtype X01 is resolved std_ulogic range 'X' to '1'; + subtype X01Z is resolved std_ulogic range 'X' to 'Z'; + subtype UX01 is resolved std_ulogic range 'U' to '1'; + subtype UX01Z is resolved std_ulogic range 'U' to 'Z'; + + -- Logical operators. + -- For logical operations, the inputs are first normalized to UX01: + -- 0 and L are normalized to 0, 1 and 1 are normalized to 1, U isnt changed, + -- all other states are normalized to X. + -- Then the classical electric rules are followed. + function "and" (l : std_ulogic; r : std_ulogic) return UX01; + function "nand" (l : std_ulogic; r : std_ulogic) return UX01; + function "or" (l : std_ulogic; r : std_ulogic) return UX01; + function "nor" (l : std_ulogic; r : std_ulogic) return UX01; + function "xor" (l : std_ulogic; r : std_ulogic) return UX01; + function "not" (l : std_ulogic) return UX01; + + -- Logical operators for vectors. + -- An assertion of severity failure fails if the length of L and R aren't + -- equal. The result range is 1 to L'Length. + function "and" (l, r : std_logic_vector) return std_logic_vector; + function "nand" (l, r : std_logic_vector) return std_logic_vector; + function "or" (l, r : std_logic_vector) return std_logic_vector; + function "nor" (l, r : std_logic_vector) return std_logic_vector; + function "xor" (l, r : std_logic_vector) return std_logic_vector; + function "not" (l : std_logic_vector) return std_logic_vector; + + function "and" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "or" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "not" (l : std_ulogic_vector) return std_ulogic_vector; + + -- Conversion functions. + -- The result range (for vectors) is S'Length - 1 downto 0. + -- XMAP is return for values not in '0', '1', 'L', 'H'. + function to_bit (s : std_ulogic; xmap : bit := '0') return bit; + function to_bitvector (s : std_logic_vector; xmap : bit := '0') + return bit_vector; + function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') + return bit_vector; + + function to_stdulogic (b : bit) return std_ulogic; + function to_stdlogicvector (b : bit_vector) return std_logic_vector; + function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector; + function to_stdulogicvector (b : bit_vector) return std_ulogic_vector; + function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector; + + -- Normalization. + -- The result range (for vectors) is 1 to S'Length. + function to_X01 (s : std_logic_vector) return std_logic_vector; + function to_X01 (s : std_ulogic_vector) return std_ulogic_vector; + function to_X01 (s : std_ulogic) return X01; + function to_X01 (b : bit_vector) return std_logic_vector; + function to_X01 (b : bit_vector) return std_ulogic_vector; + function to_X01 (b : bit) return X01; + + function to_X01Z (s : std_logic_vector) return std_logic_vector; + function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector; + function to_X01Z (s : std_ulogic) return X01Z; + function to_X01Z (b : bit_vector) return std_logic_vector; + function to_X01Z (b : bit_vector) return std_ulogic_vector; + function to_X01Z (b : bit) return X01Z; + + function to_UX01 (s : std_logic_vector) return std_logic_vector; + function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector; + function to_UX01 (s : std_ulogic) return UX01; + function to_UX01 (b : bit_vector) return std_logic_vector; + function to_UX01 (b : bit_vector) return std_ulogic_vector; + function to_UX01 (b : bit) return UX01; + + -- Edge detection. + -- An edge is detected in case of event on s, and X01 normalized value + -- rises from 0 to 1 or falls from 1 to 0. + function rising_edge (signal s : std_ulogic) return boolean; + function falling_edge (signal s : std_ulogic) return boolean; + + -- Test for unknown. Only 0, 1, L and H are known values. + function is_X (s : std_ulogic_vector) return boolean; + function is_X (s : std_logic_vector) return boolean; + function is_X (s : std_ulogic) return boolean; +end std_logic_1164; diff --git a/libraries/openieee/v93/numeric_bit-body.vhdl b/libraries/openieee/v93/numeric_bit-body.vhdl new file mode 100644 index 000000000..869b0d2b2 --- /dev/null +++ b/libraries/openieee/v93/numeric_bit-body.vhdl @@ -0,0 +1,2505 @@ +-- This -*- vhdl -*- file was generated from numeric_bit-body.proto +-- This -*- vhdl -*- file is part of GHDL. +-- IEEE 1076.3 compliant numeric bit 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 +-- . + +package body NUMERIC_BIT 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 bit; + constant nat1_to_01 : nat1_to_sl_type := (0 => '0', 1 => '1'); + + subtype sl_01 is bit; + + 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 compare_type is (compare_unknown, + compare_lt, + compare_eq, + compare_gt); + + 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 res : natural := 0; + begin + if arg'length = 0 then + assert NO_WARNING + report "NUMERIC_BIT.TO_INTEGER: null array detected, returning 0" + severity warning; + return 0; + end if; + + for i in arg'range loop + res := res + res; + if arg (i) = '1' then + res := res + 1; + end if; + end loop; + + return res; + end TO_INTEGER; + + function TO_INTEGER (ARG : SIGNED) return INTEGER + is + alias argn : SIGNED (ARG'Length -1 downto 0) is arg; + variable res : integer := 0; + variable b : bit; + begin + if argn'length = 0 then + assert NO_WARNING + report "NUMERIC_BIT.TO_INTEGER: null array 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_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_BIT.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 : bit; + 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_BIT.TO_SIGNED: vector is truncated" + severity warning; + end if; + return res; + end TO_SIGNED; + + + function "+" (l, 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 : bit; + 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 := la (i); + end if; + if i > ra'left then + rb := '0'; + else + rb := ra (i); + end if; + res (i) := compute_sum (carry, rb, lb); + carry := compute_carry (carry, rb, lb); + end loop; + return res; + end "+"; + + function "+" (l, 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 : bit; + 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 := la (i); + end if; + if i > ra'left then + rb := r (r'left); + else + rb := ra (i); + 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 : bit; + begin + if res'length < 0 then + return null_UNSIGNED; + end if; + carry := '0'; + r1 := r; + for i in res'reverse_range loop + lb := la (i); + + r2 := r1 / 2; + rd := r1 - 2 * r2; + r1 := r2; + rb := nat1_to_01 (rd); + 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 : bit; + begin + if res'length < 0 then + return null_UNSIGNED; + end if; + carry := '0'; + l1 := l; + for i in res'reverse_range loop + rb := ra (i); + + l2 := l1 / 2; + ld := l1 - 2 * l2; + l1 := l2; + lb := nat1_to_01 (ld); + 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 : bit; + begin + if res'length < 0 then + return null_SIGNED; + end if; + carry := '0'; + r1 := r; + for i in res'reverse_range loop + lb := 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); + 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 : bit; + begin + if res'length < 0 then + return null_SIGNED; + end if; + carry := '0'; + l1 := l; + for i in res'reverse_range loop + rb := 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); + 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, 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 : bit; + 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 := la (i); + end if; + if i > ra'left then + rb := '0'; + else + rb := ra (i); + 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, 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 : bit; + 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 := la (i); + end if; + if i > ra'left then + rb := r (r'left); + else + rb := ra (i); + 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 : bit; + begin + if res'length < 0 then + return null_UNSIGNED; + end if; + carry := '1'; + r1 := r; + for i in res'reverse_range loop + lb := la (i); + + r2 := r1 / 2; + rd := r1 - 2 * r2; + r1 := r2; + rb := nat1_to_01 (rd); + 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 : bit; + begin + if res'length < 0 then + return null_UNSIGNED; + end if; + carry := '1'; + l1 := l; + for i in res'reverse_range loop + rb := ra (i); + + l2 := l1 / 2; + ld := l1 - 2 * l2; + l1 := l2; + lb := nat1_to_01 (ld); + 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 : bit; + begin + if res'length < 0 then + return null_SIGNED; + end if; + carry := '1'; + r1 := r; + for i in res'reverse_range loop + lb := 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); + 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 : bit; + begin + if res'length < 0 then + return null_SIGNED; + end if; + carry := '1'; + l1 := l; + for i in res'reverse_range loop + rb := 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); + 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, 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 : bit; + 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 := 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; + end if; + end loop; + return res; + end "*"; + + function "*" (L, 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 : bit; + 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 := 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; + 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 bit + is + variable res : bit := '0'; + begin + for i in a'range loop + 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 : bit; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_unsigned; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_unsigned; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_unsigned; + 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 bit + is + variable res : bit := '0'; + begin + for i in a'range loop + 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 : bit; + begin + if arga'length = 0 then + return null_signed; + 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 : bit; + begin + if arga'length = 0 then + return null_signed; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_signed; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_signed; + 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, 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 : bit := has_0x (r); + begin + if la'length = 0 or ra'length = 0 then + return null_signed; + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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 => '0'); + 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, 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 : bit; + variable res : compare_type; + begin + res := compare_eq; + for i in 0 to sz loop + if i > la'left then + lb := '0'; + else + lb := la (i); + end if; + if i > ra'left then + rb := '0'; + else + rb := ra (i); + 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, 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 : bit; + variable res : compare_type; + begin + -- Consider sign bit as S * -(2**N). + lb := la (la'left); + rb := 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 := la (i); + end if; + if i > ra'left then + rb := r (r'left); + else + rb := ra (i); + 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 : bit; + variable res : compare_type; + begin + res := compare_eq; + r1 := r; + for i in la'reverse_range loop + lb := la (i); + r2 := r1 / 2; + rd := r1 - 2 * r2; + r1 := r2; + rb := nat1_to_01 (rd); + 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 : bit; + variable res : compare_type; + begin + res := compare_eq; + r1 := r; + for i in la'reverse_range loop + lb := 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 = '1' and rb = '0' then + res := compare_gt; + elsif lb = '0' and rb = '1' then + res := compare_lt; + end if; + end loop; + if 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, 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); + return res = compare_eq; + end "="; + + function "=" (l, 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); + 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); + 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); + 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); + 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); + return compare_eq = res; + end "="; + + function "/=" (l, 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); + return res /= compare_eq; + end "/="; + + function "/=" (l, 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); + 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); + 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); + 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); + 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); + return compare_eq /= res; + end "/="; + + function ">" (l, 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); + return res > compare_eq; + end ">"; + + function ">" (l, 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); + 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); + 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); + 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); + 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); + return compare_eq > res; + end ">"; + + function ">=" (l, 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); + return res >= compare_eq; + end ">="; + + function ">=" (l, 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); + 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); + 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); + 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); + 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); + return compare_eq >= res; + end ">="; + + function "<" (l, 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); + return res < compare_eq; + end "<"; + + function "<" (l, 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); + 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); + 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); + 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); + 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); + return compare_eq < res; + end "<"; + + function "<=" (l, 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); + return res <= compare_eq; + end "<="; + + function "<=" (l, 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); + 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); + 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); + 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); + 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); + 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 "sll" (ARG : UNSIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then + res (res'left downto count) := arg1 (arg1'left - count downto 0); + elsif count < 0 and count >= -arg1'left then + res (res'left + count downto 0) := arg1 (arg1'left downto -count); + end if; + return res; + end "sll"; + + function "srl" (ARG : UNSIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then + res (res'left - count downto 0) := arg1 (arg1'left downto count); + elsif count < 0 and count >= -arg1'left then + res (res'left downto -count) := arg1 (arg1'left + count downto 0); + end if; + return res; + end "srl"; + + function "rol" (ARG : UNSIGNED; COUNT: integer) 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 mod 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 "rol"; + + function "ror" (ARG : UNSIGNED; COUNT: integer) 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 mod 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 "ror"; + + 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; + + function "sll" (ARG : SIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then + res (res'left downto count) := arg1 (arg1'left - count downto 0); + elsif count < 0 and count >= -arg1'left then + res (res'left + count downto 0) := arg1 (arg1'left downto -count); + end if; + return res; + end "sll"; + + function "srl" (ARG : SIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then + res (res'left - count downto 0) := arg1 (arg1'left downto count); + elsif count < 0 and count >= -arg1'left then + res (res'left downto -count) := arg1 (arg1'left + count downto 0); + end if; + return res; + end "srl"; + + function "rol" (ARG : SIGNED; COUNT: integer) 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 mod 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 "rol"; + + function "ror" (ARG : SIGNED; COUNT: integer) 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 mod 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 "ror"; + + function rising_edge (signal s : bit) return boolean is + begin + return s'event and s = '1'; + end rising_edge; + + function falling_edge (signal s : bit) return boolean is + begin + return s'event and s = '0'; + end falling_edge; +end NUMERIC_BIT; diff --git a/libraries/openieee/v93/numeric_bit.vhdl b/libraries/openieee/v93/numeric_bit.vhdl new file mode 100644 index 000000000..eb21bbc2f --- /dev/null +++ b/libraries/openieee/v93/numeric_bit.vhdl @@ -0,0 +1,211 @@ +-- This -*- vhdl -*- file is part of GHDL. +-- IEEE 1076.3 compliant numeric bit package. +-- 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 +-- . + +package NUMERIC_BIT is + type UNSIGNED is array (natural range <>) of BIT; + type SIGNED is array (natural range <>) of BIT; + + + function TO_INTEGER (ARG : UNSIGNED) return NATURAL; + function TO_INTEGER (ARG : SIGNED) return INTEGER; + -- Convert ARG to an integer. + -- Simulation is aborted in case of overflow. + -- Issue a warning in case of non-logical value. + + function TO_UNSIGNED (ARG, SIZE : NATURAL) return UNSIGNED; + -- Convert ARG to unsigned. + -- Result index range is SIZE - 1 downto 0. + -- Issue a warning if value is truncated. + + function TO_SIGNED (ARG : INTEGER; SIZE : NATURAL) return SIGNED; + -- Convert ARG to signed. + -- Result index range is SIZE - 1 downto 0. + -- Issue a warning if value is truncated. + + function resize (ARG : UNSIGNED; NEW_SIZE: natural) return UNSIGNED; + function resize (ARG : SIGNED; NEW_SIZE: natural) return SIGNED; + -- Result index range is NEW_SIZE - 1 downto 0 (unless null array). + -- For SIGNED, the sign of the result is the sign of ARG. + + function "=" (L, R : UNSIGNED) return BOOLEAN; + function "=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "/=" (L, R : UNSIGNED) return BOOLEAN; + function "/=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "/=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "<" (L, R : UNSIGNED) return BOOLEAN; + function "<" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "<" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "<=" (L, R : UNSIGNED) return BOOLEAN; + function "<=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "<=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function ">" (L, R : UNSIGNED) return BOOLEAN; + function ">" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function ">" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function ">=" (L, R : UNSIGNED) return BOOLEAN; + function ">=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function ">=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + + function "=" (L, R : SIGNED) return BOOLEAN; + function "=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "/=" (L, R : SIGNED) return BOOLEAN; + function "/=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "/=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "<" (L, R : SIGNED) return BOOLEAN; + function "<" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "<" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "<=" (L, R : SIGNED) return BOOLEAN; + function "<=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "<=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function ">" (L, R : SIGNED) return BOOLEAN; + function ">" (L : SIGNED; R : INTEGER) return BOOLEAN; + function ">" (L : INTEGER; R : SIGNED) return BOOLEAN; + function ">=" (L, R : SIGNED) return BOOLEAN; + function ">=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function ">=" (L : INTEGER; R : SIGNED) return BOOLEAN; + -- Issue a warning in case of non-logical value. + + function "-" (ARG : SIGNED) return SIGNED; + -- Compute -ARG. + -- Result index range is Arg'length - 1 downto 0. + + function "abs" (ARG : SIGNED) return SIGNED; + -- Compute abs ARG. + -- Result index range is Arg'length - 1 downto 0. + + function "+" (L, R : UNSIGNED) return UNSIGNED; + function "+" (L, R : SIGNED) return SIGNED; + function "-" (L, R : UNSIGNED) return UNSIGNED; + function "-" (L, R : SIGNED) return SIGNED; + -- Compute L +/- R. + -- Result index range is max (L'Length, R'Length) - 1 downto 0. + -- Issue a warning in case of non-logical value. + + function "+" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "+" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "+" (L : SIGNED; R : INTEGER) return SIGNED; + function "+" (L : INTEGER; R : SIGNED) return SIGNED; + function "-" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "-" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "-" (L : SIGNED; R : INTEGER) return SIGNED; + function "-" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L +/- R. + -- Result index range is V'Length - 1 downto 0, where V is the vector + -- parameter. + -- Issue a warning in case of non-logical value. + -- Issue a warning if value is truncated. + + function "*" (L, R : UNSIGNED) return UNSIGNED; + function "*" (L, R : SIGNED) return SIGNED; + -- Compute L * R + -- Result index range is L'Length + R'Length - 1 downto 0. + + function "*" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "*" (L : SIGNED; R : INTEGER) return SIGNED; + -- Compute L * R + -- R is converted to a vector of length L'length + + function "*" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "*" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L * R + -- L is converted to a vector of length R'length + + function "/" (L, R : UNSIGNED) return UNSIGNED; + function "/" (L, R : SIGNED) return SIGNED; + function "rem" (L, R : UNSIGNED) return UNSIGNED; + function "rem" (L, R : SIGNED) return SIGNED; + function "mod" (L, R : UNSIGNED) return UNSIGNED; + function "mod" (L, R : SIGNED) return SIGNED; + -- Compute L op R + -- Result index range is L'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + + function "/" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "/" (L : SIGNED; R : INTEGER) return SIGNED; + function "rem" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "rem" (L : SIGNED; R : INTEGER) return SIGNED; + function "mod" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "mod" (L : SIGNED; R : INTEGER) return SIGNED; + -- Compute L op R. + -- Result index range is L'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + + function "/" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "/" (L : INTEGER; R : SIGNED) return SIGNED; + function "rem" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "rem" (L : INTEGER; R : SIGNED) return SIGNED; + function "mod" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "mod" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L op R. + -- Result index range is R'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + -- Result may be truncated. + + function "not" (l : UNSIGNED) return UNSIGNED; + function "not" (l : SIGNED) return SIGNED; + function "and" (l, r : UNSIGNED) return UNSIGNED; + function "and" (l, r : SIGNED) return SIGNED; + function "nand" (l, r : UNSIGNED) return UNSIGNED; + function "nand" (l, r : SIGNED) return SIGNED; + function "or" (l, r : UNSIGNED) return UNSIGNED; + function "or" (l, r : SIGNED) return SIGNED; + function "nor" (l, r : UNSIGNED) return UNSIGNED; + function "nor" (l, r : SIGNED) return SIGNED; + function "xor" (l, r : UNSIGNED) return UNSIGNED; + function "xor" (l, r : SIGNED) return SIGNED; + function "xnor" (l, r : UNSIGNED) return UNSIGNED; + function "xnor" (l, r : SIGNED) return SIGNED; + -- Compute L OP R. + -- Result index range is L'Length - 1 downto 0. + -- No specific handling of null array: the index range of the result + -- would be -1 downto 0 (without warning). This it not what is specified + -- in 1076.3, but corresponds to the standard implementation. + -- No specific handling of non-logical values. Behaviour is compatible + -- with std_logic_1164. + + function shift_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function shift_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + function shift_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function shift_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + + function rotate_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function rotate_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + function rotate_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function rotate_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + + function "sll" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; + function "sll" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + function "srl" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; + function "srl" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + + function "rol" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; + function "rol" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + function "ror" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; + function "ror" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + + function rising_edge (signal s : bit) return boolean; + function falling_edge (signal s : bit) return boolean; +end NUMERIC_BIT; diff --git a/libraries/openieee/v93/numeric_std-body.vhdl b/libraries/openieee/v93/numeric_std-body.vhdl new file mode 100644 index 000000000..0625a49f0 --- /dev/null +++ b/libraries/openieee/v93/numeric_std-body.vhdl @@ -0,0 +1,3071 @@ +-- 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 +-- . + +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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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 "sll" (ARG : UNSIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then + res (res'left downto count) := arg1 (arg1'left - count downto 0); + elsif count < 0 and count >= -arg1'left then + res (res'left + count downto 0) := arg1 (arg1'left downto -count); + end if; + return res; + end "sll"; + + function "srl" (ARG : UNSIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then + res (res'left - count downto 0) := arg1 (arg1'left downto count); + elsif count < 0 and count >= -arg1'left then + res (res'left downto -count) := arg1 (arg1'left + count downto 0); + end if; + return res; + end "srl"; + + function "rol" (ARG : UNSIGNED; COUNT: integer) 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 mod 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 "rol"; + + function "ror" (ARG : UNSIGNED; COUNT: integer) 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 mod 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 "ror"; + + 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; + + function "sll" (ARG : SIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then + res (res'left downto count) := arg1 (arg1'left - count downto 0); + elsif count < 0 and count >= -arg1'left then + res (res'left + count downto 0) := arg1 (arg1'left downto -count); + end if; + return res; + end "sll"; + + function "srl" (ARG : SIGNED; COUNT: INTEGER) 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 >= 0 and count <= arg1'left then + res (res'left - count downto 0) := arg1 (arg1'left downto count); + elsif count < 0 and count >= -arg1'left then + res (res'left downto -count) := arg1 (arg1'left + count downto 0); + end if; + return res; + end "srl"; + + function "rol" (ARG : SIGNED; COUNT: integer) 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 mod 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 "rol"; + + function "ror" (ARG : SIGNED; COUNT: integer) 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 mod 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 "ror"; +end NUMERIC_STD; diff --git a/libraries/openieee/v93/numeric_std.vhdl b/libraries/openieee/v93/numeric_std.vhdl new file mode 100644 index 000000000..8f58221ee --- /dev/null +++ b/libraries/openieee/v93/numeric_std.vhdl @@ -0,0 +1,225 @@ +-- This -*- vhdl -*- file is part of GHDL. +-- IEEE 1076.3 compliant numeric std package. +-- 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 +-- . + +library IEEE; +use IEEE.STD_LOGIC_1164.all; + +package NUMERIC_STD is + type UNSIGNED is array (natural range <>) of STD_LOGIC; + type SIGNED is array (natural range <>) of STD_LOGIC; + + function TO_01 (S : SIGNED; XMAP : STD_LOGIC := '0') return SIGNED; + function TO_01 (S : UNSIGNED; XMAP : STD_LOGIC := '0') return UNSIGNED; + -- Convert 'H' and '1' to '1', 'L' and '0' to '0'. + -- If any other value is present, return (others => XMAP) + -- Issue a warning in that case, and if S is a null array. + -- Result index range is S'Length - 1 downto 0. + + function std_match (l, r : std_ulogic) return boolean; + function std_match (l, r : std_ulogic_vector) return boolean; + function std_match (l, r : std_logic_vector) return boolean; + function std_match (l, r : UNSIGNED) return boolean; + function std_match (l, r : SIGNED) return boolean; + -- Return True iff L and R matches. + + + function TO_INTEGER (ARG : UNSIGNED) return NATURAL; + function TO_INTEGER (ARG : SIGNED) return INTEGER; + -- Convert ARG to an integer. + -- Simulation is aborted in case of overflow. + -- Issue a warning in case of non-logical value. + + function TO_UNSIGNED (ARG, SIZE : NATURAL) return UNSIGNED; + -- Convert ARG to unsigned. + -- Result index range is SIZE - 1 downto 0. + -- Issue a warning if value is truncated. + + function TO_SIGNED (ARG : INTEGER; SIZE : NATURAL) return SIGNED; + -- Convert ARG to signed. + -- Result index range is SIZE - 1 downto 0. + -- Issue a warning if value is truncated. + + function resize (ARG : UNSIGNED; NEW_SIZE: natural) return UNSIGNED; + function resize (ARG : SIGNED; NEW_SIZE: natural) return SIGNED; + -- Result index range is NEW_SIZE - 1 downto 0 (unless null array). + -- For SIGNED, the sign of the result is the sign of ARG. + + function "=" (L, R : UNSIGNED) return BOOLEAN; + function "=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "/=" (L, R : UNSIGNED) return BOOLEAN; + function "/=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "/=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "<" (L, R : UNSIGNED) return BOOLEAN; + function "<" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "<" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function "<=" (L, R : UNSIGNED) return BOOLEAN; + function "<=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function "<=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function ">" (L, R : UNSIGNED) return BOOLEAN; + function ">" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function ">" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + function ">=" (L, R : UNSIGNED) return BOOLEAN; + function ">=" (L : UNSIGNED; R : NATURAL) return BOOLEAN; + function ">=" (L : NATURAL; R : UNSIGNED) return BOOLEAN; + + function "=" (L, R : SIGNED) return BOOLEAN; + function "=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "/=" (L, R : SIGNED) return BOOLEAN; + function "/=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "/=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "<" (L, R : SIGNED) return BOOLEAN; + function "<" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "<" (L : INTEGER; R : SIGNED) return BOOLEAN; + function "<=" (L, R : SIGNED) return BOOLEAN; + function "<=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function "<=" (L : INTEGER; R : SIGNED) return BOOLEAN; + function ">" (L, R : SIGNED) return BOOLEAN; + function ">" (L : SIGNED; R : INTEGER) return BOOLEAN; + function ">" (L : INTEGER; R : SIGNED) return BOOLEAN; + function ">=" (L, R : SIGNED) return BOOLEAN; + function ">=" (L : SIGNED; R : INTEGER) return BOOLEAN; + function ">=" (L : INTEGER; R : SIGNED) return BOOLEAN; + -- Issue a warning in case of non-logical value. + + function "-" (ARG : SIGNED) return SIGNED; + -- Compute -ARG. + -- Result index range is Arg'length - 1 downto 0. + + function "abs" (ARG : SIGNED) return SIGNED; + -- Compute abs ARG. + -- Result index range is Arg'length - 1 downto 0. + + function "+" (L, R : UNSIGNED) return UNSIGNED; + function "+" (L, R : SIGNED) return SIGNED; + function "-" (L, R : UNSIGNED) return UNSIGNED; + function "-" (L, R : SIGNED) return SIGNED; + -- Compute L +/- R. + -- Result index range is max (L'Length, R'Length) - 1 downto 0. + -- Issue a warning in case of non-logical value. + + function "+" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "+" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "+" (L : SIGNED; R : INTEGER) return SIGNED; + function "+" (L : INTEGER; R : SIGNED) return SIGNED; + function "-" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "-" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "-" (L : SIGNED; R : INTEGER) return SIGNED; + function "-" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L +/- R. + -- Result index range is V'Length - 1 downto 0, where V is the vector + -- parameter. + -- Issue a warning in case of non-logical value. + -- Issue a warning if value is truncated. + + function "*" (L, R : UNSIGNED) return UNSIGNED; + function "*" (L, R : SIGNED) return SIGNED; + -- Compute L * R + -- Result index range is L'Length + R'Length - 1 downto 0. + + function "*" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "*" (L : SIGNED; R : INTEGER) return SIGNED; + -- Compute L * R + -- R is converted to a vector of length L'length + + function "*" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "*" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L * R + -- L is converted to a vector of length R'length + + function "/" (L, R : UNSIGNED) return UNSIGNED; + function "/" (L, R : SIGNED) return SIGNED; + function "rem" (L, R : UNSIGNED) return UNSIGNED; + function "rem" (L, R : SIGNED) return SIGNED; + function "mod" (L, R : UNSIGNED) return UNSIGNED; + function "mod" (L, R : SIGNED) return SIGNED; + -- Compute L op R + -- Result index range is L'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + + function "/" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "/" (L : SIGNED; R : INTEGER) return SIGNED; + function "rem" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "rem" (L : SIGNED; R : INTEGER) return SIGNED; + function "mod" (L : UNSIGNED; R : NATURAL) return UNSIGNED; + function "mod" (L : SIGNED; R : INTEGER) return SIGNED; + -- Compute L op R. + -- Result index range is L'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + + function "/" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "/" (L : INTEGER; R : SIGNED) return SIGNED; + function "rem" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "rem" (L : INTEGER; R : SIGNED) return SIGNED; + function "mod" (L : NATURAL; R : UNSIGNED) return UNSIGNED; + function "mod" (L : INTEGER; R : SIGNED) return SIGNED; + -- Compute L op R. + -- Result index range is R'Length - 1 downto 0. + -- Issue a warning in case of non-logical value. + -- Issue an error if R is 0. + -- Result may be truncated. + + function "not" (l : UNSIGNED) return UNSIGNED; + function "not" (l : SIGNED) return SIGNED; + function "and" (l, r : UNSIGNED) return UNSIGNED; + function "and" (l, r : SIGNED) return SIGNED; + function "nand" (l, r : UNSIGNED) return UNSIGNED; + function "nand" (l, r : SIGNED) return SIGNED; + function "or" (l, r : UNSIGNED) return UNSIGNED; + function "or" (l, r : SIGNED) return SIGNED; + function "nor" (l, r : UNSIGNED) return UNSIGNED; + function "nor" (l, r : SIGNED) return SIGNED; + function "xor" (l, r : UNSIGNED) return UNSIGNED; + function "xor" (l, r : SIGNED) return SIGNED; + function "xnor" (l, r : UNSIGNED) return UNSIGNED; + function "xnor" (l, r : SIGNED) return SIGNED; + -- Compute L OP R. + -- Result index range is L'Length - 1 downto 0. + -- No specific handling of null array: the index range of the result + -- would be -1 downto 0 (without warning). This it not what is specified + -- in 1076.3, but corresponds to the standard implementation. + -- No specific handling of non-logical values. Behaviour is compatible + -- with std_logic_1164. + + function shift_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function shift_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + function shift_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function shift_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + + function rotate_left (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function rotate_left (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + function rotate_right (ARG : UNSIGNED; COUNT: NATURAL) return UNSIGNED; + function rotate_right (ARG : SIGNED; COUNT: NATURAL) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + + function "sll" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; + function "sll" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + function "srl" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; + function "srl" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. + + function "rol" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; + function "rol" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + function "ror" (ARG : UNSIGNED; COUNT: INTEGER) return UNSIGNED; + function "ror" (ARG : SIGNED; COUNT: INTEGER) return SIGNED; + -- Result index range is ARG'Length - 1 downto 0. +end NUMERIC_STD; diff --git a/libraries/openieee/v93/std_logic_1164-body.vhdl b/libraries/openieee/v93/std_logic_1164-body.vhdl new file mode 100644 index 000000000..af43ba306 --- /dev/null +++ b/libraries/openieee/v93/std_logic_1164-body.vhdl @@ -0,0 +1,769 @@ +-- This -*- vhdl -*- file was generated from std_logic_1164-body.proto +-- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only +-- on the specifications. This file is part of GHDL. +-- 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 +-- . + +-- This is a template file. To avoid errors and duplication, the python +-- script build.py generate most of the bodies. + +package body std_logic_1164 is + + type table_1d is array (std_ulogic) of std_ulogic; + type table_2d is array (std_ulogic, std_ulogic) of std_ulogic; + + constant resolution : table_2d := + -- UX01ZWLH- + ("UUUUUUUUU", -- U + "UXXXXXXXX", -- X + "UX0X0000X", -- 0 + "UXX11111X", -- 1 + "UX01ZWLHX", -- Z + "UX01WWWWX", -- W + "UX01LWLWX", -- L + "UX01HWWHX", -- H + "UXXXXXXXX" -- - + ); + + function resolved (s : std_ulogic_vector) return std_ulogic + is + variable res : std_ulogic := 'Z'; + begin + for I in s'range loop + res := resolution (res, s (I)); + end loop; + return res; + end resolved; + + + constant and_table : table_2d := + -- UX01ZWLH- + ("UU0UUU0UU", -- U + "UX0XXX0XX", -- X + "000000000", -- 0 + "UX01XX01X", -- 1 + "UX0XXX0XX", -- Z + "UX0XXX0XX", -- W + "000000000", -- L + "UX01XX01X", -- H + "UX0XXX0XX" -- - + ); + + constant nand_table : table_2d := + -- UX01ZWLH- + ("UU1UUU1UU", -- U + "UX1XXX1XX", -- X + "111111111", -- 0 + "UX10XX10X", -- 1 + "UX1XXX1XX", -- Z + "UX1XXX1XX", -- W + "111111111", -- L + "UX10XX10X", -- H + "UX1XXX1XX" -- - + ); + + constant or_table : table_2d := + -- UX01ZWLH- + ("UUU1UUU1U", -- U + "UXX1XXX1X", -- X + "UX01XX01X", -- 0 + "111111111", -- 1 + "UXX1XXX1X", -- Z + "UXX1XXX1X", -- W + "UX01XX01X", -- L + "111111111", -- H + "UXX1XXX1X" -- - + ); + + constant nor_table : table_2d := + -- UX01ZWLH- + ("UUU0UUU0U", -- U + "UXX0XXX0X", -- X + "UX10XX10X", -- 0 + "000000000", -- 1 + "UXX0XXX0X", -- Z + "UXX0XXX0X", -- W + "UX10XX10X", -- L + "000000000", -- H + "UXX0XXX0X" -- - + ); + + constant xor_table : table_2d := + -- UX01ZWLH- + ("UUUUUUUUU", -- U + "UXXXXXXXX", -- X + "UX01XX01X", -- 0 + "UX10XX10X", -- 1 + "UXXXXXXXX", -- Z + "UXXXXXXXX", -- W + "UX01XX01X", -- L + "UX10XX10X", -- H + "UXXXXXXXX" -- - + ); + + constant xnor_table : table_2d := + -- UX01ZWLH- + ("UUUUUUUUU", -- U + "UXXXXXXXX", -- X + "UX10XX10X", -- 0 + "UX01XX01X", -- 1 + "UXXXXXXXX", -- Z + "UXXXXXXXX", -- W + "UX10XX10X", -- L + "UX01XX01X", -- H + "UXXXXXXXX" -- - + ); + + constant not_table : table_1d := + -- UX01ZWLH- + "UX10XX10X"; + + + function "and" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return and_table (l, r); + end "and"; + + function "nand" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return nand_table (l, r); + end "nand"; + + function "or" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return or_table (l, r); + end "or"; + + function "nor" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return nor_table (l, r); + end "nor"; + + function "xor" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return xor_table (l, r); + end "xor"; + + function "xnor" (l : std_ulogic; r : std_ulogic) return UX01 is + begin + return xnor_table (l, r); + end "xnor"; + + function "not" (l : std_ulogic) return UX01 is + begin + return not_table (l); + end "not"; + + function "and" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'and' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := and_table (la (I), ra (I)); + end loop; + end if; + return res; + end "and"; + + function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'nand' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := nand_table (la (I), ra (I)); + end loop; + end if; + return res; + end "nand"; + + function "or" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'or' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := or_table (la (I), ra (I)); + end loop; + end if; + return res; + end "or"; + + function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'nor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := nor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "nor"; + + function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'xor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := xor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "xor"; + + function "xnor" (l, r : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_ulogic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'xnor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := xnor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "xnor"; + + function "not" (l : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := not_table (la (I)); + end loop; + return res; + end "not"; + + function "and" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'and' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := and_table (la (I), ra (I)); + end loop; + end if; + return res; + end "and"; + + function "nand" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'nand' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := nand_table (la (I), ra (I)); + end loop; + end if; + return res; + end "nand"; + + function "or" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'or' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := or_table (la (I), ra (I)); + end loop; + end if; + return res; + end "or"; + + function "nor" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'nor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := nor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "nor"; + + function "xor" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'xor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := xor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "xor"; + + function "xnor" (l, r : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + alias ra : std_logic_vector (1 to r'length) is r; + variable res : res_type; + begin + if la'length /= ra'length then + assert false + report "arguments of overloaded 'xnor' operator are not of the same length" + severity failure; + else + for I in res_type'range loop + res (I) := xnor_table (la (I), ra (I)); + end loop; + end if; + return res; + end "xnor"; + + function "not" (l : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to l'length); + alias la : res_type is l; + variable res : res_type; + begin + for I in res_type'range loop + res (I) := not_table (la (I)); + end loop; + return res; + end "not"; + + -- Conversion functions. + -- The result range (for vectors) is S'Length - 1 downto 0. + -- XMAP is return for values not in '0', '1', 'L', 'H'. + function to_bit (s : std_ulogic; xmap : bit := '0') return bit is + begin + case s is + when '0' | 'L' => + return '0'; + when '1' | 'H' => + return '1'; + when others => + return xmap; + end case; + end to_bit; + + type bit_to_std_table is array (bit) of std_ulogic; + constant bit_to_std : bit_to_std_table := "01"; + + + function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') + return bit_vector + is + subtype res_range is natural range s'length - 1 downto 0; + alias as : std_ulogic_vector (res_range) is s; + variable res : bit_vector (res_range); + variable b : bit; + begin + for I in res_range loop + -- Inline for efficiency. + case as (I) is + when '0' | 'L' => + b := '0'; + when '1' | 'H' => + b := '1'; + when others => + b := xmap; + end case; + res (I) := b; + end loop; + return res; + end to_bitvector; + + function to_bitvector (s : std_logic_vector; xmap : bit := '0') + return bit_vector + is + subtype res_range is natural range s'length - 1 downto 0; + alias as : std_logic_vector (res_range) is s; + variable res : bit_vector (res_range); + variable b : bit; + begin + for I in res_range loop + -- Inline for efficiency. + case as (I) is + when '0' | 'L' => + b := '0'; + when '1' | 'H' => + b := '1'; + when others => + b := xmap; + end case; + res (I) := b; + end loop; + return res; + end to_bitvector; + + function to_stdulogicvector (b : bit_vector) return std_ulogic_vector is + subtype res_range is natural range b'length - 1 downto 0; + alias ab : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for I in res_range loop + res (I) := bit_to_std (ab (I)); + end loop; + return res; + end to_stdulogicvector; + + function to_stdlogicvector (b : bit_vector) return std_logic_vector is + subtype res_range is natural range b'length - 1 downto 0; + alias ab : bit_vector (res_range) is b; + variable res : std_logic_vector (res_range); + begin + for I in res_range loop + res (I) := bit_to_std (ab (I)); + end loop; + return res; + end to_stdlogicvector; + + function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (s'length - 1 downto 0); + begin + return res_type (s); + end to_stdulogicvector; + + function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (s'length - 1 downto 0); + begin + return res_type (s); + end to_stdlogicvector; + + function to_stdulogic (b : bit) return std_ulogic is + begin + return bit_to_std (b); + end to_stdulogic; + + -- Normalization. + type table_std_x01 is array (std_ulogic) of X01; + constant std_to_x01 : table_std_x01 := ('U' | 'X' | 'Z' | 'W' | '-' => 'X', + '0' | 'L' => '0', + '1' | 'H' => '1'); + + type table_bit_x01 is array (bit) of X01; + constant bit_to_x01 : table_bit_x01 := ('0' => '0', + '1' => '1'); + + + type table_std_x01z is array (std_ulogic) of X01Z; + constant std_to_x01z : table_std_x01z := ('U' | 'X' | 'W' | '-' => 'X', + '0' | 'L' => '0', + '1' | 'H' => '1', + 'Z' => 'Z'); + + type table_std_ux01 is array (std_ulogic) of UX01; + constant std_to_ux01 : table_std_ux01 := ('U' => 'U', + 'X' | 'Z' | 'W' | '-' => 'X', + '0' | 'L' => '0', + '1' | 'H' => '1'); + + + function to_X01 (s : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_x01 (sa (i)); + end loop; + return res; + end to_X01; + + function to_X01 (s : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_x01 (sa (i)); + end loop; + return res; + end to_X01; + + function to_X01 (s : std_ulogic) return X01 is + begin + return std_to_x01 (s); + end to_X01; + + function to_X01 (b : bit_vector) return std_ulogic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_X01; + + function to_X01 (b : bit_vector) return std_logic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_logic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_X01; + + function to_X01 (b : bit) return X01 is + begin + return bit_to_x01 (b); + end to_X01; + + function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_x01z (sa (i)); + end loop; + return res; + end to_X01Z; + + function to_X01Z (s : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_x01z (sa (i)); + end loop; + return res; + end to_X01Z; + + function to_X01Z (s : std_ulogic) return X01Z is + begin + return std_to_x01z (s); + end to_X01Z; + + function to_X01Z (b : bit_vector) return std_ulogic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_X01Z; + + function to_X01Z (b : bit_vector) return std_logic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_logic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_X01Z; + + function to_X01Z (b : bit) return X01Z is + begin + return bit_to_x01 (b); + end to_X01Z; + + function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector + is + subtype res_type is std_ulogic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_ux01 (sa (i)); + end loop; + return res; + end to_UX01; + + function to_UX01 (s : std_logic_vector) return std_logic_vector + is + subtype res_type is std_logic_vector (1 to s'length); + alias sa : res_type is s; + variable res : res_type; + begin + for i in res_type'range loop + res (i) := std_to_ux01 (sa (i)); + end loop; + return res; + end to_UX01; + + function to_UX01 (s : std_ulogic) return UX01 is + begin + return std_to_ux01 (s); + end to_UX01; + + function to_UX01 (b : bit_vector) return std_ulogic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_ulogic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_UX01; + + function to_UX01 (b : bit_vector) return std_logic_vector + is + subtype res_range is natural range 1 to b'length; + alias ba : bit_vector (res_range) is b; + variable res : std_logic_vector (res_range); + begin + for i in res_range loop + res (i) := bit_to_x01 (ba (i)); + end loop; + return res; + end to_UX01; + + function to_UX01 (b : bit) return UX01 is + begin + return bit_to_x01 (b); + end to_UX01; + + function rising_edge (signal s : std_ulogic) return boolean is + begin + return s'event + and to_x01 (s'last_value) = '0' + and to_x01 (s) = '1'; + end rising_edge; + + function falling_edge (signal s : std_ulogic) return boolean is + begin + return s'event + and to_x01 (s'last_value) = '1' + and to_x01 (s) = '0'; + end falling_edge; + + type std_x_array is array (std_ulogic) of boolean; + constant std_x : std_x_array := ('U' | 'X' | 'Z' | 'W' | '-' => true, + '0' | '1' | 'L' | 'H' => false); + + + function is_X (s : std_ulogic_vector) return boolean is + begin + for i in s'range loop + if std_x (s (i)) then + return true; + end if; + end loop; + return false; + end is_X; + + function is_X (s : std_logic_vector) return boolean is + begin + for i in s'range loop + if std_x (s (i)) then + return true; + end if; + end loop; + return false; + end is_X; + + function is_X (s : std_ulogic) return boolean is + begin + return std_x (s); + end is_X; +end std_logic_1164; diff --git a/libraries/openieee/v93/std_logic_1164.vhdl b/libraries/openieee/v93/std_logic_1164.vhdl new file mode 100644 index 000000000..879a7870b --- /dev/null +++ b/libraries/openieee/v93/std_logic_1164.vhdl @@ -0,0 +1,141 @@ +-- This is an implementation of -*- vhdl -*- ieee.std_logic_1164 based only +-- on the specifications. This file is part of GHDL. +-- 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 +-- . + +package std_logic_1164 is + + -- Unresolved logic state. + type std_ulogic is + ( + 'U', -- Uninitialized, this is also the default value. + 'X', -- Unknown / conflict value (forcing level). + '0', -- 0 (forcing level). + '1', -- 1 (forcing level). + 'Z', -- High impedance. + 'W', -- Unknown / conflict (weak level). + 'L', -- 0 (weak level). + 'H', -- 1 (weak level). + '-' -- Don't care. + ); + + -- Vector of logic state. + type std_ulogic_vector is array (natural range <>) of std_ulogic; + + -- Resolution function. + -- If S is empty, returns 'Z'. + -- If S has one element, return the element. + -- Otherwise, 'U' is the strongest. + -- then 'X' + -- then '0' and '1' + -- then 'W' + -- then 'H' and 'L' + -- then 'Z'. + function resolved (s : std_ulogic_vector) return std_ulogic; + + -- Resolved logic state. + subtype std_logic is resolved std_ulogic; + + -- Vector of std_logic. + type std_logic_vector is array (natural range <>) of std_logic; + + -- Subtypes of std_ulogic. The names give the values. + subtype X01 is resolved std_ulogic range 'X' to '1'; + subtype X01Z is resolved std_ulogic range 'X' to 'Z'; + subtype UX01 is resolved std_ulogic range 'U' to '1'; + subtype UX01Z is resolved std_ulogic range 'U' to 'Z'; + + -- Logical operators. + -- For logical operations, the inputs are first normalized to UX01: + -- 0 and L are normalized to 0, 1 and 1 are normalized to 1, U isnt changed, + -- all other states are normalized to X. + -- Then the classical electric rules are followed. + function "and" (l : std_ulogic; r : std_ulogic) return UX01; + function "nand" (l : std_ulogic; r : std_ulogic) return UX01; + function "or" (l : std_ulogic; r : std_ulogic) return UX01; + function "nor" (l : std_ulogic; r : std_ulogic) return UX01; + function "xor" (l : std_ulogic; r : std_ulogic) return UX01; + function "xnor" (l : std_ulogic; r : std_ulogic) return UX01; + function "not" (l : std_ulogic) return UX01; + + -- Logical operators for vectors. + -- An assertion of severity failure fails if the length of L and R aren't + -- equal. The result range is 1 to L'Length. + function "and" (l, r : std_logic_vector) return std_logic_vector; + function "nand" (l, r : std_logic_vector) return std_logic_vector; + function "or" (l, r : std_logic_vector) return std_logic_vector; + function "nor" (l, r : std_logic_vector) return std_logic_vector; + function "xor" (l, r : std_logic_vector) return std_logic_vector; + function "xnor" (l, r : std_logic_vector) return std_logic_vector; + function "not" (l : std_logic_vector) return std_logic_vector; + + function "and" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "nand" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "or" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "nor" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "xor" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "xnor" (l, r : std_ulogic_vector) return std_ulogic_vector; + function "not" (l : std_ulogic_vector) return std_ulogic_vector; + + -- Conversion functions. + -- The result range (for vectors) is S'Length - 1 downto 0. + -- XMAP is return for values not in '0', '1', 'L', 'H'. + function to_bit (s : std_ulogic; xmap : bit := '0') return bit; + function to_bitvector (s : std_logic_vector; xmap : bit := '0') + return bit_vector; + function to_bitvector (s : std_ulogic_vector; xmap : bit := '0') + return bit_vector; + + function to_stdulogic (b : bit) return std_ulogic; + function to_stdlogicvector (b : bit_vector) return std_logic_vector; + function to_stdlogicvector (s : std_ulogic_vector) return std_logic_vector; + function to_stdulogicvector (b : bit_vector) return std_ulogic_vector; + function to_stdulogicvector (s : std_logic_vector) return std_ulogic_vector; + + -- Normalization. + -- The result range (for vectors) is 1 to S'Length. + function to_X01 (s : std_logic_vector) return std_logic_vector; + function to_X01 (s : std_ulogic_vector) return std_ulogic_vector; + function to_X01 (s : std_ulogic) return X01; + function to_X01 (b : bit_vector) return std_logic_vector; + function to_X01 (b : bit_vector) return std_ulogic_vector; + function to_X01 (b : bit) return X01; + + function to_X01Z (s : std_logic_vector) return std_logic_vector; + function to_X01Z (s : std_ulogic_vector) return std_ulogic_vector; + function to_X01Z (s : std_ulogic) return X01Z; + function to_X01Z (b : bit_vector) return std_logic_vector; + function to_X01Z (b : bit_vector) return std_ulogic_vector; + function to_X01Z (b : bit) return X01Z; + + function to_UX01 (s : std_logic_vector) return std_logic_vector; + function to_UX01 (s : std_ulogic_vector) return std_ulogic_vector; + function to_UX01 (s : std_ulogic) return UX01; + function to_UX01 (b : bit_vector) return std_logic_vector; + function to_UX01 (b : bit_vector) return std_ulogic_vector; + function to_UX01 (b : bit) return UX01; + + -- Edge detection. + -- An edge is detected in case of event on s, and X01 normalized value + -- rises from 0 to 1 or falls from 1 to 0. + function rising_edge (signal s : std_ulogic) return boolean; + function falling_edge (signal s : std_ulogic) return boolean; + + -- Test for unknown. Only 0, 1, L and H are known values. + function is_X (s : std_ulogic_vector) return boolean; + function is_X (s : std_logic_vector) return boolean; + function is_X (s : std_ulogic) return boolean; +end std_logic_1164; -- cgit v1.2.3