From 977ff5e02c6d2f9bfdabcf8b4e98b81e2d83e849 Mon Sep 17 00:00:00 2001 From: gingold Date: Sat, 24 Sep 2005 05:10:24 +0000 Subject: First import from sources --- COPYING | 340 + back_end.adb | 37 + back_end.ads | 53 + bug.adb | 73 + bug.ads | 22 + canon.adb | 2316 +++ canon.ads | 61 + configuration.adb | 548 + configuration.ads | 49 + disp_tree.adb | 1853 ++ disp_tree.ads | 30 + disp_vhdl.adb | 2369 +++ disp_vhdl.ads | 36 + doc/ghdl.texi | 2371 +++ errorout.adb | 1055 + errorout.ads | 137 + evaluation.adb | 2030 ++ evaluation.ads | 98 + files_map.adb | 943 + files_map.ads | 150 + flags.adb | 241 + flags.ads | 183 + ieee-std_logic_1164.adb | 161 + ieee-std_logic_1164.ads | 35 + ieee-vital_timing.adb | 1369 ++ ieee-vital_timing.ads | 41 + ieee.ads | 5 + iir_chain_handling.adb | 68 + iir_chain_handling.ads | 47 + iir_chains.adb | 64 + iir_chains.ads | 117 + iirs.adb | 6572 ++++++ iirs.adb.in | 316 + iirs.ads | 4920 +++++ iirs_utils.adb | 813 + iirs_utils.ads | 156 + libraries.adb | 1634 ++ libraries.ads | 167 + libraries/Makefile.inc | 169 + libraries/README | 27 + libraries/ieee/math_complex-body.vhdl | 394 + libraries/ieee/math_complex.vhdl | 126 + libraries/ieee/math_real-body.vhdl | 410 + libraries/ieee/math_real.vhdl | 223 + libraries/ieee/numeric_bit-body.vhdl | 1818 ++ libraries/ieee/numeric_bit.vhdl | 813 + libraries/ieee/numeric_std-body.vhdl | 2545 +++ libraries/ieee/numeric_std.vhdl | 853 + libraries/ieee/std_logic_1164.vhdl | 175 + libraries/ieee/std_logic_1164_body.vhdl | 830 + libraries/mentor/std_logic_arith.vhdl | 254 + libraries/mentor/std_logic_arith_body.vhdl | 2915 +++ libraries/std/textio.vhdl | 130 + libraries/std/textio_body.vhdl | 1320 ++ libraries/synopsys/std_logic_arith.vhdl | 2391 +++ libraries/synopsys/std_logic_misc-body.vhdl | 811 + libraries/synopsys/std_logic_misc.vhdl | 170 + libraries/synopsys/std_logic_signed.vhdl | 343 + libraries/synopsys/std_logic_textio.vhdl | 634 + libraries/synopsys/std_logic_unsigned.vhdl | 329 + libraries/vital2000/memory_b.vhdl | 7151 +++++++ libraries/vital2000/memory_p.vhdl | 1729 ++ libraries/vital2000/prmtvs_b.vhdl | 5622 +++++ libraries/vital2000/prmtvs_p.vhdl | 1413 ++ libraries/vital2000/timing_b.vhdl | 2187 ++ libraries/vital2000/timing_p.vhdl | 1202 ++ libraries/vital95/vital_primitives.vhdl | 1410 ++ libraries/vital95/vital_primitives_body.vhdl | 5614 +++++ libraries/vital95/vital_timing.vhdl | 880 + libraries/vital95/vital_timing_body.vhdl | 1275 ++ lists.adb | 257 + lists.ads | 123 + name_table.adb | 358 + name_table.ads | 98 + nodes.adb | 412 + nodes.ads | 862 + ortho/Makefile.inc | 41 + ortho/agcc/Makefile.inc | 112 + ortho/agcc/agcc-autils.adb | 93 + ortho/agcc/agcc-autils.ads | 28 + ortho/agcc/agcc-bindings.c | 738 + ortho/agcc/agcc-convert.ads | 26 + ortho/agcc/agcc-diagnostic.ads | 24 + ortho/agcc/agcc-fe.ads | 238 + ortho/agcc/agcc-ggc.ads | 33 + ortho/agcc/agcc-ghdl.c | 658 + ortho/agcc/agcc-hconfig.ads.in | 21 + ortho/agcc/agcc-hwint.ads.in | 23 + ortho/agcc/agcc-input.ads | 29 + ortho/agcc/agcc-libiberty.ads | 21 + ortho/agcc/agcc-machmode.ads.in | 35 + ortho/agcc/agcc-options.ads.in | 31 + ortho/agcc/agcc-output.ads | 24 + ortho/agcc/agcc-real.ads.in | 42 + ortho/agcc/agcc-rtl.ads | 31 + ortho/agcc/agcc-stor_layout.ads | 24 + ortho/agcc/agcc-tm.ads.in | 37 + ortho/agcc/agcc-toplev.ads | 51 + ortho/agcc/agcc-trees.adb | 33 + ortho/agcc/agcc-trees.ads.in | 514 + ortho/agcc/agcc.adb | 23 + ortho/agcc/agcc.ads | 45 + ortho/agcc/agcc.sed | 23 + ortho/agcc/c.adb | 55 + ortho/agcc/c.ads | 64 + ortho/agcc/gen_tree.c | 575 + ortho/gcc/Makefile | 50 + ortho/gcc/agcc-fe.adb | 776 + ortho/gcc/lang.opt | 88 + ortho/gcc/ortho_gcc-main.adb | 44 + ortho/gcc/ortho_gcc-main.ads | 18 + ortho/gcc/ortho_gcc.adb | 1362 ++ ortho/gcc/ortho_gcc.ads | 557 + ortho/gcc/ortho_gcc.private.ads | 122 + ortho/gcc/ortho_gcc_front.ads | 19 + ortho/gcc/ortho_ident.adb | 52 + ortho/gcc/ortho_ident.ads | 30 + ortho/gcc/ortho_nodes.ads | 20 + ortho/ortho_front.ads | 41 + ortho/ortho_nodes.common.ads | 457 + parse.adb | 5701 +++++ parse.ads | 33 + post_sems.adb | 67 + post_sems.ads | 25 + scan-scan_literal.adb | 626 + scan.adb | 1175 ++ scan.ads | 97 + sem.adb | 2295 ++ sem.ads | 78 + sem_assocs.adb | 1679 ++ sem_assocs.ads | 55 + sem_decls.adb | 2413 +++ sem_decls.ads | 57 + sem_expr.adb | 3811 ++++ sem_expr.ads | 154 + sem_names.adb | 3318 +++ sem_names.ads | 113 + sem_scopes.adb | 1260 ++ sem_scopes.ads | 239 + sem_specs.adb | 1636 ++ sem_specs.ads | 82 + sem_stmts.adb | 1942 ++ sem_stmts.ads | 79 + sem_types.adb | 1479 ++ sem_types.ads | 41 + std_names.adb | 352 + std_names.ads | 491 + std_package.adb | 921 + std_package.ads | 169 + str_table.adb | 92 + str_table.ads | 44 + tokens.adb | 325 + tokens.ads | 212 + translate/Makefile | 65 + translate/TODO | 342 + translate/gcc/ANNOUNCE | 21 + translate/gcc/Make-lang.in | 182 + translate/gcc/Makefile.in | 275 + translate/gcc/README | 54 + translate/gcc/config-lang.in | 38 + translate/gcc/dist.sh | 670 + translate/gcc/lang-options.h | 29 + translate/gcc/lang-specs.h | 28 + translate/ghdldrv/Makefile | 114 + translate/ghdldrv/default_pathes.ads.in | 30 + translate/ghdldrv/ghdl_gcc.adb | 33 + translate/ghdldrv/ghdl_mcode.adb | 33 + translate/ghdldrv/ghdl_simul.adb | 32 + translate/ghdldrv/ghdlcomp.adb | 745 + translate/ghdldrv/ghdlcomp.ads | 67 + translate/ghdldrv/ghdldrv.adb | 1705 ++ translate/ghdldrv/ghdldrv.ads | 20 + translate/ghdldrv/ghdllocal.adb | 1052 + translate/ghdldrv/ghdllocal.ads | 98 + translate/ghdldrv/ghdlmain.adb | 355 + translate/ghdldrv/ghdlmain.ads | 85 + translate/ghdldrv/ghdlprint.adb | 1561 ++ translate/ghdldrv/ghdlprint.ads | 22 + translate/ghdldrv/ghdlrun.adb | 658 + translate/ghdldrv/ghdlrun.ads | 20 + translate/ghdldrv/ghdlsimul.adb | 142 + translate/ghdldrv/ghdlsimul.ads | 20 + translate/grt/Makefile | 51 + translate/grt/Makefile.inc | 161 + translate/grt/config/clock.c | 36 + translate/grt/config/i386.S | 108 + translate/grt/config/linux.c | 268 + translate/grt/config/ppc.S | 327 + translate/grt/config/pthread.c | 157 + translate/grt/config/sparc.S | 134 + translate/grt/config/times.c | 48 + translate/grt/config/win32.c | 164 + translate/grt/ghdl_main.adb | 51 + translate/grt/ghdl_main.ads | 26 + translate/grt/ghwdump.c | 195 + translate/grt/ghwlib.c | 1717 ++ translate/grt/ghwlib.h | 386 + translate/grt/grt-astdio.adb | 193 + translate/grt/grt-astdio.ads | 51 + translate/grt/grt-avhpi.adb | 868 + translate/grt/grt-avhpi.ads | 455 + translate/grt/grt-avls.adb | 242 + translate/grt/grt-avls.ads | 77 + translate/grt/grt-cbinding.c | 90 + translate/grt/grt-cvpi.c | 277 + translate/grt/grt-disp.adb | 203 + translate/grt/grt-disp.ads | 39 + translate/grt/grt-disp_rti.adb | 1369 ++ translate/grt/grt-disp_rti.ads | 22 + translate/grt/grt-disp_signals.adb | 456 + translate/grt/grt-disp_signals.ads | 39 + translate/grt/grt-errors.adb | 225 + translate/grt/grt-errors.ads | 70 + translate/grt/grt-files.adb | 429 + translate/grt/grt-files.ads | 112 + translate/grt/grt-hooks.adb | 154 + translate/grt/grt-hooks.ads | 63 + translate/grt/grt-images.adb | 233 + translate/grt/grt-images.ads | 39 + translate/grt/grt-lib.adb | 210 + translate/grt/grt-lib.ads | 93 + translate/grt/grt-main.adb | 178 + translate/grt/grt-main.ads | 27 + translate/grt/grt-names.adb | 96 + translate/grt/grt-names.ads | 35 + translate/grt/grt-options.adb | 468 + translate/grt/grt-options.ads | 127 + translate/grt/grt-processes.adb | 795 + translate/grt/grt-processes.ads | 156 + translate/grt/grt-rtis.ads | 347 + translate/grt/grt-rtis_addr.adb | 268 + translate/grt/grt-rtis_addr.ads | 88 + translate/grt/grt-rtis_binding.ads | 60 + translate/grt/grt-rtis_types.adb | 111 + translate/grt/grt-rtis_types.ads | 48 + translate/grt/grt-rtis_utils.adb | 623 + translate/grt/grt-rtis_utils.ads | 67 + translate/grt/grt-sdf.adb | 1330 ++ translate/grt/grt-sdf.ads | 113 + translate/grt/grt-shadow_ieee.adb | 25 + translate/grt/grt-shadow_ieee.ads | 34 + translate/grt/grt-signals.adb | 2949 +++ translate/grt/grt-signals.ads | 720 + translate/grt/grt-stack2.adb | 198 + translate/grt/grt-stack2.ads | 36 + translate/grt/grt-stacks.adb | 36 + translate/grt/grt-stacks.ads | 67 + translate/grt/grt-stats.adb | 326 + translate/grt/grt-stats.ads | 44 + translate/grt/grt-stdio.ads | 110 + translate/grt/grt-types.ads | 294 + translate/grt/grt-values.adb | 215 + translate/grt/grt-values.ads | 25 + translate/grt/grt-vcd.adb | 716 + translate/grt/grt-vcd.ads | 48 + translate/grt/grt-vital_annotate.adb | 467 + translate/grt/grt-vital_annotate.ads | 35 + translate/grt/grt-vpi.adb | 800 + translate/grt/grt-vpi.ads | 251 + translate/grt/grt-vstrings.adb | 243 + translate/grt/grt-vstrings.ads | 100 + translate/grt/grt-waves.adb | 1486 ++ translate/grt/grt-waves.ads | 20 + translate/grt/grt.adc | 36 + translate/grt/grt.ads | 20 + translate/grt/main.adb | 25 + translate/grt/main.ads | 27 + translate/ortho_front.adb | 443 + translate/trans_be.adb | 149 + translate/trans_be.ads | 26 + translate/trans_decls.ads | 211 + translate/translation.adb | 27760 +++++++++++++++++++++++++ translate/translation.ads | 96 + types.ads | 124 + version.ads | 3 + website/index.html | 109 + xrefs.adb | 251 + xrefs.ads | 108 + xtools/Makefile | 34 + xtools/check_iirs.adb | 64 + xtools/check_iirs_pkg.adb | 1217 ++ xtools/check_iirs_pkg.ads | 38 + 282 files changed, 181399 insertions(+) create mode 100644 COPYING create mode 100644 back_end.adb create mode 100644 back_end.ads create mode 100644 bug.adb create mode 100644 bug.ads create mode 100644 canon.adb create mode 100644 canon.ads create mode 100644 configuration.adb create mode 100644 configuration.ads create mode 100644 disp_tree.adb create mode 100644 disp_tree.ads create mode 100644 disp_vhdl.adb create mode 100644 disp_vhdl.ads create mode 100644 doc/ghdl.texi create mode 100644 errorout.adb create mode 100644 errorout.ads create mode 100644 evaluation.adb create mode 100644 evaluation.ads create mode 100644 files_map.adb create mode 100644 files_map.ads create mode 100644 flags.adb create mode 100644 flags.ads create mode 100644 ieee-std_logic_1164.adb create mode 100644 ieee-std_logic_1164.ads create mode 100644 ieee-vital_timing.adb create mode 100644 ieee-vital_timing.ads create mode 100644 ieee.ads create mode 100644 iir_chain_handling.adb create mode 100644 iir_chain_handling.ads create mode 100644 iir_chains.adb create mode 100644 iir_chains.ads create mode 100644 iirs.adb create mode 100644 iirs.adb.in create mode 100644 iirs.ads create mode 100644 iirs_utils.adb create mode 100644 iirs_utils.ads create mode 100644 libraries.adb create mode 100644 libraries.ads create mode 100644 libraries/Makefile.inc create mode 100644 libraries/README create mode 100644 libraries/ieee/math_complex-body.vhdl create mode 100644 libraries/ieee/math_complex.vhdl create mode 100644 libraries/ieee/math_real-body.vhdl create mode 100644 libraries/ieee/math_real.vhdl create mode 100644 libraries/ieee/numeric_bit-body.vhdl create mode 100644 libraries/ieee/numeric_bit.vhdl create mode 100644 libraries/ieee/numeric_std-body.vhdl create mode 100644 libraries/ieee/numeric_std.vhdl create mode 100644 libraries/ieee/std_logic_1164.vhdl create mode 100644 libraries/ieee/std_logic_1164_body.vhdl create mode 100644 libraries/mentor/std_logic_arith.vhdl create mode 100644 libraries/mentor/std_logic_arith_body.vhdl create mode 100644 libraries/std/textio.vhdl create mode 100644 libraries/std/textio_body.vhdl create mode 100644 libraries/synopsys/std_logic_arith.vhdl create mode 100644 libraries/synopsys/std_logic_misc-body.vhdl create mode 100644 libraries/synopsys/std_logic_misc.vhdl create mode 100644 libraries/synopsys/std_logic_signed.vhdl create mode 100644 libraries/synopsys/std_logic_textio.vhdl create mode 100644 libraries/synopsys/std_logic_unsigned.vhdl create mode 100644 libraries/vital2000/memory_b.vhdl create mode 100644 libraries/vital2000/memory_p.vhdl create mode 100644 libraries/vital2000/prmtvs_b.vhdl create mode 100644 libraries/vital2000/prmtvs_p.vhdl create mode 100644 libraries/vital2000/timing_b.vhdl create mode 100644 libraries/vital2000/timing_p.vhdl create mode 100644 libraries/vital95/vital_primitives.vhdl create mode 100644 libraries/vital95/vital_primitives_body.vhdl create mode 100644 libraries/vital95/vital_timing.vhdl create mode 100644 libraries/vital95/vital_timing_body.vhdl create mode 100644 lists.adb create mode 100644 lists.ads create mode 100644 name_table.adb create mode 100644 name_table.ads create mode 100644 nodes.adb create mode 100644 nodes.ads create mode 100644 ortho/Makefile.inc create mode 100644 ortho/agcc/Makefile.inc create mode 100644 ortho/agcc/agcc-autils.adb create mode 100644 ortho/agcc/agcc-autils.ads create mode 100644 ortho/agcc/agcc-bindings.c create mode 100644 ortho/agcc/agcc-convert.ads create mode 100644 ortho/agcc/agcc-diagnostic.ads create mode 100644 ortho/agcc/agcc-fe.ads create mode 100644 ortho/agcc/agcc-ggc.ads create mode 100644 ortho/agcc/agcc-ghdl.c create mode 100644 ortho/agcc/agcc-hconfig.ads.in create mode 100644 ortho/agcc/agcc-hwint.ads.in create mode 100644 ortho/agcc/agcc-input.ads create mode 100644 ortho/agcc/agcc-libiberty.ads create mode 100644 ortho/agcc/agcc-machmode.ads.in create mode 100644 ortho/agcc/agcc-options.ads.in create mode 100644 ortho/agcc/agcc-output.ads create mode 100644 ortho/agcc/agcc-real.ads.in create mode 100644 ortho/agcc/agcc-rtl.ads create mode 100644 ortho/agcc/agcc-stor_layout.ads create mode 100644 ortho/agcc/agcc-tm.ads.in create mode 100644 ortho/agcc/agcc-toplev.ads create mode 100644 ortho/agcc/agcc-trees.adb create mode 100644 ortho/agcc/agcc-trees.ads.in create mode 100644 ortho/agcc/agcc.adb create mode 100644 ortho/agcc/agcc.ads create mode 100644 ortho/agcc/agcc.sed create mode 100644 ortho/agcc/c.adb create mode 100644 ortho/agcc/c.ads create mode 100644 ortho/agcc/gen_tree.c create mode 100644 ortho/gcc/Makefile create mode 100644 ortho/gcc/agcc-fe.adb create mode 100644 ortho/gcc/lang.opt create mode 100644 ortho/gcc/ortho_gcc-main.adb create mode 100644 ortho/gcc/ortho_gcc-main.ads create mode 100644 ortho/gcc/ortho_gcc.adb create mode 100644 ortho/gcc/ortho_gcc.ads create mode 100644 ortho/gcc/ortho_gcc.private.ads create mode 100644 ortho/gcc/ortho_gcc_front.ads create mode 100644 ortho/gcc/ortho_ident.adb create mode 100644 ortho/gcc/ortho_ident.ads create mode 100644 ortho/gcc/ortho_nodes.ads create mode 100644 ortho/ortho_front.ads create mode 100644 ortho/ortho_nodes.common.ads create mode 100644 parse.adb create mode 100644 parse.ads create mode 100644 post_sems.adb create mode 100644 post_sems.ads create mode 100644 scan-scan_literal.adb create mode 100644 scan.adb create mode 100644 scan.ads create mode 100644 sem.adb create mode 100644 sem.ads create mode 100644 sem_assocs.adb create mode 100644 sem_assocs.ads create mode 100644 sem_decls.adb create mode 100644 sem_decls.ads create mode 100644 sem_expr.adb create mode 100644 sem_expr.ads create mode 100644 sem_names.adb create mode 100644 sem_names.ads create mode 100644 sem_scopes.adb create mode 100644 sem_scopes.ads create mode 100644 sem_specs.adb create mode 100644 sem_specs.ads create mode 100644 sem_stmts.adb create mode 100644 sem_stmts.ads create mode 100644 sem_types.adb create mode 100644 sem_types.ads create mode 100644 std_names.adb create mode 100644 std_names.ads create mode 100644 std_package.adb create mode 100644 std_package.ads create mode 100644 str_table.adb create mode 100644 str_table.ads create mode 100644 tokens.adb create mode 100644 tokens.ads create mode 100644 translate/Makefile create mode 100644 translate/TODO create mode 100644 translate/gcc/ANNOUNCE create mode 100644 translate/gcc/Make-lang.in create mode 100644 translate/gcc/Makefile.in create mode 100644 translate/gcc/README create mode 100644 translate/gcc/config-lang.in create mode 100755 translate/gcc/dist.sh create mode 100644 translate/gcc/lang-options.h create mode 100644 translate/gcc/lang-specs.h create mode 100644 translate/ghdldrv/Makefile create mode 100644 translate/ghdldrv/default_pathes.ads.in create mode 100644 translate/ghdldrv/ghdl_gcc.adb create mode 100644 translate/ghdldrv/ghdl_mcode.adb create mode 100644 translate/ghdldrv/ghdl_simul.adb create mode 100644 translate/ghdldrv/ghdlcomp.adb create mode 100644 translate/ghdldrv/ghdlcomp.ads create mode 100644 translate/ghdldrv/ghdldrv.adb create mode 100644 translate/ghdldrv/ghdldrv.ads create mode 100644 translate/ghdldrv/ghdllocal.adb create mode 100644 translate/ghdldrv/ghdllocal.ads create mode 100644 translate/ghdldrv/ghdlmain.adb create mode 100644 translate/ghdldrv/ghdlmain.ads create mode 100644 translate/ghdldrv/ghdlprint.adb create mode 100644 translate/ghdldrv/ghdlprint.ads create mode 100644 translate/ghdldrv/ghdlrun.adb create mode 100644 translate/ghdldrv/ghdlrun.ads create mode 100644 translate/ghdldrv/ghdlsimul.adb create mode 100644 translate/ghdldrv/ghdlsimul.ads create mode 100644 translate/grt/Makefile create mode 100644 translate/grt/Makefile.inc create mode 100644 translate/grt/config/clock.c create mode 100644 translate/grt/config/i386.S create mode 100644 translate/grt/config/linux.c create mode 100644 translate/grt/config/ppc.S create mode 100644 translate/grt/config/pthread.c create mode 100644 translate/grt/config/sparc.S create mode 100644 translate/grt/config/times.c create mode 100644 translate/grt/config/win32.c create mode 100644 translate/grt/ghdl_main.adb create mode 100644 translate/grt/ghdl_main.ads create mode 100644 translate/grt/ghwdump.c create mode 100644 translate/grt/ghwlib.c create mode 100644 translate/grt/ghwlib.h create mode 100644 translate/grt/grt-astdio.adb create mode 100644 translate/grt/grt-astdio.ads create mode 100644 translate/grt/grt-avhpi.adb create mode 100644 translate/grt/grt-avhpi.ads create mode 100644 translate/grt/grt-avls.adb create mode 100644 translate/grt/grt-avls.ads create mode 100644 translate/grt/grt-cbinding.c create mode 100644 translate/grt/grt-cvpi.c create mode 100644 translate/grt/grt-disp.adb create mode 100644 translate/grt/grt-disp.ads create mode 100644 translate/grt/grt-disp_rti.adb create mode 100644 translate/grt/grt-disp_rti.ads create mode 100644 translate/grt/grt-disp_signals.adb create mode 100644 translate/grt/grt-disp_signals.ads create mode 100644 translate/grt/grt-errors.adb create mode 100644 translate/grt/grt-errors.ads create mode 100644 translate/grt/grt-files.adb create mode 100644 translate/grt/grt-files.ads create mode 100644 translate/grt/grt-hooks.adb create mode 100644 translate/grt/grt-hooks.ads create mode 100644 translate/grt/grt-images.adb create mode 100644 translate/grt/grt-images.ads create mode 100644 translate/grt/grt-lib.adb create mode 100644 translate/grt/grt-lib.ads create mode 100644 translate/grt/grt-main.adb create mode 100644 translate/grt/grt-main.ads create mode 100644 translate/grt/grt-names.adb create mode 100644 translate/grt/grt-names.ads create mode 100644 translate/grt/grt-options.adb create mode 100644 translate/grt/grt-options.ads create mode 100644 translate/grt/grt-processes.adb create mode 100644 translate/grt/grt-processes.ads create mode 100644 translate/grt/grt-rtis.ads create mode 100644 translate/grt/grt-rtis_addr.adb create mode 100644 translate/grt/grt-rtis_addr.ads create mode 100644 translate/grt/grt-rtis_binding.ads create mode 100644 translate/grt/grt-rtis_types.adb create mode 100644 translate/grt/grt-rtis_types.ads create mode 100644 translate/grt/grt-rtis_utils.adb create mode 100644 translate/grt/grt-rtis_utils.ads create mode 100644 translate/grt/grt-sdf.adb create mode 100644 translate/grt/grt-sdf.ads create mode 100644 translate/grt/grt-shadow_ieee.adb create mode 100644 translate/grt/grt-shadow_ieee.ads create mode 100644 translate/grt/grt-signals.adb create mode 100644 translate/grt/grt-signals.ads create mode 100644 translate/grt/grt-stack2.adb create mode 100644 translate/grt/grt-stack2.ads create mode 100644 translate/grt/grt-stacks.adb create mode 100644 translate/grt/grt-stacks.ads create mode 100644 translate/grt/grt-stats.adb create mode 100644 translate/grt/grt-stats.ads create mode 100644 translate/grt/grt-stdio.ads create mode 100644 translate/grt/grt-types.ads create mode 100644 translate/grt/grt-values.adb create mode 100644 translate/grt/grt-values.ads create mode 100644 translate/grt/grt-vcd.adb create mode 100644 translate/grt/grt-vcd.ads create mode 100644 translate/grt/grt-vital_annotate.adb create mode 100644 translate/grt/grt-vital_annotate.ads create mode 100644 translate/grt/grt-vpi.adb create mode 100644 translate/grt/grt-vpi.ads create mode 100644 translate/grt/grt-vstrings.adb create mode 100644 translate/grt/grt-vstrings.ads create mode 100644 translate/grt/grt-waves.adb create mode 100644 translate/grt/grt-waves.ads create mode 100644 translate/grt/grt.adc create mode 100644 translate/grt/grt.ads create mode 100644 translate/grt/main.adb create mode 100644 translate/grt/main.ads create mode 100644 translate/ortho_front.adb create mode 100644 translate/trans_be.adb create mode 100644 translate/trans_be.ads create mode 100644 translate/trans_decls.ads create mode 100644 translate/translation.adb create mode 100644 translate/translation.ads create mode 100644 types.ads create mode 100644 version.ads create mode 100644 website/index.html create mode 100644 xrefs.adb create mode 100644 xrefs.ads create mode 100644 xtools/Makefile create mode 100644 xtools/check_iirs.adb create mode 100644 xtools/check_iirs_pkg.adb create mode 100644 xtools/check_iirs_pkg.ads diff --git a/COPYING b/COPYING new file mode 100644 index 000000000..d60c31a97 --- /dev/null +++ b/COPYING @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program 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 this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/back_end.adb b/back_end.adb new file mode 100644 index 000000000..034aa23eb --- /dev/null +++ b/back_end.adb @@ -0,0 +1,37 @@ +-- Back-end specialization +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Flags; +with Types; use Types; +with Iirs_Utils; use Iirs_Utils; + +package body Back_End is + -- Transform a library identifier into a file name. + -- Very simple mechanism: just add '-simVV.cf' extension, where VV + -- is the version. + function Default_Library_To_File_Name (Library: Iir_Library_Declaration) + return String + is + begin + case Flags.Vhdl_Std is + when Vhdl_87 => + return Image_Identifier (Library) & "-obj87.cf"; + when Vhdl_93c | Vhdl_93 | Vhdl_00 | Vhdl_02 => + return Image_Identifier (Library) & "-obj93.cf"; + end case; + end Default_Library_To_File_Name; +end Back_End; diff --git a/back_end.ads b/back_end.ads new file mode 100644 index 000000000..3ff6fb1f7 --- /dev/null +++ b/back_end.ads @@ -0,0 +1,53 @@ +-- Back-end specialization +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Iirs; use Iirs; + +package Back_End is + -- Return the name of the library file for LIBRARY. + -- The library file describe the contents of LIBRARY. + function Default_Library_To_File_Name (Library : Iir_Library_Declaration) + return String; + + type Library_To_File_Name_Acc is + access function (Library : Iir_Library_Declaration) return String; + + Library_To_File_Name : Library_To_File_Name_Acc := + Default_Library_To_File_Name'Access; + + -- UNIT is a design unit from parse. + -- According to the current back-end, do what is necessary. + -- + -- If MAIN is true, then UNIT is a wanted to be analysed design unit, and + -- dump/list options can applied. + -- This avoid to dump/list units fetched (through a selected name or a + -- use clause) indirectly by the main unit. + type Finish_Compilation_Acc is access + procedure (Unit : Iir_Design_Unit; Main : Boolean := False); + + Finish_Compilation : Finish_Compilation_Acc := null; + + -- DECL is an architecture (library unit) or a subprogram (specification) + -- decorated with a FOREIGN attribute. Do back-end checks. + -- May be NULL for no additionnal checks. + type Sem_Foreign_Acc is access procedure (Decl : Iir); + Sem_Foreign : Sem_Foreign_Acc := null; + + --procedure Finish_Compilation + -- (Unit : Iir_Design_Unit; Main : Boolean := False); +end Back_End; + diff --git a/bug.adb b/bug.adb new file mode 100644 index 000000000..770114ea8 --- /dev/null +++ b/bug.adb @@ -0,0 +1,73 @@ +-- Bug handling +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Command_Line; use Ada.Command_Line; +with GNAT.Directory_Operations; +with Version; use Version; + +package body Bug is + -- Declared in the files generated by gnatbind. + -- Note: since the string is exported with C convension, there is no way + -- to know the length (gnat1 crashes if the string is unconstrained). + -- Hopefully, the format of the string seems to be fixed. + GNAT_Version : constant String (1 .. 31); + pragma Import (C, GNAT_Version, "__gnat_version"); + + procedure Disp_Bug_Box (Except : Exception_Occurrence) + is + Id : Exception_Id; + begin + New_Line (Standard_Error); + Put_Line + (Standard_Error, + "******************** GHDL Bug occured ****************************"); + Put_Line + (Standard_Error, + "Please, report this bug to ghdl@free.fr, with all the output."); + Put_Line (Standard_Error, "GHDL version: " & Ghdl_Version); + Put_Line (Standard_Error, "Compiled with " & GNAT_Version); + Put_Line (Standard_Error, "In directory: " & + GNAT.Directory_Operations.Get_Current_Dir); + --Put_Line + -- ("Program name: " & Command_Name); + --Put_Line + -- ("Program arguments:"); + --for I in 1 .. Argument_Count loop + -- Put_Line (" " & Argument (I)); + --end loop; + Put_Line (Standard_Error, "Command line:"); + Put (Standard_Error, Command_Name); + for I in 1 .. Argument_Count loop + Put (Standard_Error, ' '); + Put (Standard_Error, Argument (I)); + end loop; + New_Line (Standard_Error); + Id := Exception_Identity (Except); + if Id /= Null_Id then + Put_Line (Standard_Error, + "Exception " & Exception_Name (Id) & " raised"); + --Put_Line ("exception message: " & Exception_Message (Except)); + Put_Line (Standard_Error, + "Exception information:"); + Put (Standard_Error, Exception_Information (Except)); + end if; + Put_Line + (Standard_Error, + "******************************************************************"); + end Disp_Bug_Box; +end Bug; diff --git a/bug.ads b/bug.ads new file mode 100644 index 000000000..ce57a35a7 --- /dev/null +++ b/bug.ads @@ -0,0 +1,22 @@ +-- Bug handling +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Exceptions; use Ada.Exceptions; + +package Bug is + procedure Disp_Bug_Box (Except : Exception_Occurrence); +end Bug; diff --git a/canon.adb b/canon.adb new file mode 100644 index 000000000..1ac67b4e5 --- /dev/null +++ b/canon.adb @@ -0,0 +1,2316 @@ +-- Canonicalization pass +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Errorout; use Errorout; +with Iirs_Utils; use Iirs_Utils; +with Types; use Types; +with Name_Table; +with Sem; +with Std_Names; +with Types; use Types; +with Iir_Chains; use Iir_Chains; +with Flags; + +package body Canon is + -- Canonicalize a list of declarations. LIST can be null. + -- PARENT must be the parent of the current statements chain for LIST, + -- or NULL_IIR if LIST has no corresponding current statments. + procedure Canon_Declarations (Top : Iir_Design_Unit; + Decl_Parent : Iir; + Parent : Iir); + procedure Canon_Declaration (Top : Iir_Design_Unit; + Decl : Iir; + Parent : Iir; + Decl_Parent : Iir); + + -- Canonicalize an association list. + -- If ASSOCIATION_LIST is not null, then it is re-ordored and returned. + -- If ASSOCIATION_LIST is null then: + -- if INTERFACE_LIST is null then returns null. + -- if INTERFACE_LIST is not null, a default list is created. + function Canon_Association_Chain + (Interface_Chain: Iir; Association_Chain: Iir) + return Iir; + + function Canon_Association_Chain_And_Actuals + (Interface_Chain : Iir; Association_Chain : Iir) + return Iir; + + -- Canonicalize block configuration CONF. + -- TOP is used to added dependences to the design unit which CONF + -- belongs to. + procedure Canon_Block_Configuration (Top : Iir_Design_Unit; + Conf : Iir_Block_Configuration); + + function Is_Signal_Object (Decl: Iir) return Boolean is + Adecl: Iir; + begin + Adecl := Get_Base_Name (Decl); + case Get_Kind (Adecl) is + when Iir_Kind_Variable_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Constant_Interface_Declaration => + return False; + when Iir_Kind_Signal_Declaration + | Iir_Kind_Signal_Interface_Declaration => + return True; + when others => + Error_Kind ("is_signal_object", Adecl); + end case; + end Is_Signal_Object; + + procedure Canon_Extract_Sensitivity_Aggregate + (Aggr : Iir; + Sensitivity_List : Iir_List; + Is_Target : Boolean; + Aggr_Type : Iir; + Dim : Natural) + is + Assoc : Iir; + begin + Assoc := Get_Association_Choices_Chain (Aggr); + if Get_Nbr_Elements (Get_Index_Subtype_List (Aggr_Type)) = Dim then + while Assoc /= Null_Iir loop + Canon_Extract_Sensitivity + (Get_Associated (Assoc), Sensitivity_List, Is_Target); + Assoc := Get_Chain (Assoc); + end loop; + else + while Assoc /= Null_Iir loop + Canon_Extract_Sensitivity_Aggregate + (Get_Associated (Assoc), Sensitivity_List, Is_Target, Aggr_Type, + Dim + 1); + Assoc := Get_Chain (Assoc); + end loop; + end if; + end Canon_Extract_Sensitivity_Aggregate; + + procedure Canon_Extract_Sensitivity + (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) + is + El : Iir; + List: Iir_List; + begin + if Get_Expr_Staticness (Expr) /= None then + return; + end if; + + case Get_Kind (Expr) is + when Iir_Kind_Slice_Name => + if not Is_Target and then + Get_Name_Staticness (Expr) >= Globally + then + if Is_Signal_Object (Expr) then + Add_Element (Sensitivity_List, Expr); + end if; + else + declare + Suff : Iir; + begin + Canon_Extract_Sensitivity + (Get_Prefix (Expr), Sensitivity_List, Is_Target); + Suff := Get_Suffix (Expr); + if Get_Kind (Suff) not in Iir_Kinds_Scalar_Type_Definition + then + Canon_Extract_Sensitivity + (Suff, Sensitivity_List, False); + end if; + end; + end if; + + when Iir_Kind_Selected_Element => + if not Is_Target and then + Get_Name_Staticness (Expr) >= Globally + then + if Is_Signal_Object (Expr) then + Add_Element (Sensitivity_List, Expr); + end if; + else + Canon_Extract_Sensitivity (Get_Prefix (Expr), + Sensitivity_List, + Is_Target); + end if; + + when Iir_Kind_Indexed_Name => + if not Is_Target + and then Get_Name_Staticness (Expr) >= Globally + then + if Is_Signal_Object (Expr) then + Add_Element (Sensitivity_List, Expr); + end if; + else + Canon_Extract_Sensitivity (Get_Prefix (Expr), + Sensitivity_List, + Is_Target); + List := Get_Index_List (Expr); + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Canon_Extract_Sensitivity (El, Sensitivity_List, False); + end loop; + end if; + + when Iir_Kind_Function_Call => + El := Get_Parameter_Association_Chain (Expr); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Association_Element_By_Expression => + Canon_Extract_Sensitivity + (Get_Actual (El), Sensitivity_List, False); + when Iir_Kind_Association_Element_Open => + null; + when others => + Error_Kind ("canon_extract_sensitivity(call)", El); + end case; + El := Get_Chain (El); + end loop; + + when Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression => + Canon_Extract_Sensitivity + (Get_Expression (Expr), Sensitivity_List, False); + + when Iir_Kind_Allocator_By_Subtype => + null; + + when Iir_Kinds_Monadic_Operator => + Canon_Extract_Sensitivity + (Get_Operand (Expr), Sensitivity_List, False); + when Iir_Kinds_Dyadic_Operator => + Canon_Extract_Sensitivity + (Get_Left (Expr), Sensitivity_List, False); + Canon_Extract_Sensitivity + (Get_Right (Expr), Sensitivity_List, False); + + when Iir_Kind_Range_Expression => + Canon_Extract_Sensitivity + (Get_Left_Limit (Expr), Sensitivity_List, False); + Canon_Extract_Sensitivity + (Get_Right_Limit (Expr), Sensitivity_List, False); + + when Iir_Kinds_Type_Attribute => + null; + when Iir_Kind_Event_Attribute => + -- LRM 8.1 + -- An attribute name: [...]; otherwise, apply this rule to the + -- prefix of the attribute name. + Canon_Extract_Sensitivity + (Get_Prefix (Expr), Sensitivity_List, False); + + + when Iir_Kind_Last_Value_Attribute => + null; + + when Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Stable_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute => + -- LRM 8.1 + -- A simple name that denotes a signal, add the longuest static + -- prefix of the name to the sensitivity set; + -- + -- An attribute name: if the designator denotes a signal + -- attribute, add the longuest static prefix of the name of the + -- implicit signal denoted by the attribute name to the + -- sensitivity set; [...] + if not Is_Target then + Add_Element (Sensitivity_List, Expr); + end if; + + when Iir_Kind_Object_Alias_Declaration => + Canon_Extract_Sensitivity + (Get_Name (Expr), Sensitivity_List, Is_Target); + + when Iir_Kind_Constant_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Variable_Interface_Declaration => + null; + + when Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_High_Array_Attribute => + null; + --Canon_Extract_Sensitivity + -- (Get_Prefix (Expr), Sensitivity_List, Is_Target); + + when Iir_Kind_Aggregate => + declare + Aggr_Type : Iir; + begin + Aggr_Type := Get_Base_Type (Get_Type (Expr)); + case Get_Kind (Aggr_Type) is + when Iir_Kind_Array_Type_Definition => + Canon_Extract_Sensitivity_Aggregate + (Expr, Sensitivity_List, Is_Target, Aggr_Type, 1); + when Iir_Kind_Record_Type_Definition => + El := Get_Association_Choices_Chain (Expr); + while El /= Null_Iir loop + Canon_Extract_Sensitivity + (Get_Associated (El), Sensitivity_List, Is_Target); + El := Get_Chain (El); + end loop; + when others => + Error_Kind ("canon_extract_sensitivity(aggr)", Aggr_Type); + end case; + end; + + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + Canon_Extract_Sensitivity + (Get_Named_Entity (Expr), Sensitivity_List, Is_Target); + + when others => + Error_Kind ("canon_extract_sensitivity", Expr); + end case; + end Canon_Extract_Sensitivity; + +-- function Make_Aggregate (Array_Type : Iir_Array_Type_Definition; El : Iir) +-- return Iir_Aggregate +-- is +-- Res : Iir_Aggregate; +-- Choice : Iir; +-- begin +-- Res := Create_Iir (Iir_Kind_Aggregate); +-- Location_Copy (Res, El); +-- Choice := Create_Iir (Iir_Kind_Association_Choice_By_None); +-- Set_Associated (Choice, El); +-- Append_Element (Get_Association_Choices_List (Res), Choice); + +-- -- will call sem_aggregate +-- return Sem_Expr.Sem_Expression (Res, Array_Type); +-- end Make_Aggregate; + +-- procedure Canon_Concatenation_Operator (Expr : Iir) +-- is +-- Array_Type : Iir_Array_Type_Definition; +-- El_Type : Iir; +-- Left, Right : Iir; +-- Func_List : Iir_Implicit_Functions_List; +-- Func : Iir_Implicit_Function_Declaration; +-- begin +-- Array_Type := Get_Type (Expr); +-- El_Type := Get_Base_Type (Get_Element_Subtype (Array_Type)); +-- Left := Get_Left (Expr); +-- if Get_Type (Left) = El_Type then +-- Set_Left (Expr, Make_Aggregate (Array_Type, Left)); +-- end if; +-- Right := Get_Right (Expr); +-- if Get_Type (Right) = El_Type then +-- Set_Right (Expr, Make_Aggregate (Array_Type, Right)); +-- end if; + +-- -- FIXME: must convert the implementation. +-- -- Use implicit declaration list from the array_type ? +-- Func_List := Get_Implicit_Functions_List +-- (Get_Type_Declarator (Array_Type)); +-- for I in Natural loop +-- Func := Get_Nth_Element (Func_List, I); +-- if Get_Implicit_Definition (Func) +-- = Iir_Predefined_Array_Array_Concat +-- then +-- Set_Implementation (Expr, Func); +-- exit; +-- end if; +-- end loop; +-- end Canon_Concatenation_Operator; + + -- canon on expressions, mainly for function calls. + procedure Canon_Expression (Expr: Iir) + is + El : Iir; + List: Iir_List; + begin + if Expr = Null_Iir then + return; + end if; + case Get_Kind (Expr) is + when Iir_Kind_Range_Expression => + Canon_Expression (Get_Left_Limit (Expr)); + Canon_Expression (Get_Right_Limit (Expr)); + + when Iir_Kind_Slice_Name => + declare + Suffix : Iir; + begin + Suffix := Get_Suffix (Expr); + if Get_Kind (Suffix) not in Iir_Kinds_Discrete_Type_Definition + then + Canon_Expression (Suffix); + end if; + Canon_Expression (Get_Prefix (Expr)); + end; + + when Iir_Kind_Indexed_Name => + Canon_Expression (Get_Prefix (Expr)); + List := Get_Index_List (Expr); + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Canon_Expression (El); + end loop; + +-- when Iir_Kind_Selected_Name => +-- -- Use this order to allow tail recursion optimisation. +-- Canon_Expression (Get_Suffix (Expr)); +-- Canon_Expression (Get_Prefix (Expr)); + when Iir_Kind_Selected_Element => + Canon_Expression (Get_Prefix (Expr)); + when Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference => + Canon_Expression (Get_Prefix (Expr)); + + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + Canon_Expression (Get_Named_Entity (Expr)); + + when Iir_Kinds_Monadic_Operator => + Canon_Expression (Get_Operand (Expr)); + when Iir_Kinds_Dyadic_Operator => + Canon_Expression (Get_Left (Expr)); + Canon_Expression (Get_Right (Expr)); + if Get_Kind (Expr) = Iir_Kind_Concatenation_Operator + and then Canon_Concatenation + and then Get_Kind (Get_Implementation (Expr)) = + Iir_Kind_Implicit_Function_Declaration + then + --Canon_Concatenation_Operator (Expr); + raise Internal_Error; + end if; + + when Iir_Kind_Function_Call => + declare + Imp : Iir; + Assoc_Chain : Iir; + begin + Imp := Get_Implementation (Expr); + if Get_Kind (Imp) /= Iir_Kind_Implicit_Function_Declaration then + Assoc_Chain := Canon_Association_Chain_And_Actuals + (Get_Interface_Declaration_Chain (Imp), + Get_Parameter_Association_Chain (Expr)); + Set_Parameter_Association_Chain (Expr, Assoc_Chain); + else + -- FIXME: + -- should canon concatenation. + null; + end if; + end; + when Iir_Kind_Type_Conversion + | Iir_Kind_Qualified_Expression => + Canon_Expression (Get_Expression (Expr)); + when Iir_Kind_Aggregate => + -- FIXME + null; + when Iir_Kind_Allocator_By_Expression => + Canon_Expression (Get_Expression (Expr)); + when Iir_Kind_Allocator_By_Subtype => + null; + + when Iir_Kinds_Literal + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Unit_Declaration => + null; + + when Iir_Kinds_Array_Attribute => + -- No need to canon parameter, since it is a locally static + -- expression. + declare + Prefix : Iir; + begin + Prefix := Get_Prefix (Expr); + case Get_Kind (Prefix) is + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration => + null; + when others => + Canon_Expression (Prefix); + end case; + end; + + when Iir_Kinds_Type_Attribute => + null; + when Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Transaction_Attribute => + -- FIXME: add the default parameter ? + Canon_Expression (Get_Prefix (Expr)); + when Iir_Kind_Event_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute => + Canon_Expression (Get_Prefix (Expr)); + + when Iir_Kinds_Scalar_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute => + Canon_Expression (Get_Parameter (Expr)); + + when Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Instance_Name_Attribute => + null; + + when Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Object_Alias_Declaration => + null; + + when Iir_Kind_Enumeration_Literal => + null; + + when Iir_Kind_Element_Declaration => + null; + + when Iir_Kind_Attribute_Value => + null; + + when others => + Error_Kind ("canon_expression", Expr); + null; + end case; + end Canon_Expression; + + procedure Canon_Waveform_Chain + (Chain : Iir_Waveform_Element; Sensitivity_List: Iir_List) + is + We: Iir_Waveform_Element; + begin + We := Chain; + while We /= Null_Iir loop + if Sensitivity_List /= Null_Iir_List then + Canon_Extract_Sensitivity + (Get_We_Value (We), Sensitivity_List, False); + end if; + if Canon_Flag_Expressions then + Canon_Expression (Get_We_Value (We)); + if Get_Time (We) /= Null_Iir then + Canon_Expression (Get_Time (We)); + end if; + end if; + We := Get_Chain (We); + end loop; + end Canon_Waveform_Chain; + + -- Names associations by position, + -- reorder associations by name, + -- create omitted association, + function Canon_Association_Chain + (Interface_Chain : Iir; Association_Chain : Iir) + return Iir + is + -- The canon list of association. + N_Chain, Last : Iir; + Interface : Iir; + Assoc_El, Prev_Assoc_El, Next_Assoc_El : Iir; + Assoc_Chain : Iir; + + Found : Boolean; + begin + -- No argument, so return now. + if Interface_Chain = Null_Iir then + if Association_Chain /= Null_Iir then + raise Internal_Error; + end if; + return Null_Iir; + end if; + + Sub_Chain_Init (N_Chain, Last); + Assoc_Chain := Association_Chain; + + -- Reorder the list of association in the interface order. + -- Add missing associations. + Interface := Interface_Chain; + while Interface /= Null_Iir loop + -- Search associations with INTERFACE. + Found := False; + Assoc_El := Assoc_Chain; + Prev_Assoc_El := Null_Iir; + while Assoc_El /= Null_Iir loop + Next_Assoc_El := Get_Chain (Assoc_El); + if Get_Formal (Assoc_El) = Null_Iir then + Set_Formal (Assoc_El, Interface); + end if; + if Get_Associated_Formal (Assoc_El) = Interface then + + -- Remove ASSOC_EL from ASSOC_CHAIN + if Prev_Assoc_El /= Null_Iir then + Set_Chain (Prev_Assoc_El, Next_Assoc_El); + else + Assoc_Chain := Next_Assoc_El; + end if; + + -- Append ASSOC_EL in N_CHAIN. + Set_Chain (Assoc_El, Null_Iir); + Sub_Chain_Append (N_Chain, Last, Assoc_El); + + case Get_Kind (Assoc_El) is + when Iir_Kind_Association_Element_Open => + goto Done; + when Iir_Kind_Association_Element_By_Expression => + if Get_Whole_Association_Flag (Assoc_El) then + goto Done; + end if; + when Iir_Kind_Association_Element_By_Individual => + Found := True; + when others => + Error_Kind ("canon_association_list", Assoc_El); + end case; + elsif Found then + -- No more associations. + goto Done; + else + Prev_Assoc_El := Assoc_El; + end if; + Assoc_El := Next_Assoc_El; + end loop; + if Found then + goto Done; + end if; + + -- No association, use default expr. + Assoc_El := Create_Iir (Iir_Kind_Association_Element_Open); + Set_Artificial_Flag (Assoc_El, True); + -- FIXME: association_list can be null_iir_list! + --Location_Copy (Assoc_El, Association_List); + Set_Formal (Assoc_El, Interface); + Sub_Chain_Append (N_Chain, Last, Assoc_El); + + << Done >> null; + Interface := Get_Chain (Interface); + end loop; + pragma Assert (Assoc_Chain = Null_Iir); + + return N_Chain; + end Canon_Association_Chain; + + procedure Canon_Association_Chain_Actuals (Association_Chain : Iir) + is + Assoc_El : Iir; + begin + -- Canon actuals. + Assoc_El := Association_Chain; + while Assoc_El /= Null_Iir loop + if Get_Kind (Assoc_El) = Iir_Kind_Association_Element_By_Expression + then + Canon_Expression (Get_Actual (Assoc_El)); + end if; + Assoc_El := Get_Chain (Assoc_El); + end loop; + end Canon_Association_Chain_Actuals; + + function Canon_Association_Chain_And_Actuals + (Interface_Chain : Iir; Association_Chain : Iir) + return Iir + is + Res : Iir; + begin + Res := Canon_Association_Chain (Interface_Chain, Association_Chain); + Canon_Association_Chain_Actuals (Res); + return Res; + end Canon_Association_Chain_And_Actuals; + + function Canon_Subprogram_Call (Call : Iir) return Iir + is + Imp : Iir; + Assoc_Chain : Iir; + Inter_Chain : Iir; + begin + Imp := Get_Implementation (Call); + Inter_Chain := Get_Interface_Declaration_Chain (Imp); + Assoc_Chain := Get_Parameter_Association_Chain (Call); + Assoc_Chain := Canon_Association_Chain (Inter_Chain, Assoc_Chain); + Set_Parameter_Association_Chain (Call, Assoc_Chain); + return Assoc_Chain; + end Canon_Subprogram_Call; + + -- Create a default association list for INTERFACE_LIST. + -- The default is a list of interfaces associated with open. + function Canon_Default_Association_Chain (Interface_Chain : Iir) + return Iir + is + Res : Iir; + Last : Iir; + Assoc, El : Iir; + begin + El := Interface_Chain; + Sub_Chain_Init (Res, Last); + while El /= Null_Iir loop + Assoc := Create_Iir (Iir_Kind_Association_Element_Open); + Set_Artificial_Flag (Assoc, True); + Set_Formal (Assoc, El); + Location_Copy (Assoc, El); + Sub_Chain_Append (Res, Last, Assoc); + El := Get_Chain (El); + end loop; + return Res; + end Canon_Default_Association_Chain; + +-- function Canon_Default_Map_Association_List +-- (Formal_List, Actual_List : Iir_List; Loc : Location_Type) +-- return Iir_Association_List +-- is +-- Res : Iir_Association_List; +-- Formal, Actual : Iir; +-- Assoc : Iir; +-- Nbr_Assoc : Natural; +-- begin +-- -- formal is the entity port/generic. +-- if Formal_List = Null_Iir_List then +-- if Actual_List /= Null_Iir_List then +-- raise Internal_Error; +-- end if; +-- return Null_Iir_List; +-- end if; + +-- Res := Create_Iir (Iir_Kind_Association_List); +-- Set_Location (Res, Loc); +-- Nbr_Assoc := 0; +-- for I in Natural loop +-- Formal := Get_Nth_Element (Formal_List, I); +-- exit when Formal = Null_Iir; +-- Actual := Find_Name_In_List (Actual_List, Get_Identifier (Formal)); +-- if Actual /= Null_Iir then +-- Assoc := Create_Iir (Iir_Kind_Association_Element_By_Expression); +-- Set_Whole_Association_Flag (Assoc, True); +-- Set_Actual (Assoc, Actual); +-- Nbr_Assoc := Nbr_Assoc + 1; +-- else +-- Assoc := Create_Iir (Iir_Kind_Association_Element_Open); +-- end if; +-- Set_Location (Assoc, Loc); +-- Set_Formal (Assoc, Formal); +-- Set_Associated_Formal (Assoc, Formal); +-- Append_Element (Res, Assoc); +-- end loop; +-- if Nbr_Assoc /= Get_Nbr_Elements (Actual_List) then +-- -- There is non-associated actuals. +-- raise Internal_Error; +-- end if; +-- return Res; +-- end Canon_Default_Map_Association_List; + + -- Inner loop if any; used to canonicalize exit/next statement. + Cur_Loop : Iir; + + procedure Canon_Procedure_Call (Call : Iir_Procedure_Call) + is + Assoc_Chain : Iir; + begin + Assoc_Chain := Canon_Association_Chain_And_Actuals + (Get_Interface_Declaration_Chain (Get_Implementation (Call)), + Get_Parameter_Association_Chain (Call)); + Set_Parameter_Association_Chain (Call, Assoc_Chain); + end Canon_Procedure_Call; + + procedure Canon_Sequential_Stmts (First : Iir) + is + Stmt: Iir; + Expr: Iir; + Prev_Loop : Iir; + Label : Iir; + begin + Stmt := First; + while Stmt /= Null_Iir loop + case Get_Kind (Stmt) is + when Iir_Kind_If_Statement => + declare + Cond: Iir; + Clause: Iir := Stmt; + begin + while Clause /= Null_Iir loop + Cond := Get_Condition (Clause); + if Cond /= Null_Iir then + Canon_Expression (Cond); + end if; + Canon_Sequential_Stmts + (Get_Sequential_Statement_Chain (Clause)); + Clause := Get_Else_Clause (Clause); + end loop; + end; + + when Iir_Kind_Signal_Assignment_Statement => + Canon_Expression (Get_Target (Stmt)); + Canon_Waveform_Chain (Get_Waveform_Chain (Stmt), Null_Iir_List); + + when Iir_Kind_Variable_Assignment_Statement => + Canon_Expression (Get_Target (Stmt)); + Canon_Expression (Get_Expression (Stmt)); + + when Iir_Kind_Wait_Statement => + declare + Expr: Iir; + List: Iir_List; + begin + Expr := Get_Timeout_Clause (Stmt); + if Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + Expr := Get_Condition_Clause (Stmt); + if Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + List := Get_Sensitivity_List (Stmt); + if List = Null_Iir_List and then Expr /= Null_Iir then + List := Create_Iir_List; + Canon_Extract_Sensitivity (Expr, List, False); + Set_Sensitivity_List (Stmt, List); + end if; + end; + + when Iir_Kind_Case_Statement => + Canon_Expression (Get_Expression (Stmt)); + declare + Choice: Iir; + begin + Choice := Get_Case_Statement_Alternative_Chain (Stmt); + while Choice /= Null_Iir loop + -- FIXME: canon choice expr. + Canon_Sequential_Stmts (Get_Associated (Choice)); + Choice := Get_Chain (Choice); + end loop; + end; + + when Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement => + if Get_Kind (Stmt) = Iir_Kind_Assertion_Statement then + Canon_Expression (Get_Assertion_Condition (Stmt)); + end if; + Expr := Get_Report_Expression (Stmt); + if Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + Expr := Get_Severity_Expression (Stmt); + if Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + + when Iir_Kind_For_Loop_Statement => + -- FIXME: decl. + Prev_Loop := Cur_Loop; + Cur_Loop := Stmt; + Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt)); + Cur_Loop := Prev_Loop; + + when Iir_Kind_While_Loop_Statement => + Expr := Get_Condition (Stmt); + if Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + Prev_Loop := Cur_Loop; + Cur_Loop := Stmt; + Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt)); + Cur_Loop := Prev_Loop; + + when Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement => + Expr := Get_Condition (Stmt); + if Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + Label := Get_Loop (Stmt); + if Label = Null_Iir then + Set_Loop (Stmt, Cur_Loop); + end if; + + when Iir_Kind_Procedure_Call_Statement => + Canon_Procedure_Call (Get_Procedure_Call (Stmt)); + + when Iir_Kind_Null_Statement => + null; + + when Iir_Kind_Return_Statement => + Canon_Expression (Get_Expression (Stmt)); + + when others => + Error_Kind ("canon_sequential_stmts", Stmt); + end case; + Stmt := Get_Chain (Stmt); + end loop; + end Canon_Sequential_Stmts; + + procedure Add_Driver_For_Signal (Driver_List : Iir_List; + Signal : Iir) + is + Choice : Iir; + begin + if Get_Kind (Signal) = Iir_Kind_Aggregate then + Choice := Get_Association_Choices_Chain (Signal); + while Choice /= Null_Iir loop + Add_Driver_For_Signal (Driver_List, Get_Associated (Choice)); + Choice := Get_Chain (Choice); + end loop; + else + Add_Element (Driver_List, Get_Longuest_Static_Prefix (Signal)); + end if; + end Add_Driver_For_Signal; + + -- Create a statement transform from concurrent_signal_assignment + -- statement STMT (either selected or conditional). + -- waveform transformation is not done. + -- PROC is the process created. + -- PARENT is the place where signal assignment must be placed. This may + -- be PROC, or an 'if' statement if the assignment is guarded. + -- See LRM93 9.5 + procedure Canon_Concurrent_Signal_Assignment + (Stmt: in out Iir; + Proc: out Iir_Sensitized_Process_Statement; + Chain : out Iir) + is + If_Stmt: Iir; + Sensitivity_List : Iir_List; + begin + Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); + Location_Copy (Proc, Stmt); + Set_Parent (Proc, Get_Parent (Stmt)); + Sensitivity_List := Create_Iir_List; + Set_Sensitivity_List (Proc, Sensitivity_List); + + -- LRM93 9.5 + -- 1. If a label appears on the concurrent signal assignment, then the + -- same label appears on the process statement. + Set_Label (Proc, Get_Label (Stmt)); + + -- LRM93 9.5 + -- 2. The equivalent process statement is a postponed process if and + -- only if the current signal assignment statement includes the + -- reserved word POSTPONED. + Set_Postponed_Flag (Proc, Get_Postponed_Flag (Proc)); + + Set_Driver_List (Proc, Create_Iir_List); + Add_Driver_For_Signal (Get_Driver_List (Proc), Get_Target (Stmt)); + + Canon_Extract_Sensitivity (Get_Target (Stmt), Sensitivity_List, True); + + if Canon_Flag_Expressions then + Canon_Expression (Get_Target (Stmt)); + end if; + + if Get_Guard (Stmt) /= Null_Iir then + -- LRM93 9.1 + -- If the option guarded appears in the concurrent signal assignment + -- statement, then the concurrent signal assignment is called a + -- guarded assignment. + -- If the concurrent signal assignement statement is a guarded + -- assignment and the target of the concurrent signal assignment is + -- a guarded target, then the statement transform is as follow: + -- if GUARD then signal_transform else disconnect_statements end if; + -- Otherwise, if the concurrent signal assignment statement is a + -- guarded assignement, but the target if the concurrent signal + -- assignment is not a guarded target, the then statement transform + -- is as follows: + -- if GUARD then signal_transform end if; + If_Stmt := Create_Iir (Iir_Kind_If_Statement); + Set_Sequential_Statement_Chain (Proc, If_Stmt); + Location_Copy (If_Stmt, Stmt); + Canon_Extract_Sensitivity (Get_Guard (Stmt), Sensitivity_List, False); + Set_Condition (If_Stmt, Get_Guard (Stmt)); + Chain := If_Stmt; + + declare + Target : Iir; + Else_Clause : Iir_Elsif; + Dis_Stmt : Iir_Signal_Assignment_Statement; + begin + Target := Get_Target (Stmt); + if Get_Guarded_Target_State (Stmt) = True then + -- The target is a guarded target. + -- create the disconnection statement. + Else_Clause := Create_Iir (Iir_Kind_Elsif); + Location_Copy (Else_Clause, Stmt); + Set_Else_Clause (If_Stmt, Else_Clause); + Dis_Stmt := Create_Iir (Iir_Kind_Signal_Assignment_Statement); + Location_Copy (Dis_Stmt, Stmt); + Set_Target (Dis_Stmt, Target); + Set_Sequential_Statement_Chain (Else_Clause, Dis_Stmt); + -- XX + Set_Waveform_Chain (Dis_Stmt, Null_Iir); + end if; + end; + else + -- LRM93 9.1 + -- Finally, if the concurrent signal assignment statement is not a + -- guarded assignment, and the traget of the concurrent signal + -- assignment is not a guarded target,t hen the statement transform + -- is as follows: + -- signal_transform + Chain := Proc; + end if; + end Canon_Concurrent_Signal_Assignment; + + function Canon_Concurrent_Procedure_Call (El : Iir) + return Iir_Sensitized_Process_Statement + is + Proc : Iir_Sensitized_Process_Statement; + Call_Stmt : Iir_Procedure_Call_Statement; + Wait_Stmt : Iir_Wait_Statement; + Call : Iir_Procedure_Call; + Assoc_Chain : Iir; + Assoc : Iir; + Imp : Iir; + Driver_List : Iir_Driver_List; + Interface : Iir; + Sensitivity_List : Iir_List; + Is_Sensitized : Boolean; + begin + Call := Get_Procedure_Call (El); + Imp := Get_Implementation (Call); + + -- Optimization: the process is a sensitized process only if the + -- procedure is known not to have wait statement. + Is_Sensitized := Get_Wait_State (Imp) = False; + + -- LRM93 9.3 + -- The equivalent process statement has also no sensitivity list, an + -- empty declarative part, and a statement part that consists of a + -- procedure call statement followed by a wait statement. + if Is_Sensitized then + Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); + else + Proc := Create_Iir (Iir_Kind_Process_Statement); + end if; + Location_Copy (Proc, El); + Set_Parent (Proc, Get_Parent (El)); + + -- LRM93 9.3 + -- The equivalent process statement has a label if and only if the + -- concurrent procedure call statement has a label; if the equivalent + -- process statement has a label, it is the same as that of the + -- concurrent procedure call statement. + Set_Label (Proc, Get_Label (El)); + + -- LRM93 9.3 + -- The equivalent process statement is a postponed process if and only + -- if the concurrent procedure call statement includes the reserved + -- word POSTPONED. + Set_Postponed_Flag (Proc, Get_Postponed_Flag (El)); + + Set_Attribute_Value_Chain (Proc, Get_Attribute_Value_Chain (El)); + + Call_Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement); + Set_Sequential_Statement_Chain (Proc, Call_Stmt); + Location_Copy (Call_Stmt, El); + Set_Procedure_Call (Call_Stmt, Call); + Assoc_Chain := Canon_Association_Chain + (Get_Interface_Declaration_Chain (Imp), + Get_Parameter_Association_Chain (Call)); + Set_Parameter_Association_Chain (Call, Assoc_Chain); + Driver_List := Null_Iir_List; + Assoc := Assoc_Chain; + + -- LRM93 9.3 + -- If there exists a name that denotes a signal in the actual part of + -- any association element in the concurrent procedure call statement, + -- and that actual is associated with a formal parameter of mode IN or + -- INOUT, then the equivalent process statement includes a final wait + -- statement with a sensitivity clause that is constructed by taking + -- the union of the sets constructed by applying th rule of Section 8.1 + -- to each actual part associated with a formal parameter. + Sensitivity_List := Create_Iir_List; + while Assoc /= Null_Iir loop + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_By_Expression => + Interface := Get_Associated_Formal (Assoc); + if Get_Mode (Interface) in Iir_In_Modes then + Canon_Extract_Sensitivity + (Get_Actual (Assoc), Sensitivity_List, False); + end if; + -- LRM 2.1.1.2 Signal Parameters + if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration + and then Get_Mode (Interface) in Iir_Out_Modes + then + if Driver_List = Null_Iir_List then + Driver_List := Create_Iir_List; + Set_Driver_List (Proc, Driver_List); + end if; + Add_Element + (Driver_List, + Get_Longuest_Static_Prefix (Get_Actual (Assoc))); + end if; + when Iir_Kind_Association_Element_Open + | Iir_Kind_Association_Element_By_Individual => + null; + when others => + raise Internal_Error; + end case; + Assoc := Get_Chain (Assoc); + end loop; + if Get_Nbr_Elements (Sensitivity_List) = 0 then + Destroy_Iir_List (Sensitivity_List); + end if; + if Is_Sensitized then + Set_Sensitivity_List (Proc, Sensitivity_List); + else + Wait_Stmt := Create_Iir (Iir_Kind_Wait_Statement); + Location_Copy (Wait_Stmt, El); + Set_Parent (Wait_Stmt, Proc); + Set_Sensitivity_List (Wait_Stmt, Sensitivity_List); + Set_Chain (Call_Stmt, Wait_Stmt); + end if; + return Proc; + end Canon_Concurrent_Procedure_Call; + + function Canon_Wave_Transform + (Orig_Stmt : Iir; Waveform_Chain : Iir_Waveform_Element; Proc : Iir) + return Iir + is + Stmt : Iir; + begin + if Waveform_Chain = Null_Iir then + -- LRM 9.5.1 Conditionnal Signal Assignment + -- If the waveform is of the form: + -- UNAFFECTED + -- then the wave transform in the corresponding process statement + -- is of the form: + -- NULL; + -- In this example, the final NULL causes the driver to be unchanged, + -- rather than disconnected. + -- (This is the null statement not a null waveform element). + Stmt := Create_Iir (Iir_Kind_Null_Statement); + else + -- LRM 9.5.1 Conditionnal Signal Assignment + -- If the waveform is of the form: + -- waveform_element1, waveform_element1, ..., waveform_elementN + -- then the wave transform in the corresponding process statement is + -- of the form: + -- target <= [ delay_mechanism ] waveform_element1, + -- waveform_element2, ..., waveform_elementN; + Stmt := Create_Iir (Iir_Kind_Signal_Assignment_Statement); + Set_Target (Stmt, Get_Target (Orig_Stmt)); + Canon_Waveform_Chain (Waveform_Chain, Get_Sensitivity_List (Proc)); + Set_Waveform_Chain (Stmt, Waveform_Chain); + Set_Delay_Mechanism (Stmt, Get_Delay_Mechanism (Orig_Stmt)); + Set_Reject_Time_Expression + (Stmt, Get_Reject_Time_Expression (Orig_Stmt)); + end if; + Location_Copy (Stmt, Orig_Stmt); + return Stmt; + end Canon_Wave_Transform; + + -- Create signal_transform for a conditional concurrent signal assignment. + procedure Canon_Conditional_Concurrent_Signal_Assigment + (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) + is + Expr : Iir; + Stmt : Iir; + Res1 : Iir; + Last_Res : Iir; + Wf : Iir; + Cond_Wf : Iir_Conditional_Waveform; + Cond_Wf_Chain : Iir_Conditional_Waveform; + begin + Cond_Wf_Chain := Get_Conditional_Waveform_Chain (Conc_Stmt); + Stmt := Null_Iir; + Cond_Wf := Cond_Wf_Chain; + Last_Res := Null_Iir; + while Cond_Wf /= Null_Iir loop + Expr := Get_Condition (Cond_Wf); + Wf := Canon_Wave_Transform + (Conc_Stmt, Get_Waveform_Chain (Cond_Wf), Proc); + if Expr = Null_Iir and Cond_Wf = Cond_Wf_Chain then + Res1 := Wf; + else + if Expr /= Null_Iir then + if Canon_Flag_Expressions then + Canon_Expression (Expr); + end if; + Canon_Extract_Sensitivity + (Expr, Get_Sensitivity_List (Proc), False); + end if; + if Stmt = Null_Iir then + Res1 := Create_Iir (Iir_Kind_If_Statement); + else + Res1 := Create_Iir (Iir_Kind_Elsif); + end if; + Location_Copy (Res1, Cond_Wf); + Set_Condition (Res1, Expr); + Set_Sequential_Statement_Chain (Res1, Wf); + end if; + if Stmt = Null_Iir then + Stmt := Res1; + else + Set_Else_Clause (Last_Res, Res1); + end if; + Last_Res := Res1; + Cond_Wf := Get_Chain (Cond_Wf); + end loop; + Set_Sequential_Statement_Chain (Parent, Stmt); + end Canon_Conditional_Concurrent_Signal_Assigment; + + procedure Canon_Selected_Concurrent_Signal_Assignment + (Conc_Stmt : Iir; Proc : Iir; Parent : Iir) + is + Selected_Waveform : Iir; + Case_Stmt: Iir_Case_Statement; + Expr : Iir; + Stmt : Iir; + Assoc : Iir; + begin + Case_Stmt := Create_Iir (Iir_Kind_Case_Statement); + Set_Sequential_Statement_Chain (Parent, Case_Stmt); + Location_Copy (Case_Stmt, Conc_Stmt); + Expr := Get_Expression (Conc_Stmt); + if Canon_Flag_Expressions then + Canon_Expression (Expr); + end if; + Set_Expression (Case_Stmt, Expr); + Canon_Extract_Sensitivity + (Expr, Get_Sensitivity_List (Proc), False); + + Selected_Waveform := Get_Selected_Waveform_Chain (Conc_Stmt); + Set_Case_Statement_Alternative_Chain (Case_Stmt, Selected_Waveform); + while Selected_Waveform /= Null_Iir loop + Assoc := Get_Associated (Selected_Waveform); + if Assoc /= Null_Iir then + Stmt := Canon_Wave_Transform (Conc_Stmt, Assoc, Proc); + Set_Associated (Selected_Waveform, Stmt); + end if; + Selected_Waveform := Get_Chain (Selected_Waveform); + end loop; + end Canon_Selected_Concurrent_Signal_Assignment; + + procedure Canon_Concurrent_Stmts (Top : Iir_Design_Unit; Parent : Iir) + is + -- Current element in the chain of concurrent statements. + El: Iir; + -- Previous element or NULL_IIR if EL is the first element. + -- This is used to make Replace_Stmt efficient. + Prev_El : Iir; + + -- Replace in the chain EL by N_STMT. + procedure Replace_Stmt (N_Stmt : Iir) is + begin + if Prev_El = Null_Iir then + Set_Concurrent_Statement_Chain (Parent, N_Stmt); + else + Set_Chain (Prev_El, N_Stmt); + end if; + Set_Chain (N_Stmt, Get_Chain (El)); + end Replace_Stmt; + + Proc: Iir; + Stmt: Iir; + Sub_Chain : Iir; + Expr: Iir; + Proc_Num : Natural := 0; + Sensitivity_List : Iir_List; + begin + Prev_El := Null_Iir; + El := Get_Concurrent_Statement_Chain (Parent); + while El /= Null_Iir loop + -- Add a label if required. + if Canon_Flag_Add_Labels + and then Get_Label (El) = Null_Identifier + then + declare + Str : String := Natural'Image (Proc_Num); + begin + -- Note: the label starts with a capitalized letter, to avoid + -- any clash with user's identifiers. + Str (1) := 'P'; + Set_Label (El, Name_Table.Get_Identifier (Str)); + end; + Proc_Num := Proc_Num + 1; + end if; + + case Get_Kind (El) is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain); + + Canon_Conditional_Concurrent_Signal_Assigment + (El, Proc, Sub_Chain); + + Replace_Stmt (Proc); + Free_Iir (El); + El := Proc; + + when Iir_Kind_Concurrent_Selected_Signal_Assignment => + Canon_Concurrent_Signal_Assignment (El, Proc, Sub_Chain); + + Canon_Selected_Concurrent_Signal_Assignment + (El, Proc, Sub_Chain); + + Replace_Stmt (Proc); + Free_Iir (El); + El := Proc; + + when Iir_Kind_Concurrent_Assertion_Statement => + -- Create a new entry. + Proc := Create_Iir (Iir_Kind_Sensitized_Process_Statement); + Location_Copy (Proc, El); + Set_Parent (Proc, Get_Parent (El)); + + -- LRM93 9.4 + -- The equivalent process statement has a label if and only if + -- the current assertion statement has a label; if the + -- equivalent process statement has a label; it is the same + -- as that of the concurrent assertion statement. + Set_Label (Proc, Get_Label (El)); + + -- LRM93 9.4 + -- The equivalent process statement is a postponed process if + -- and only if the current assertion statement includes the + -- reserved word POSTPONED. + Set_Postponed_Flag (Proc, Get_Postponed_Flag (El)); + + Stmt := Create_Iir (Iir_Kind_Assertion_Statement); + Set_Sequential_Statement_Chain (Proc, Stmt); + Location_Copy (Stmt, El); + Sensitivity_List := Create_Iir_List; + Set_Sensitivity_List (Proc, Sensitivity_List); + + -- Expand the expression, fill the sensitivity list, + Canon_Extract_Sensitivity + (Get_Assertion_Condition (El), Sensitivity_List, False); + if Canon_Flag_Expressions then + Canon_Expression (Get_Assertion_Condition (El)); + end if; + Set_Assertion_Condition + (Stmt, Get_Assertion_Condition (El)); + + Expr := Get_Report_Expression (El); + if Canon_Flag_Expressions and Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + Set_Report_Expression (Stmt, Expr); + + Expr := Get_Severity_Expression (El); + if Canon_Flag_Expressions and Expr /= Null_Iir then + Canon_Expression (Expr); + end if; + Set_Severity_Expression (Stmt, Expr); + + Replace_Stmt (Proc); + El := Proc; + + when Iir_Kind_Concurrent_Procedure_Call_Statement => + Proc := Canon_Concurrent_Procedure_Call (El); + Replace_Stmt (Proc); + El := Proc; + + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + Canon_Declarations (Top, El, Null_Iir); + if Canon_Flag_Sequentials_Stmts then + Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (El)); + end if; + + when Iir_Kind_Component_Instantiation_Statement => + declare + Inst : Iir; + Assoc_Chain : Iir; + begin + Inst := Get_Instantiated_Unit (El); + Inst := Get_Entity_From_Entity_Aspect (Inst); + Assoc_Chain := Canon_Association_Chain + (Get_Generic_Chain (Inst), + Get_Generic_Map_Aspect_Chain (El)); + Set_Generic_Map_Aspect_Chain (El, Assoc_Chain); + + Assoc_Chain := Canon_Association_Chain + (Get_Port_Chain (Inst), + Get_Port_Map_Aspect_Chain (El)); + Set_Port_Map_Aspect_Chain (El, Assoc_Chain); + end; + + when Iir_Kind_Block_Statement => + declare + Header : Iir_Block_Header; + Chain : Iir; + Guard : Iir_Guard_Signal_Declaration; + begin + Guard := Get_Guard_Decl (El); + if Guard /= Null_Iir then + Expr := Get_Guard_Expression (Guard); + Set_Guard_Sensitivity_List (Guard, Create_Iir_List); + Canon_Extract_Sensitivity + (Expr, Get_Guard_Sensitivity_List (Guard), False); + if Canon_Flag_Expressions then + Canon_Expression (Expr); + end if; + end if; + Header := Get_Block_Header (El); + if Header /= Null_Iir then + -- Generics. + Chain := Get_Generic_Map_Aspect_Chain (Header); + if Chain /= Null_Iir then + Chain := Canon_Association_Chain + (Get_Generic_Chain (Header), Chain); + else + Chain := Canon_Default_Association_Chain + (Get_Generic_Chain (Header)); + end if; + Set_Generic_Map_Aspect_Chain (Header, Chain); + + -- Ports. + Chain := Get_Port_Map_Aspect_Chain (Header); + if Chain /= Null_Iir then + Chain := Canon_Association_Chain + (Get_Port_Chain (Header), Chain); + else + Chain := Canon_Default_Association_Chain + (Get_Port_Chain (Header)); + end if; + Set_Port_Map_Aspect_Chain (Header, Chain); + end if; + Canon_Declarations (Top, El, El); + Canon_Concurrent_Stmts (Top, El); + end; + + when Iir_Kind_Generate_Statement => + declare + Scheme : Iir; + begin + Scheme := Get_Generation_Scheme (El); + if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then + Canon_Declaration (Top, Scheme, Null_Iir, Null_Iir); + elsif Canon_Flag_Expressions then + Canon_Expression (Scheme); + end if; + Canon_Declarations (Top, El, El); + Canon_Concurrent_Stmts (Top, El); + end; + + when others => + Error_Kind ("canon_concurrent_stmts", El); + end case; + Prev_El := El; + El := Get_Chain (El); + end loop; + end Canon_Concurrent_Stmts; + +-- procedure Canon_Binding_Indication +-- (Component: Iir; Binding : Iir_Binding_Indication) +-- is +-- List : Iir_Association_List; +-- begin +-- if Binding = Null_Iir then +-- return; +-- end if; +-- List := Get_Generic_Map_Aspect_List (Binding); +-- List := Canon_Association_List (Get_Generic_List (Component), List); +-- Set_Generic_Map_Aspect_List (Binding, List); +-- List := Get_Port_Map_Aspect_List (Binding); +-- List := Canon_Association_List (Get_Port_List (Component), List); +-- Set_Port_Map_Aspect_List (Binding, List); +-- end Canon_Binding_Indication; + + procedure Add_Binding_Indication_Dependence (Top : Iir_Design_Unit; + Binding : Iir) + is + Aspect : Iir; + Unit : Iir; + begin + if Binding = Null_Iir then + return; + end if; + Aspect := Get_Entity_Aspect (Binding); + if Aspect = Null_Iir then + return; + end if; + case Get_Kind (Aspect) is + when Iir_Kind_Entity_Aspect_Entity => + if Get_Architecture (Aspect) /= Null_Iir then + Unit := Aspect; + else + Unit := Get_Entity (Aspect); + end if; + when Iir_Kind_Entity_Aspect_Configuration => + Unit := Get_Configuration (Aspect); + when Iir_Kind_Entity_Aspect_Open => + Unit := Null_Iir; + when others => + Error_Kind ("add_binding_indication_dependence", Aspect); + end case; + if Unit /= Null_Iir then + Add_Dependence (Top, Unit); + end if; + end Add_Binding_Indication_Dependence; + + procedure Canon_Component_Configuration (Top : Iir_Design_Unit; Cfg : Iir) + is + Bind : Iir; + Instances : Iir_List; + Entity_Aspect : Iir; + Block : Iir_Block_Configuration; + Map_Chain : Iir; + Entity : Iir; + begin + Bind := Get_Binding_Indication (Cfg); + if Bind = Null_Iir then + -- Add a default binding indication + -- Extract a component instantiation + Instances := Get_Instantiation_List (Cfg); + if Instances = Iir_List_All or Instances = Iir_List_Others then + -- designator_all and designator_others must have been replaced + -- by a list during canon. + raise Internal_Error; + else + Bind := Get_Default_Binding_Indication + (Get_First_Element (Instances)); + end if; + if Bind = Null_Iir then + -- Component is not bound. + return; + end if; + Set_Binding_Indication (Cfg, Bind); + Add_Binding_Indication_Dependence (Top, Bind); + return; + else + Entity_Aspect := Get_Entity_Aspect (Bind); + if Entity_Aspect = Null_Iir then + Entity_Aspect := Get_Default_Entity_Aspect (Bind); + Set_Entity_Aspect (Bind, Entity_Aspect); + end if; + if Entity_Aspect /= Null_Iir then + Add_Binding_Indication_Dependence (Top, Bind); + Entity := Get_Entity_From_Entity_Aspect (Entity_Aspect); + Map_Chain := Get_Generic_Map_Aspect_Chain (Bind); + if Map_Chain = Null_Iir then + Map_Chain := Get_Default_Generic_Map_Aspect_Chain (Bind); + else + Map_Chain := Canon_Association_Chain + (Get_Generic_Chain (Entity), Map_Chain); + end if; + Set_Generic_Map_Aspect_Chain (Bind, Map_Chain); + + Map_Chain := Get_Port_Map_Aspect_Chain (Bind); + if Map_Chain = Null_Iir then + Map_Chain := Get_Default_Port_Map_Aspect_Chain (Bind); + else + Map_Chain := Canon_Association_Chain + (Get_Port_Chain (Entity), Map_Chain); + end if; + Set_Port_Map_Aspect_Chain (Bind, Map_Chain); + + if Get_Kind (Cfg) = Iir_Kind_Component_Configuration then + Block := Get_Block_Configuration (Cfg); + if Block /= Null_Iir then + -- If there is no architecture_identifier in the binding, + -- set it from the block_configuration. + if Get_Kind (Entity_Aspect) = Iir_Kind_Entity_Aspect_Entity + and then Get_Architecture (Entity_Aspect) = Null_Iir + then + Entity := Get_Library_Unit (Get_Entity (Entity_Aspect)); + if Get_Kind (Entity) /= Iir_Kind_Entity_Declaration then + raise Internal_Error; + end if; + Set_Architecture + (Entity_Aspect, Get_Block_Specification (Block)); + end if; + Canon_Block_Configuration (Top, Block); + end if; + end if; + end if; + end if; + end Canon_Component_Configuration; + + procedure Canon_Incremental_Binding + (Conf_Spec : Iir_Configuration_Specification; + Comp_Conf : Iir_Component_Configuration; + Parent : Iir) + is + function Merge_Association_Chain + (Inter_Chain : Iir; First_Chain : Iir; Sec_Chain : Iir) + return Iir + is + -- Result (chain). + First, Last : Iir; + + -- Copy an association and append new elements to FIRST/LAST. + procedure Copy_Association (Assoc : in out Iir; Inter : Iir) + is + El : Iir; + begin + loop + El := Create_Iir (Get_Kind (Assoc)); + Location_Copy (El, Assoc); + Set_Formal (El, Get_Formal (Assoc)); + Set_Whole_Association_Flag + (El, Get_Whole_Association_Flag (Assoc)); + + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_Open => + null; + when Iir_Kind_Association_Element_By_Expression => + Set_Actual (El, Get_Actual (Assoc)); + Set_In_Conversion (El, Get_In_Conversion (Assoc)); + Set_Out_Conversion (El, Get_Out_Conversion (Assoc)); + Set_Collapse_Signal_Flag + (Assoc, + Sem.Can_Collapse_Signals (Assoc, Get_Formal (Assoc))); + when Iir_Kind_Association_Element_By_Individual => + Set_Actual_Type (El, Get_Actual_Type (Assoc)); + Set_Individual_Association_Chain + (El, Get_Individual_Association_Chain (Assoc)); + when others => + Error_Kind ("copy_association", Assoc); + end case; + + Sub_Chain_Append (First, Last, El); + Assoc := Get_Chain (Assoc); + exit when Assoc = Null_Iir; + exit when Get_Associated_Formal (Assoc) /= Inter; + end loop; + end Copy_Association; + + procedure Advance (Assoc : in out Iir; Inter : Iir) + is + begin + loop + Assoc := Get_Chain (Assoc); + exit when Assoc = Null_Iir; + exit when Get_Associated_Formal (Assoc) /= Inter; + end loop; + end Advance; + + Inter : Iir; + F_El : Iir; + S_El : Iir; + begin + if Sec_Chain = Null_Iir then + -- Short-cut. + return First_Chain; + end if; + F_El := First_Chain; + Sub_Chain_Init (First, Last); + Inter := Inter_Chain; + while Inter /= Null_Iir loop + -- Consistency check. + if Get_Associated_Formal (F_El) /= Inter then + raise Internal_Error; + end if; + -- Find the associated in the second chain. + S_El := Sec_Chain; + while S_El /= Null_Iir loop + exit when Get_Associated_Formal (S_El) = Inter; + S_El := Get_Chain (S_El); + end loop; + if S_El /= Null_Iir + and then Get_Kind (S_El) /= Iir_Kind_Association_Element_Open + then + Copy_Association (S_El, Inter); + Advance (F_El, Inter); + else + Copy_Association (F_El, Inter); + end if; + Inter := Get_Chain (Inter); + end loop; + return First; + end Merge_Association_Chain; + + Res : Iir_Component_Configuration; + Cs_Binding : Iir_Binding_Indication; + Cc_Binding : Iir_Binding_Indication; + Res_Binding : Iir_Binding_Indication; + Entity : Iir; + Instance_List : Iir_List; + Conf_Instance_List : Iir_List; + Instance : Iir; + N_Nbr : Natural; + begin + -- Create the new component configuration + Res := Create_Iir (Iir_Kind_Component_Configuration); + Location_Copy (Res, Comp_Conf); + Set_Parent (Res, Parent); + Set_Component_Name (Res, Get_Component_Name (Conf_Spec)); + +-- -- Keep in the designator list only the non-incrementally +-- -- bound instances. +-- Inst_List := Get_Instantiation_List (Comp_Conf); +-- Designator_List := Create_Iir_List; +-- for I in 0 .. Get_Nbr_Elements (Inst_List) - 1 loop +-- Inst := Get_Nth_Element (Inst_List, I); +-- if Get_Component_Configuration (Inst) = Comp_Conf then +-- Set_Component_Configuration (Inst, Res); +-- Append_Element (Designator_List, Inst); +-- end if; +-- end loop; +-- Set_Instantiation_List (Res, Designator_List); +-- Set_Binding_Indication +-- (Res, Get_Binding_Indication (Comp_Conf)); +-- Append (Last_Item, Conf, Comp_Conf); + + Cs_Binding := Get_Binding_Indication (Conf_Spec); + Cc_Binding := Get_Binding_Indication (Comp_Conf); + Res_Binding := Create_Iir (Iir_Kind_Binding_Indication); + Location_Copy (Res_Binding, Res); + Set_Binding_Indication (Res, Res_Binding); + + Entity := Get_Entity_From_Entity_Aspect (Get_Entity_Aspect (Cs_Binding)); + + -- Merge generic map aspect. + Set_Generic_Map_Aspect_Chain + (Res_Binding, + Merge_Association_Chain (Get_Generic_Chain (Entity), + Get_Generic_Map_Aspect_Chain (Cs_Binding), + Get_Generic_Map_Aspect_Chain (Cc_Binding))); + + -- merge port map aspect + Set_Port_Map_Aspect_Chain + (Res_Binding, + Merge_Association_Chain (Get_Port_Chain (Entity), + Get_Port_Map_Aspect_Chain (Cs_Binding), + Get_Port_Map_Aspect_Chain (Cc_Binding))); + + -- set entity aspect + Set_Entity_Aspect (Res_Binding, Get_Entity_Aspect (Cs_Binding)); + + -- create list of instances: + -- * keep common instances + -- replace component_configuration of them + -- remove them in the instance list of COMP_CONF + Instance_List := Create_Iir_List; + Set_Instantiation_List (Res, Instance_List); + Conf_Instance_List := Get_Instantiation_List (Comp_Conf); + N_Nbr := 0; + for I in 0 .. Get_Nbr_Elements (Conf_Instance_List) - 1 loop + Instance := Get_Nth_Element (Conf_Instance_List, I); + if Get_Component_Configuration (Instance) = Conf_Spec then + -- The incremental binding applies to this instance. + Set_Component_Configuration (Instance, Res); + Append_Element (Instance_List, Instance); + else + Replace_Nth_Element (Conf_Instance_List, N_Nbr, Instance); + N_Nbr := N_Nbr + 1; + end if; + end loop; + Set_Nbr_Elements (Conf_Instance_List, N_Nbr); + + -- Insert RES. + Set_Chain (Res, Get_Chain (Comp_Conf)); + Set_Chain (Comp_Conf, Res); + end Canon_Incremental_Binding; + + procedure Canon_Component_Specification_All_Others + (Conf : Iir; Parent : Iir; Spec : Iir_List; List : Iir_List; Comp : Iir) + is + El : Iir; + Comp_Conf : Iir; + begin + El := Get_Concurrent_Statement_Chain (Parent); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Component_Instantiation_Statement => + if Get_Instantiated_Unit (El) = Comp then + Comp_Conf := Get_Component_Configuration (El); + if Comp_Conf = Null_Iir then + -- The component is not yet configured. + Append_Element (List, El); + Set_Component_Configuration (El, Conf); + else + -- The component is already configured. + -- Handle incremental configuration. + if (Get_Kind (Comp_Conf) + = Iir_Kind_Configuration_Specification) + and then Spec = Iir_List_All + then + -- FIXME: handle incremental configuration. + raise Internal_Error; + end if; + if Spec = Iir_List_All then + -- Several component configuration for an instance. + -- Must have been caught by sem. + raise Internal_Error; + elsif Spec = Iir_List_Others then + null; + else + raise Internal_Error; + end if; + end if; + end if; + when Iir_Kind_Generate_Statement => + if False + and then Flags.Vhdl_Std = Vhdl_87 + and then + Get_Kind (Conf) = Iir_Kind_Configuration_Specification + then + Canon_Component_Specification_All_Others + (Conf, El, Spec, List, Comp); + end if; + when others => + null; + end case; + El := Get_Chain (El); + end loop; + end Canon_Component_Specification_All_Others; + + procedure Canon_Component_Specification_List + (Conf : Iir; Parent : Iir; Spec : Iir_List) + is + El : Iir; + Comp_Conf : Iir; + begin + -- Already has a designator list. + for I in Natural loop + El := Get_Nth_Element (Spec, I); + exit when El = Null_Iir; + Comp_Conf := Get_Component_Configuration (El); + if Comp_Conf /= Null_Iir and then Comp_Conf /= Conf then + if Get_Kind (Comp_Conf) /= Iir_Kind_Configuration_Specification + or else Get_Kind (Conf) /= Iir_Kind_Component_Configuration + then + raise Internal_Error; + end if; + Canon_Incremental_Binding (Comp_Conf, Conf, Parent); + else + Set_Component_Configuration (El, Conf); + end if; + end loop; + end Canon_Component_Specification_List; + + -- PARENT is the parent for the chain of concurrent statements. + procedure Canon_Component_Specification (Conf : Iir; Parent : Iir) + is + Spec : Iir_List; + List : Iir_Designator_List; + begin + Spec := Get_Instantiation_List (Conf); + + if Spec = Iir_List_All or Spec = Iir_List_Others then + List := Create_Iir_List; + Canon_Component_Specification_All_Others + (Conf, Parent, Spec, List, Get_Component_Name (Conf)); + Set_Instantiation_List (Conf, List); + else + -- Has Already a designator list. + Canon_Component_Specification_List (Conf, Parent, Spec); + end if; + end Canon_Component_Specification; + + -- Replace ALL/OTHERS with the explicit list of signals. + procedure Canon_Disconnection_Specification + (Dis : Iir_Disconnection_Specification; Decl_Parent : Iir) + is + Signal_List : Iir_List; + Force : Boolean; + El : Iir; + N_List : Iir_Designator_List; + begin + if Canon_Flag_Expressions then + Canon_Expression (Get_Expression (Dis)); + end if; + Signal_List := Get_Signal_List (Dis); + if Signal_List = Iir_List_All then + Force := True; + elsif Signal_List = Iir_List_Others then + Force := False; + else + return; + end if; + N_List := Create_Iir_List; + Set_Signal_List (Dis, N_List); + El := Get_Declaration_Chain (Decl_Parent); + while El /= Null_Iir loop + if Get_Kind (El) = Iir_Kind_Signal_Declaration + and then Get_Type (El) = Get_Type (Dis) + and then Get_Signal_Kind (El) /= Iir_No_Signal_Kind + then + if not Get_Has_Disconnect_Flag (El) then + Set_Has_Disconnect_Flag (El, True); + Append_Element (N_List, El); + else + if Force then + raise Internal_Error; + end if; + end if; + end if; + El := Get_Chain (El); + end loop; + end Canon_Disconnection_Specification; + + procedure Canon_Declaration (Top : Iir_Design_Unit; + Decl : Iir; + Parent : Iir; + Decl_Parent : Iir) + is + begin + case Get_Kind (Decl) is + when Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + Canon_Declarations (Top, Decl, Null_Iir); + if Canon_Flag_Sequentials_Stmts then + Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Decl)); + end if; + + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + null; + + when Iir_Kind_Type_Declaration => + declare + Def : Iir; + begin + Def := Get_Type (Decl); + if Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration then + Canon_Declarations (Decl, Def, Null_Iir); + end if; + end; + + when Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration => + null; + + when Iir_Kind_Protected_Type_Body => + Canon_Declarations (Top, Decl, Null_Iir); + + when Iir_Kind_Variable_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Constant_Declaration => + if Canon_Flag_Expressions then + Canon_Expression (Get_Default_Value (Decl)); + end if; + + when Iir_Kind_Iterator_Declaration => + null; + + when Iir_Kind_Object_Alias_Declaration => + null; + when Iir_Kind_Non_Object_Alias_Declaration => + null; + + when Iir_Kind_File_Declaration => + -- FIXME + null; + + when Iir_Kind_Attribute_Declaration => + null; + when Iir_Kind_Attribute_Specification => + if Canon_Flag_Expressions then + Canon_Expression (Get_Expression (Decl)); + end if; + when Iir_Kind_Disconnection_Specification => + Canon_Disconnection_Specification (Decl, Decl_Parent); + + when Iir_Kind_Group_Template_Declaration => + null; + when Iir_Kind_Group_Declaration => + null; + + when Iir_Kind_Use_Clause => + null; + + when Iir_Kind_Component_Declaration => + null; + + when Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Implicit_Function_Declaration => + null; + + when Iir_Kind_Configuration_Specification => + Canon_Component_Specification (Decl, Parent); + Canon_Component_Configuration (Top, Decl); +-- declare +-- List : Iir_List; +-- Binding : Iir_Binding_Indication; +-- Component : Iir_Component_Declaration; +-- Aspect : Iir; +-- Entity : Iir; +-- begin +-- Binding := Get_Binding_Indication (Decl); +-- Component := Get_Component_Name (Decl); +-- Aspect := Get_Entity_Aspect (Binding); +-- case Get_Kind (Aspect) is +-- when Iir_Kind_Entity_Aspect_Entity => +-- Entity := Get_Entity (Aspect); +-- when others => +-- Error_Kind ("configuration_specification", Aspect); +-- end case; +-- Entity := Get_Library_Unit (Entity); +-- List := Get_Generic_Map_Aspect_List (Binding); +-- if List = Null_Iir_List then +-- Set_Generic_Map_Aspect_List +-- (Binding, +-- Canon_Default_Map_Association_List +-- (Get_Generic_List (Entity), Get_Generic_List (Component), +-- Get_Location (Decl))); +-- end if; +-- List := Get_Port_Map_Aspect_List (Binding); +-- if List = Null_Iir_List then +-- Set_Port_Map_Aspect_List +-- (Binding, +-- Canon_Default_Map_Association_List +-- (Get_Port_List (Entity), Get_Port_List (Component), +-- Get_Location (Decl))); +-- end if; +-- end; + + when Iir_Kinds_Signal_Attribute => + null; + when others => + Error_Kind ("canon_declaration", Decl); + end case; + end Canon_Declaration; + + procedure Canon_Declarations (Top : Iir_Design_Unit; + Decl_Parent : Iir; + Parent : Iir) + is + Decl : Iir; + begin + if Parent /= Null_Iir then + Clear_Instantiation_Configuration (Parent, True); + end if; + Decl := Get_Declaration_Chain (Decl_Parent); + while Decl /= Null_Iir loop + Canon_Declaration (Top, Decl, Parent, Decl_Parent); + Decl := Get_Chain (Decl); + end loop; + end Canon_Declarations; + + procedure Canon_Block_Configuration (Top : Iir_Design_Unit; + Conf : Iir_Block_Configuration) + is + use Iir_Chains.Configuration_Item_Chain_Handling; + El : Iir; + Spec : Iir; + Stmts : Iir; + Blk : Iir; + Sub_Blk : Iir; + Last_Item : Iir; + begin + -- Note: the only allowed declarations are use clauses, which are not + -- canonicalized. + + -- FIXME: handle indexed/sliced name? + Spec := Get_Block_Specification (Conf); + Blk := Get_Block_From_Block_Specification (Spec); + Stmts := Get_Concurrent_Statement_Chain (Blk); + + Clear_Instantiation_Configuration (Blk, False); + + Build_Init (Last_Item, Conf); + + -- 1) Configure instantiations with configuration specifications. + -- TODO: merge. + El := Get_Declaration_Chain (Blk); + while El /= Null_Iir loop + if Get_Kind (El) = Iir_Kind_Configuration_Specification then + -- Already canoncalized during canon of block declarations. + -- But need to set configuration on instantiations. + Canon_Component_Specification (El, Blk); + end if; + El := Get_Chain (El); + end loop; + + -- 2) Configure instantations with component configurations, + -- and map block configurations with block/generate statements. + El := Get_Configuration_Item_Chain (Conf); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Configuration_Specification => + raise Internal_Error; + when Iir_Kind_Component_Configuration => + Canon_Component_Specification (El, Blk); + when Iir_Kind_Block_Configuration => + Sub_Blk := Get_Block_Specification (El); + case Get_Kind (Sub_Blk) is + when Iir_Kind_Block_Statement => + Set_Block_Block_Configuration (Sub_Blk, El); + when Iir_Kind_Indexed_Name + | Iir_Kind_Slice_Name => + Sub_Blk := Get_Prefix (Sub_Blk); + Set_Prev_Block_Configuration + (El, Get_Generate_Block_Configuration (Sub_Blk)); + Set_Generate_Block_Configuration (Sub_Blk, El); + when Iir_Kind_Generate_Statement => + Set_Generate_Block_Configuration (Sub_Blk, El); + when others => + Error_Kind ("canon_block_configuration(0)", Sub_Blk); + end case; + when others => + Error_Kind ("canon_block_configuration(1)", El); + end case; + El := Get_Chain (El); + end loop; + + -- 3) Add default component configuration for unspecified component + -- instantiation statements, + -- Add default block configuration for unconfigured block statements. + El := Stmts; + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Component_Instantiation_Statement => + declare + Comp_Conf : Iir; + Comp : Iir; + Res : Iir_Component_Configuration; + Designator_List : Iir_List; + Inst_List : Iir_List; + Inst : Iir; + begin + Comp_Conf := Get_Component_Configuration (El); + if Comp_Conf = Null_Iir then + Comp := Get_Instantiated_Unit (El); + if Get_Kind (Comp) = Iir_Kind_Component_Declaration then + -- Create a component configuration. + -- FIXME: should merge all these default configuration + -- of the same component. + Res := Create_Iir (Iir_Kind_Component_Configuration); + Location_Copy (Res, El); + Set_Parent (Res, Conf); + Set_Component_Name (Res, Comp); + Designator_List := Create_Iir_List; + Append_Element (Designator_List, El); + Set_Instantiation_List (Res, Designator_List); + Append (Last_Item, Conf, Res); + end if; + elsif Get_Kind (Comp_Conf) + = Iir_Kind_Configuration_Specification + then + -- Create component configuration + Res := Create_Iir (Iir_Kind_Component_Configuration); + Location_Copy (Res, Comp_Conf); + Set_Parent (Res, Conf); + Set_Component_Name (Res, Get_Component_Name (Comp_Conf)); + -- Keep in the designator list only the non-incrementally + -- bound instances, and only the instances in the current + -- statements parts (vhdl-87 generate issue). + Inst_List := Get_Instantiation_List (Comp_Conf); + Designator_List := Create_Iir_List; + for I in 0 .. Get_Nbr_Elements (Inst_List) - 1 loop + Inst := Get_Nth_Element (Inst_List, I); + if Get_Component_Configuration (Inst) = Comp_Conf + and then Get_Parent (Inst) = Blk + then + Set_Component_Configuration (Inst, Res); + Append_Element (Designator_List, Inst); + end if; + end loop; + Set_Instantiation_List (Res, Designator_List); + Set_Binding_Indication + (Res, Get_Binding_Indication (Comp_Conf)); + Append (Last_Item, Conf, Res); + end if; + end; + when Iir_Kind_Block_Statement => + declare + Res : Iir_Block_Configuration; + begin + if Get_Block_Block_Configuration (El) = Null_Iir then + Res := Create_Iir (Iir_Kind_Block_Configuration); + Location_Copy (Res, El); + Set_Parent (Res, Conf); + Set_Block_Specification (Res, El); + Append (Last_Item, Conf, Res); + end if; + end; + when Iir_Kind_Generate_Statement => + declare + Res : Iir_Block_Configuration; + Scheme : Iir; + Blk_Config : Iir_Block_Configuration; + Blk_Spec : Iir; + begin + Scheme := Get_Generation_Scheme (El); + Blk_Config := Get_Generate_Block_Configuration (El); + if Blk_Config = Null_Iir then + -- No block configuration for the (implicit) internal + -- block. Create one. + Res := Create_Iir (Iir_Kind_Block_Configuration); + Location_Copy (Res, El); + Set_Parent (Res, Conf); + Set_Block_Specification (Res, El); + Append (Last_Item, Conf, Res); + elsif Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then + Blk_Spec := Get_Block_Specification (Blk_Config); + if Get_Kind (Blk_Spec) /= Iir_Kind_Generate_Statement then + -- There are partial configurations. + -- Create a default block configuration. + Res := Create_Iir (Iir_Kind_Block_Configuration); + Location_Copy (Res, El); + Set_Parent (Res, Conf); + Blk_Spec := Create_Iir (Iir_Kind_Selected_Name); + Location_Copy (Blk_Spec, Res); + Set_Suffix_Identifier + (Blk_Spec, Std_Names.Name_Others); + Set_Prefix (Blk_Spec, El); + Set_Block_Specification (Res, Blk_Spec); + Append (Last_Item, Conf, Res); + end if; + end if; + end; + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + null; + when others => + Error_Kind ("canon_block_configuration(3)", El); + end case; + El := Get_Chain (El); + end loop; + + -- 4) Canon component configuration and block configuration (recursion). + El := Get_Configuration_Item_Chain (Conf); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Block_Configuration => + Canon_Block_Configuration (Top, El); + when Iir_Kind_Component_Configuration => + Canon_Component_Configuration (Top, El); + when others => + Error_Kind ("canon_block_configuration", El); + end case; + El := Get_Chain (El); + end loop; + end Canon_Block_Configuration; + + procedure Canonicalize (Unit: Iir_Design_Unit) + is + El: Iir; + begin + if False then + -- Canon context clauses. + -- This code is not executed since context clauses are already + -- canonicalized. + El := Get_Context_Items (Unit); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Use_Clause => + null; + when Iir_Kind_Library_Clause => + null; + when others => + Error_Kind ("canonicalize1", El); + end case; + end loop; + end if; + + El := Get_Library_Unit (Unit); + case Get_Kind (El) is + when Iir_Kind_Entity_Declaration => + Canon_Declarations (Unit, El, El); + Canon_Concurrent_Stmts (Unit, El); + when Iir_Kind_Architecture_Declaration => + Canon_Declarations (Unit, El, El); + Canon_Concurrent_Stmts (Unit, El); + when Iir_Kind_Package_Declaration => + Canon_Declarations (Unit, El, Null_Iir); + when Iir_Kind_Package_Body => + Canon_Declarations (Unit, El, Null_Iir); + when Iir_Kind_Configuration_Declaration => + Canon_Declarations (Unit, El, Null_Iir); + Canon_Block_Configuration (Unit, Get_Block_Configuration (El)); + when others => + Error_Kind ("canonicalize2", El); + end case; + end Canonicalize; + +-- -- Create a default component configuration for component instantiation +-- -- statement INST. +-- function Create_Default_Component_Configuration +-- (Inst : Iir_Component_Instantiation_Statement; +-- Parent : Iir; +-- Config_Unit : Iir_Design_Unit) +-- return Iir_Component_Configuration +-- is +-- Res : Iir_Component_Configuration; +-- Designator : Iir; +-- Comp : Iir_Component_Declaration; +-- Bind : Iir; +-- Aspect : Iir; +-- begin +-- Bind := Get_Default_Binding_Indication (Inst); + +-- if Bind = Null_Iir then +-- -- Component is not bound. +-- return Null_Iir; +-- end if; + +-- Res := Create_Iir (Iir_Kind_Component_Configuration); +-- Location_Copy (Res, Inst); +-- Set_Parent (Res, Parent); +-- Comp := Get_Instantiated_Unit (Inst); + +-- Set_Component_Name (Res, Comp); +-- -- Create the instantiation list with only one element: INST. +-- Designator := Create_Iir (Iir_Kind_Designator_List); +-- Append_Element (Designator, Inst); +-- Set_Instantiation_List (Res, Designator); + +-- Set_Binding_Indication (Res, Bind); +-- Aspect := Get_Entity_Aspect (Bind); +-- case Get_Kind (Aspect) is +-- when Iir_Kind_Entity_Aspect_Entity => +-- Add_Dependence (Config_Unit, Get_Entity (Aspect)); +-- if Get_Architecture (Aspect) /= Null_Iir then +-- raise Internal_Error; +-- end if; +-- when others => +-- Error_Kind ("Create_Default_Component_Configuration", Aspect); +-- end case; + +-- return Res; +-- end Create_Default_Component_Configuration; + + -- Create a default configuration declaration for architecture ARCH. + function Create_Default_Configuration_Declaration + (Arch : Iir_Architecture_Declaration) + return Iir_Design_Unit + is + Loc : Location_Type; + Config : Iir_Configuration_Declaration; + Res : Iir_Design_Unit; + Entity : Iir_Entity_Declaration; + Blk_Cfg : Iir_Block_Configuration; + begin + Loc := Get_Location (Arch); + Res := Create_Iir (Iir_Kind_Design_Unit); + Set_Location (Res, Loc); + Set_Parent (Res, Get_Parent (Get_Design_Unit (Arch))); + Set_Date_State (Res, Date_Analyze); + Set_Date (Res, Date_Uptodate); + Config := Create_Iir (Iir_Kind_Configuration_Declaration); + Set_Location (Config, Loc); + Set_Library_Unit (Res, Config); + Set_Design_Unit (Config, Res); + Entity := Get_Entity (Arch); + Set_Entity (Config, Get_Design_Unit (Entity)); + Set_Dependence_List (Res, Create_Iir_List); + Add_Dependence (Res, Get_Design_Unit (Entity)); + Add_Dependence (Res, Get_Design_Unit (Arch)); + + Blk_Cfg := Create_Iir (Iir_Kind_Block_Configuration); + Set_Location (Blk_Cfg, Loc); + Set_Parent (Blk_Cfg, Config); + Set_Block_Specification (Blk_Cfg, Arch); + Set_Block_Configuration (Config, Blk_Cfg); + + Canon_Block_Configuration (Res, Blk_Cfg); + + return Res; + end Create_Default_Configuration_Declaration; + +end Canon; diff --git a/canon.ads b/canon.ads new file mode 100644 index 000000000..fe30b4569 --- /dev/null +++ b/canon.ads @@ -0,0 +1,61 @@ +-- Canonicalization pass +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Iirs; use Iirs; + +package Canon is + -- If true, a label will be added for statements which do not have a + -- label. + Canon_Flag_Add_Labels : Boolean := False; + + -- If true, canon sequentials statements (processes and subprograms). + Canon_Flag_Sequentials_Stmts : Boolean := False; + + -- If true, canon expressions. + Canon_Flag_Expressions : Boolean := False; + + -- If true, operands of type array element of a concatenation operator + -- are converted (by an aggregate) into array. + Canon_Concatenation : Boolean := False; + + -- Do canonicalization: + -- Transforms concurrent statements into sensitized process statements + -- (all but component instanciation and block). + -- This computes sensivity list. + -- + -- Association list are completed: + -- * Formal are added. + -- * association are created for formal not associated (actual is open). + -- * an association is created (for block header only). + procedure Canonicalize (Unit: Iir_Design_Unit); + + -- Create a default configuration declaration for architecture ARCH. + function Create_Default_Configuration_Declaration + (Arch : Iir_Architecture_Declaration) + return Iir_Design_Unit; + + -- Canonicalize a subprogram call. + -- Return the new association chain. + function Canon_Subprogram_Call (Call : Iir) return Iir; + + -- Compute the sensivity list of EXPR and add it to SENSIVITY_LIST. + -- If IS_TARGET is true, the longuest static prefix of the signal name + -- is not added to the sensitivity list, but other static prefix (such + -- as indexes of an indexed name) are added. + procedure Canon_Extract_Sensitivity + (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False); +end Canon; diff --git a/configuration.adb b/configuration.adb new file mode 100644 index 000000000..8192ac2b3 --- /dev/null +++ b/configuration.adb @@ -0,0 +1,548 @@ +-- Configuration generation. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Libraries; +with Errorout; use Errorout; +with Std_Package; +with Sem_Names; +with Name_Table; use Name_Table; +with Flags; + +package body Configuration is + procedure Add_Design_Concurrent_Stmts (Parent : Iir); + procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration); + procedure Add_Design_Aspect (Aspect : Iir); + + Current_File_Dependence : Iir_List := Null_Iir_List; + Current_Configuration : Iir_Configuration_Declaration := Null_Iir; + + -- UNIT is a design unit of a configuration declaration. + -- Fill the DESIGN_UNITS table with all design units required to build + -- UNIT. + procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir) + is + List : Iir_List; + El : Iir; + Lib_Unit : Iir; + File : Iir_Design_File; + Prev_File_Dependence : Iir_List; + begin + if Flag_Build_File_Dependence then + File := Get_Design_File (Unit); + if Current_File_Dependence /= Null_Iir_List then + Add_Element (Current_File_Dependence, File); + end if; + end if; + + -- If already in the table, then nothing to do. + if Get_Elab_Flag (Unit) then + return; + end if; + + Set_Elab_Flag (Unit, True); + + Lib_Unit := Get_Library_Unit (Unit); + + if Flag_Build_File_Dependence then + Prev_File_Dependence := Current_File_Dependence; + + if Get_Kind (Lib_Unit) = Iir_Kind_Configuration_Declaration + and then Get_Identifier (Lib_Unit) = Null_Identifier + then + -- Do not add dependence for default configuration. + Current_File_Dependence := Null_Iir_List; + else + File := Get_Design_File (Unit); + Current_File_Dependence := Get_File_Dependence_List (File); + -- Create a list if not yet created. + if Current_File_Dependence = Null_Iir_List then + Current_File_Dependence := Create_Iir_List; + Set_File_Dependence_List (File, Current_File_Dependence); + end if; + end if; + end if; + + if Flag_Load_All_Design_Units then + Libraries.Load_Design_Unit (Unit, From); + end if; + + -- Add packages from depend list. + -- If Flag_Build_File_Dependences is set, add design units of the + -- dependence list are added, because of LRM 11.4 Analysis Order. + -- Note: a design unit may be referenced but unused. + -- (eg: component specification which does not apply). + List := Get_Dependence_List (Unit); + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + El := Libraries.Find_Design_Unit (El); + if El /= Null_Iir then + Lib_Unit := Get_Library_Unit (El); + if Flag_Build_File_Dependence + or else Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration + then + Add_Design_Unit (El, Unit); + end if; + end if; + end loop; + + -- Lib_Unit may have changed. + Lib_Unit := Get_Library_Unit (Unit); + + case Get_Kind (Lib_Unit) is + when Iir_Kind_Package_Declaration => + -- Analyze the package declaration, so that Set_Package below + -- will set the full package (and not a stub). + Libraries.Load_Design_Unit (Unit, From); + Lib_Unit := Get_Library_Unit (Unit); + when Iir_Kind_Configuration_Declaration => + -- Add entity and architecture. + -- find all sub-configuration + Libraries.Load_Design_Unit (Unit, From); + Lib_Unit := Get_Library_Unit (Unit); + Add_Design_Unit (Get_Entity (Lib_Unit), Unit); + declare + Blk : Iir_Block_Configuration; + Prev_Configuration : Iir_Configuration_Declaration; + Arch : Iir; + begin + Prev_Configuration := Current_Configuration; + Current_Configuration := Lib_Unit; + Blk := Get_Block_Configuration (Lib_Unit); + Arch := Get_Block_Specification (Blk); + Add_Design_Block_Configuration (Blk); + Current_Configuration := Prev_Configuration; + Add_Design_Unit (Get_Design_Unit (Arch), Unit); + end; + when Iir_Kind_Architecture_Declaration => + -- Add entity + -- find all entity/architecture/configuration instantiation + Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); + Add_Design_Concurrent_Stmts (Lib_Unit); + when Iir_Kind_Entity_Declaration => + null; + when Iir_Kind_Package_Body => + null; + when others => + Error_Kind ("add_design_unit", Lib_Unit); + end case; + + -- Add it in the table, after the dependencies. + Design_Units.Append (Unit); + + -- Restore now the file dependence. + -- Indeed, we may add a package body when we are in a package + -- declaration. However, the later does not depend on the former. + -- The file which depends on the package declaration also depends on + -- the package body. + if Flag_Build_File_Dependence then + Current_File_Dependence := Prev_File_Dependence; + end if; + + if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration then + -- Add body (if any). + declare + Bod : Iir_Design_Unit; + begin + Bod := Libraries.Find_Secondary_Unit (Unit, Null_Identifier); + if Get_Need_Body (Lib_Unit) then + if not Flags.Flag_Elaborate_With_Outdated then + -- LIB_UNIT requires a body. + if Bod = Null_Iir then + Error_Msg_Elab ("body of " & Disp_Node (Lib_Unit) + & " was never analyzed"); + elsif Get_Date (Bod) < Get_Date (Unit) then + Error_Msg_Elab (Disp_Node (Bod) & " is outdated"); + Bod := Null_Iir; + end if; + end if; + else + if Bod /= Null_Iir + and then Get_Date (Bod) < Get_Date (Unit) + then + -- There is a body for LIB_UNIT (which doesn't + -- require it) but it is outdated. + Bod := Null_Iir; + end if; + end if; + if Bod /= Null_Iir then + Set_Package (Get_Library_Unit (Bod), Lib_Unit); + Add_Design_Unit (Bod, Unit); + end if; + end; + end if; + end Add_Design_Unit; + + procedure Add_Design_Concurrent_Stmts (Parent : Iir) + is + Stmt : Iir; + begin + Stmt := Get_Concurrent_Statement_Chain (Parent); + while Stmt /= Null_Iir loop + case Get_Kind (Stmt) is + when Iir_Kind_Component_Instantiation_Statement => + declare + Unit : Iir; + begin + Unit := Get_Instantiated_Unit (Stmt); + if Get_Kind (Unit) /= Iir_Kind_Component_Declaration then + Add_Design_Aspect (Unit); + end if; + end; + when Iir_Kind_Generate_Statement + | Iir_Kind_Block_Statement => + Add_Design_Concurrent_Stmts (Stmt); + when Iir_Kind_Process_Statement + | Iir_Kind_Sensitized_Process_Statement => + null; + when others => + Error_Kind ("add_design_concurrent_stmts(2)", Stmt); + end case; + Stmt := Get_Chain (Stmt); + end loop; + end Add_Design_Concurrent_Stmts; + + procedure Add_Design_Aspect (Aspect : Iir) + is + use Libraries; + + Entity : Iir; + Arch : Iir; + Config : Iir; + Id : Name_Id; + Entity_Lib : Iir; + begin + if Aspect = Null_Iir then + return; + end if; + case Get_Kind (Aspect) is + when Iir_Kind_Entity_Aspect_Entity => + Entity := Get_Entity (Aspect); + Entity_Lib := Get_Library_Unit (Entity); + Add_Design_Unit (Entity, Aspect); + Arch := Get_Architecture (Aspect); + if Arch /= Null_Iir then + case Get_Kind (Arch) is + when Iir_Kind_Simple_Name => + Id := Get_Identifier (Arch); + Arch := Load_Secondary_Unit (Entity, Id, Aspect); + if Arch = Null_Iir then + Error_Msg_Elab + ("cannot find architecture " & Name_Table.Image (Id) + & " of " & Disp_Node (Entity_Lib)); + return; + else + Set_Architecture (Aspect, Get_Library_Unit (Arch)); + end if; + when Iir_Kind_Architecture_Declaration => + Arch := Get_Design_Unit (Arch); + when others => + Error_Kind ("add_design_aspect", Arch); + end case; + else + Arch := Get_Latest_Architecture (Entity_Lib); + if Arch = Null_Iir then + Error_Msg_Elab ("no architecture in library for " + & Disp_Node (Entity_Lib), Aspect); + return; + end if; + Arch := Get_Design_Unit (Arch); + end if; + Load_Design_Unit (Arch, Aspect); + Config := Get_Default_Configuration_Declaration + (Get_Library_Unit (Arch)); + if Config /= Null_Iir then + Add_Design_Unit (Config, Aspect); + end if; + when Iir_Kind_Entity_Aspect_Configuration => + Add_Design_Unit (Get_Configuration (Aspect), Aspect); + when Iir_Kind_Entity_Aspect_Open => + null; + when others => + Error_Kind ("add_design_aspect", Aspect); + end case; + end Add_Design_Aspect; + + -- Return TRUE is PORT must not be open, and emit an error message only if + -- LOC is not NULL_IIR. + function Check_Open_Port (Port : Iir; Loc : Iir) return Boolean is + begin + case Get_Mode (Port) is + when Iir_In_Mode => + -- LRM 1.1.1.2 Ports + -- A port of mode IN may be unconnected or unassociated only if + -- its declaration includes a default expression. + if Get_Default_Value (Port) = Null_Iir then + if Loc /= Null_Iir then + Error_Msg_Elab + ("IN " & Disp_Node (Port) & " must be connected", Loc); + end if; + return True; + end if; + when Iir_Out_Mode + | Iir_Inout_Mode + | Iir_Buffer_Mode + | Iir_Linkage_Mode => + -- LRM 1.1.1.2 Ports + -- A port of any mode other than IN may be unconnected or + -- unassociated as long as its type is not an unconstrained array + -- type. + if Get_Kind (Get_Type (Port)) + in Iir_Kinds_Unconstrained_Array_Type_Definition + then + if Loc /= Null_Iir then + Error_Msg_Elab ("unconstrained " & Disp_Node (Port) + & " must be connected", Loc); + end if; + return True; + end if; + when others => + Error_Kind ("check_open_port", Port); + end case; + return False; + end Check_Open_Port; + + procedure Check_Binding_Indication (Conf : Iir) + is + Assoc : Iir; + Conf_Chain : Iir; + Inst_Chain : Iir; + Bind : Iir_Binding_Indication; + Err : Boolean; + Inst : Iir; + Inst_List : Iir_List; + Formal : Iir; + Assoc_1 : Iir; + Actual : Iir; + begin + Bind := Get_Binding_Indication (Conf); + Conf_Chain := Get_Port_Map_Aspect_Chain (Bind); + + Err := False; + -- Note: the assoc chain is already canonicalized. + + -- First pass: check for open associations in configuration. + Assoc := Conf_Chain; + while Assoc /= Null_Iir loop + if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then + Formal := Get_Formal (Assoc); + Err := Err or Check_Open_Port (Formal, Assoc); + if Flags.Warn_Binding and then not Get_Artificial_Flag (Assoc) then + Warning_Msg_Elab + (Disp_Node (Formal) & " of " & Disp_Node (Get_Parent (Formal)) + & " is not bound", Assoc); + Warning_Msg_Elab + ("(in " & Disp_Node (Current_Configuration) & ")", + Current_Configuration); + end if; + end if; + Assoc := Get_Chain (Assoc); + end loop; + if Err then + return; + end if; + + -- Second pass: check for port connected to open in instantiation. + Inst_List := Get_Instantiation_List (Conf); + for I in Natural loop + Inst := Get_Nth_Element (Inst_List, I); + exit when Inst = Null_Iir; + Err := False; + + -- Mark component ports not associated. + Inst_Chain := Get_Port_Map_Aspect_Chain (Inst); + Assoc := Inst_Chain; + while Assoc /= Null_Iir loop + if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then + Formal := Get_Base_Name (Get_Formal (Assoc)); + Set_Open_Flag (Formal, True); + Err := True; + end if; + Assoc := Get_Chain (Assoc); + end loop; + + -- If there is any component port open, search them in the + -- configuration. + if Err then + Assoc := Conf_Chain; + while Assoc /= Null_Iir loop + Formal := Get_Base_Name (Get_Formal (Assoc)); + if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then + Actual := Null_Iir; + else + Actual := Get_Actual (Assoc); + Actual := Sem_Names.Name_To_Object (Actual); + end if; + if Actual /= Null_Iir then + Actual := Get_Base_Name (Actual); + end if; + if Actual /= Null_Iir + and then Get_Open_Flag (Actual) + and then Check_Open_Port (Formal, Null_Iir) + then + -- For a better message, find the location. + Assoc_1 := Inst_Chain; + while Assoc_1 /= Null_Iir loop + if Get_Kind (Assoc_1) = Iir_Kind_Association_Element_Open + and then Actual = Get_Base_Name (Get_Formal (Assoc_1)) + then + Err := Check_Open_Port (Formal, Assoc_1); + exit; + end if; + Assoc_1 := Get_Chain (Assoc_1); + end loop; + end if; + Assoc := Get_Chain (Assoc); + end loop; + + -- Clear open flag. + Assoc := Inst_Chain; + while Assoc /= Null_Iir loop + if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then + Formal := Get_Base_Name (Get_Formal (Assoc)); + Set_Open_Flag (Formal, False); + end if; + Assoc := Get_Chain (Assoc); + end loop; + end if; + end loop; + end Check_Binding_Indication; + + -- CONF is either a configuration specification or a component + -- configuration. + procedure Add_Design_Binding_Indication (Conf : Iir) + is + Bind : Iir_Binding_Indication; + Inst : Iir; + begin + Bind := Get_Binding_Indication (Conf); + if Bind = Null_Iir then + if Flags.Warn_Binding then + Inst := Get_First_Element (Get_Instantiation_List (Conf)); + Warning_Msg_Elab + (Disp_Node (Inst) & " is not bound", Conf); + Warning_Msg_Elab + ("(in " & Disp_Node (Current_Configuration) & ")", + Current_Configuration); + end if; + return; + end if; + Check_Binding_Indication (Conf); + Add_Design_Aspect (Get_Entity_Aspect (Bind)); + end Add_Design_Binding_Indication; + + procedure Add_Design_Block_Configuration (Blk : Iir_Block_Configuration) + is + Item : Iir; + begin + if Blk = Null_Iir then + return; + end if; + Item := Get_Configuration_Item_Chain (Blk); + while Item /= Null_Iir loop + case Get_Kind (Item) is + when Iir_Kind_Configuration_Specification => + Add_Design_Binding_Indication (Item); + when Iir_Kind_Component_Configuration => + Add_Design_Binding_Indication (Item); + Add_Design_Block_Configuration (Get_Block_Configuration (Item)); + when Iir_Kind_Block_Configuration => + Add_Design_Block_Configuration (Item); + when others => + Error_Kind ("add_design_block_configuration", Item); + end case; + Item := Get_Chain (Item); + end loop; + end Add_Design_Block_Configuration; + + -- elaboration of a design hierarchy: + -- creates a list of design unit. + -- + -- find top configuration (may be a default one), add it to the list. + -- For each element of the list: + -- add direct dependences (packages, entity, arch) if not in the list + -- for architectures and configuration: find instantiations and add + -- corresponding configurations + function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) + return Iir + is + use Libraries; + + Unit : Iir_Design_Unit; + Lib_Unit : Iir; + Top : Iir; + begin + Unit := Find_Primary_Unit (Work_Library, Primary_Id); + if Unit = Null_Iir then + Error_Msg_Elab ("cannot find entity or configuration " + & Name_Table.Image (Primary_Id)); + return Null_Iir; + end if; + Lib_Unit := Get_Library_Unit (Unit); + case Get_Kind (Lib_Unit) is + when Iir_Kind_Entity_Declaration => + Load_Design_Unit (Unit, Null_Iir); + Lib_Unit := Get_Library_Unit (Unit); + if Secondary_Id /= Null_Identifier then + Unit := Find_Secondary_Unit (Unit, Secondary_Id); + if Unit = Null_Iir then + Error_Msg_Elab + ("cannot find architecture " + & Name_Table.Image (Secondary_Id) + & " of " & Disp_Node (Lib_Unit)); + return Null_Iir; + end if; + else + declare + Arch_Unit : Iir_Architecture_Declaration; + begin + Arch_Unit := Get_Latest_Architecture (Lib_Unit); + if Arch_Unit = Null_Iir then + Error_Msg_Elab + (Disp_Node (Lib_Unit) + & " has no architecture in library " + & Name_Table.Image (Get_Identifier (Work_Library))); + return Null_Iir; + end if; + Unit := Get_Design_Unit (Arch_Unit); + end; + end if; + Load_Design_Unit (Unit, Lib_Unit); + if Nbr_Errors /= 0 then + return Null_Iir; + end if; + Lib_Unit := Get_Library_Unit (Unit); + Top := Get_Default_Configuration_Declaration (Lib_Unit); + if Top = Null_Iir then + -- No default configuration for this architecture. + raise Internal_Error; + end if; + when Iir_Kind_Configuration_Declaration => + Top := Unit; + when others => + Error_Msg_Elab (Name_Table.Image (Primary_Id) + & " is neither an entity nor a configuration"); + return Null_Iir; + end case; + + Set_Elab_Flag (Std_Package.Std_Standard_Unit, True); + + Add_Design_Unit (Top, Null_Iir); + return Top; + end Configure; + +end Configuration; diff --git a/configuration.ads b/configuration.ads new file mode 100644 index 000000000..081099876 --- /dev/null +++ b/configuration.ads @@ -0,0 +1,49 @@ +-- Configuration generation. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Iirs; use Iirs; +with GNAT.Table; + +package Configuration is + package Design_Units is new GNAT.Table + (Table_Component_Type => Iir_Design_Unit, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 16, + Table_Increment => 100); + + -- Get the top configuration to build a design hierarchy whose top is + -- PRIMARY + SECONDARY. + -- PRIMARY must designate a configuration declaration or an entity + -- declaration. In the last case, SECONDARY must be null_identifier or + -- designates an architecture declaration. + -- + -- creates a list of design unit. + -- and return the top configuration. + -- Note: this set the Elab_Flag on units. + function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) + return Iir; + + -- Add design unit UNIT (with its dependences) in the design_units table. + procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir); + + -- If set, all design units (even package bodies) are loaded. + Flag_Load_All_Design_Units : Boolean := True; + + Flag_Build_File_Dependence : Boolean := False; +end Configuration; diff --git a/disp_tree.adb b/disp_tree.adb new file mode 100644 index 000000000..6b3203f33 --- /dev/null +++ b/disp_tree.adb @@ -0,0 +1,1853 @@ +-- Node displaying (for debugging). +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Text_IO; use Ada.Text_IO; +with System.Storage_Elements; +with Ada.Unchecked_Conversion; +with Types; use Types; +with Name_Table; +with Iirs_Utils; use Iirs_Utils; +with Tokens; +with Errorout; +with Files_Map; + +package body Disp_Tree is + procedure Disp_Tab (Tab: Natural) is + Blanks : String (1 .. Tab) := (others => ' '); + begin + Put (Blanks); + end Disp_Tab; + + function Addr_Image (A : System.Address) return String is + Res : String (1 .. System.Address'Size / 4); + Hex_Digits : constant array (Integer range 0 .. 15) of Character + := "0123456789abcdef"; + use System; + use System.Storage_Elements; + Addr_Num : Integer_Address := To_Integer (A); + begin + for I in reverse Res'Range loop + Res (I) := Hex_Digits (Integer (Addr_Num mod 16)); + Addr_Num := Addr_Num / 16; + end loop; + return Res; + end Addr_Image; + + procedure Disp_Iir_Address (Node: Iir) + is + function To_Addr is new Ada.Unchecked_Conversion + (Source => Iir, Target => System.Address); + begin + Put ('[' & Addr_Image (To_Addr (Node)) & ']'); + end Disp_Iir_Address; + + function Inc_Tab (Tab: Natural) return Natural is + begin + return Tab + 4; + end Inc_Tab; + + + -- For iir. + + procedure Disp_Tree_Flat (Tree: Iir; Tab: Natural); + + procedure Disp_Tree_List + (Tree_List: Iir_List; Tab: Natural; Flat_Decl : Boolean := False) + is + El: Iir; + begin + if Tree_List = Null_Iir_List then + Disp_Tab (Tab); + Put_Line (" null-list"); + elsif Tree_List = Iir_List_All then + Disp_Tab (Tab); + Put_Line (" list-all"); + elsif Tree_List = Iir_List_Others then + Disp_Tab (Tab); + Put_Line (" list-others"); + else + for I in Natural loop + El := Get_Nth_Element (Tree_List, I); + exit when El = Null_Iir; + Disp_Tree (El, Tab, Flat_Decl); + end loop; + end if; + end Disp_Tree_List; + + procedure Disp_Tree_Chain + (Tree_Chain: Iir; Tab: Natural; Flat_Decl : Boolean := False) + is + El: Iir; + begin + El := Tree_Chain; + while El /= Null_Iir loop + Disp_Tree (El, Tab, Flat_Decl); + El := Get_Chain (El); + end loop; + end Disp_Tree_Chain; + + procedure Disp_Tree_Flat_Chain (Tree_Chain: Iir; Tab: Natural) + is + El: Iir; + begin + El := Tree_Chain; + while El /= Null_Iir loop + Disp_Tree_Flat (El, Tab); + El := Get_Chain (El); + end loop; + end Disp_Tree_Flat_Chain; + + procedure Disp_Tree_List_Flat (Tree_List: Iir_List; Tab: Natural) + is + El: Iir; + begin + if Tree_List = Null_Iir_List then + Disp_Tab (Tab); + Put_Line (" null-list"); + elsif Tree_List = Iir_List_All then + Disp_Tab (Tab); + Put_Line (" list-all"); + elsif Tree_List = Iir_List_Others then + Disp_Tab (Tab); + Put_Line (" list-others"); + else + for I in Natural loop + El := Get_Nth_Element (Tree_List, I); + exit when El = Null_Iir; + Disp_Tree_Flat (El, Tab); + end loop; + end if; + end Disp_Tree_List_Flat; + + procedure Disp_Ident (Ident: Name_Id) + is + use Name_Table; + begin + if Ident /= Null_Identifier then + Image (Ident); + Put_Line (" '" & Name_Buffer (1 .. Name_Length) & '''); + else + Put_Line (" "); + end if; + end Disp_Ident; + + procedure Disp_Tree_Flat (Tree: Iir; Tab: Natural) + is + procedure Disp_Identifier (Identifying: Iir) + is + Ident : Name_Id; + begin + if Identifying /= Null_Iir then + Ident := Get_Identifier (Identifying); + Disp_Ident (Ident); + else + New_Line; + end if; + end Disp_Identifier; + + procedure Disp_Decl_Ident + is + A_Type: Iir; + begin + A_Type := Get_Type_Declarator (Tree); + if A_Type /= Null_Iir then + Disp_Identifier (A_Type); + else + Put_Line (" "); + return; + end if; + end Disp_Decl_Ident; + begin + Disp_Tab (Tab); + Disp_Iir_Address (Tree); + + if Tree = Null_Iir then + Put_Line (" *NULL*"); + return; + else + Put (' '); + end if; + + case Get_Kind (Tree) is + when Iir_Kind_Design_File => + Put_Line ("design file"); + + when Iir_Kind_Design_Unit => + Put ("design_unit"); + Disp_Identifier (Tree); + + when Iir_Kind_Use_Clause => + Put_Line ("use_clause"); + + when Iir_Kind_Library_Clause => + Put ("library clause"); + Disp_Identifier (Tree); + + when Iir_Kind_Library_Declaration => + Put ("library declaration"); + Disp_Identifier (Tree); + + when Iir_Kind_Proxy => + Put_Line ("proxy"); + + when Iir_Kind_Waveform_Element => + Put_Line ("waveform_element"); + + when Iir_Kind_Package_Declaration => + Put ("package_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Package_Body => + Put ("package_body"); + Disp_Identifier (Tree); + when Iir_Kind_Entity_Declaration => + Put ("entity_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Architecture_Declaration => + Put ("architecture_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Configuration_Declaration => + Put ("configuration_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Function_Declaration => + Put ("function_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Function_Body => + Put_Line ("function_body"); + when Iir_Kind_Procedure_Declaration => + Put ("procedure_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Procedure_Body => + Put_Line ("procedure_body"); + when Iir_Kind_Object_Alias_Declaration => + Put ("object_alias_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Non_Object_Alias_Declaration => + Put ("non_object_alias_declaration"); + Disp_Identifier (Tree); + + when Iir_Kind_Signal_Interface_Declaration => + Put ("signal_interface_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Signal_Declaration => + Put ("signal_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Variable_Interface_Declaration => + Put ("variable_interface_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Variable_Declaration => + if Get_Shared_Flag (Tree) then + Put ("(shared) "); + end if; + Put ("variable_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Constant_Interface_Declaration => + Put ("constant_interface_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Constant_Declaration => + Put ("constant_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Iterator_Declaration => + Put ("iterator_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_File_Interface_Declaration => + Put ("file_interface_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_File_Declaration => + Put ("file_declaration"); + Disp_Identifier (Tree); + + when Iir_Kind_Type_Declaration => + Put ("type_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Anonymous_Type_Declaration => + Put ("anonymous_type_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Subtype_Declaration => + Put ("subtype_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Component_Declaration => + Put ("component_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Element_Declaration => + Put ("element_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Attribute_Declaration => + Put ("attribute_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Group_Template_Declaration => + Put ("group_template_declaration"); + Disp_Identifier (Tree); + when Iir_Kind_Group_Declaration => + Put ("group_declaration"); + Disp_Identifier (Tree); + + when Iir_Kind_Enumeration_Type_Definition => + Put ("enumeration_type_definition"); + Disp_Decl_Ident; + when Iir_Kind_Enumeration_Subtype_Definition => + Put ("enumeration_subtype_definition"); + Disp_Decl_Ident; + when Iir_Kind_Integer_Subtype_Definition => + Put ("integer_subtype_definition"); + Disp_Decl_Ident; + when Iir_Kind_Integer_Type_Definition => + Put ("integer_type_definition"); + Disp_Identifier (Get_Type_Declarator (Tree)); + when Iir_Kind_Floating_Subtype_Definition => + Put ("floating_subtype_definition"); + Disp_Decl_Ident; + when Iir_Kind_Floating_Type_Definition => + Put ("floating_type_definition"); + Disp_Identifier (Get_Type_Declarator (Tree)); + when Iir_Kind_Array_Subtype_Definition => + Put ("array_subtype_definition"); + Disp_Decl_Ident; + when Iir_Kind_Array_Type_Definition => + Put ("array_type_definition"); + Disp_Decl_Ident; + when Iir_Kind_Record_Type_Definition => + Put ("record_type_definition"); + Disp_Decl_Ident; + when Iir_Kind_Access_Type_Definition => + Put ("access_type_definition"); + Disp_Decl_Ident; + when Iir_Kind_File_Type_Definition => + Put ("file_type_definition"); + Disp_Identifier (Get_Type_Declarator (Tree)); + when Iir_Kind_Subtype_Definition => + Put_Line ("subtype_definition"); + when Iir_Kind_Physical_Type_Definition => + Put ("physical_type_definition"); + Disp_Identifier (Get_Type_Declarator (Tree)); + when Iir_Kind_Physical_Subtype_Definition => + Put_Line ("physical_subtype_definition"); + + when Iir_Kind_Simple_Name => + Put ("simple_name "); + Disp_Identifier (Tree); + + when Iir_Kind_Operator_Symbol => + Put ("operator_symbol """); + Name_Table.Image (Get_Identifier (Tree)); + Put (Name_Table.Name_Buffer (1 .. Name_Table.Name_Length)); + Put_Line (""""); + + when Iir_Kind_Null_Literal => + Put_Line ("null_literal"); + + when Iir_Kind_Physical_Int_Literal => + Put_Line ("physical_int_literal"); + + when Iir_Kind_Physical_Fp_Literal => + Put_Line ("physical_fp_literal"); + + when Iir_Kind_Component_Instantiation_Statement => + Put ("component_instantiation_statement"); + Disp_Ident (Get_Label (Tree)); + when Iir_Kind_Block_Statement => + Put ("block_statement"); + Disp_Ident (Get_Label (Tree)); + when Iir_Kind_Sensitized_Process_Statement => + Put ("sensitized_process_statement"); + Disp_Ident (Get_Label (Tree)); + when Iir_Kind_Process_Statement => + Put ("process_statement"); + Disp_Ident (Get_Label (Tree)); + when Iir_Kind_Case_Statement => + Put_Line ("case_statement"); + when Iir_Kind_If_Statement => + Put_Line ("if_statement"); + when Iir_Kind_Elsif => + Put_Line ("Elsif"); + when Iir_Kind_For_Loop_Statement => + Put_Line ("for_loop_statement"); + when Iir_Kind_While_Loop_Statement => + Put_Line ("while_loop_statement"); + when Iir_Kind_Exit_Statement => + Put_Line ("exit_statement"); + when Iir_Kind_Next_Statement => + Put_Line ("next_statement"); + when Iir_Kind_Wait_Statement => + Put_Line ("wait_statement"); + when Iir_Kind_Assertion_Statement => + Put_Line ("assertion_statement"); + when Iir_Kind_Variable_Assignment_Statement => + Put_Line ("variable_assignment_statement"); + when Iir_Kind_Signal_Assignment_Statement => + Put_Line ("signal_assignment_statement"); + when Iir_Kind_Concurrent_Assertion_Statement => + Put_Line ("concurrent_assertion_statement"); + when Iir_Kind_Procedure_Call_Statement => + Put_Line ("procedure_call_statement"); + when Iir_Kind_Concurrent_Procedure_Call_Statement => + Put_Line ("concurrent_procedure_call_statement"); + when Iir_Kind_Return_Statement => + Put_Line ("return_statement"); + when Iir_Kind_Null_Statement => + Put_Line ("null_statement"); + + when Iir_Kind_Enumeration_Literal => + Put ("enumeration_literal"); + Disp_Identifier (Tree); + + when Iir_Kind_Character_Literal => + Put_Line ("character_literal"); + when Iir_Kind_Integer_Literal => + Put_Line ("integer_literal: " + & Iir_Int64'Image (Get_Value (Tree))); + when Iir_Kind_Floating_Point_Literal => + Put_Line ("floating_point_literal: " + & Iir_Fp64'Image (Get_Fp_Value (Tree))); + when Iir_Kind_String_Literal => + Put_Line ("string_literal: " & Image_String_Lit (Tree)); + when Iir_Kind_Unit_Declaration => + Put ("physical unit"); + Disp_Identifier (Tree); + when Iir_Kind_Entity_Class => + Put_Line ("entity_class '" + & Tokens.Image (Get_Entity_Class (Tree)) & '''); + + when Iir_Kind_Attribute_Name => + Put ("attribute_name"); + Disp_Ident (Get_Attribute_Identifier (Tree)); + + when Iir_Kind_Implicit_Function_Declaration => + Put ("implicit_function_declaration: "); + Put_Line (Iirs_Utils.Get_Predefined_Function_Name + (Get_Implicit_Definition (Tree))); + when Iir_Kind_Implicit_Procedure_Declaration => + Put ("implicit_procedure_declaration: "); + Put_Line (Iirs_Utils.Get_Predefined_Function_Name + (Get_Implicit_Definition (Tree))); + + when others => + Put_Line (Iir_Kind'Image (Get_Kind (Tree))); + end case; + end Disp_Tree_Flat; + + procedure Disp_Staticness (Static: Iir_Staticness) is + begin + case Static is + when Unknown => + Put ("???"); + when None => + Put ("none"); + when Globally => + Put ("global"); + when Locally => + Put ("local"); + end case; + end Disp_Staticness; + + procedure Disp_Flag (Bool : Boolean) is + begin + if Bool then + Put ("true"); + else + Put ("false"); + end if; + New_Line; + end Disp_Flag; + + procedure Disp_Expr_Staticness (Expr: Iir) is + begin + Put (" expr: "); + Disp_Staticness (Get_Expr_Staticness (Expr)); + New_Line; + end Disp_Expr_Staticness; + + procedure Disp_Type_Staticness (Atype: Iir) is + begin + Put (" type: "); + Disp_Staticness (Get_Type_Staticness (Atype)); + New_Line; + end Disp_Type_Staticness; + + procedure Disp_Name_Staticness (Expr: Iir) is + begin + Put (" expr: "); + Disp_Staticness (Get_Expr_Staticness (Expr)); + Put (", name: "); + Disp_Staticness (Get_Name_Staticness (Expr)); + New_Line; + end Disp_Name_Staticness; + + procedure Disp_Choice_Staticness (Expr: Iir) is + begin + Put (" choice: "); + Disp_Staticness (Get_Choice_Staticness (Expr)); + New_Line; + end Disp_Choice_Staticness; + + procedure Disp_Type_Resolved_Flag (Atype : Iir) is + begin + if Get_Resolved_Flag (Atype) then + Put_Line ("resolved"); + else + New_Line; + end if; + end Disp_Type_Resolved_Flag; + + procedure Disp_Lexical_Layout (Decl : Iir) + is + V : Iir_Lexical_Layout_Type; + begin + V := Get_Lexical_Layout (Decl); + if (V and Iir_Lexical_Has_Mode) /= 0 then + Put (" +mode"); + end if; + if (V and Iir_Lexical_Has_Class) /= 0 then + Put (" +class"); + end if; + if (V and Iir_Lexical_Has_Type) /= 0 then + Put (" +type"); + end if; + New_Line; + end Disp_Lexical_Layout; + + procedure Disp_Purity_State (State : Iir_Pure_State) + is + begin + case State is + when Pure => + Put (" pure"); + when Impure => + Put (" impure"); + when Maybe_Impure => + Put (" maybe_impure"); + when Unknown => + Put (" unknown"); + end case; + New_Line; + end Disp_Purity_State; + + procedure Disp_State (State : Tri_State_Type) + is + begin + case State is + when True => + Put (" true"); + when False => + Put (" false"); + when Unknown => + Put (" unknown"); + end case; + New_Line; + end Disp_State; + + procedure Disp_Depth (Depth : Iir_Int32) is + begin + Put (Iir_Int32'Image (Depth)); + New_Line; + end Disp_Depth; + + procedure Disp_Tree (Tree: Iir; + Tab: Natural := 0; + Flat_Decl: Boolean := false) is + Ntab: Natural := Inc_Tab (Tab); + Kind : Iir_Kind; + + procedure Header (Str: String; Nl: Boolean := true) is + begin + Disp_Tab (Ntab); + Put (Str); + if Nl then + New_Line; + end if; + end Header; + + procedure Disp_Label (Tree: Iir)is + Label : Name_Id; + begin + Label := Get_Label (Tree); + if Label /= Null_Identifier then + Header ("label: " & Name_Table.Image (Label)); + else + Header ("label: -"); + end if; + end Disp_Label; + begin + Disp_Tree_Flat (Tree, Tab); + if Tree = Null_Iir then + return; + end if; + + if Get_Location (Tree) /= Location_Nil then + Header ("loc: " & Errorout.Get_Location_Str (Get_Location (Tree))); + end if; + if False then + Header ("parent:"); + Disp_Tree_Flat (Get_Parent (Tree), Ntab); + end if; + + Kind := Get_Kind (Tree); + case Kind is + when Iir_Kind_Overload_List => + Header ("overload_list"); + Disp_Tree_List (Get_Overload_List (Tree), Ntab, Flat_Decl); + + when Iir_Kind_Error => + null; + + when Iir_Kind_Design_File => + Header ("design_file_filename: " + & Name_Table.Image (Get_Design_File_Filename (Tree))); + Header ("design_file_directory: " + & Name_Table.Image (Get_Design_File_Directory (Tree))); + Header ("analysis_time_stamp: " + & Files_Map.Get_Time_Stamp_String + (Get_Analysis_Time_Stamp (Tree))); + Header ("file_time_stamp: " + & Files_Map.Get_Time_Stamp_String + (Get_File_Time_Stamp (Tree))); + Header ("library:"); + Disp_Tree_Flat (Get_Parent (Tree), Ntab); + Header ("design_unit_chain:"); + Disp_Tree_Chain (Get_First_Design_Unit (Tree), Ntab, Flat_Decl); + + when Iir_Kind_Design_Unit => + if Flat_Decl then + return; + end if; + Header ("flags: date_state: " + & Date_State_Type'Image (Get_Date_State (Tree)) + & ", elab: " + & Boolean'Image (Get_Elab_Flag (Tree))); + Header ("date:" & Date_Type'Image (Get_Date (Tree))); + Header ("parent (design file):"); + Disp_Tree_Flat (Get_Design_File (Tree), Ntab); + Header ("dependence list:"); + Disp_Tree_List_Flat (Get_Dependence_List (Tree), Ntab); + if Get_Date_State (Tree) /= Date_Disk then + Header ("context items:"); + Disp_Tree_Chain (Get_Context_Items (Tree), Ntab); + end if; + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + Header ("library unit:"); + Disp_Tree (Get_Library_Unit (Tree), Ntab); + when Iir_Kind_Use_Clause => + Header ("selected name:"); + Disp_Tree (Get_Selected_Name (Tree), Ntab, True); + Header ("use_clause_chain:"); + Disp_Tree (Get_Use_Clause_Chain (Tree), Ntab); + when Iir_Kind_Library_Clause => + Header ("library declaration:"); + Disp_Tree_Flat (Get_Library_Declaration (Tree), Ntab); + + when Iir_Kind_Library_Declaration => + if Flat_Decl then + return; + end if; + Header ("library_directory: " + & Name_Table.Image (Get_Library_Directory (Tree))); + Header ("design file list:"); + Disp_Tree_Chain (Get_Design_File_Chain (Tree), Ntab); + + when Iir_Kind_Entity_Declaration => + Header ("generic chain:"); + Disp_Tree_Chain (Get_Generic_Chain (Tree), Ntab); + Header ("port chain:"); + Disp_Tree_Chain (Get_Port_Chain (Tree), Ntab); + Header ("declaration chain:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + Header ("concurrent_statements:"); + Disp_Tree_Chain (Get_Concurrent_Statement_Chain (Tree), Ntab); + when Iir_Kind_Package_Declaration => + if Flat_Decl then + return; + end if; + Header ("need_body: " & Boolean'Image (Get_Need_Body (Tree))); + Header ("declaration chain:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + when Iir_Kind_Package_Body => + Header ("package:"); + Disp_Tree_Flat (Get_Package (Tree), Ntab); + Header ("declaration:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + when Iir_Kind_Architecture_Declaration => + if Flat_Decl then + return; + end if; + Header ("entity:"); + Disp_Tree_Flat (Get_Entity (Tree), Ntab); + Header ("declaration_chain:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + Header ("concurrent_statements:"); + Disp_Tree_Chain (Get_Concurrent_Statement_Chain (Tree), Ntab); + Header ("default configuration:"); + Disp_Tree_Flat + (Get_Default_Configuration_Declaration (Tree), Ntab); + when Iir_Kind_Configuration_Declaration => + Header ("entity:"); + Disp_Tree_Flat (Get_Entity (Tree), Ntab); + Header ("declaration_chain:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + Header ("block_configuration:"); + Disp_Tree (Get_Block_Configuration (Tree), Ntab, True); + + when Iir_Kind_Entity_Aspect_Entity => + Header ("entity:"); + Disp_Tree_Flat (Get_Entity (Tree), Ntab); + Header ("architecture:"); + Disp_Tree_Flat (Get_Architecture (Tree), Ntab); + when Iir_Kind_Entity_Aspect_Configuration => + Header ("configuration:"); + Disp_Tree (Get_Configuration (Tree), Ntab, True); + when Iir_Kind_Entity_Aspect_Open => + null; + + when Iir_Kind_Block_Configuration => + Header ("block_specification:"); + Disp_Tree (Get_Block_Specification (Tree), Ntab, True); + Header ("declaration_chain:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + Header ("configuration_item_chain:"); + Disp_Tree_Chain (Get_Configuration_Item_Chain (Tree), Ntab); + Header ("prev_block_configuration:"); + Disp_Tree_Flat (Get_Prev_Block_Configuration (Tree), Ntab); + when Iir_Kind_Attribute_Specification => + Header ("attribute_designator:"); + Disp_Tree (Get_Attribute_Designator (Tree), Ntab, True); + Header ("entity_name_list:"); + Disp_Tree_List_Flat (Get_Entity_Name_List (Tree), Ntab); + Header ("entity_class: " + & Tokens.Image (Get_Entity_Class (Tree))); + Header ("expression:"); + Disp_Tree (Get_Expression (Tree), Ntab); + Header ("attribute_value_spec_chain:"); + Disp_Tree_Chain (Get_Attribute_Value_Spec_Chain (Tree), Ntab); + when Iir_Kind_Configuration_Specification + | Iir_Kind_Component_Configuration => + Header ("instantiation_list:"); + Disp_Tree_List_Flat (Get_Instantiation_List (Tree), Ntab); + Header ("component_name:"); + Disp_Tree (Get_Component_Name (Tree), Ntab, True); + Header ("binding_indication:"); + Disp_Tree (Get_Binding_Indication (Tree), Ntab); + if Kind = Iir_Kind_Component_Configuration then + Header ("block_configuration:"); + Disp_Tree (Get_Block_Configuration (Tree), Ntab); + end if; + when Iir_Kind_Binding_Indication => + Header ("entity_aspect:"); + Disp_Tree (Get_Entity_Aspect (Tree), Ntab, True); + Header ("generic_map_aspect_chain:"); + Disp_Tree_Chain (Get_Generic_Map_Aspect_Chain (Tree), Ntab); + Header ("port_map_aspect_chain:"); + Disp_Tree_Chain (Get_Port_Map_Aspect_Chain (Tree), Ntab); + Header ("default_generic_map_aspect_chain:"); + Disp_Tree_Chain + (Get_Default_Generic_Map_Aspect_Chain (Tree), Ntab); + Header ("default_port_map_aspect_chain:"); + Disp_Tree_Chain (Get_Default_Port_Map_Aspect_Chain (Tree), Ntab); + when Iir_Kind_Block_Header => + Header ("generic chain:"); + Disp_Tree_Chain (Get_Generic_Chain (Tree), Ntab); + Header ("generic_map_aspect_chain:"); + Disp_Tree_Chain (Get_Generic_Map_Aspect_Chain (Tree), Ntab); + Header ("port chain:"); + Disp_Tree_Chain (Get_Port_Chain (Tree), Ntab); + Header ("port_map_aspect_chain:"); + Disp_Tree_Chain (Get_Port_Map_Aspect_Chain (Tree), Ntab); + when Iir_Kind_Attribute_Value => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("attribute_specification:"); + Disp_Tree_Flat (Get_Attribute_Specification (Tree), Ntab); + Header ("designated_entity:"); + Disp_Tree_Flat (Get_Designated_Entity (Tree), Ntab); + when Iir_Kind_Signature => + Header ("return_type:"); + Disp_Tree_Flat (Get_Return_Type (Tree), Ntab); + Header ("type_marks_list:"); + Disp_Tree_List (Get_Type_Marks_List (Tree), Ntab); + when Iir_Kind_Disconnection_Specification => + Header ("signal_list:"); + Disp_Tree_List (Get_Signal_List (Tree), Ntab, True); + Header ("type_mark:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + Header ("time expression:"); + Disp_Tree (Get_Expression (Tree), Ntab); + + when Iir_Kind_Association_Element_By_Expression => + Header ("whole_association_flag: ", False); + Disp_Flag (Get_Whole_Association_Flag (Tree)); + Header ("collapse_signal_flag: ", False); + Disp_Flag (Get_Collapse_Signal_Flag (Tree)); + Header ("formal:"); + Disp_Tree (Get_Formal (Tree), Ntab, True); + Header ("out_conversion:"); + Disp_Tree (Get_Out_Conversion (Tree), Ntab, True); + Header ("actual:"); + Disp_Tree (Get_Actual (Tree), Ntab, True); + Header ("in_conversion:"); + Disp_Tree (Get_In_Conversion (Tree), Ntab, True); + when Iir_Kind_Association_Element_By_Individual => + Header ("whole_association_flag: ", False); + Disp_Flag (Get_Whole_Association_Flag (Tree)); + Header ("formal:"); + Disp_Tree (Get_Formal (Tree), Ntab, True); + Header ("actual_type:"); + Disp_Tree (Get_Actual_Type (Tree), Ntab, True); + Header ("individual_association_chain:"); + Disp_Tree_Chain (Get_Individual_Association_Chain (Tree), Ntab); + when Iir_Kind_Association_Element_Open => + Header ("formal:"); + Disp_Tree (Get_Formal (Tree), Ntab, True); + + when Iir_Kind_Waveform_Element => + Header ("value:"); + Disp_Tree (Get_We_Value (Tree), Ntab, True); + Header ("time:"); + Disp_Tree (Get_Time (Tree), Ntab); + when Iir_Kind_Conditional_Waveform => + Header ("condition:"); + Disp_Tree (Get_Condition (Tree), Ntab); + Header ("waveform_chain:"); + Disp_Tree_Chain (Get_Waveform_Chain (Tree), Ntab); + + when Iir_Kind_Choice_By_Name => + Header ("name:"); + Disp_Tree (Get_Name (Tree), Ntab); + Header ("associated:"); + Disp_Tree (Get_Associated (Tree), Ntab, True); + when Iir_Kind_Choice_By_Others => + Header ("associated"); + Disp_Tree (Get_Associated (Tree), Ntab, True); + when Iir_Kind_Choice_By_None => + Header ("associated"); + Disp_Tree (Get_Associated (Tree), Ntab, True); + when Iir_Kind_Choice_By_Range => + Header ("staticness: ", False); + Disp_Choice_Staticness (Tree); + Header ("range:"); + Disp_Tree (Get_Expression (Tree), Ntab); + Header ("associated"); + Disp_Tree (Get_Associated (Tree), Ntab, True); + when Iir_Kind_Choice_By_Expression => + Header ("expression:"); + Disp_Tree (Get_Expression (Tree), Ntab); + Header ("staticness: ", False); + Disp_Choice_Staticness (Tree); + Header ("associated"); + Disp_Tree (Get_Associated (Tree), Ntab, True); + + when Iir_Kind_Signal_Interface_Declaration => + if Flat_Decl then + return; + end if; + Header ("staticness: ", False); + Disp_Name_Staticness (Tree); + Header ("lexical layout:", False); + Disp_Lexical_Layout (Tree); + Header ("mode: " & Iir_Mode'Image (Get_Mode (Tree))); + Header ("signal kind: " + & Iir_Signal_Kind'Image (Get_Signal_Kind (Tree))); + Header ("has_active_flag: ", False); + Disp_Flag (Get_Has_Active_Flag (Tree)); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + Header ("default value:"); + Disp_Tree (Get_Default_Value (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Variable_Interface_Declaration => + if Flat_Decl then + return; + end if; + Header ("staticness: ", False); + Disp_Name_Staticness (Tree); + Header ("lexical layout:", False); + Disp_Lexical_Layout (Tree); + Header ("mode: " & Iir_Mode'Image (Get_Mode (Tree))); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + Header ("default value:"); + Disp_Tree (Get_Default_Value (Tree), Ntab, True); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Constant_Interface_Declaration => + if Flat_Decl then + return; + end if; + Header ("staticness: ", False); + Disp_Name_Staticness (Tree); + Header ("lexical layout:", False); + Disp_Lexical_Layout (Tree); + Header ("mode: " & Iir_Mode'Image (Get_Mode (Tree))); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + Header ("default value:"); + Disp_Tree (Get_Default_Value (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_File_Interface_Declaration => + if Flat_Decl then + return; + end if; + Header ("staticness: ", False); + Disp_Name_Staticness (Tree); + Header ("lexical layout:", False); + Disp_Lexical_Layout (Tree); + Header ("mode: " & Iir_Mode'Image (Get_Mode (Tree))); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + + when Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration => + if Flat_Decl then + return; + end if; + Header ("kind: " & Iir_Signal_Kind'Image (Get_Signal_Kind (Tree))); + Header ("has_active_flag: ", False); + Disp_Flag (Get_Has_Active_Flag (Tree)); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + if Kind = Iir_Kind_Signal_Declaration then + Header ("default value:"); + Disp_Tree (Get_Default_Value (Tree), Ntab, True); + Header ("signal_driver:"); + Disp_Tree_Flat (Get_Signal_Driver (Tree), Ntab); + else + Header ("guard expr:"); + Disp_Tree (Get_Guard_Expression (Tree), Ntab); + Header ("guard sensitivity list:"); + Disp_Tree_List (Get_Guard_Sensitivity_List (Tree), Ntab); + end if; + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration => + if Flat_Decl then + return; + end if; + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + if Kind = Iir_Kind_Constant_Declaration then + Header ("deferred flag: " & Boolean'Image + (Get_Deferred_Declaration_Flag (Tree))); + Header ("deferred: "); + Disp_Tree (Get_Deferred_Declaration (Tree), Ntab, True); + Header ("default value:"); + Disp_Tree (Get_Default_Value (Tree), Ntab, True); + end if; + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Variable_Declaration => + if Flat_Decl then + return; + end if; + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("default value:"); + Disp_Tree (Get_Default_Value (Tree), Ntab, True); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_File_Declaration => + if Flat_Decl then + return; + end if; + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("logical name:"); + Disp_Tree (Get_File_Logical_Name (Tree), Ntab); + Header ("mode: " & Iir_Mode'Image (Get_Mode (Tree))); + Header ("file_open_kind:"); + Disp_Tree (Get_File_Open_Kind (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration => + if Flat_Decl then + return; + end if; + Header ("type (definition):"); + Disp_Tree (Get_Type (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Anonymous_Type_Declaration => + if Flat_Decl then + return; + end if; + Header ("type (definition):"); + Disp_Tree (Get_Type (Tree), Ntab); + when Iir_Kind_Component_Declaration => + if Flat_Decl then + return; + end if; + Header ("generic chain:"); + Disp_Tree_Chain (Get_Generic_Chain (Tree), Ntab); + Header ("port chain:"); + Disp_Tree_Chain (Get_Port_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Element_Declaration => + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + when Iir_Kind_Attribute_Declaration => + if Flat_Decl then + return; + end if; + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + if Flat_Decl then + return; + end if; + Header ("interface_declaration_chain:"); + Disp_Tree_Chain (Get_Interface_Declaration_Chain (Tree), Ntab); + if Kind = Iir_Kind_Function_Declaration then + Header ("return type:"); + Disp_Tree (Get_Return_Type (Tree), Ntab, True); + Header ("pure_flag: ", False); + Disp_Flag (Get_Pure_Flag (Tree)); + else + Header ("purity_state:", False); + Disp_Purity_State (Get_Purity_State (Tree)); + end if; + Header ("wait_state:", False); + Disp_State (Get_Wait_State (Tree)); + + Header ("subprogram_depth:", False); + Disp_Depth (Get_Subprogram_Depth (Tree)); + Header ("subprogram_body:"); + Disp_Tree_Flat (Get_Subprogram_Body (Tree), Ntab); + Header ("driver list:"); + Disp_Tree_List (Get_Driver_List (Tree), Ntab, True); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + Header ("specification:"); + Disp_Tree_Flat (Get_Subprogram_Specification (Tree), Ntab); + Header ("declaration_chain:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + Header ("statements:"); + Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab); + when Iir_Kind_Implicit_Function_Declaration => + if Flat_Decl then + return; + end if; + Header ("operation: " + & Iir_Predefined_Functions'Image + (Get_Implicit_Definition (Tree))); + Header ("interface declaration chain:"); + Disp_Tree_Chain (Get_Interface_Declaration_Chain (Tree), Ntab); + Header ("return type:"); + Disp_Tree (Get_Return_Type (Tree), Ntab, True); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Implicit_Procedure_Declaration => + if Flat_Decl then + return; + end if; + Header ("interface declaration chain:"); + Disp_Tree_Chain (Get_Interface_Declaration_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Object_Alias_Declaration => + if Flat_Decl then + return; + end if; + Header ("name:"); + Disp_Tree (Get_Name (Tree), Ntab); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + when Iir_Kind_Non_Object_Alias_Declaration => + if Flat_Decl then + return; + end if; + Header ("name:"); + Disp_Tree (Get_Name (Tree), Ntab); + Header ("signature:"); + Disp_Tree (Get_Signature (Tree), Ntab, True); + + when Iir_Kind_Group_Template_Declaration => + Header ("entity_class_entry:"); + Disp_Tree_Chain (Get_Entity_Class_Entry_Chain (Tree), Ntab); + when Iir_Kind_Group_Declaration => + Header ("group_constituent_list:"); + Disp_Tree_List_Flat (Get_Group_Constituent_List (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + + when Iir_Kind_Enumeration_Type_Definition => + if Flat_Decl then + return; + end if; + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("type declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + Header ("literals:"); + Disp_Tree_List (Get_Enumeration_Literal_List (Tree), Ntab); + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Floating_Type_Definition => + if Flat_Decl and then not Is_Anonymous_Type_Definition (Tree) + then + return; + end if; + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("type_declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Subtype_Definition => + if Flat_Decl + and then Kind /= Iir_Kind_Subtype_Definition + and then Get_Type_Declarator (Tree) /= Null_Iir + then + return; + end if; + if Kind /= Iir_Kind_Subtype_Definition then + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("resolved flag: ", False); + Disp_Type_Resolved_Flag (Tree); + Header ("signal_type_flag: ", False); + Disp_Flag (Get_Signal_Type_Flag (Tree)); + Header ("type declarator:"); + Disp_Tree (Get_Type_Declarator (Tree), Ntab, True); + Header ("base type:"); + Disp_Tree (Get_Base_Type (Tree), Ntab, True); + end if; + Header ("type mark:"); + Disp_Tree (Get_Type_Mark (Tree), Ntab, True); + Header ("resolution function:"); + Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab); + Header ("range constraint:"); + Disp_Tree (Get_Range_Constraint (Tree), Ntab); + when Iir_Kind_Range_Expression => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("left limit:"); + Disp_Tree (Get_Left_Limit (Tree), Ntab, True); + Header ("right limit:"); + Disp_Tree (Get_Right_Limit (Tree), Ntab, True); + Header ("direction: " + & Iir_Direction'Image (Get_Direction (Tree))); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + when Iir_Kind_Array_Subtype_Definition => + if Flat_Decl and then Get_Type_Declarator (Tree) /= Null_Iir then + return; + end if; + Header ("staticness:", false); + Disp_Type_Staticness (Tree); + Header ("resolved flag: ", False); + Disp_Type_Resolved_Flag (Tree); + Header ("signal_type_flag: ", False); + Disp_Flag (Get_Signal_Type_Flag (Tree)); + Header ("type declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + Header ("base type:"); + declare + Base : Iir := Get_Base_Type (Tree); + Fl : Boolean; + begin + if Base /= Null_Iir + and then Kind = Iir_Kind_Array_Type_Definition + then + Fl := Get_Type_Declarator (Base) + /= Get_Type_Declarator (Tree); + else + Fl := False; + end if; + Disp_Tree (Base, Ntab, Fl); + end; + Header ("type mark:"); + Disp_Tree (Get_Type_Mark (Tree), Ntab, True); + Header ("index_subtype_list:"); + Disp_Tree_List (Get_Index_Subtype_List (Tree), Ntab, True); + Header ("element_subtype:"); + Disp_Tree_Flat (Get_Element_Subtype (Tree), Ntab); + Header ("resolution function:"); + Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab); + when Iir_Kind_Unconstrained_Array_Subtype_Definition => + if Flat_Decl and then Get_Type_Declarator (Tree) /= Null_Iir then + return; + end if; + Header ("type declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + Header ("resolved flag: ", False); + Disp_Type_Resolved_Flag (Tree); + Header ("signal_type_flag: ", False); + Disp_Flag (Get_Signal_Type_Flag (Tree)); + Header ("base type:"); + Disp_Tree (Get_Base_Type (Tree), Ntab, True); + Header ("type mark:"); + Disp_Tree (Get_Type_Mark (Tree), Ntab, True); + Header ("resolution function:"); + Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab); + Header ("index_subtype_list:"); + Disp_Tree_List (Get_Index_Subtype_List (Tree), Ntab, True); + when Iir_Kind_Array_Type_Definition => + if Flat_Decl and then Get_Type_Declarator (Tree) /= Null_Iir then + return; + end if; + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("resolved flag: ", False); + Disp_Type_Resolved_Flag (Tree); + Header ("signal_type_flag: ", False); + Disp_Flag (Get_Signal_Type_Flag (Tree)); + Header ("index_subtype_list:"); + Disp_Tree_List (Get_Index_Subtype_List (Tree), Ntab, True); + Header ("element_subtype:"); + Disp_Tree (Get_Element_Subtype (Tree), Ntab, True); + when Iir_Kind_Record_Type_Definition => + if Flat_Decl and then Get_Type_Declarator (Tree) /= Null_Iir then + return; + end if; + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("resolved flag: ", False); + Disp_Type_Resolved_Flag (Tree); + Header ("signal_type_flag: ", False); + Disp_Flag (Get_Signal_Type_Flag (Tree)); + Header ("elements:"); + Disp_Tree_Chain (Get_Element_Declaration_Chain (Tree), Ntab, True); + when Iir_Kind_Record_Subtype_Definition => + if Flat_Decl and then not Is_Anonymous_Type_Definition (Tree) then + return; + end if; + Header ("type declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + Header ("resolved flag: ", False); + Disp_Type_Resolved_Flag (Tree); + Header ("signal_type_flag: ", False); + Disp_Flag (Get_Signal_Type_Flag (Tree)); + Header ("base type:"); + Disp_Tree (Get_Base_Type (Tree), Ntab, True); + Header ("type mark:"); + Disp_Tree (Get_Type_Mark (Tree), Ntab, True); + Header ("resolution function:"); + Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab); + when Iir_Kind_Physical_Type_Definition => + if Flat_Decl and then Get_Type_Declarator (Tree) /= Null_Iir then + return; + end if; + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("resolved flag: ", False); + Disp_Type_Resolved_Flag (Tree); + Header ("declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + Header ("unit chain:"); + Disp_Tree_Chain (Get_Unit_Chain (Tree), Ntab); + when Iir_Kind_Unit_Declaration => + if Flat_Decl then + return; + end if; + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("physical_literal:"); + Disp_Tree (Get_Physical_Literal (Tree), Ntab, True); + Header ("physical_Unit_Value:"); + Disp_Tree (Get_Physical_Unit_Value (Tree), Ntab, True); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + + when Iir_Kind_Access_Type_Definition => + if Flat_Decl then + return; + end if; + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("resolved flag: ", False); + Disp_Type_Resolved_Flag (Tree); + Header ("signal_type_flag: ", False); + Disp_Flag (Get_Signal_Type_Flag (Tree)); + Header ("declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + Header ("designated type:"); + Disp_Tree_Flat (Get_Designated_Type (Tree), Ntab); + when Iir_Kind_Access_Subtype_Definition => + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("resolved flag: ", False); + Disp_Type_Resolved_Flag (Tree); + Header ("declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + Header ("base type:"); + Disp_Tree (Get_Base_Type (Tree), Ntab, True); + Header ("type mark:"); + Disp_Tree (Get_Type_Mark (Tree), Ntab, True); + Header ("designated type:"); + Disp_Tree_Flat (Get_Designated_Type (Tree), Ntab); + Header ("resolution function:"); + Disp_Tree_Flat (Get_Resolution_Function (Tree), Ntab); + + when Iir_Kind_Incomplete_Type_Definition => + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + Header ("base type:"); + Disp_Tree (Get_Base_Type (Tree), Ntab, True); + + when Iir_Kind_File_Type_Definition => + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + Header ("type mark:"); + Disp_Tree_Flat (Get_Type_Mark (Tree), Ntab); + when Iir_Kind_Protected_Type_Declaration => + Header ("staticness: ", False); + Disp_Type_Staticness (Tree); + Header ("declarator:"); + Disp_Tree_Flat (Get_Type_Declarator (Tree), Ntab); + Header ("protected_type_body:"); + Disp_Tree_Flat (Get_Protected_Type_Body (Tree), Ntab); + Header ("declarative_part:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + when Iir_Kind_Protected_Type_Body => + Header ("protected_type_declaration:"); + Disp_Tree_Flat (Get_Protected_Type_Declaration (Tree), Ntab); + Header ("declarative_part:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + + when Iir_Kind_Block_Statement => + if Flat_Decl then + return; + end if; + Disp_Label (Tree); + Header ("guard decl:"); + Disp_Tree (Get_Guard_Decl (Tree), Ntab); + Header ("block header:"); + Disp_Tree (Get_Block_Header (Tree), Ntab); + Header ("declaration_chain:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + Header ("concurrent statements:"); + Disp_Tree_Chain (Get_Concurrent_Statement_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Generate_Statement => + if Flat_Decl then + return; + end if; + Disp_Label (Tree); + Header ("generation_scheme:"); + Disp_Tree (Get_Generation_Scheme (Tree), Ntab); + Header ("declaration_chain:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + Header ("concurrent statements:"); + Disp_Tree_Chain (Get_Concurrent_Statement_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + + when Iir_Kind_Component_Instantiation_Statement => + Disp_Label (Tree); + Header ("instantiated unit:"); + Disp_Tree (Get_Instantiated_Unit (Tree), Ntab, True); + Header ("generic map aspect chain:"); + Disp_Tree_Chain (Get_Generic_Map_Aspect_Chain (Tree), Ntab); + Header ("port map aspect chain:"); + Disp_Tree_Chain (Get_Port_Map_Aspect_Chain (Tree), Ntab); + Header ("component_configuration:"); + Disp_Tree (Get_Component_Configuration (Tree), Ntab); + Header ("default binding indication:"); + Disp_Tree (Get_Default_Binding_Indication (Tree), Ntab, True); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + Header ("guarded_target_flag: " + & Tri_State_Type'Image (Get_Guarded_Target_State (Tree))); + Header ("target:"); + Disp_Tree (Get_Target (Tree), Ntab, True); + if Get_Guard (Tree) = Tree then + Header ("guard: guarded"); + else + Header ("guard:"); + Disp_Tree_Flat (Get_Guard (Tree), Ntab); + end if; + Header ("conditional waveform chain:"); + Disp_Tree_Chain (Get_Conditional_Waveform_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Concurrent_Selected_Signal_Assignment => + Header ("guarded_target_flag: " + & Tri_State_Type'Image (Get_Guarded_Target_State (Tree))); + Header ("target:"); + Disp_Tree (Get_Target (Tree), Ntab, True); + if Get_Guard (Tree) = Tree then + Header ("guard: guarded"); + else + Header ("guard:"); + Disp_Tree_Flat (Get_Guard (Tree), Ntab); + end if; + Header ("choices:"); + Disp_Tree_Chain (Get_Selected_Waveform_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Concurrent_Assertion_Statement => + Header ("condition:"); + Disp_Tree (Get_Assertion_Condition (Tree), Ntab); + Header ("report expression:"); + Disp_Tree (Get_Report_Expression (Tree), Ntab); + Header ("severity expression:"); + Disp_Tree (Get_Severity_Expression (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + Disp_Label (Tree); + Header ("passive: " & Boolean'Image (Get_Passive_Flag (Tree))); + if Kind = Iir_Kind_Sensitized_Process_Statement then + Header ("sensivity list:"); + Disp_Tree_List (Get_Sensitivity_List (Tree), Ntab, True); + end if; + Header ("driver list:"); + Disp_Tree_List (Get_Driver_List (Tree), Ntab, True); + Header ("declaration_chain:"); + Disp_Tree_Chain (Get_Declaration_Chain (Tree), Ntab); + Header ("process statements:"); + Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_If_Statement => + Header ("condition:"); + Disp_Tree (Get_Condition (Tree), Ntab, True); + Header ("then sequence:"); + Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab); + Header ("elsif:"); + Disp_Tree (Get_Else_Clause (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Elsif => + Header ("condition:"); + Disp_Tree (Get_Condition (Tree), Ntab); + Header ("then sequence:"); + Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab); + Header ("elsif:"); + Disp_Tree (Get_Else_Clause (Tree), Tab); + when Iir_Kind_For_Loop_Statement => + Header ("iterator:"); + Disp_Tree (Get_Iterator_Scheme (Tree), Ntab); + Header ("statements:"); + Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_While_Loop_Statement => + Header ("condition:"); + Disp_Tree (Get_Condition (Tree), Ntab); + Header ("statements:"); + Disp_Tree_Chain (Get_Sequential_Statement_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Case_Statement => + Header ("expression:"); + Disp_Tree (Get_Expression (Tree), Ntab, True); + Header ("choices chain:"); + Disp_Tree_Chain + (Get_Case_Statement_Alternative_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Signal_Assignment_Statement => + Header ("guarded_target_flag: " + & Tri_State_Type'Image (Get_Guarded_Target_State (Tree))); + Header ("target:"); + Disp_Tree (Get_Target (Tree), Ntab, True); + Header ("waveform_chain:"); + Disp_Tree_Chain (Get_Waveform_Chain (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Variable_Assignment_Statement => + Header ("target:"); + Disp_Tree (Get_Target (Tree), Ntab, True); + Header ("expression:"); + Disp_Tree (Get_Expression (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Assertion_Statement => + Header ("condition:"); + Disp_Tree (Get_Assertion_Condition (Tree), Ntab); + Header ("report expression:"); + Disp_Tree (Get_Report_Expression (Tree), Ntab); + Header ("severity expression:"); + Disp_Tree (Get_Severity_Expression (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Report_Statement => + Header ("report expression:"); + Disp_Tree (Get_Report_Expression (Tree), Ntab); + Header ("severity expression:"); + Disp_Tree (Get_Severity_Expression (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Return_Statement => + Header ("expression:"); + Disp_Tree (Get_Expression (Tree), Ntab, True); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Wait_Statement => + Header ("sensitivity list:"); + Disp_Tree_List (Get_Sensitivity_List (Tree), Ntab, True); + Header ("condition:"); + Disp_Tree (Get_Condition_Clause (Tree), Ntab); + Header ("timeout:"); + Disp_Tree (Get_Timeout_Clause (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Procedure_Call_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement => + Disp_Label (Tree); + Header ("procedure_call:"); + Disp_Tree (Get_Procedure_Call (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Procedure_Call => + Header ("implementation:"); + Disp_Tree (Get_Implementation (Tree), Ntab, True); + Header ("method_object:"); + Disp_Tree (Get_Method_Object (Tree), Ntab); + Header ("parameters:"); + Disp_Tree_Chain (Get_Parameter_Association_Chain (Tree), Ntab); + when Iir_Kind_Exit_Statement + | Iir_Kind_Next_Statement => + Header ("loop:"); + Disp_Tree_Flat (Get_Loop (Tree), Ntab); + Header ("condition:"); + Disp_Tree (Get_Condition (Tree), Ntab); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + when Iir_Kind_Null_Statement => + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + + when Iir_Kinds_Dyadic_Operator => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("implementation:"); + Disp_Tree (Get_Implementation (Tree), Ntab, True); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("left:"); + Disp_Tree (Get_Left (Tree), Ntab, True); + Header ("right:"); + Disp_Tree (Get_Right (Tree), Ntab, True); + + when Iir_Kinds_Monadic_Operator => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("implementation:"); + Disp_Tree (Get_Implementation (Tree), Ntab, True); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("operand:"); + Disp_Tree (Get_Operand (Tree), Ntab, True); + + when Iir_Kind_Function_Call => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("implementation:"); + Disp_Tree_Flat (Get_Implementation (Tree), Ntab); + Header ("method_object:"); + Disp_Tree (Get_Method_Object (Tree), Ntab); + Header ("parameters:"); + Disp_Tree_Chain (Get_Parameter_Association_Chain (Tree), Ntab); + when Iir_Kind_Qualified_Expression => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("type mark:"); + Disp_Tree (Get_Type_Mark (Tree), Ntab, True); + Header ("expression:"); + Disp_Tree (Get_Expression (Tree), Ntab, True); + when Iir_Kind_Type_Conversion => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("expression:"); + Disp_Tree (Get_Expression (Tree), Ntab, True); + when Iir_Kind_Allocator_By_Expression => + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("expression:"); + Disp_Tree (Get_Expression (Tree), Ntab, True); + when Iir_Kind_Allocator_By_Subtype => + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("subtype indication:"); + Disp_Tree (Get_Expression (Tree), Ntab, True); + when Iir_Kind_Selected_Element => + Header ("prefix:"); + Disp_Tree (Get_Prefix (Tree), Ntab, True); + Header ("selected element:"); + Disp_Tree (Get_Selected_Element (Tree), Ntab, True); + when Iir_Kind_Implicit_Dereference + | Iir_Kind_Dereference => + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("prefix:"); + Disp_Tree (Get_Prefix (Tree), Ntab, True); + + when Iir_Kind_Aggregate => + Header ("staticness: value: ", false); + Disp_Staticness (Get_Value_Staticness (Tree)); + Disp_Expr_Staticness (Tree); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + Header ("aggregate_info:"); + Disp_Tree (Get_Aggregate_Info (Tree), Ntab); + Header ("associations:"); + Disp_Tree_Chain (Get_Association_Choices_Chain (Tree), Ntab); + when Iir_Kind_Aggregate_Info => + Header ("aggr_others_flag: ", False); + Disp_Flag (Get_Aggr_Others_Flag (Tree)); + Header ("aggr_named_flag: ", False); + Disp_Flag (Get_Aggr_Named_Flag (Tree)); + Header ("aggr_dynamic_flag: ", False); + Disp_Flag (Get_Aggr_Dynamic_Flag (Tree)); + Header ("aggr_low_limit:"); + Disp_Tree (Get_Aggr_Low_Limit (Tree), Ntab, False); + Header ("aggr_high_limit:"); + Disp_Tree (Get_Aggr_High_Limit (Tree), Ntab, False); + Header ("aggr_max_length:" & + Iir_Int32'Image (Get_Aggr_Max_Length (Tree))); + Header ("sub_aggregate_info:"); + Disp_Tree (Get_Sub_Aggregate_Info (Tree), Ntab); + when Iir_Kind_Operator_Symbol => + null; + when Iir_Kind_Simple_Name => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + when Iir_Kind_Indexed_Name => + Header ("staticness:", false); + Disp_Name_Staticness (Tree); + Header ("prefix:"); + Disp_Tree (Get_Prefix (Tree), Ntab, True); + Header ("index:"); + Disp_Tree_List (Get_Index_List (Tree), Ntab, True); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + when Iir_Kind_Slice_Name => + Header ("staticness:", false); + Disp_Name_Staticness (Tree); + Header ("prefix:"); + Disp_Tree (Get_Prefix (Tree), Ntab, True); + Header ("suffix:"); + Disp_Tree (Get_Suffix (Tree), Ntab); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + when Iir_Kind_Parenthesis_Name => + Header ("prefix:"); + Disp_Tree (Get_Prefix (Tree), Ntab, Flat_Decl); + Header ("association chain:"); + Disp_Tree_Chain (Get_Association_Chain (Tree), Ntab); + when Iir_Kind_Selected_By_All_Name => + Header ("prefix:"); + Disp_Tree (Get_Prefix (Tree), Ntab, True); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + when Iir_Kind_Selected_Name => + Header ("prefix:"); + Disp_Tree (Get_Prefix (Tree), Ntab, True); + Header ("identifier: ", False); + Disp_Ident (Get_Suffix_Identifier (Tree)); + + when Iir_Kind_Attribute_Name => + Header ("prefix:"); + Disp_Tree (Get_Prefix (Tree), Ntab, True); + Header ("signature:"); + Disp_Tree (Get_Signature (Tree), Ntab); + + when Iir_Kind_Base_Attribute => + Header ("prefix:"); + Disp_Tree_Flat (Get_Prefix (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + when Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("prefix:"); + Disp_Tree_Flat (Get_Prefix (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + when Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute => + Header ("prefix:"); + Disp_Tree_Flat (Get_Prefix (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("parameter:"); + Disp_Tree (Get_Parameter (Tree), Ntab); + when Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("prefix:"); + Disp_Tree_Flat (Get_Prefix (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("parameter:"); + Disp_Tree (Get_Parameter (Tree), Ntab); + when Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("prefix:"); + Disp_Tree_Flat (Get_Prefix (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("parameter:"); + Disp_Tree (Get_Parameter (Tree), Ntab); + when Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute => + Header ("prefix:"); + Disp_Tree_Flat (Get_Prefix (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("has_active_flag: ", False); + Disp_Flag (Get_Has_Active_Flag (Tree)); + when Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute => + Header ("prefix:"); + Disp_Tree_Flat (Get_Prefix (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + when Iir_Kind_Behavior_Attribute + | Iir_Kind_Structure_Attribute => + Header ("prefix:"); + Disp_Tree_Flat (Get_Prefix (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + when Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute => + Header ("prefix:"); + Disp_Tree_Flat (Get_Prefix (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + + when Iir_Kind_Enumeration_Literal => + if Flat_Decl and then Get_Literal_Origin (Tree) = Null_Iir then + return; + end if; + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("value:" & Iir_Int32'Image (Get_Enum_Pos (Tree))); + Header ("attribute_value_chain:"); + Disp_Tree_Flat_Chain (Get_Attribute_Value_Chain (Tree), Ntab); + Header ("origin:"); + Disp_Tree (Get_Literal_Origin (Tree), Ntab, True); + when Iir_Kind_Integer_Literal => + Header ("staticness:", false); + Disp_Expr_Staticness (Tree); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("origin:"); + Disp_Tree (Get_Literal_Origin (Tree), Ntab, True); + when Iir_Kind_Floating_Point_Literal => + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("origin:"); + Disp_Tree (Get_Literal_Origin (Tree), Ntab, True); + when Iir_Kind_String_Literal => + Header ("value: """ & Iirs_Utils.Image_String_Lit (Tree) & """"); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + Header ("origin:"); + Disp_Tree (Get_Literal_Origin (Tree), Ntab, True); + when Iir_Kind_Bit_String_Literal => + Header ("base:" & Base_Type'Image (Get_Bit_String_Base (Tree))); + Header ("value: """ & Iirs_Utils.Image_String_Lit (Tree) & """"); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + when Iir_Kind_Character_Literal => + Header ("value: '" & + Name_Table.Get_Character (Get_Identifier (Tree)) & + '''); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + when Iir_Kind_Physical_Int_Literal => + Header ("staticness:", False); + Disp_Expr_Staticness (Tree); + Header ("value: " & Iir_Int64'Image (Get_Value (Tree))); + Header ("unit_name: "); + Disp_Tree_Flat (Get_Unit_Name (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("origin:"); + Disp_Tree (Get_Literal_Origin (Tree), Ntab); + when Iir_Kind_Physical_Fp_Literal => + Header ("staticness:", False); + Disp_Expr_Staticness (Tree); + Header ("fp_value: " & Iir_Fp64'Image (Get_Fp_Value (Tree))); + Header ("unit_name: "); + Disp_Tree_Flat (Get_Unit_Name (Tree), Ntab); + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + Header ("origin:"); + Disp_Tree (Get_Literal_Origin (Tree), Ntab); + when Iir_Kind_Null_Literal => + Header ("type:"); + Disp_Tree_Flat (Get_Type (Tree), Ntab); + when Iir_Kind_Simple_Aggregate => + Header ("simple_aggregate_list:"); + Disp_Tree_List (Get_Simple_Aggregate_List (Tree), Ntab, True); + Header ("type:"); + Disp_Tree (Get_Type (Tree), Ntab, True); + Header ("origin:"); + Disp_Tree (Get_Literal_Origin (Tree), Ntab, True); + + when Iir_Kind_Proxy => + Header ("proxy:"); + Disp_Tree_Flat (Get_Proxy (Tree), Ntab); + when Iir_Kind_Entity_Class => + null; + end case; + end Disp_Tree; +end Disp_Tree; diff --git a/disp_tree.ads b/disp_tree.ads new file mode 100644 index 000000000..6e3e3d714 --- /dev/null +++ b/disp_tree.ads @@ -0,0 +1,30 @@ +-- Node displaying (for debugging). +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Iirs; use Iirs; + +package Disp_Tree is + -- Disp NODE as an address. The format is "[XXXXXXXX]", where each X is + -- an hexadecimal digit (quotes are not displayed). + procedure Disp_Iir_Address (Node: Iir); + + -- Disp TREE recursively. + procedure Disp_Tree (Tree: Iir; + Tab: Natural := 0; + Flat_Decl: Boolean := false); + +end Disp_Tree; diff --git a/disp_vhdl.adb b/disp_vhdl.adb new file mode 100644 index 000000000..1976f0324 --- /dev/null +++ b/disp_vhdl.adb @@ -0,0 +1,2369 @@ +-- VHDL regeneration from internal nodes. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + + +-- Disp an iir tree. +-- Try to be as pretty as possible, and to keep line numbers and positions +-- of the identifiers. +with Ada.Text_IO; use Ada.Text_IO; +with Types; use Types; +with Std_Package; +with Flags; use Flags; +with Errorout; use Errorout; +with Iirs_Utils; use Iirs_Utils; +with Name_Table; +with Std_Names; +with Tokens; + +package body Disp_Vhdl is + + -- Disp the name of DECL. + procedure Disp_Name_Of (Decl: Iir); + + Indentation: constant Count := 2; + + -- If set, disp after a string literal the type enclosed into brackets. + Disp_String_Literal_Type: constant Boolean := False; + + -- If set, disp position number of associations + --Disp_Position_Number: constant Boolean := False; + +-- procedure Disp_Tab (Tab: Natural) is +-- Blanks : String (1 .. Tab) := (others => ' '); +-- begin +-- Put (Blanks); +-- end Disp_Tab; + + procedure Disp_Type (A_Type: Iir); + + procedure Disp_Expression (Expr: Iir); + procedure Disp_Concurrent_Statement (Stmt: Iir); + procedure Disp_Concurrent_Statement_Chain (Parent: Iir; Indent : Count); + procedure Disp_Declaration_Chain (Parent : Iir; Indent: Count); + procedure Disp_Process_Statement (Process: Iir); + procedure Disp_Sequential_Statements (First : Iir); + procedure Disp_Choice (Choice: in out Iir); + procedure Disp_Association_Chain (Chain : Iir); + procedure Disp_Block_Configuration + (Block: Iir_Block_Configuration; Indent: Count); + procedure Disp_Subprogram_Declaration (Subprg: Iir); + procedure Disp_Binding_Indication (Bind : Iir; Indent : Count); + + procedure Disp_Ident (Id: Name_Id) is + begin + Put (Name_Table.Image (Id)); + end Disp_Ident; + + procedure Disp_Identifier (Node : Iir) is + Ident : Name_Id; + begin + Ident := Get_Identifier (Node); + if Ident /= Null_Identifier then + Disp_Ident (Ident); + else + Put (""); + end if; + end Disp_Identifier; + + procedure Disp_Label (Node : Iir) is + Ident : Name_Id; + begin + Ident := Get_Label (Node); + if Ident /= Null_Identifier then + Disp_Ident (Ident); + else + Put (""); + end if; + end Disp_Label; + + procedure Disp_Character_Literal (Lit: Iir_Character_Literal) is + begin + Put (''' & Name_Table.Get_Character (Get_Identifier (Lit)) & '''); + end Disp_Character_Literal; + + procedure Disp_Function_Name (Func: Iir) + is + use Name_Table; + use Std_Names; + Id: Name_Id; + begin + Id := Get_Identifier (Func); + case Id is + when Name_Id_Operators + | Name_Word_Operators + | Name_Xnor + | Name_Shift_Operators => + Put (""""); + Put (Image (Id)); + Put (""""); + when others => + Disp_Ident (Id); + end case; + end Disp_Function_Name; + + -- Disp the name of DECL. + procedure Disp_Name_Of (Decl: Iir) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Component_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Type_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Library_Declaration + | Iir_Kind_Unit_Declaration => + Disp_Identifier (Decl); + when Iir_Kind_Anonymous_Type_Declaration => + Put ('<'); + Disp_Ident (Get_Identifier (Decl)); + Put ('>'); + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration => + Disp_Function_Name (Decl); + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + Disp_Identifier (Decl); + when Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition => + Disp_Identifier (Get_Type_Declarator (Decl)); + when Iir_Kind_Component_Instantiation_Statement => + Disp_Ident (Get_Label (Decl)); + when Iir_Kind_Design_Unit => + Disp_Name_Of (Get_Library_Unit (Decl)); + when Iir_Kind_Enumeration_Literal + | Iir_Kind_Simple_Name => + Disp_Identifier (Decl); + when Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement => + Disp_Label (Decl); + when others => + Error_Kind ("disp_name_of", Decl); + end case; + end Disp_Name_Of; + + procedure Disp_Range (Decl: Iir) is + begin + if Get_Kind (Decl) = Iir_Kind_Range_Expression then + Disp_Expression (Get_Left_Limit (Decl)); + if Get_Direction (Decl) = Iir_To then + Put (" to "); + else + Put (" downto "); + end if; + Disp_Expression (Get_Right_Limit (Decl)); + else + Disp_Name_Of (Get_Type_Declarator (Decl)); + end if; + end Disp_Range; + + procedure Disp_Name (Name: Iir) is + begin + case Get_Kind (Name) is + when Iir_Kind_Selected_By_All_Name => + Disp_Name (Get_Prefix (Name)); + Put (".all"); + when Iir_Kind_Dereference => + Disp_Name (Get_Prefix (Name)); + Put (".all"); + when Iir_Kind_Simple_Name => + Put (Iirs_Utils.Image_Identifier (Name)); + when Iir_Kind_Selected_Name => + Disp_Name (Get_Prefix (Name)); + Put ("."); + Disp_Ident (Get_Suffix_Identifier (Name)); + when Iir_Kind_Type_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + Disp_Name_Of (Name); + when others => + Error_Kind ("disp_name", Name); + end case; + end Disp_Name; + + procedure Disp_Use_Clause (Clause: Iir_Use_Clause) is + begin + Put ("use "); + Disp_Name (Get_Selected_Name (Clause)); + Put_Line (";"); + end Disp_Use_Clause; + + -- Disp the resolution function (if any) of type definition DEF. + procedure Disp_Resolution_Function (Def: Iir) is + Decl: Iir; + begin + Decl := Get_Resolution_Function (Def); + if Decl /= Null_Iir then + Disp_Name (Decl); + Put (' '); + end if; + end Disp_Resolution_Function; + + procedure Disp_Integer_Subtype_Definition + (Def: Iir_Integer_Subtype_Definition) + is + Base_Type: Iir_Integer_Type_Definition; + Decl: Iir; + begin + if Def /= Std_Package.Universal_Integer_Subtype_Definition then + Base_Type := Get_Base_Type (Def); + Decl := Get_Type_Declarator (Base_Type); + if Base_Type /= Std_Package.Universal_Integer_Subtype_Definition + and then Def /= Decl + then + Disp_Name_Of (Decl); + Put (" "); + end if; + end if; + Disp_Resolution_Function (Def); + Put ("range "); + Disp_Expression (Get_Range_Constraint (Def)); + Put (";"); + end Disp_Integer_Subtype_Definition; + + procedure Disp_Floating_Subtype_Definition + (Def: Iir_Floating_Subtype_Definition) + is + Base_Type: Iir_Floating_Type_Definition; + Decl: Iir; + begin + if Def /= Std_Package.Universal_Real_Subtype_Definition then + Base_Type := Get_Base_Type (Def); + Decl := Get_Type_Declarator (Base_Type); + if Base_Type /= Std_Package.Universal_Real_Subtype_Definition + and then Def /= Decl + then + Disp_Name_Of (Decl); + Put (" "); + end if; + end if; + Disp_Resolution_Function (Def); + Put ("range "); + Disp_Expression (Get_Range_Constraint (Def)); + Put (";"); + end Disp_Floating_Subtype_Definition; + + procedure Disp_Subtype_Indication (Def: Iir; Full_Decl: Boolean := False) + is + Type_Mark: Iir; + Base_Type : Iir; + Index: Iir; + Decl: Iir; + begin + Decl := Get_Type_Declarator (Def); + if not Full_Decl and then Decl /= Null_Iir then + Disp_Name_Of (Decl); + return; + end if; + + -- Resolution function name. + Disp_Resolution_Function (Def); + + -- type mark. + Type_Mark := Get_Type_Mark (Def); + if Type_Mark /= Null_Iir then + Decl := Get_Type_Declarator (Type_Mark); + Disp_Name_Of (Decl); + end if; + + if Get_Kind (Def) = Iir_Kind_Unconstrained_Array_Subtype_Definition then + return; + end if; + + Base_Type := Get_Base_Type (Def); + case Get_Kind (Base_Type) is + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + if Type_Mark = Null_Iir + or else Get_Range_Constraint (Def) + /= Get_Range_Constraint (Type_Mark) + then + if Type_Mark /= Null_Iir then + Put (" range "); + end if; + Disp_Expression (Get_Range_Constraint (Def)); + end if; + when Iir_Kind_Array_Type_Definition => + Put (" ("); + for I in Natural loop + Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I); + exit when Index = Null_Iir; + if I /= 0 then + Put (", "); + end if; + Disp_Expression (Get_Range_Constraint (Index)); + --Disp_Range (Get_Range_Constraint (Index); + end loop; + Put (")"); + when Iir_Kind_Record_Type_Definition => + null; + when others => + Error_Kind ("disp_subtype_indication", Base_Type); + end case; + end Disp_Subtype_Indication; + + procedure Disp_Enumeration_Type_Definition + (Def: Iir_Enumeration_Type_Definition) + is + Len : Count; + Start_Col: Count; + Decl: Name_Id; + A_Lit: Iir; --Enumeration_Literal_Acc; + begin + for I in Natural loop + A_Lit := Get_Nth_Element (Get_Enumeration_Literal_List (Def), I); + exit when A_Lit = Null_Iir; + if I = Natural'first then + Put ("("); + Start_Col := Col; + else + Put (", "); + end if; + Decl := Get_Identifier (A_Lit); + if Name_Table.Is_Character (Decl) then + Len := 3; + else + Len := Count (Name_Table.Get_Name_Length (Decl)); + end if; + if Col + Len + 2 > Line_Length then + New_Line; + Set_Col (Start_Col); + end if; + Disp_Name_Of (A_Lit); + end loop; + Put (");"); + end Disp_Enumeration_Type_Definition; + + procedure Disp_Enumeration_Subtype_Definition + (Def: Iir_Enumeration_Subtype_Definition) + is + Base_Type: Iir; + begin + Base_Type := Get_Base_Type (Def); + Disp_Resolution_Function (Def); + Put ("range "); + Disp_Range (Def); + Put (";"); + end Disp_Enumeration_Subtype_Definition; + + procedure Disp_Array_Subtype_Definition + (Def: Iir_Array_Subtype_Definition) + is + Index: Iir; + A_Type: Iir_Array_Type_Definition; + begin + Disp_Resolution_Function (Def); + + A_Type := Get_Base_Type (Def); + Put ("array ("); + for I in Natural loop + Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I); + exit when Index = Null_Iir; + if I /= 0 then + Put (", "); + end if; + Disp_Subtype_Indication (Index); + end loop; + Put (") of "); + Disp_Subtype_Indication (Get_Element_Subtype (Def)); + end Disp_Array_Subtype_Definition; + + procedure Disp_Array_Type_Definition (Def: Iir_Array_Type_Definition) is + Index: Iir; + begin + Put ("array ("); + for I in Natural loop + Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I); + exit when Index = Null_Iir; + if I /= 0 then + Put (", "); + end if; + Disp_Subtype_Indication (Index); + Put (" range <>"); + end loop; + Put (") of "); + Disp_Type (Get_Element_Subtype (Def)); + Put (";"); + end Disp_Array_Type_Definition; + + procedure Disp_Physical_Literal (Lit: Iir) is + begin + case Get_Kind (Lit) is + when Iir_Kind_Physical_Int_Literal => + Disp_Int64 (Get_Value (Lit)); + when Iir_Kind_Physical_Fp_Literal => + Disp_Fp64 (Get_Fp_Value (Lit)); + when others => + Error_Kind ("disp_physical_literal", Lit); + end case; + Put (' '); + Disp_Identifier (Get_Unit_Name (Lit)); + end Disp_Physical_Literal; + + procedure Disp_Physical_Subtype_Definition + (Def: Iir_Physical_Subtype_Definition; Indent: Count) + is + Base_Type: Iir; + Unit: Iir_Unit_Declaration; + begin + Disp_Resolution_Function (Def); + Put ("range "); + Disp_Expression (Get_Range_Constraint (Def)); + Base_Type := Get_Base_Type (Def); + if Get_Type_Declarator (Base_Type) = Get_Type_Declarator (Def) then + Put_Line (" units"); + Set_Col (Indent + Indentation); + Unit := Get_Unit_Chain (Base_Type); + Disp_Identifier (Unit); + Put_Line (";"); + Unit := Get_Chain (Unit); + while Unit /= Null_Iir loop + Set_Col (Indent + Indentation); + Disp_Identifier (Unit); + Put (" = "); + Disp_Physical_Literal (Get_Physical_Literal (Unit)); + Put_Line (";"); + Unit := Get_Chain (Unit); + end loop; + Set_Col (Indent); + Put ("end units;"); + end if; + end Disp_Physical_Subtype_Definition; + + procedure Disp_Record_Type_Definition + (Def: Iir_Record_Type_Definition; Indent: Count) + is + El: Iir_Element_Declaration; + begin + Put_Line ("record"); + Set_Col (Indent); + Put_Line ("begin"); + El := Get_Element_Declaration_Chain (Def); + while El /= Null_Iir loop + Set_Col (Indent + Indentation); + Disp_Identifier (El); + Put (" : "); + Disp_Subtype_Indication (Get_Type (El)); + Put_Line (";"); + El := Get_Chain (El); + end loop; + Set_Col (Indent); + Put ("end record;"); + end Disp_Record_Type_Definition; + + procedure Disp_Designator_List (List: Iir_List) is + El: Iir; + begin + if List = Null_Iir_List then + return; + end if; + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + if I > 0 then + Put (", "); + end if; + Disp_Expression (El); + --Disp_Text_Literal (El); + end loop; + end Disp_Designator_List; + + -- Display the full definition of a type, ie the sequence that can create + -- such a type. + procedure Disp_Type_Definition (Decl: in Iir; Indent: Count) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Enumeration_Type_Definition => + Disp_Enumeration_Type_Definition (Decl); + when Iir_Kind_Enumeration_Subtype_Definition => + Disp_Enumeration_Subtype_Definition (Decl); + when Iir_Kind_Integer_Subtype_Definition => + Disp_Integer_Subtype_Definition (Decl); + when Iir_Kind_Floating_Subtype_Definition => + Disp_Floating_Subtype_Definition (Decl); + when Iir_Kind_Array_Type_Definition => + Disp_Array_Type_Definition (Decl); + when Iir_Kind_Array_Subtype_Definition => + Disp_Array_Subtype_Definition (Decl); + when Iir_Kind_Physical_Subtype_Definition => + Disp_Physical_Subtype_Definition (Decl, Indent); + when Iir_Kind_Record_Type_Definition => + Disp_Record_Type_Definition (Decl, Indent); + when Iir_Kind_Access_Type_Definition => + Put ("access "); + Disp_Subtype_Indication (Get_Designated_Type (Decl)); + Put (';'); + when Iir_Kind_File_Type_Definition => + Put ("file of "); + Disp_Subtype_Indication (Get_Type_Mark (Decl)); + Put (';'); + when Iir_Kind_Protected_Type_Declaration => + Put_Line ("protected"); + Disp_Declaration_Chain (Decl, Indent + Indentation); + Set_Col (Indent); + Put ("end protected;"); + when Iir_Kind_Integer_Type_Definition => + Put (""); + when Iir_Kind_Floating_Type_Definition => + Put (""); + when Iir_Kind_Physical_Type_Definition => + Put (""); + when others => + Error_Kind ("disp_type_definition", Decl); + end case; + end Disp_Type_Definition; + + procedure Disp_Type_Declaration (Decl: Iir_Type_Declaration) + is + Indent: Count; + Def : Iir; + begin + Indent := Col; + Put ("type "); + Disp_Name_Of (Decl); + Def := Get_Type (Decl); + if Def = Null_Iir + or else Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition + then + Put_Line (";"); + else + Put (" is "); + Disp_Type_Definition (Def, Indent); + New_Line; + end if; + end Disp_Type_Declaration; + + procedure Disp_Anonymous_Type_Declaration + (Decl: Iir_Anonymous_Type_Declaration) + is + Indent: Count; + Def : Iir; + begin + Indent := Col; + Put ("-- type "); + Disp_Name_Of (Decl); + Put (" is "); + Def := Get_Type (Decl); + Disp_Type_Definition (Def, Indent); + if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then + declare + Unit : Iir_Unit_Declaration; + begin + Put_Line (" units"); + Set_Col (Indent); + Put ("-- "); + Unit := Get_Unit_Chain (Def); + Disp_Identifier (Unit); + Put_Line (";"); + Unit := Get_Chain (Unit); + while Unit /= Null_Iir loop + Set_Col (Indent); + Put ("-- "); + Disp_Identifier (Unit); + Put (" = "); + Disp_Physical_Literal (Get_Physical_Literal (Unit)); + Put_Line (";"); + Unit := Get_Chain (Unit); + end loop; + Set_Col (Indent); + Put ("-- end units;"); + end; + end if; + New_Line; + end Disp_Anonymous_Type_Declaration; + + procedure Disp_Subtype_Declaration (Decl: in Iir_Subtype_Declaration) is + begin + Put ("subtype "); + Disp_Name_Of (Decl); + Put (" is "); + Disp_Subtype_Indication (Get_Type (Decl), True); + Put_Line (";"); + end Disp_Subtype_Declaration; + + procedure Disp_Type (A_Type: Iir) + is + Decl: Iir; + begin + Decl := Get_Type_Declarator (A_Type); + if Decl /= Null_Iir then + Disp_Name_Of (Decl); + else + case Get_Kind (A_Type) is + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition => + raise Program_Error; + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + Disp_Subtype_Indication (A_Type); + when Iir_Kind_Array_Subtype_Definition => + Disp_Subtype_Indication (A_Type); + when others => + Error_Kind ("disp_type", A_Type); + end case; + end if; + end Disp_Type; + + procedure Disp_Mode (Mode: Iir_Mode) is + begin + case Mode is + when Iir_In_Mode => + Put ("in "); + when Iir_Out_Mode => + Put ("out "); + when Iir_Inout_Mode => + Put ("inout "); + when Iir_Buffer_Mode => + Put ("buffer "); + when Iir_Linkage_Mode => + Put ("linkage "); + when Iir_Unknown_Mode => + Put (" "); + end case; + end Disp_Mode; + + procedure Disp_Signal_Kind (Kind: Iir_Signal_Kind) is + begin + case Kind is + when Iir_No_Signal_Kind => + null; + when Iir_Register_Kind => + Put (" register"); + when Iir_Bus_Kind => + Put (" bus"); + end case; + end Disp_Signal_Kind; + + procedure Disp_Interface_Declaration (Interface: Iir) is + Default: Iir; + begin + case Get_Kind (Interface) is + when Iir_Kind_Signal_Interface_Declaration => + Put ("signal "); + when Iir_Kind_Variable_Interface_Declaration => + Put ("variable "); + when Iir_Kind_Constant_Interface_Declaration => + Put ("constant "); + when others => + Error_Kind ("disp_interface_declaration", Interface); + end case; + Disp_Name_Of (Interface); + Put (": "); + Disp_Mode (Get_Mode (Interface)); + Disp_Type (Get_Type (Interface)); + if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration then + Disp_Signal_Kind (Get_Signal_Kind (Interface)); + end if; + Default := Get_Default_Value (Interface); + if Default /= Null_Iir then + Put (" := "); + Disp_Expression (Default); + end if; + end Disp_Interface_Declaration; + + procedure Disp_Interface_Chain (Chain: Iir; Str: String) + is + Interface: Iir; + Start: Count; + begin + if Chain = Null_Iir then + return; + end if; + Put (" ("); + Start := Col; + Interface := Chain; + while Interface /= Null_Iir loop + Set_Col (Start); + Disp_Interface_Declaration (Interface); + if Get_Chain (Interface) /= Null_Iir then + Put ("; "); + else + Put (')'); + Put (Str); + end if; + Interface := Get_Chain (Interface); + end loop; + end Disp_Interface_Chain; + + procedure Disp_Ports (Parent : Iir) is + begin + Put ("port"); + Disp_Interface_Chain (Get_Port_Chain (Parent), ";"); + end Disp_Ports; + + procedure Disp_Generics (Parent : Iir) is + begin + Put ("generic"); + Disp_Interface_Chain (Get_Generic_Chain (Parent), ";"); + end Disp_Generics; + + procedure Disp_Entity_Declaration (Decl: Iir_Entity_Declaration) is + Start: Count; + begin + Start := Col; + Put ("entity "); + Disp_Name_Of (Decl); + Put_Line (" is"); + if Get_Generic_Chain (Decl) /= Null_Iir then + Set_Col (Start + Indentation); + Disp_Generics (Decl); + end if; + if Get_Port_Chain (Decl) /= Null_Iir then + Set_Col (Start + Indentation); + Disp_Ports (Decl); + end if; + Disp_Declaration_Chain (Decl, Start + Indentation); + if Get_Concurrent_Statement_Chain (Decl) /= Null_Iir then + Set_Col (Start); + Put_Line ("begin"); + Disp_Concurrent_Statement_Chain (Decl, Start + Indentation); + end if; + Set_Col (Start); + Put_Line ("end entity;"); + end Disp_Entity_Declaration; + + procedure Disp_Component_Declaration (Decl: Iir_Component_Declaration) + is + Indent: Count; + begin + Indent := Col; + Put ("component "); + Disp_Name_Of (Decl); + if Get_Generic_Chain (Decl) /= Null_Iir then + Set_Col (Indent + Indentation); + Disp_Generics (Decl); + end if; + if Get_Port_Chain (Decl) /= Null_Iir then + Set_Col (Indent + Indentation); + Disp_Ports (Decl); + end if; + Set_Col (Indent); + Put ("end component;"); + end Disp_Component_Declaration; + + procedure Disp_Concurrent_Statement_Chain (Parent : Iir; Indent : Count) + is + El: Iir; + begin + El := Get_Concurrent_Statement_Chain (Parent); + while El /= Null_Iir loop + Set_Col (Indent); + Disp_Concurrent_Statement (El); + El := Get_Chain (El); + end loop; + end Disp_Concurrent_Statement_Chain; + + procedure Disp_Architecture_Declaration (Arch: Iir_Architecture_Declaration) + is + Start: Count; + begin + Start := Col; + Put ("architecture "); + Disp_Name_Of (Arch); + Put (" of "); + Disp_Name_Of (Get_Entity (Arch)); + Put_Line (" is"); + Disp_Declaration_Chain (Arch, Start + Indentation); + Set_Col (Start); + Put_Line ("begin"); + Disp_Concurrent_Statement_Chain (Arch, Start + Indentation); + Set_Col (Start); + Put_Line ("end;"); + end Disp_Architecture_Declaration; + + procedure Disp_Object_Alias_Declaration (Decl: Iir_Object_Alias_Declaration) + is + begin + Put ("alias "); + Disp_Name_Of (Decl); + Put (": "); + Disp_Type (Get_Type (Decl)); + Put (" is "); + Disp_Expression (Get_Name (Decl)); + Put_Line (";"); + end Disp_Object_Alias_Declaration; + + procedure Disp_Non_Object_Alias_Declaration + (Decl: Iir_Non_Object_Alias_Declaration) + is + begin + Put ("alias "); + Disp_Function_Name (Decl); + Put (" is "); + Disp_Name (Get_Name (Decl)); + Put_Line (";"); + end Disp_Non_Object_Alias_Declaration; + + procedure Disp_File_Declaration (Decl: Iir_File_Declaration) is + Expr: Iir; + begin + Put ("file "); + Disp_Name_Of (Decl); + Put (": "); + Disp_Type (Get_Type (Decl)); + if Vhdl_Std = Vhdl_87 then + Put (" is "); + Disp_Mode (Get_Mode (Decl)); + Disp_Expression (Get_File_Logical_Name (Decl)); + else + Expr := Get_File_Open_Kind (Decl); + if Expr /= Null_Iir then + Put (" open "); + Disp_Expression (Expr); + end if; + Expr := Get_File_Logical_Name (Decl); + if Expr /= Null_Iir then + Put (" is "); + Disp_Expression (Expr); + end if; + end if; + Put (';'); + end Disp_File_Declaration; + + procedure Disp_Object_Declaration (Decl: Iir) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Variable_Declaration => + if Get_Shared_Flag (Decl) then + Put ("shared "); + end if; + Put ("variable "); + when Iir_Kind_Constant_Declaration => + Put ("constant "); + when Iir_Kind_Signal_Declaration => + Put ("signal "); + when Iir_Kind_Object_Alias_Declaration => + Disp_Object_Alias_Declaration (Decl); + return; + when Iir_Kind_File_Declaration => + Disp_File_Declaration (Decl); + return; + when others => + raise Internal_Error; + end case; + Disp_Name_Of (Decl); + Put (": "); + Disp_Type (Get_Type (Decl)); + if Get_Kind (Decl) = Iir_Kind_Signal_Declaration then + Disp_Signal_Kind (Get_Signal_Kind (Decl)); + end if; + + if Get_Default_Value (Decl) /= Null_Iir then + Put (" := "); + Disp_Expression (Get_Default_Value (Decl)); + end if; + Put_Line (";"); + end Disp_Object_Declaration; + + procedure Disp_Driver_List (List: Iir_Driver_List; Indent : Count) + is + El: Iir; + begin + if List = Null_Iir_List or else Get_Nbr_Elements (List) = 0 then + return; + end if; + Set_Col (Indent); + Put_Line ("-- drivers needed for signals:"); + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Set_Col (Indent); + Put ("-- "); + Disp_Expression (El); + New_Line; + end loop; + end Disp_Driver_List; + + procedure Disp_Subprogram_Declaration (Subprg: Iir) + is + Indent: Count; + begin + Indent := Col; + case Get_Kind (Subprg) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration => + Put ("function "); + Disp_Function_Name (Subprg); + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + Put ("procedure "); + Disp_Identifier (Subprg); + when others => + raise Internal_Error; + end case; + + Disp_Interface_Chain (Get_Interface_Declaration_Chain (Subprg), ""); + + case Get_Kind (Subprg) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration => + Put (" return "); + Disp_Type (Get_Return_Type (Subprg)); + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + null; + when others => + raise Internal_Error; + end case; + + if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then + Disp_Driver_List (Get_Driver_List (Subprg), Indent); + end if; + end Disp_Subprogram_Declaration; + + procedure Disp_Subprogram_Body (Subprg : Iir) + is + Decl : Iir; + Indent : Count; + begin + Decl := Get_Subprogram_Specification (Subprg); + Indent := Col; + if Get_Chain (Decl) /= Subprg then + Disp_Subprogram_Declaration (Decl); + end if; + Put_Line ("is"); + Set_Col (Indent); + Disp_Declaration_Chain (Subprg, Indent + Indentation); + Set_Col (Indent); + Put_Line ("begin"); + Set_Col (Indent + Indentation); + Disp_Sequential_Statements (Get_Sequential_Statement_Chain (Subprg)); + Set_Col (Indent); + Put_Line ("end;"); + end Disp_Subprogram_Body; + + procedure Disp_Instantiation_List (Insts: Iir_List) is + El : Iir; + begin + if Insts = Iir_List_All then + Put ("all"); + elsif Insts = Iir_List_Others then + Put ("others"); + else + for I in Natural loop + El := Get_Nth_Element (Insts, I); + exit when El = Null_Iir; + if I /= Natural'First then + Put (", "); + end if; + Disp_Name_Of (El); + end loop; + end if; + end Disp_Instantiation_List; + + procedure Disp_Configuration_Specification + (Spec : Iir_Configuration_Specification) + is + Indent : Count; + begin + Indent := Col; + Put ("for "); + Disp_Instantiation_List (Get_Instantiation_List (Spec)); + Put (": "); + Disp_Name_Of (Get_Component_Name (Spec)); + New_Line; + Disp_Binding_Indication (Get_Binding_Indication (Spec), + Indent + Indentation); + Put_Line (";"); + end Disp_Configuration_Specification; + + procedure Disp_Disconnection_Specification + (Dis : Iir_Disconnection_Specification) + is + begin + Put ("disconnect "); + Disp_Instantiation_List (Get_Signal_List (Dis)); + Put (": "); + Disp_Subtype_Indication (Get_Type (Dis)); + Put (" after "); + Disp_Expression (Get_Expression (Dis)); + Put_Line (";"); + end Disp_Disconnection_Specification; + + procedure Disp_Attribute_Declaration (Attr : Iir_Attribute_Declaration) + is + begin + Put ("attribute "); + Disp_Identifier (Attr); + Put (": "); + Disp_Type (Get_Type (Attr)); + Put_Line (";"); + end Disp_Attribute_Declaration; + + procedure Disp_Entity_Kind (Tok : Tokens.Token_Type) is + begin + Put (Tokens.Image (Tok)); + end Disp_Entity_Kind; + + procedure Disp_Entity_Name_List (List : Iir_List) + is + El : Iir; + begin + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + if I /= 0 then + Put (", "); + end if; + Disp_Name_Of (El); + end loop; + end Disp_Entity_Name_List; + + procedure Disp_Attribute_Specification (Attr : Iir_Attribute_Specification) + is + begin + Put ("attribute "); + Disp_Identifier (Get_Attribute_Designator (Attr)); + Put (" of "); + Disp_Entity_Name_List (Get_Entity_Name_List (Attr)); + Put (": "); + Disp_Entity_Kind (Get_Entity_Class (Attr)); + Put (" is "); + Disp_Expression (Get_Expression (Attr)); + Put_Line (";"); + end Disp_Attribute_Specification; + + procedure Disp_Protected_Type_Body + (Bod : Iir_Protected_Type_Body; Indent : Count) + is + begin + Put ("type "); + Disp_Identifier (Bod); + Put (" is protected body"); + New_Line; + Disp_Declaration_Chain (Bod, Indent + Indentation); + Set_Col (Indent); + Put_Line ("end protected body;"); + end Disp_Protected_Type_Body; + + procedure Disp_Declaration_Chain (Parent : Iir; Indent: Count) + is + Decl: Iir; + begin + Decl := Get_Declaration_Chain (Parent); + while Decl /= Null_Iir loop + Set_Col (Indent); + case Get_Kind (Decl) is + when Iir_Kind_Type_Declaration => + Disp_Type_Declaration (Decl); + when Iir_Kind_Anonymous_Type_Declaration => + Disp_Anonymous_Type_Declaration (Decl); + when Iir_Kind_Subtype_Declaration => + Disp_Subtype_Declaration (Decl); + when Iir_Kind_Use_Clause => + Disp_Use_Clause (Decl); + when Iir_Kind_Component_Declaration => + Disp_Component_Declaration (Decl); + when Iir_Kinds_Object_Declaration => + Disp_Object_Declaration (Decl); + when Iir_Kind_Non_Object_Alias_Declaration => + Disp_Non_Object_Alias_Declaration (Decl); + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + Disp_Subprogram_Declaration (Decl); + Put_Line (";"); + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + Disp_Subprogram_Declaration (Decl); + if Get_Subprogram_Body (Decl) = Null_Iir + or else Get_Subprogram_Body (Decl) /= Get_Chain (Decl) + then + Put_Line (";"); + end if; + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + Disp_Subprogram_Body (Decl); + when Iir_Kind_Protected_Type_Body => + Disp_Protected_Type_Body (Decl, Indent); + when Iir_Kind_Configuration_Specification => + Disp_Configuration_Specification (Decl); + when Iir_Kind_Disconnection_Specification => + Disp_Disconnection_Specification (Decl); + when Iir_Kind_Attribute_Declaration => + Disp_Attribute_Declaration (Decl); + when Iir_Kind_Attribute_Specification => + Disp_Attribute_Specification (Decl); + when Iir_Kinds_Signal_Attribute => + null; + when others => + Error_Kind ("disp_declaration_chain", Decl); + end case; + Decl := Get_Chain (Decl); + end loop; + end Disp_Declaration_Chain; + + procedure Disp_Waveform (Chain : Iir_Waveform_Element) + is + We: Iir_Waveform_Element; + Val : Iir; + begin + if Chain = Null_Iir then + Put ("null after {disconnection_time}"); + return; + end if; + We := Chain; + while We /= Null_Iir loop + if We /= Chain then + Put (", "); + end if; + Val := Get_We_Value (We); + Disp_Expression (Val); + if Get_Time (We) /= Null_Iir then + Put (" after "); + Disp_Expression (Get_Time (We)); + end if; + We := Get_Chain (We); + end loop; + end Disp_Waveform; + + procedure Disp_Delay_Mechanism (Stmt: Iir) is + Expr: Iir; + begin + case Get_Delay_Mechanism (Stmt) is + when Iir_Transport_Delay => + Put ("transport "); + when Iir_Inertial_Delay => + Expr := Get_Reject_Time_Expression (Stmt); + if Expr /= Null_Iir then + Put ("reject "); + Disp_Expression (Expr); + Put (" inertial "); + end if; + end case; + end Disp_Delay_Mechanism; + + procedure Disp_Signal_Assignment (Stmt: Iir) is + begin + Disp_Expression (Get_Target (Stmt)); + Put (" <= "); + Disp_Delay_Mechanism (Stmt); + Disp_Waveform (Get_Waveform_Chain (Stmt)); + Put_Line (";"); + end Disp_Signal_Assignment; + + procedure Disp_Variable_Assignment (Stmt: Iir) is + begin + Disp_Expression (Get_Target (Stmt)); + Put (" := "); + Disp_Expression (Get_Expression (Stmt)); + Put_Line (";"); + end Disp_Variable_Assignment; + + procedure Disp_Label (Label: Name_Id) is + begin + if Label /= Null_Identifier then + Disp_Ident (Label); + Put (": "); + end if; + end Disp_Label; + + procedure Disp_Concurrent_Selected_Signal_Assignment (Stmt: Iir) + is + Indent: Count; + Assoc: Iir; + Assoc_Chain : Iir; + begin + Indent := Col; + Set_Col (Indent); + Disp_Label (Get_Label (Stmt)); + Put ("with "); + Disp_Expression (Get_Expression (Stmt)); + Put (" select "); + Disp_Expression (Get_Target (Stmt)); + Put (" <= "); + if Get_Guard (Stmt) /= Null_Iir then + Put ("guarded "); + end if; + Disp_Delay_Mechanism (Stmt); + Assoc_Chain := Get_Selected_Waveform_Chain (Stmt); + Assoc := Assoc_Chain; + while Assoc /= Null_Iir loop + if Assoc /= Assoc_Chain then + Put_Line (","); + end if; + Set_Col (Indent + Indentation); + Disp_Waveform (Get_Associated (Assoc)); + Put (" when "); + Disp_Choice (Assoc); + end loop; + Put_Line (";"); + end Disp_Concurrent_Selected_Signal_Assignment; + + procedure Disp_Concurrent_Conditional_Signal_Assignment (Stmt: Iir) + is + Indent: Count; + Cond_Wf : Iir_Conditional_Waveform; + Expr : Iir; + begin + Disp_Label (Get_Label (Stmt)); + Disp_Expression (Get_Target (Stmt)); + Put (" <= "); + if Get_Guard (Stmt) /= Null_Iir then + Put ("guarded "); + end if; + Disp_Delay_Mechanism (Stmt); + Indent := Col; + Set_Col (Indent); + Cond_Wf := Get_Conditional_Waveform_Chain (Stmt); + while Cond_Wf /= Null_Iir loop + Disp_Waveform (Get_Waveform_Chain (Cond_Wf)); + Expr := Get_Condition (Cond_Wf); + if Expr /= Null_Iir then + Put (" when "); + Disp_Expression (Expr); + Put_Line (" else"); + Set_Col (Indent); + end if; + Cond_Wf := Get_Chain (Cond_Wf); + end loop; + + Put_Line (";"); + end Disp_Concurrent_Conditional_Signal_Assignment; + + procedure Disp_Assertion_Statement (Stmt: Iir) is + Start: Count; + Expr: Iir; + begin + Start := Col; + if Get_Kind (Stmt) = Iir_Kind_Concurrent_Assertion_Statement then + Disp_Label (Get_Label (Stmt)); + end if; + Put ("assert "); + Disp_Expression (Get_Assertion_Condition (Stmt)); + Expr := Get_Report_Expression (Stmt); + if Expr /= Null_Iir then + Set_Col (Start + Indentation); + Put ("report "); + Disp_Expression (Expr); + end if; + Expr := Get_Severity_Expression (Stmt); + if Expr /= Null_Iir then + Set_Col (Start + Indentation); + Put ("severity "); + Disp_Expression (Expr); + end if; + Put_Line (";"); + end Disp_Assertion_Statement; + + procedure Disp_Report_Statement (Stmt: Iir) + is + Start: Count; + Expr: Iir; + begin + Start := Col; + Put ("report "); + Expr := Get_Report_Expression (Stmt); + Disp_Expression (Expr); + Expr := Get_Severity_Expression (Stmt); + if Expr /= Null_Iir then + Set_Col (Start + Indentation); + Put ("severity "); + Disp_Expression (Expr); + end if; + Put_Line (";"); + end Disp_Report_Statement; + + procedure Disp_Dyadic_Operator (Expr: Iir) is + begin + Put ("("); + Disp_Expression (Get_Left (Expr)); + Put (' ' & Name_Table.Image (Iirs_Utils.Get_Operator_Name (Expr)) & ' '); + Disp_Expression (Get_Right (Expr)); + Put (")"); + end Disp_Dyadic_Operator; + + procedure Disp_Monadic_Operator (Expr: Iir) is + begin + Put (Name_Table.Image (Iirs_Utils.Get_Operator_Name (Expr)) & " ("); + Disp_Expression (Get_Operand (Expr)); + Put (")"); + end Disp_Monadic_Operator; + + procedure Disp_Case_Statement (Stmt: Iir_Case_Statement) + is + Indent: Count; + Assoc: Iir; + Sel_Stmt : Iir; + begin + Indent := Col; + Put ("case "); + Disp_Expression (Get_Expression (Stmt)); + Put_Line (" is"); + Assoc := Get_Case_Statement_Alternative_Chain (Stmt); + while Assoc /= Null_Iir loop + Set_Col (Indent + Indentation); + Put ("when "); + Sel_Stmt := Get_Associated (Assoc); + Disp_Choice (Assoc); + Put_Line (" =>"); + Set_Col (Indent + 2 * Indentation); + Disp_Sequential_Statements (Sel_Stmt); + end loop; + Set_Col (Indent); + Put_Line ("end case;"); + end Disp_Case_Statement; + + procedure Disp_Wait_Statement (Stmt: Iir_Wait_Statement) is + List: Iir_List; + Expr: Iir; + begin + Put ("wait"); + List := Get_Sensitivity_List (Stmt); + if List /= Null_Iir_List then + Put (" on "); + Disp_Designator_List (List); + end if; + Expr := Get_Condition_Clause (Stmt); + if Expr /= Null_Iir then + Put (" until "); + Disp_Expression (Expr); + end if; + Expr := Get_Timeout_Clause (Stmt); + if Expr /= Null_Iir then + Put (" for "); + Disp_Expression (Expr); + end if; + Put_Line (";"); + end Disp_Wait_Statement; + + procedure Disp_If_Statement (Stmt: Iir_If_Statement) is + Clause: Iir; + Expr: Iir; + Start: Count; + begin + Start := Col; + Put ("if "); + Clause := Stmt; + Disp_Expression (Get_Condition (Clause)); + Put_Line (" then"); + while Clause /= Null_Iir loop + Set_Col (Start + Indentation); + Disp_Sequential_Statements (Get_Sequential_Statement_Chain (Clause)); + Clause := Get_Else_Clause (Clause); + exit when Clause = Null_Iir; + Expr := Get_Condition (Clause); + Set_Col (Start); + if Expr /= Null_Iir then + Put ("elsif "); + Disp_Expression (Expr); + Put_Line (" then"); + else + Put_Line ("else"); + end if; + end loop; + Set_Col (Start); + Put_Line ("end if;"); + end Disp_If_Statement; + + procedure Disp_Iterator (Iterator: Iir) is + begin + Disp_Subtype_Indication (Iterator); + end Disp_Iterator; + + procedure Disp_Parameter_Specification + (Iterator : Iir_Iterator_Declaration) is + begin + Disp_Identifier (Iterator); + Put (" in "); + Disp_Iterator (Get_Type (Iterator)); + end Disp_Parameter_Specification; + + procedure Disp_Procedure_Call (Call : Iir) + is + Obj : Iir; + begin + Obj := Get_Method_Object (Call); + if Obj /= Null_Iir then + Disp_Name (Obj); + Put ('.'); + end if; + Disp_Identifier (Get_Implementation (Call)); + Put (' '); + Disp_Association_Chain (Get_Parameter_Association_Chain (Call)); + Put_Line (";"); + end Disp_Procedure_Call; + + procedure Disp_Sequential_Statements (First : Iir) + is + Stmt: Iir; + Start: Count; + begin + Start := Col; + Stmt := First; + while Stmt /= Null_Iir loop + Set_Col (Start); + case Get_Kind (Stmt) is + when Iir_Kind_Null_Statement => + Put_Line ("null;"); + when Iir_Kind_If_Statement => + Disp_If_Statement (Stmt); + when Iir_Kind_For_Loop_Statement => + Put ("for "); + Disp_Parameter_Specification (Get_Iterator_Scheme (Stmt)); + Put_Line (" loop"); + Set_Col (Start + Indentation); + Disp_Sequential_Statements + (Get_Sequential_Statement_Chain (Stmt)); + Set_Col (Start); + Put_Line ("end loop;"); + when Iir_Kind_While_Loop_Statement => + if Get_Condition (Stmt) /= Null_Iir then + Put ("while "); + Disp_Expression (Get_Condition (Stmt)); + Put (" "); + end if; + Put_Line ("loop"); + Set_Col (Start + Indentation); + Disp_Sequential_Statements + (Get_Sequential_Statement_Chain (Stmt)); + Set_Col (Start); + Put_Line ("end loop;"); + when Iir_Kind_Signal_Assignment_Statement => + Disp_Signal_Assignment (Stmt); + when Iir_Kind_Variable_Assignment_Statement => + Disp_Variable_Assignment (Stmt); + when Iir_Kind_Assertion_Statement => + Disp_Assertion_Statement (Stmt); + when Iir_Kind_Report_Statement => + Disp_Report_Statement (Stmt); + when Iir_Kind_Return_Statement => + if Get_Expression (Stmt) /= Null_Iir then + Put ("return "); + Disp_Expression (Get_Expression (Stmt)); + Put_Line (";"); + else + Put_Line ("return;"); + end if; + when Iir_Kind_Case_Statement => + Disp_Case_Statement (Stmt); + when Iir_Kind_Wait_Statement => + Disp_Wait_Statement (Stmt); + when Iir_Kind_Procedure_Call_Statement => + Disp_Procedure_Call (Get_Procedure_Call (Stmt)); + when Iir_Kind_Exit_Statement + | Iir_Kind_Next_Statement => + if Get_Kind (Stmt) = Iir_Kind_Exit_Statement then + Put ("exit"); + else + Put ("next"); + end if; + -- FIXME: label. + if Get_Condition (Stmt) /= Null_Iir then + Put (" when "); + Disp_Expression (Get_Condition (Stmt)); + end if; + Put_Line (";"); + + when others => + Error_Kind ("disp_sequential_statements", Stmt); + end case; + Stmt := Get_Chain (Stmt); + end loop; + end Disp_Sequential_Statements; + + procedure Disp_Process_Statement (Process: Iir) + is + Start: Count; + begin + Start := Col; + Disp_Label (Get_Label (Process)); + + Put ("process "); + if Get_Kind (Process) = Iir_Kind_Sensitized_Process_Statement then + Put ("("); + Disp_Designator_List (Get_Sensitivity_List (Process)); + Put (")"); + end if; + if Vhdl_Std >= Vhdl_93 then + Put_Line (" is"); + else + New_Line; + end if; + Disp_Driver_List (Get_Driver_List (Process), Start + Indentation); + Disp_Declaration_Chain (Process, Start + Indentation); + Set_Col (Start); + Put_Line ("begin"); + Set_Col (Start + Indentation); + Disp_Sequential_Statements (Get_Sequential_Statement_Chain (Process)); + Set_Col (Start); + Put_Line ("end process;"); + end Disp_Process_Statement; + + procedure Disp_Association_Chain (Chain : Iir) + is + El: Iir; + Formal: Iir; + Indent: Count; + Need_Comma : Boolean; + Conv : Iir; + begin + if Chain = Null_Iir then + return; + end if; + Put ("("); + Indent := Col; + Need_Comma := False; + + El := Chain; + while El /= Null_Iir loop + if Get_Kind (El) /= Iir_Kind_Association_Element_By_Individual then + if Need_Comma then + Put (", "); + end if; + if Get_Kind (El) = Iir_Kind_Association_Element_By_Expression then + Conv := Get_Out_Conversion (El); + if Conv /= Null_Iir then + Disp_Function_Name (Conv); + Put (" ("); + end if; + else + Conv := Null_Iir; + end if; + Formal := Get_Formal (El); + if Formal /= Null_Iir then + Disp_Expression (Formal); + if Conv /= Null_Iir then + Put (")"); + end if; + Put (" => "); + end if; + if Get_Kind (El) = Iir_Kind_Association_Element_Open then + Put ("open"); + else + Conv := Get_In_Conversion (El); + if Conv /= Null_Iir then + Disp_Function_Name (Conv); + Put (" ("); + end if; + Disp_Expression (Get_Actual (El)); + if Conv /= Null_Iir then + Put (")"); + end if; + end if; + Need_Comma := True; + end if; + El := Get_Chain (El); + end loop; + Put (")"); + end Disp_Association_Chain; + + procedure Disp_Generic_Map_Aspect (Parent : Iir) is + begin + Put ("generic map "); + Disp_Association_Chain (Get_Generic_Map_Aspect_Chain (Parent)); + end Disp_Generic_Map_Aspect; + + procedure Disp_Port_Map_Aspect (Parent : Iir) is + begin + Put ("port map "); + Disp_Association_Chain (Get_Port_Map_Aspect_Chain (Parent)); + end Disp_Port_Map_Aspect; + + procedure Disp_Entity_Aspect (Aspect : Iir) is + Arch : Iir; + begin + case Get_Kind (Aspect) is + when Iir_Kind_Entity_Aspect_Entity => + Put ("entity "); + Disp_Name_Of (Get_Entity (Aspect)); + Arch := Get_Architecture (Aspect); + if Arch /= Null_Iir then + Put (" ("); + Disp_Name_Of (Arch); + Put (")"); + end if; + when Iir_Kind_Entity_Aspect_Configuration => + Put ("configuration "); + Disp_Name_Of (Get_Configuration (Aspect)); + when Iir_Kind_Entity_Aspect_Open => + Put ("open"); + when others => + Error_Kind ("disp_entity_aspect", Aspect); + end case; + end Disp_Entity_Aspect; + + procedure Disp_Component_Instantiation_Statement + (Stmt: Iir_Component_Instantiation_Statement) + is + Component: Iir; + Alist: Iir; + begin + Disp_Label (Get_Label (Stmt)); + Component := Get_Instantiated_Unit (Stmt); + if Get_Kind (Component) = Iir_Kind_Component_Declaration then + Disp_Name_Of (Component); + else + Disp_Entity_Aspect (Component); + end if; + Alist := Get_Generic_Map_Aspect_Chain (Stmt); + if Alist /= Null_Iir then + Put (" "); + Disp_Generic_Map_Aspect (Stmt); + end if; + Alist := Get_Port_Map_Aspect_Chain (Stmt); + if Alist /= Null_Iir then + Put (" "); + Disp_Port_Map_Aspect (Stmt); + end if; + Put (";"); + end Disp_Component_Instantiation_Statement; + + procedure Disp_Function_Call (Expr: Iir_Function_Call) is + begin + Disp_Function_Name (Get_Implementation (Expr)); + Disp_Association_Chain (Get_Parameter_Association_Chain (Expr)); + end Disp_Function_Call; + + procedure Disp_Indexed_Name (Indexed: Iir) + is + List : Iir_List; + El: Iir; + begin + Disp_Expression (Get_Prefix (Indexed)); + Put (" ("); + List := Get_Index_List (Indexed); + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + if I /= 0 then + Put (", "); + end if; + Disp_Expression (El); + end loop; + Put (")"); + end Disp_Indexed_Name; + + procedure Disp_Choice (Choice: in out Iir) is + begin + loop + case Get_Kind (Choice) is + when Iir_Kind_Choice_By_Others => + Put ("others"); + when Iir_Kind_Choice_By_None => + null; + when Iir_Kind_Choice_By_Expression => + Disp_Expression (Get_Expression (Choice)); + when Iir_Kind_Choice_By_Range => + Disp_Range (Get_Expression (Choice)); + when Iir_Kind_Choice_By_Name => + Disp_Name_Of (Get_Name (Choice)); + when others => + Error_Kind ("disp_choice", Choice); + end case; + Choice := Get_Chain (Choice); + exit when Choice = Null_Iir; + exit when Get_Same_Alternative_Flag (Choice) = False; + --exit when Choice = Null_Iir; + Put (" | "); + end loop; + end Disp_Choice; + + procedure Disp_Aggregate (Aggr: Iir_Aggregate) + is + Indent: Count; + Assoc: Iir; + Expr : Iir; + begin + Put ("("); + Indent := Col; + Assoc := Get_Association_Choices_Chain (Aggr); + loop + Expr := Get_Associated (Assoc); + if Get_Kind (Assoc) /= Iir_Kind_Choice_By_None then + Disp_Choice (Assoc); + Put (" => "); + else + Assoc := Get_Chain (Assoc); + end if; + if Get_Kind (Expr) = Iir_Kind_Aggregate + or else Get_Kind (Expr) = Iir_Kind_String_Literal then + Set_Col (Indent); + end if; + Disp_Expression (Expr); + exit when Assoc = Null_Iir; + Put (", "); + end loop; + Put (")"); + end Disp_Aggregate; + + procedure Disp_Simple_Aggregate (Aggr: Iir_Simple_Aggregate) + is + List : Iir_List; + El : Iir; + First : Boolean := True; + begin + Put ("("); + List := Get_Simple_Aggregate_List (Aggr); + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + if First then + First := False; + else + Put (", "); + end if; + Disp_Expression (El); + end loop; + Put (")"); + end Disp_Simple_Aggregate; + + procedure Disp_Parametered_Attribute (Name : String; Expr : Iir) + is + Param : Iir; + Pfx : Iir; + begin + Pfx := Get_Prefix (Expr); + case Get_Kind (Pfx) is + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration => + Disp_Name_Of (Pfx); + when others => + Disp_Expression (Pfx); + end case; + Put ("'"); + Put (Name); + Param := Get_Parameter (Expr); + if Param /= Null_Iir then + Put (" ("); + Disp_Expression (Param); + Put (")"); + end if; + end Disp_Parametered_Attribute; + + procedure Disp_String_Literal (Str : Iir) + is + Ptr : String_Fat_Acc; + Len : Natural; + begin + Ptr := Get_String_Fat_Acc (Str); + Len := Get_String_Length (Str); + Put (Ptr (1 .. Len)); + end Disp_String_Literal; + + procedure Disp_Expression (Expr: Iir) + is + Orig : Iir; + begin + case Get_Kind (Expr) is + when Iir_Kind_Integer_Literal => + Orig := Get_Literal_Origin (Expr); + if Orig /= Null_Iir then + Disp_Expression (Orig); + else + Disp_Int64 (Get_Value (Expr)); + end if; + when Iir_Kind_Floating_Point_Literal => + Orig := Get_Literal_Origin (Expr); + if Orig /= Null_Iir then + Disp_Expression (Orig); + else + Disp_Fp64 (Get_Fp_Value (Expr)); + end if; + when Iir_Kind_String_Literal => + Put (""""); + Disp_String_Literal (Expr); + Put (""""); + if Disp_String_Literal_Type or Flags.List_Verbose then + Put ("[type: "); + Disp_Type (Get_Type (Expr)); + Put ("]"); + end if; + when Iir_Kind_Bit_String_Literal => + if False then + case Get_Bit_String_Base (Expr) is + when Base_2 => + Put ('B'); + when Base_8 => + Put ('O'); + when Base_16 => + Put ('X'); + end case; + end if; + Put ("B"""); + Disp_String_Literal (Expr); + Put (""""); + when Iir_Kind_Physical_Fp_Literal + | Iir_Kind_Physical_Int_Literal => + Orig := Get_Literal_Origin (Expr); + if Orig /= Null_Iir then + Disp_Expression (Orig); + else + Disp_Physical_Literal (Expr); + end if; + when Iir_Kind_Unit_Declaration => + Disp_Name_Of (Expr); + when Iir_Kind_Enumeration_Literal => + Disp_Name_Of (Expr); + when Iir_Kind_Object_Alias_Declaration => + Disp_Name_Of (Expr); + when Iir_Kind_Aggregate => + Disp_Aggregate (Expr); + when Iir_Kind_Null_Literal => + Put ("null"); + when Iir_Kind_Simple_Aggregate => + Disp_Simple_Aggregate (Expr); + + when Iir_Kind_Element_Declaration => + Disp_Name_Of (Expr); + + when Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Iterator_Declaration => + Disp_Name_Of (Expr); + return; + + when Iir_Kind_Simple_Name => + Disp_Name (Expr); + + when Iir_Kinds_Dyadic_Operator => + Disp_Dyadic_Operator (Expr); + when Iir_Kinds_Monadic_Operator => + Disp_Monadic_Operator (Expr); + when Iir_Kind_Function_Call => + Disp_Function_Call (Expr); + when Iir_Kind_Type_Conversion => + Disp_Type (Get_Type (Expr)); + Put (" ("); + Disp_Expression (Get_Expression (Expr)); + Put (")"); + when Iir_Kind_Qualified_Expression => + Disp_Type (Get_Type_Mark (Expr)); + Put ("'("); + Disp_Expression (Get_Expression (Expr)); + Put (")"); + when Iir_Kind_Allocator_By_Expression => + Put ("new "); + Disp_Expression (Get_Expression (Expr)); + when Iir_Kind_Allocator_By_Subtype => + Put ("new "); + Disp_Subtype_Indication (Get_Expression (Expr)); + + when Iir_Kind_Indexed_Name => + Disp_Indexed_Name (Expr); + when Iir_Kind_Slice_Name => + Disp_Expression (Get_Prefix (Expr)); + Put (" ("); + Disp_Range (Get_Suffix (Expr)); + Put (")"); + when Iir_Kind_Selected_Element => + Disp_Expression (Get_Prefix (Expr)); + Put ("."); + Disp_Name_Of (Get_Selected_Element (Expr)); + when Iir_Kind_Implicit_Dereference => + Disp_Expression (Get_Prefix (Expr)); + when Iir_Kind_Dereference => + Disp_Expression (Get_Prefix (Expr)); + Put (".all"); + + when Iir_Kind_Left_Type_Attribute => + Disp_Expression (Get_Prefix (Expr)); + Put ("'left"); + when Iir_Kind_Right_Type_Attribute => + Disp_Expression (Get_Prefix (Expr)); + Put ("'right"); + when Iir_Kind_High_Type_Attribute => + Disp_Expression (Get_Prefix (Expr)); + Put ("'high"); + when Iir_Kind_Low_Type_Attribute => + Disp_Expression (Get_Prefix (Expr)); + Put ("'low"); + + when Iir_Kind_Stable_Attribute => + Disp_Parametered_Attribute ("stable", Expr); + when Iir_Kind_Delayed_Attribute => + Disp_Parametered_Attribute ("delayed", Expr); + when Iir_Kind_Transaction_Attribute => + Disp_Expression (Get_Prefix (Expr)); + Put ("'transaction"); + when Iir_Kind_Event_Attribute => + Disp_Expression (Get_Prefix (Expr)); + Put ("'event"); + when Iir_Kind_Active_Attribute => + Disp_Expression (Get_Prefix (Expr)); + Put ("'active"); + when Iir_Kind_Last_Value_Attribute => + Disp_Expression (Get_Prefix (Expr)); + Put ("'last_value"); + when Iir_Kind_Last_Event_Attribute => + Disp_Expression (Get_Prefix (Expr)); + Put ("'last_event"); + + when Iir_Kind_Pos_Attribute => + Disp_Parametered_Attribute ("pos", Expr); + when Iir_Kind_Val_Attribute => + Disp_Parametered_Attribute ("val", Expr); + when Iir_Kind_Succ_Attribute => + Disp_Parametered_Attribute ("succ", Expr); + when Iir_Kind_Pred_Attribute => + Disp_Parametered_Attribute ("pred", Expr); + + when Iir_Kind_Length_Array_Attribute => + Disp_Parametered_Attribute ("length", Expr); + when Iir_Kind_Range_Array_Attribute => + Disp_Parametered_Attribute ("range", Expr); + when Iir_Kind_Reverse_Range_Array_Attribute => + Disp_Parametered_Attribute ("reverse_range", Expr); + when Iir_Kind_Left_Array_Attribute => + Disp_Parametered_Attribute ("left", Expr); + when Iir_Kind_Right_Array_Attribute => + Disp_Parametered_Attribute ("right", Expr); + when Iir_Kind_Low_Array_Attribute => + Disp_Parametered_Attribute ("low", Expr); + when Iir_Kind_High_Array_Attribute => + Disp_Parametered_Attribute ("high", Expr); + when Iir_Kind_Ascending_Array_Attribute => + Disp_Parametered_Attribute ("ascending", Expr); + + when Iir_Kind_Image_Attribute => + Disp_Parametered_Attribute ("image", Expr); + when Iir_Kind_Simple_Name_Attribute => + Disp_Name_Of (Get_Prefix (Expr)); + Put ("'simple_name"); + when Iir_Kind_Instance_Name_Attribute => + Disp_Name_Of (Get_Prefix (Expr)); + Put ("'instance_name"); + when Iir_Kind_Path_Name_Attribute => + Disp_Name_Of (Get_Prefix (Expr)); + Put ("'path_name"); + + when Iir_Kind_Selected_By_All_Name => + Disp_Expression (Get_Prefix (Expr)); + Put (""); + return; + when Iir_Kind_Selected_Name => + Disp_Expression (Get_Prefix (Expr)); + Put ('.'); + Disp_Expression (Get_Suffix (Expr)); + return; + + when Iir_Kinds_Type_And_Subtype_Definition => + Disp_Type (Expr); + + when Iir_Kind_Proxy => + Disp_Expression (Get_Proxy (Expr)); + + when Iir_Kind_Range_Expression => + Disp_Range (Expr); + when Iir_Kind_Subtype_Declaration => + Disp_Name_Of (Expr); + + when others => + Error_Kind ("disp_expression", Expr); + end case; + end Disp_Expression; + + procedure Disp_Block_Header (Header : Iir_Block_Header; Indent: Count) + is + Chain : Iir; + begin + if Header = Null_Iir then + return; + end if; + Chain := Get_Generic_Chain (Header); + if Chain /= Null_Iir then + Set_Col (Indent + Indentation); + Disp_Generics (Header); + Chain := Get_Generic_Map_Aspect_Chain (Header); + if Chain /= Null_Iir then + Set_Col (Indent + Indentation); + Disp_Generic_Map_Aspect (Header); + Put_Line (";"); + end if; + end if; + Chain := Get_Port_Chain (Header); + if Chain /= Null_Iir then + Set_Col (Indent + Indentation); + Disp_Ports (Header); + Chain := Get_Port_Map_Aspect_Chain (Header); + if Chain /= Null_Iir then + Set_Col (Indent + Indentation); + Disp_Port_Map_Aspect (Header); + Put_Line (";"); + end if; + end if; + end Disp_Block_Header; + + procedure Disp_Block_Statement (Block: Iir_Block_Statement) + is + Indent: Count; + Sensitivity: Iir_List; + Guard : Iir_Guard_Signal_Declaration; + begin + Indent := Col; + Disp_Label (Get_Label (Block)); + Put ("block"); + Guard := Get_Guard_Decl (Block); + if Guard /= Null_Iir then + Put (" ("); + Disp_Expression (Get_Guard_Expression (Guard)); + Put_Line (")"); + Sensitivity := Get_Guard_Sensitivity_List (Guard); + if Sensitivity /= Null_Iir_List then + Set_Col (Indent + Indentation); + Put ("-- guard sensitivity list "); + Disp_Designator_List (Sensitivity); + end if; + else + New_Line; + end if; + Disp_Block_Header (Get_Block_Header (Block), + Indent + Indentation); + Disp_Declaration_Chain (Block, Indent + Indentation); + Set_Col (Indent); + Put_Line ("begin"); + Disp_Concurrent_Statement_Chain (Block, Indent + Indentation); + Set_Col (Indent); + Put_Line ("end;"); + end Disp_Block_Statement; + + procedure Disp_Generate_Statement (Stmt : Iir_Generate_Statement) + is + Indent : Count; + Scheme : Iir; + begin + Indent := Col; + Disp_Label (Get_Label (Stmt)); + Scheme := Get_Generation_Scheme (Stmt); + case Get_Kind (Scheme) is + when Iir_Kind_Iterator_Declaration => + Put ("for "); + Disp_Parameter_Specification (Scheme); + when others => + Put ("if "); + Disp_Expression (Scheme); + end case; + Put_Line (" generate"); + Disp_Declaration_Chain (Stmt, Indent); + Set_Col (Indent); + Put_Line ("begin"); + Disp_Concurrent_Statement_Chain (Stmt, Indent + Indentation); + Set_Col (Indent); + Put_Line ("end generate;"); + end Disp_Generate_Statement; + + procedure Disp_Concurrent_Statement (Stmt: Iir) is + begin + case Get_Kind (Stmt) is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + Disp_Concurrent_Conditional_Signal_Assignment (Stmt); + when Iir_Kind_Concurrent_Selected_Signal_Assignment => + Disp_Concurrent_Selected_Signal_Assignment (Stmt); + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + Disp_Process_Statement (Stmt); + when Iir_Kind_Concurrent_Assertion_Statement => + Disp_Assertion_Statement (Stmt); + when Iir_Kind_Component_Instantiation_Statement => + Disp_Component_Instantiation_Statement (Stmt); + when Iir_Kind_Concurrent_Procedure_Call_Statement => + Disp_Procedure_Call (Get_Procedure_Call (Stmt)); + when Iir_Kind_Block_Statement => + Disp_Block_Statement (Stmt); + when Iir_Kind_Generate_Statement => + Disp_Generate_Statement (Stmt); + when others => + Error_Kind ("disp_concurrent_statement", Stmt); + end case; + end Disp_Concurrent_Statement; + + procedure Disp_Package_Declaration (Decl: Iir_Package_Declaration) is + begin + Put ("package "); + Disp_Identifier (Decl); + Put_Line (" is"); + Disp_Declaration_Chain (Decl, Col + Indentation); + Put_Line ("end;"); + end Disp_Package_Declaration; + + procedure Disp_Package_Body (Decl: Iir) + is + begin + Put ("package body "); + Disp_Identifier (Decl); + Put_Line (" is"); + Disp_Declaration_Chain (Decl, Col + Indentation); + Put_Line ("end;"); + end Disp_Package_Body; + + procedure Disp_Binding_Indication (Bind : Iir; Indent : Count) + is + El : Iir; + begin + El := Get_Entity_Aspect (Bind); + if El /= Null_Iir then + Set_Col (Indent); + Put ("use "); + Disp_Entity_Aspect (El); + end if; + El := Get_Generic_Map_Aspect_Chain (Bind); + if El /= Null_Iir then + Set_Col (Indent); + Disp_Generic_Map_Aspect (Bind); + end if; + El := Get_Port_Map_Aspect_Chain (Bind); + if El /= Null_Iir then + Set_Col (Indent); + Disp_Port_Map_Aspect (Bind); + end if; + end Disp_Binding_Indication; + + procedure Disp_Component_Configuration + (Conf : Iir_Component_Configuration; Indent : Count) + is + Block : Iir_Block_Configuration; + Binding : Iir; + begin + Set_Col (Indent); + Put ("for "); + Disp_Instantiation_List (Get_Instantiation_List (Conf)); + Put(" : "); + Disp_Name_Of (Get_Component_Name (Conf)); + New_Line; + Binding := Get_Binding_Indication (Conf); + if Binding /= Null_Iir then + Disp_Binding_Indication (Binding, Indent + Indentation); + end if; + Block := Get_Block_Configuration (Conf); + if Block /= Null_Iir then + Disp_Block_Configuration (Block, Indent + Indentation); + end if; + Set_Col (Indent); + Put_Line ("end for;"); + end Disp_Component_Configuration; + + procedure Disp_Configuration_Items + (Conf : Iir_Block_Configuration; Indent : Count) + is + El : Iir; + begin + El := Get_Configuration_Item_Chain (Conf); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Block_Configuration => + Disp_Block_Configuration (El, Indent); + when Iir_Kind_Component_Configuration => + Disp_Component_Configuration (El, Indent); + when Iir_Kind_Configuration_Specification => + -- This may be created by canon. + Set_Col (Indent); + Disp_Configuration_Specification (El); + Set_Col (Indent); + Put_Line ("end for;"); + when others => + Error_Kind ("disp_configuration_item_list", El); + end case; + El := Get_Chain (El); + end loop; + end Disp_Configuration_Items; + + procedure Disp_Block_Configuration + (Block: Iir_Block_Configuration; Indent: Count) + is + Spec : Iir; + begin + Set_Col (Indent); + Put ("for "); + Spec := Get_Block_Specification (Block); + case Get_Kind (Spec) is + when Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Architecture_Declaration => + Disp_Name_Of (Spec); + when Iir_Kind_Indexed_Name => + Disp_Name_Of (Get_Prefix (Spec)); + Put (" ("); + Disp_Expression (Get_First_Element (Get_Index_List (Spec))); + Put (")"); + when Iir_Kind_Selected_Name => + Disp_Name_Of (Get_Prefix (Spec)); + Put (" ("); + Put (Iirs_Utils.Image_Identifier (Spec)); + Put (")"); + when Iir_Kind_Slice_Name => + Disp_Name_Of (Get_Prefix (Spec)); + Put (" ("); + Disp_Range (Get_Suffix (Spec)); + Put (")"); + when others => + Error_Kind ("disp_block_configuration", Spec); + end case; + New_Line; + Disp_Declaration_Chain (Block, Indent + Indentation); + Disp_Configuration_Items (Block, Indent + Indentation); + Set_Col (Indent); + Put_Line ("end for;"); + end Disp_Block_Configuration; + + procedure Disp_Configuration_Declaration + (Decl: Iir_Configuration_Declaration) + is + begin + Put ("configuration "); + Disp_Name_Of (Decl); + Put (" of "); + Disp_Name_Of (Get_Entity (Decl)); + Put_Line (" is"); + Disp_Declaration_Chain (Decl, Col); + Disp_Block_Configuration (Get_Block_Configuration (Decl), + Col + Indentation); + Put_Line ("end;"); + end Disp_Configuration_Declaration; + + procedure Disp_Design_Unit (Unit: Iir_Design_Unit) + is + Decl: Iir; + Indent: Count; + begin + Indent := Col; + Decl := Get_Context_Items (Unit); + while Decl /= Null_Iir loop + Set_Col (Indent); + case Get_Kind (Decl) is + when Iir_Kind_Use_Clause => + Disp_Use_Clause (Decl); + when Iir_Kind_Library_Clause => + Put ("library "); + Disp_Identifier (Decl); + Put_Line (";"); + when others => + Error_Kind ("disp_design_unit1", Decl); + end case; + Decl := Get_Chain (Decl); + end loop; + + Decl := Get_Library_Unit (Unit); + Set_Col (Indent); + case Get_Kind (Decl) is + when Iir_Kind_Entity_Declaration => + Disp_Entity_Declaration (Decl); + when Iir_Kind_Architecture_Declaration => + Disp_Architecture_Declaration (Decl); + when Iir_Kind_Package_Declaration => + Disp_Package_Declaration (Decl); + when Iir_Kind_Package_Body => + Disp_Package_Body (Decl); + when Iir_Kind_Configuration_Declaration => + Disp_Configuration_Declaration (Decl); + when others => + Error_Kind ("disp_design_unit2", Decl); + end case; + New_Line (2); + end Disp_Design_Unit; + + procedure Disp_Vhdl (An_Iir: Iir) is + begin + Set_Line_Length (80); + -- Put (Count'Image (Line_Length)); + case Get_Kind (An_Iir) is + when Iir_Kind_Design_Unit => + Disp_Design_Unit (An_Iir); + when Iir_Kind_Character_Literal => + Disp_Character_Literal (An_Iir); + when Iir_Kind_Enumeration_Type_Definition => + Disp_Enumeration_Type_Definition (An_Iir); + when Iir_Kind_Enumeration_Subtype_Definition => + Disp_Enumeration_Subtype_Definition (An_Iir); + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + Disp_Concurrent_Conditional_Signal_Assignment (An_Iir); + when Iir_Kinds_Dyadic_Operator => + Disp_Dyadic_Operator (An_Iir); + when Iir_Kind_Signal_Interface_Declaration => + Disp_Name_Of (An_Iir); + when Iir_Kind_Signal_Declaration => + Disp_Identifier (An_Iir); + when Iir_Kind_Enumeration_Literal => + Disp_Identifier (An_Iir); + when Iir_Kind_Component_Instantiation_Statement => + Disp_Component_Instantiation_Statement (An_Iir); + when Iir_Kind_Integer_Subtype_Definition => + Disp_Integer_Subtype_Definition (An_Iir); + when Iir_Kind_Array_Subtype_Definition => + Disp_Array_Subtype_Definition (An_Iir); + when Iir_Kind_Array_Type_Definition => + Disp_Array_Type_Definition (An_Iir); + when Iir_Kind_Package_Declaration => + Disp_Package_Declaration (An_Iir); + when Iir_Kind_Wait_Statement => + Disp_Wait_Statement (An_Iir); + when Iir_Kind_Selected_Name => + Disp_Name (An_Iir); + when others => + Error_Kind ("disp", An_Iir); + end case; + end Disp_Vhdl; + + procedure Disp_Int64 (Val: Iir_Int64) + is + Str: String := Iir_Int64'Image (Val); + begin + if Str(Str'First) = ' ' then + Put (Str (Str'First + 1 .. Str'Last)); + else + Put (Str); + end if; + end Disp_Int64; + + procedure Disp_Int32 (Val: Iir_Int32) + is + Str: String := Iir_Int32'Image (Val); + begin + if Str(Str'First) = ' ' then + Put (Str (Str'First + 1 .. Str'Last)); + else + Put (Str); + end if; + end Disp_Int32; + + procedure Disp_Fp64 (Val: Iir_Fp64) + is + Str: String := Iir_Fp64'Image (Val); + begin + if Str(Str'First) = ' ' then + Put (Str (Str'First + 1 .. Str'Last)); + else + Put (Str); + end if; + end Disp_Fp64; +end Disp_Vhdl; diff --git a/disp_vhdl.ads b/disp_vhdl.ads new file mode 100644 index 000000000..592c786a9 --- /dev/null +++ b/disp_vhdl.ads @@ -0,0 +1,36 @@ +-- VHDL regeneration from internal nodes. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Iirs; use Iirs; + +package Disp_Vhdl is + -- General procedure to display a node. + -- Mainly used to dispatch to other functions according to the kind of + -- the node. + procedure Disp_Vhdl (An_Iir: Iir); + + -- Disp an iir_int64, without the leading blank. + procedure Disp_Int64 (Val: Iir_Int64); + + -- Disp an iir_int32, without the leading blank. + procedure Disp_Int32 (Val: Iir_Int32); + + -- Disp an iir_Fp64, without the leading blank. + procedure Disp_Fp64 (Val: Iir_Fp64); +end Disp_Vhdl; + diff --git a/doc/ghdl.texi b/doc/ghdl.texi new file mode 100644 index 000000000..4824cdf84 --- /dev/null +++ b/doc/ghdl.texi @@ -0,0 +1,2371 @@ +\input texinfo @c -*-texinfo-*- +@c %**start of header +@setfilename ghdl.info +@settitle GHDL guide +@c %**end of header + +@titlepage +@title GHDL guide +@subtitle GHDL, a VHDL compiler +@subtitle For GHDL version 0.19 (Sokcho edition) +@author Tristan Gingold +@c The following two commands start the copyright page. +@page +@vskip 0pt plus 1filll +Copyright @copyright{} 2002, 2003, 2004, 2005 Tristan Gingold. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.1 or +any later version published by the Free Software Foundation. +@end titlepage + +@ignore +Part I: User guide +1) Intro: what is vhdl, what is ghdl +2) starting with ghdl: a few examples +2.1) hello world +2.2) a nand gate +2.3) testsuite for a nand gate +2.4) a nand3 gate (using components) +2.5) testsuite for the nand3 + +Part II: Reference guide +1) command line options +1.1) filename extension. +2) Current standards +2.w) what is 93c +3) Linking with Ada or C code. FOREIGN use. +3) library organization +4) built-in libraries and pathes. +5) debugging your program. +6) report messages (run time errors, boundary errors, assertion) +7) Error message, improve it. +8) current bugs, how to report a bug. +9) Copyright + +done: ?) source representation +done: ?) copyright +done: ?) debugging +done: ?) executable options +done: ?) top entity characteristics +done: ?) work library +done: ?) ieee library +done: ?) file format (textio/not textio) + +TODO: +XX: indexes +XXX: signals cannot be forced, only viewed in depth. +x: implementation dependant: files (see 4.3.1.4) + +To check: +model vs modeling vs modelize +behaviour vs behavior +analyze vs analyse + +Internal overview + ortho + grt subprograms +@end ignore + +@contents + +@ifnottex +@node Top +@top GHDL guide +GHDL, a VHDL compiler. + +Copyright @copyright{} 2002, 2003, 2004 Tristan Gingold. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.1 +or any later version published by the Free Software Foundation. + +@menu +* Introduction:: What is GHDL, what is VHDL +* Starting with GHDL:: Build a VHDL program with GHDL +* Invoking GHDL:: +* Simulation and run time:: +* GHDL implementation of VHDL:: +* GHDL implementation of VITAL:: +* Flaws and bugs report:: +* Copyrights:: +* Index:: + +@end menu + +@end ifnottex + +@node Introduction, Starting with GHDL, Top, Top +@comment node-name, next, previous, up +@chapter Introduction + +@menu +* What is VHDL:: +* What is GHDL:: +@end menu + +@section Content of this manual +This manual is the user and reference manual for GHDL. It does not +contain an introduction to VHDL. Thus, the reader should have at least +a basic knowledge of VHDL. A good knowledge of VHDL language reference +manual (usually called LRM) is a plus. + +@c FIXME: references: URL, LRM reference. + +@node What is VHDL, What is GHDL, Introduction, Introduction +@comment node-name, next, previous, up +@section What is @code{VHDL}? +@dfn{VHDL} is an acronym for Very High Speed Integrated Circuit Hardware +Description Language which is a programming language used to describe a +logic circuit by function, data flow behaviour, or structure. + +@code{VHDL} @emph{is} a programming language: although @code{VHDL} was +not designed for writing general purpose programs, you can write any +algorithm with the @code{VHDL} language. If you are able to write +programs, you will find in @code{VHDL} features similar to those found +in procedural languages such as @code{C}, @code{Pascal} or @code{Ada}. +@code{VHDL} derives most of its syntax and semantics from @code{Ada}. +Knowing @code{Ada} is an advantage for learning @code{VHDL} (it is an +advantage in general as well). + +However, @code{VHDL} was not designed as a general purpose language but as an +@code{HDL} (hardware description language). As the name implies, @code{VHDL} +aims at modeling or documenting electronics systems. Due to the nature +of hardware components which are always running, @code{VHDL} is a highly +concurrent language, built upon an event-based timing model. + +Like a program written in any other language, a @code{VHDL} program +can be executed. Since @code{VHDL} is used to model designs, the term +@dfn{simulation} is often used instead of @dfn{execution}, with the +same meaning. + +Like a program written in another hardware description language, a +@code{VHDL} program can be transformed with a @code{synthesis tool} +into a netlist, that is, a detailed gate-level implementation. + +@node What is GHDL, , What is VHDL, Introduction +@comment node-name, next, previous, up +@section What is @code{GHDL}? +@dfn{GHDL} is a shorthand for G Hardware Design Language. Currently, +@code{G} has no meaning. + +@dfn{GHDL} is a @code{VHDL} compiler that can execute (nearly) any +@code{VHDL} program. @code{GHDL} is @emph{not} a synthesis tool: you cannot +create a netlist with @code{GHDL}. + +Unlike some other simulators, @code{GHDL} is a compiler: it directly +translates a @code{VHDL} file to machine code, using the @code{GCC} +back-end and without using an intermediary language such as @code{C} +or @code{C++}. Therefore, the compiled code should be faster and +the analysis time should be shorter than with a compiler using an +intermediary language. + +The current version of @code{GHDL} does not contain any graphical +viewer: you cannot see signal waves. You can still check with a test +bench. The current version can produce a @code{VCD} file which can be +viewed with a wave viewer. + +@code{GHDL} aims at implementing @code{VHDL} as defined by IEEE 1076. +It supports most of the 1987 standard and most features added by the +1993 standard. + + +@node Starting with GHDL, Invoking GHDL, Introduction, Top +@comment node-name, next, previous, up +@chapter Starting with GHDL +In this chapter, you will learn how to use the GHDL compiler by +working on two examples. + +@menu +* The hello word program:: +* A full adder:: +* Starting with a design:: +@end menu + +@node The hello word program, A full adder, Starting with GHDL, Starting with GHDL +@comment node-name, next, previous, up +@section The hello world program +To illustrate the large purpose of VHDL, here is a commented VHDL +"Hello world" program. + +@example +-- @r{Hello world program.} +use std.textio.all; -- @r{Imports the standard textio package.} + +-- @r{Defines a design entity, without any ports.} +entity hello_world is +end hello_world; + +architecture behaviour of hello_world is +begin + process + variable l : line; + begin + write (l, String'("Hello world!")); + writeline (output, l); + wait; + end process; +end behaviour; +@end example + +Suppose this program is contained in the file @file{hello.vhdl}. +First, you have to compile the file; this is called @dfn{analysis} of a design +file in VHDL terms. +@smallexample +$ ghdl -a hello.vhdl +@end smallexample +This command generates a file @file{hello.o}, which is the object file +corresponding to your VHDL program. This command also creates or updates +a file @file{work-obj93.cf}, which describes the library @samp{work}. + +Then, you have to build an executable file. +@smallexample +$ ghdl -e hello_world +@end smallexample +The @samp{-e} option means @dfn{elaborate}. With this option, @code{GHDL} +creates code in order to elaborate a design, with the @samp{hello} +entity at the top of the hierarchy. + +The result is an executable program called @file{hello} which can be run: +@smallexample +$ ghdl -r hello_world +@end smallexample +or directly: +@smallexample +$ ./hello_world +@end smallexample + +and which should display: +@smallexample +Hello world! +@end smallexample + +@node A full adder, Starting with a design, The hello word program, Starting with GHDL +@comment node-name, next, previous, up +@section A full adder +VHDL is generally used for hardware design. This example starts with +a full adder described in the @file{adder.vhdl} file: + +@example +entity adder is + -- @r{@var{i0}, @var{i1} and the carry-in @var{ci} are inputs of the adder.} + -- @r{@var{s} is the sum output, @var{co} is the carry-out.} + port (i0, i1 : in bit; ci : in bit; s : out bit; co : out bit); +end adder; + +architecture rtl of adder is +begin + -- @r{This full-adder architecture contains two concurrent assignment.} + -- @r{Compute the sum.} + s <= i0 xor i1 xor ci; + -- @r{Compute the carry.} + co <= (i0 and i1) or (i0 and ci) or (i1 and ci); +end rtl; +@end example + +You can analyze this design file: +@smallexample +$ ghdl -a adder.vhdl +@end smallexample + +You can try to execute the @samp{adder} design, but this is useless, +since nothing externally visible will happen. In order to +check this full adder, a testbench has to be run. This testbench is +very simple, since the adder is also simple: it checks exhaustively all +inputs. Note that only the behaviour is tested, timing constraints are +not checked. The file @file{adder_tb.vhdl} contains the testbench for +the adder: +@example +-- @r{A testbench has no ports.} +entity adder_tb is +end adder_tb; + +architecture behav of adder_tb is + -- @r{Declaration of the component that will be instantiated.} + component adder + port (i0, i1 : in bit; ci : in bit; s : out bit; co : out bit); + end component; + -- @r{Specifies which entity is bound with the component.} + for adder_0: adder use entity work.adder; + signal i0, i1, ci, s, co : bit; +begin + -- @r{Component instantiation.} + adder_0: adder port map (i0 => i0, i1 => i1, ci => ci, + s => s, co => co); + + -- @r{This process does the real job.} + process + type pattern_type is record + -- @r{The inputs of the adder.} + i0, i1, ci : bit; + -- @r{The expected outputs of the adder.} + s, co : bit; + end record; + -- @r{The patterns to apply.} + type pattern_array is array (natural range <>) of pattern_type; + constant patterns : pattern_array := + (('0', '0', '0', '0', '0'), + ('0', '0', '1', '1', '0'), + ('0', '1', '0', '1', '0'), + ('0', '1', '1', '0', '1'), + ('1', '0', '0', '1', '0'), + ('1', '0', '1', '0', '1'), + ('1', '1', '0', '0', '1'), + ('1', '1', '1', '1', '1')); + begin + -- @r{Check each pattern.} + for i in patterns'range loop + -- @r{Set the inputs.} + i0 <= patterns(i).i0; + i1 <= patterns(i).i1; + ci <= patterns(i).ci; + -- @r{Wait for the results.} + wait for 1 ns; + -- @r{Check the outputs.} + assert s = patterns(i).s + report "bad sum value" severity error; + assert co = patterns(i).co + report "bad carray out value" severity error; + end loop; + assert false report "end of test" severity note; + -- @r{Wait forever; this will finish the simulation.} + wait; + end process; +end behav; +@end example + +As usual, you should analyze the design: +@smallexample +$ ghdl -a adder_tb.vhdl +@end smallexample +And build an executable for the testbench: +@smallexample +$ ghdl -e adder_tb +@end smallexample +You do not need to specify which object files are required: GHDL knows them +and automatically adds them in the executable. Now, it is time to run the +testbench: +@smallexample +$ ghdl -r adder_tb +adder_tb.vhdl:52:7:(assertion note): end of test +@end smallexample + +If your design is rather complex, you'd like to inspect signals. Signals +value can be dumped using the VCD file format. The resulting file can be +read with a wave viewer such as GTKWave. First, you should simulate your +design and dump a waveform file: +@smallexample +$ ghdl -r adder_tb --vcd=adder.vcd +@end smallexample +Then, you may now view the waves: +@smallexample +$ gtkwave adder.vcd +@end smallexample + +@xref{Simulation options}, for more details on the @option{--vcd} option and +other run time options. + +@node Starting with a design, , A full adder, Starting with GHDL +@comment node-name, next, previous, up +@section Starting with a design +Unless you are only studying VHDL, you will work with bigger designs than +the ones of the previous examples. + +Let's see how to analyze and run a bigger design, such as the DLX model +suite written by Peter Ashenden which is distributed under the terms of the +GNU General Public License. + +First, untar the sources: +@smallexample +$ tar zxvf dlx.tar.Z +@end smallexample + +In order not to pollute the sources with the library, it is a good idea +to create a @file{work/} subdirectory for the @samp{WORK} library. To +any GHDL commands, we will add the @option{--workdir=work} option, so +that all files generated by the compiler (except the executable) will be +placed in this directory. +@smallexample +$ cd dlx +$ mkdir work +@end smallexample + +We will run the @samp{dlx_test_behaviour} design. We need to analyze +all the design units for the design hierarchy, in the correct order. +GHDL provides an easy way to do this, by importing the sources: +@smallexample +$ ghdl -i --workdir=work *.vhdl +@end smallexample + +and making a design: +@smallexample +$ ghdl -m --workdir=work dlx_test_behaviour +@end smallexample + +Before this second stage, GHDL knows all the design units of the DLX, +but no one have been analyzed. The make command of GHDL analyzes and +elaborates a design. This creates many files in the @file{work/} +directory, and the @file{dlx_test_behaviour} executable in the current +directory. + +The simulation needs to have a DLX program contained in the file +@file{dlx.out}. This memory image will be be loaded in the DLX memory. +Just take one sample: +@smallexample +$ cp test_loop.out dlx.out +@end smallexample + +And you can run the test suite: +@smallexample +$ ghdl -r dlx_test_behaviour +@end smallexample + +The test bench monitors the bus and displays each instruction executed. +It finishes with an assertion of severity level note: +@smallexample +dlx-behaviour.vhdl:395:11:(assertion note): TRAP instruction + encountered, execution halted +@end smallexample + +Since the clock is still running, you have to manually stop the program +with the @kbd{C-c} key sequence. This behavior prevents you from running the +test bench in batch mode. However, you may force the simulator to +stop when an assertion above or equal a certain severity level occurs: +@smallexample +$ ghdl -r dlx_test_behaviour --assert-level=note +@end smallexample + +With this option, the program stops just after the previous message: +@smallexample +dlx-behaviour.vhdl:395:11:(assertion note): TRAP instruction + encountered, execution halted +error: assertion failed +@end smallexample + +If you want to make room on your hard drive, you can either: +@itemize @bullet{} +@item +clean the design library with the GHDL command: +@smallexample +$ ghdl --clean --workdir=work +@end smallexample +This removes the executable and all the object files. If you want to +rebuild the design at this point, just do the make command as shown above. +@item +remove the design library with the GHDL command: +@smallexample +$ ghdl --remove --workdir=work +@end smallexample +This removes the executable, all the object files and the library file. +If you want to rebuild the design, you have to import the sources again, +and to make the design. +@item +remove the @file{work/} directory: +@smallexample +$ rm -rf work +@end smallexample +Only the executable is kept. If you want to rebuild the design, create +the @file{work/} directory, import the sources, and make the design. +@end itemize + +Sometimes, a design does not fully follow the VHDL standards. For example it +uses the badly engineered @samp{std_logic_unsigned} package. GHDL supports +this VHDL dialect through some options: +@smallexample +--ieee=synopsys -fexplicit +@end smallexample +@xref{IEEE library pitfalls}, for more details. + +@node Invoking GHDL, Simulation and run time, Starting with GHDL, Top +@comment node-name, next, previous, up +@chapter Invoking GHDL +The form of the @code{ghdl} command is + +@smallexample +$ ghdl @var{command} [@var{options@dots{}}] +@end smallexample + +The GHDL program has several commands. The first argument selects +the commands. The options are used to slighly modify the action. + +No options are allowed before the command. Except for the run commands, +no options are allowed after a filename or a unit name. + +@menu +* Building commands:: +* GHDL options:: +* Passing options to other programs:: +* GHDL warnings:: +* Rebuilding commands:: +* Library commands:: +* Cross-reference command:: +* File commands:: +* Misc commands:: +* IEEE library pitfalls:: +@end menu + +@node Building commands, GHDL options, Invoking GHDL, Invoking GHDL +@comment node-name, next, previous, up +@section Building commands +The mostly used commands of GHDL are those to analyze and elaborate a design. + +@menu +* Analysis command:: +* Elaboration command:: +* Run command:: +* Elaborate and run command:: +* Bind command:: +* Link command:: +* List link command:: +* Check syntax command:: +* Analyze and elaborate command:: +@end menu + +@node Analysis command, Elaboration command, Building commands, Building commands +@comment node-name, next, previous, up +@subsection Analysis command +@cindex analysis +@cindex @option{-a} command +@smallexample +$ ghdl -a [@var{options}] @var{files} +@end smallexample + +The @dfn{analysis} command compiles one or more files, and creates an +object file for each source file. The analysis command is selected with +@var{-a} switch. Any argument starting with a dash is a option, the +others are filenames. No options are allowed after a filename +argument. GHDL analyzes each filename in the given order, and stops the +analysis in case of error (the following files are not analyzed). +@c FIXME: check this. + +@xref{GHDL options}, for details on the GHDL options. For example, +to produce debugging information such as line numbers, use: + +@smallexample +$ ghdl -a -g my_design.vhdl +@end smallexample + +@node Elaboration command, Run command, Analysis command, Building commands +@comment node-name, next, previous, up +@subsection Elaboration command +@cindex elaboration +@cindex @option{-e} command +@smallexample +$ ghdl -e [@var{options}] @var{primary_unit} [@var{secondary_unit}] +@end smallexample + +The @dfn{elaboration} command creates an executable containing the +code of the @code{VHDL} sources, the elaboration code and simulation +code to execute a design hiearachy. The elaboration command is selected +with @var{-e} switch, and must be followed by either: + +@itemize @bullet +@item a name of a configuration unit +@item a name of an entity unit +@item a name of an entity unit followed by a name of an architecture unit +@end itemize + +Name of the units must be a simple name, without any dot. You can +select the name of the @samp{WORK} library with the @option{--work=NAME} +option, as described in @ref{GHDL options}. + +@xref{Top entity}, for the restrictions on the root design of a +hierarchy. + +The file name of the executable is the name of the primary unit, or for +the later case, the concatenation of the name of the primary unit, a +dash, and the name of the secondary unit (or architecture). + +The @option{-o} followed by a file name can override the default +executable file name. + +For the elaboration command, @code{GHDL} re-analyzes all the +configurations, entities, architectures and package declarations, and +creates the default configurations and the default binding indications +according to the LRM rules. It also generates the list of objects files +required for the executable. Then, it links all these files with the +run time library. + +The actual elaboration is performed at run-time. + +@node Run command, Elaborate and run command, Elaboration command, Building commands +@comment node-name, next, previous, up +@subsection Run command +@cindex run +@cindex @option{-r} command +Run (or simulate) an elaborated design hierarchy. + +@smallexample +$ ghdl -r @var{primary_unit} [@var{secondary_unit}] [@var{simulation_options}] +@end smallexample + +The arguments are the same as the @xref{Elaboration command}. This command +simply build the filename of the executable and execute it. You may also +directly execute the program. + +This command exists for three reasons: +@itemize @bullet{} +@item +You don't have to create the executable program name. +@item +It is coherent with the @samp{-a} and @samp{-e} commands. +@item +It will work with future implementations, where the code is generated in +memory. +@end itemize + +@xref{Simulation and run time}, for details on options. + +@node Elaborate and run command, Bind command, Run command, Building commands +@comment node-name, next, previous, up +@subsection Elaborate and run command +@cindex elaborate and run +@cindex @option{--elab-run} command +Elaborate and then simulate a design unit. + +@smallexample +$ ghdl --elab-run [@var{elab_options}] @var{primary_unit} [@var{secondary_unit}] [@var{run_options}] +@end smallexample + +This command acts like the elaboration command (@pxref{Elaboration command}) +followed by the run command (@pxref{Run command}). + +@node Bind command, Link command, Elaborate and run command, Building commands +@subsection Bind command +@cindex binding +@cindex @option{--bind} command +Bind a design unit and prepare the link step. + +@smallexample +$ ghdl --bind [@var{options}] @var{primary_unit} [@var{secondary_unit}] +@end smallexample + +This performs only the first stage of the elaboration command; the list +of objects files is created but the executable is not built. This +command should be used only when the main entry point is not ghdl. + +@node Link command, List link command, Bind command, Building commands +@subsection Link command +@cindex linking +@cindex @option{--link} command +Link an already bound design unit. + +@smallexample +$ ghdl --link [@var{options}] @var{primary_unit} [@var{secondary_unit}] +@end smallexample + +This performs only the second stage of the elaboration command: the +executable is created by linking the files of the object files list. +This command is available only for completness. The elaboration command is +equivalent to the bind command followed by the link command. + +@node List link command, Check syntax command, Link command, Building commands +@subsection List link command +@cindex @option{--list-link} command +Disp files which will be linked. + +@smallexample +$ ghdl --list-link @var{primary_unit} [@var{secondary_unit}] +@end smallexample + +This command may be used only after a bind command. GHDL displays all +the files which will be linked to create an executable. This command is +intended to add object files in a link of an foreign program. + +@node Check syntax command, Analyze and elaborate command, List link command, Building commands +@subsection Check syntax command +@cindex checking syntax +@cindex @option{-s} command +Analyze files but do not generate code. + +@smallexample +$ ghdl -a [@var{options}] @var{files} +@end smallexample + +This command may be used to check the syntax of files. It does not update +the library. + +@node Analyze and elaborate command, , Check syntax command, Building commands +@subsection Analyze and elaborate command +@cindex Analyze and elaborate command +@cindex @option{-c} command +Analyze files and elaborate in the same time. + +@smallexample +$ ghdl -c [@var{options}] @var{file}@dots{} -e @var{primary_unit} [@var{secondary_unit}] +@end smallexample + +This command combines analyze and elaboration: @var{file}s are analyzed and +the unit is then elaborated. However, code is only generated during the +elaboration. + +To be more precise, the files are first parsed, and then the elaboration +drives the analysis. Therefore, there is no analysis order, and you don't +need to care about it. + +All the units of the files are put into the @samp{work} library. But, the +work library is neither read from disk nor saved. Therefore, you must give +all the files of the @samp{work} library your design needs. + +The advantages over the traditionnal approach (analyze and then elaborate) are: +@itemize +@item +The compilation cycle is achieved in one command. +@item +Since the files are only parsed once, the compilation cycle may be faster. +@item +You don't need to know an analysis order +@item +This command produces smaller executable, since unused units and subprograms +do not generate code. +@end itemize +However, you should know that currently most of the time is spent in code +generation and the analyze and elaborate command generate code for all units +needed, even units of @samp{std} and @samp{ieee} libraries. Therefore, +according to the design, the time for this command may be higher than the time +for the analyze command followed by the elaborate command. + +This command is still experimental. In case of problems, you should go back +to the traditionnal way. + +@comment node-name, next, previous, up +@node GHDL options, Passing options to other programs, Building commands, Invoking GHDL +@comment node-name, next, previous, up +@section GHDL options +@cindex IEEE 1164 +@cindex 1164 +@cindex IEEE 1076.3 +@cindex 1076.3 +@c document gcc options +Besides the options described below, @code{GHDL} passes any debugging options +(those that begin with @option{-g}) and optimizations options (those that +begin with @option{-O} or @option{-f}) to @code{GCC}. Refer to the @code{GCC} +manual for details. + +@table @code +@item --work=@var{NAME} +@cindex @option{--work} switch +@cindex WORK library +Specify the name of the @samp{WORK} library. Analyzed units are always +placed in the library logically named @samp{WORK}. With this option, +you can set its name. By default, the name is @var{work}. + +@code{GHDL} checks @samp{WORK} is a valid identifier. Although being +more or less supported, the @samp{WORK} identifier should not be an +extended identifier, since the filesystem may prevent it from correctly +working (due to case sensitivity or forbidden characters in filenames). + +@code{VHDL} rules forbides you to add units in the @samp{std} library. +Furthermode, you should not put units in the @samp{ieee} library. + +@item --workdir=@var{PATH} +@cindex @option{--workdir} switch +Specify the directory where the @samp{WORK} library is. When this +option is not present, the @samp{WORK} library is in the current +directory. The object files created by the compiler are always placed +in the same directory as the @samp{WORK} library. + +@item --std=@var{STD} +@cindex @option{--std} switch +Specify the standard to use. By default, the standard is @samp{93c}, which +means VHDL-93 accepting VHDL-87 syntax. For details on @var{STD} values see +@ref{VHDL standards}. + +@item --ieee=@var{VER} +@cindex @option{--ieee} switch +@cindex ieee library +@cindex synopsys library +@cindex mentor library +Select the @code{IEEE} library to use. @var{VER} must be one of: + +@table @samp +@item none +Do not supply an @code{IEEE} library. Any library clause with the @samp{IEEE} +identifier will fail, unless you have created by your own a library with +the @code{IEEE} name. + +@item standard +Supply an @code{IEEE} library containing only packages defined by +@sc{ieee} standards. Currently, there are the multivalue logic system +packages @samp{std_logic_1164} defined by IEEE 1164, the synthesis +packages , @samp{numeric_bit} and @samp{numeric_std} defined by IEEE +1076.3, and the @sc{vital} packages @samp{vital_timing} and +@samp{vital_primitives}, defined by IEEE 1076.4. The version of these +packages is defined by the VHDL standard used. @xref{VITAL packages}, +for more details. + +@item synopsys +Supply the former packages and the following additionnal packages: +@samp{std_logic_arith}, @samp{std_logic_signed}, +@samp{std_logic_unsigned}, @samp{std_logic_textio}. +@c @samp{std_logic_misc}. +These packages were created by some companies, and are popular. However +they are not standard packages, and have been placed in the @code{IEEE} +library without the @sc{ieee} permission. + +@item mentor +Supply the standardr packages and the following additionnal package: +@samp{std_logic_arith}. The package is a slight variation on a definitly +not standard but widely mis-used package. +@end table + +To avoid errors, you must use the same @code{IEEE} library for all units of +your design, and during elaboration. + +@item -P@var{PATH} +@cindex @option{-P} switch +Add @var{PATH} to the end of the list of directories to be searched for +library files. + +The @code{WORK} library is always searched in the path specified by the +@option{--workdir=} option, or in the current directory if the later +option is not specified. + +@item -fexplicit +@cindex @option{-fexplicit} switch +When two operators are overloaded, give preference to the explicit declaration. +This may be used to avoid the most common pitfall of the @samp{std_logic_arith} +package. @xref{IEEE library pitfalls}, for an example. + +This option is not set by default. I don't think this option is a +good feature, because it breaks the encapsulation rule. When set, an +operator can be silently overriden in another package. You'd better to fix +your design and use the @samp{numeric_std} package. + +@item --no-vital-checks +@item --vital-checks +@cindex @option{--no-vital-checks} switch +@cindex @option{--vital-checks} switch +Disable or enable checks of restriction on VITAL units. Checks are enabled +by default. + +Checks are performed only when a design unit is decorated by a VITAL attribute. +The VITAL attributes are @samp{VITAL_Level0} and @samp{VITAL_Level1}, both +declared in the @samp{ieee.VITAL_Timing} package. + +Currently, VITAL checks are only partially implemented. @xref{VHDL +restrictions for VITAL}, for more details. + +@item --GHDL1=@var{COMMAND} +@cindex @option{--GHLD1} switch +Use @var{COMMAND} as the command name for the compiler. If @var{COMMAND} is +not a path, then it is search in the list of program directories. + +@item -v +Be verbose. For example, for analysis, elaboration and make commands, GHDL +displays the commands executed. +@end table + +@node Passing options to other programs, GHDL warnings, GHDL options, Invoking GHDL +@comment node-name, next, previous, up +@section Passing options to other programs +For many commands, @code{GHDL} acts as a driver: it invokes programs to perform +the command. You can pass arbritrary options to these programs. + +Both the compiler and the linker are in fact GCC programs. @xref{Invoking GCC, +GCC options, GCC Command Options, gcc, GCC manual}, for details on GCC +options. + +@table @code +@item -Wc,@var{OPTION} +@cindex @option{-W} switch +Pass @var{OPTION} as an option to the compiler. + +@item -Wa,@var{OPTION} +@cindex @option{-Wa} switch +Pass @var{OPTION} as an option to the assembler. + +@item -Wl,@var{OPTION} +@cindex @option{-Wl} switch +Pass @var{OPTION} as an option to the linker. +@end table + +@node GHDL warnings, Rebuilding commands, Passing options to other programs, Invoking GHDL +@comment node-name, next, previous, up +@section GHDL warnings +Some contructions are not erroneous but dubious. Warnings are diagnostic +messages that report such constructions. Some warnings are reported only +during analysis, others during elaboration. + +@table @code +@item --warn-reserved +@cindex @option{--warn-reserved} switch +Emit a warning if an identifier is a reserved word in a latter VHDL standard. + +@item --warn-default-binding +@cindex @option{--warn-default-binding} switch +During analyze, warns if a component instantiation has neither +configuration specification nor default binding. This may be usefull if you +want to detect during analyze possibly unbound component if you don't use +configuration. @xref{VHDL standards}, for more details about default binding +rules. + +@item --warn-binding +@cindex @option{--warn-binding} switch +During elaboration, warns if a component instantiation is not bound +(and not explicitly left unbound). Also warns if a port of an entity +is not bound in a configuration specification or in a component +configuration. This warning is enabled by default, since default +binding rules are somewhat complex and an unbound component is most +often unexpected. + +However, warnings are even emitted if a component instantiation is +inside a generate statement. As a consequence, if you use conditionnal +generate statement to select a component according to the implementation, +you will certainly get warnings. + +@item --warn-library +@cindex @option{--warn-library} switch +Warns if a design unit replaces another design unit with the same name. + +@item --warn-vital-generic +@cindex @option{--warn-vital-generic} switch +Warns if a generic name of a vital entity is not a vital generic name. This +is set by default. + +@item --warn-delayed-checks +@cindex @option{--warn-delayed-checks} switch +Warns for checks that cannot be done during analysis time and are postponed to +elaboration time. These checks are checks for no wait statement in a procedure +called in a sensitized process. If the body of the procedure is not known +at analysis time, the check will be performed during elaboration. + +@item --warn-body +@cindex @option{--warn-body} switch +Emit a warning if a package body which is not required is analyzed. If a +package does not declare a subprogram or a deferred constant, the package +does not require a body. + +@item --warn-specs +@cindex @option{--warn-specs} switch +Emit a warning if an all or others specification does not apply. + +@item --warn-unused +@cindex @option{--warn-unused} switch +Emit a warning when a subprogram is never used. + +@item --warn-error +@cindex @option{--warn-error} switch +When this option is set, warnings are considered as errors. + +@end table + +@node Rebuilding commands, Library commands, GHDL warnings, Invoking GHDL +@comment node-name, next, previous, up +@section Rebuilding commands +Analyzing and elaborating a design consisting in severals files can be tricky, +due to dependences. GHDL has a few commands to rebuild a design. + +@menu +* Import command:: +* Make command:: +* Generate Makefile command:: +@end menu + +@node Import command, Make command, Rebuilding commands, Rebuilding commands +@comment node-name, next, previous, up +@subsection Import command +@cindex importing files +@cindex @option{-i} coomand +Add files in the work design library. + +@smallexample +$ ghdl -i [@var{options}] @var{file}@dots{} +@end smallexample + +All the files specified in the command line are scanned, parsed and added in +the libraries but as not yet analyzed. No object files are created. + +The purpose of this command is to localize design units in the design files. +The make command will then be able to recursively build a hierarchy from +an entity name or a configuration name. + +Since the files are parsed, there must be correct files. However, since they +are not analyzed, many errors are tolerated by this command. + +Note that all the files are added in the work library. If you have many +libraries, you must use the command for each library. + +@c Due to the LRM rules, there may be many analysis orders, producing +@c different results. For example, if an entity has several architectures, +@c the last architecture analyzed is the default one in default binding +@c indications. + +@xref{Make command}, to actually build the design. + +@node Make command, Generate Makefile command, Import command, Rebuilding commands +@comment node-name, next, previous, up +@subsection Make command +@cindex make +@cindex @option{-m} command +@smallexample +$ ghdl -m [@var{options}] @var{primary} [@var{secondary}] +@end smallexample + +Analyze automatically outdated files and elaborate a design. + +The primary unit denoted by the @var{primary} argument must already be +known by the system, either because you have already analyzed it (even +if you have modified it) or because you have imported it. GHDL analyzes +all outdated files. A file may be outdated because it has been modified +(e.g. you just have edited it), or because a design unit contained in +the file depends on a unit which is outdated. This rule is of course +recursive. + +With the @option{-f} (force) option, GHDL analyzes all the units of the +work library needed to create the design hierarchy. Not outdated units +are recompiled. This is useful if you want to compile a design hierarch +with new compilation flags (for example, to add the @option{-g} +debugging option). + +The make command will only re-analyze design units in the work library. +GHDL fails if it has to analyze an outdated unit from another library. + +The purpose of this command is to be able to compile a design without prior +knowledge of file order. In the VHDL model, some units must be analyzed +before others (e.g. an entity before its architecture). It might be a +nightmare to analyze a full design of several files, if you don't have +the ordered list of file. This command computes an analysis order. + +The make command fails when a unit was not previously parsed. For +example, if you split a file containing several design units into +several files, you must either import these new files or analyze them so +that GHDL knows in which file these units are. + +The make command imports files which have been modified. Then, a design +hierarchy is internally built as if no units are outdated. Then, all outdated +design units, using the dependences of the design hierarchy, are analyzed. +If necessary, the design hierarchy is elaborated. + +This is not perfect, since defaults architecture (the most recently +analyzed one) may change while outdated design files are analyzed. In +such a case, re-run the make command of GHDL. + +@c does not exists: @section GHDL robust make command + +@node Generate Makefile command, , Make command, Rebuilding commands +@comment node-name, next, previous, up +@subsection Generate Makefile command +@cindex @option{--gen-makefile} command +Generate a Makefile to build a design unit. + +@smallexample +$ ghdl --gen-makefile [@var{options}] @var{primary} [@var{secondary}] +@end smallexample + +This command works like the make command (@pxref{Make command}), but only a +makefile is generated on the standard output. + +@node Library commands, Cross-reference command, Rebuilding commands, Invoking GHDL +@comment node-name, next, previous, up +@section Library commands +GHDL has a few commands which act on a library. + +@comment node-name, next, previous, up +@menu +* Directory command:: +* Clean command:: +* Remove command:: +@end menu + +@node Directory command, Clean command, Library commands, Library commands +@comment node-name, next, previous, up +@subsection Directory command +@cindex displaying library +@cindex @option{-d} command +Display the name of the units contained in a design library. +@smallexample +$ ghdl -d [@var{options}] +@end smallexample + +The directory command, selected with the @var{-d} command line argument +displays the content of the work design library. All options are +allowed, but only a few are meaningful: @option{--work=NAME}, +@option{--workdir=PATH} and @option{--std=VER}. + +@node Clean command, Remove command, Directory command, Library commands +@comment node-name, next, previous, up +@subsection Clean command +@cindex cleaning +@cindex @option{--clean} command +Remove object and executable files but keep the library. + +@smallexample +$ ghdl --clean [@var{options}] +@end smallexample + +GHDL tries to remove any object, executable or temporary file it could +have created. Source files are not removed. + +There is no short command line form for this option to prevent accidental +clean up. + +@node Remove command, , Clean command, Library commands +@subsection Remove command +@cindex cleaning all +@cindex @option{--remove} command +Do like the clean command but remove the library too. + +@smallexample +$ ghdl --remove [@var{options}] +@end smallexample + +There is no short command line form for this option to prevent accidental +clean up. Note that after removing a design library, the files are not +known anymore by GHDL. + +@node Cross-reference command, File commands, Library commands, Invoking GHDL +@comment node-name, next, previous, up +@section Cross-reference command +To easily navigate through your sources, you may generate cross-references. + +@smallexample +$ ghdl --xref-html [@var{options}] @var{file}@dots{} +@end smallexample + +This command generates an html file for each @var{file} given in the command +line, with syntax highlighting and full cross-reference: every identifier is +a link to its declaration. Besides, an index of the files is created too. + +The set of @var{file} are analyzed, and then, if the analyze is +successful, html files are generated in the directory specified by the +@option{-o @var{dir}} option, or @file{html/} directory by default. + +If the @option{--format=html2} is specified, then the generated html +files follow the HTML 2.0 standard, and colours are specified with +@samp{} tags. However, colours are hard-coded. + +If the @option{--format=css} is specified, then the generated html files +follow the HTML 4.0 standard, and use the CSS-1 file @file{ghdl.css} to +specify colours. This file is generated only if it does not already exist (it +is never overwritten) and can be customized by the user to change colours or +appearance. Refer to a generated file and its comments for more informations. + +@node File commands, Misc commands, Cross-reference command, Invoking GHDL +@comment node-name, next, previous, up +@section File commands +The following commands act on one or severals files. They do not analysis +files, therefore, they work even if a file has semantic errors. + +@menu +* Pretty print command:: +* Find command:: +* Chop command:: +* Lines command:: +@end menu + +@node Pretty print command, Find command, File commands, File commands +@comment node-name, next, previous, up +@subsection Pretty print command +@cindex @option{--pp-html} command +@cindex pretty printing +@cindex vhdl to html + +Generate HTML on standard output from VHDL. + +@smallexample +$ ghdl --pp-html [@var{options}] @var{file}@dots{} +@end smallexample + +The files are just scanned and an html file, with syntax highlighting is +generated on standard output. + +Since the files are not even parsed, erroneous files or uncomplete designs +can be pretty printed. + +The style of the html file can be modified with the @option{--format=} option. +By default or when the @option{--format=html2} option is specified, the output +is an HTML 2.0 file, with colours set throught @samp{} tags. When the +@option{--format=css} option is specified, the output is an HTML 4.0 file, +with colours set through a CSS file, whose name is @samp{ghdl.css}. +@xref{Cross-reference command}, for more details about this CSS file. + +@node Find command, Chop command, Pretty print command, File commands +@comment node-name, next, previous, up +@subsection Find command +@cindex @option{-f} command +Display the name of the design units in files. + +@smallexample +$ ghdl -f @var{file}@dots{} +@end smallexample + +The files are scanned, parsed and the names of design units are displayed. +Design units marked with two stars are candidate to be at the apex of a +design hierarchy. + + +@node Chop command, Lines command, Find command, File commands +@comment node-name, next, previous, up +@subsection Chop command +@cindex @option{--chop} command +Chop (or split) files at design unit. + +@smallexample +$ ghdl --chop @var{files} +@end smallexample + +@code{GHDL} reads files, and writes a file in the current directory for +every design unit. + +The file name of a design unit is build according to the unit. For an +entity declaration, a package declaration or a configuration the file +name is @file{NAME.vhdl}, where @var{NAME} is the name of the design +unit. For a package body, the file name is @file{NAME-body.vhdl}. +Finally, for an architecture @var{ARCH} of an entity @var{ENTITY}, the +file name is @file{ENTITY-ARCH.vhdl}. + +Since the input files are parsed, this command aborts in case of syntax +error. The command aborts too if a file to be written already exists. + +Comments between design units are stored into the most adequate files. + +This command may be useful to split big files, if your computer has not +enough memory to compile such files. The size of the executable is +reduced too. + +@node Lines command, , Chop command, File commands +@comment node-name, next, previous, up +@subsection Lines command +@cindex @option{--lines} command +Display on the standard output lines of files preceded by line number. + +@smallexample +$ ghdl --lines @var{files} +@end smallexample + +@node Misc commands, IEEE library pitfalls, File commands, Invoking GHDL +@comment node-name, next, previous, up +@section Misc commands +There are a few GHDL commands which are seldom useful. + +@menu +* Help command:: +* Dispconfig command:: +* Disp standard command:: +* Version command:: +@end menu + +@node Help command, Dispconfig command, Misc commands, Misc commands +@subsection Help command +@cindex @option{-h} command +@cindex @option{--help} command +Display (on the standard output) a short description of the all the commands +available. If the help switch is followed by an command switch, then options +for this later command are displayed. + +@smallexample +$ ghdl --help +$ ghdl -h +$ ghdl -h @var{command} +@end smallexample + +@node Dispconfig command, Disp standard command, Help command, Misc commands +@comment node-name, next, previous, up +@subsection Dispconfig command +@cindex @option{--dispconfig} command +@cindex display configuration +Display the program pathes and options used by GHDL. + +@smallexample +$ ghdl --dispconfig [@var{options}] +@end smallexample + +This may be useful to track installation errors. + +@node Disp standard command, Version command, Dispconfig command, Misc commands +@comment node-name, next, previous, up +@subsection Disp standard command +@cindex @option{--disp-standard} command +@cindex display @samp{std.standard} +Display the @samp{std.standard} package: + +@smallexample +$ ghdl --disp-standard [@var{options}] +@end smallexample + +@node Version command, , Disp standard command, Misc commands +@comment node-name, next, previous, up +@subsection Version command +@cindex @option{--version} command +@cindex version +Display the @code{GHDL} version and exit. + +@smallexample +$ ghdl --version +@end smallexample + +@node IEEE library pitfalls, , Misc commands, Invoking GHDL +@comment node-name, next, previous, up +@section IEEE library pitfalls +When you use options @option{--ieee=synopsys} or @option{--ieee=mentor}, +the @code{IEEE} library contains non standard packages such as +@samp{std_logic_arith}. @c FIXME: ref + +These packages are not standard because there are not described by an IEEE +standard, even if they have been put in the @code{IEEE} library. Furthermore, +they are not really de-facto standard, because there a slight differences +between the packages of Mentor and those of Synopsys. + +Furthermore, since they are not well-thought, their use have pitfalls. For +example, this description has error during compilation: +@example +library ieee; +use ieee.std_logic_1164.all; + +-- @r{A counter from 0 to 10}. +entity counter is + port (val : out std_logic_vector (3 downto 0); + ck : std_logic; + rst : std_logic); +end counter; + +library ieee; +use ieee.std_logic_unsigned.all; + +architecture bad of counter +is + signal v : std_logic_vector (3 downto 0); +begin + process (ck, rst) + begin + if rst = '1' then + v <= x"0"; + elsif rising_edge (ck) then + if v = "1010" then -- @r{Error} + v <= x"0"; + else + v <= v + 1; + end if; + end if; + end process; + + val <= v; +end bad; +@end example + +When you analyze this design, GHDL does not accept it (too long lines +have been split for readability): +@smallexample +$ ghdl -a --ieee=synopsys bad_counter.vhdl +bad_counter.vhdl:13:14: operator "=" is overloaded +bad_counter.vhdl:13:14: possible interpretations are: +../../libraries/ieee/std_logic_1164.v93:69:5: implicit function "=" + [std_logic_vector, std_logic_vector return boolean] +../../libraries/synopsys/std_logic_unsigned.vhdl:64:5: function "=" + [std_logic_vector, std_logic_vector return boolean] +../translate/ghdldrv/ghdl: compilation error +@end smallexample +Indeed, the @code{"="} operator is defined in both packages, and both +are visible at the place it is used. The first declaration is an +implicit one, which occurs when the @code{std_logic_vector} type is +declared and is a element to element comparaison, the second one is an +explicit declared function, with the semantic of an unsigned comparaison. + +With some analyser, the explicit declaration has priority on the implicit +declaration, and this design can be analyzed without error. However, this +is not the rule given by the VHDL LRM, and since GHDL follows these rules, +it emits an error. + +You can force GHDL to use this rule with the @option{-fexplicit} option. +@xref{GHDL options}, for more details. + +However it is easy to fix this error, by using a selected name: +@example +library ieee; +use ieee.std_logic_unsigned.all; + +architecture fixed_bad of counter +is + signal v : std_logic_vector (3 downto 0); +begin + process (ck, rst) + begin + if rst = '1' then + v <= x"0"; + elsif rising_edge (ck) then + if ieee.std_logic_unsigned."=" (v, "1010") then + v <= x"0"; + else + v <= v + 1; + end if; + end if; + end process; + + val <= v; +end fixed_bad; +@end example + +It is better to only use the standard packages defined by IEEE, which +provides the same functionnalities: +@example +library ieee; +use ieee.numeric_std.all; + +architecture good of counter +is + signal v : unsigned (3 downto 0); +begin + process (ck, rst) + begin + if rst = '1' then + v <= x"0"; + elsif rising_edge (ck) then + if v = "1010" then + v <= x"0"; + else + v <= v + 1; + end if; + end if; + end process; + + val <= std_logic_vector (v); +end good; +@end example + +@node Simulation and run time, GHDL implementation of VHDL, Invoking GHDL, Top +@comment node-name, next, previous, up +@chapter Simulation and run time + +@menu +* Simulation options:: +* Debugging VHDL programs:: +@end menu + +@node Simulation options, Debugging VHDL programs, Simulation and run time, Simulation and run time +@comment node-name, next, previous, up +@section Simulation options +In most system environments, it is possible to pass options while +invoking a program. Contrary to most programming language, there is no +standard method in VHDL to obtain the arguments or to set the exit +status. + +In GHDL, it is impossible to pass parameters to your design. A later version +could do it through the generics interfaces of the top entity. + +However, the GHDL run time behaviour can be modified with some options; for +example, it is possible to stop simulation after a certain time. + +The exit status of the simulation is @samp{EXIT_SUCCESS} (0) if the +simulation completes, or @samp{EXIT_FAILURE} (1) in case of error +(assertion failure, overflow or any constraint error). + +Here is the list of the most useful options. Some debugging options are +also available, but not described here. The @samp{--help} options lists +all options available, including the debugging one. + +@table @code +@item --assert-level=@var{LEVEL} +@cindex @option{--assert-level} option +Select the assertion level at which an assertion violation stops the +simulation. @var{LEVEL} is the name from the @code{severity_level} +enumerated type defined in the @code{standard} package or the +@samp{none} name. + +By default, only assertion violation of severity level @samp{failure} +stops the simulation. + +For example, if @var{LEVEL} was @samp{warning}, any assertion violation +with severity level @samp{warning}, @samp{error} or @samp{failure} would +stop simulation, but the assertion violation at the @samp{note} severity +level would only display a message. + +@samp{--assert-level=none} prevents any assertion violation to stop +simulation. + +@item --stop-time=@var{TIME} +@cindex @option{--stop-time} option +Stop the simulation after @var{TIME}. @var{TIME} is expressed as a time +value, @emph{without} any space. The time is the simulation time, not +the real clock time. + +For examples: + +@smallexample +$ ./my_design --stop-time=10ns +$ ./my_design --stop-time=ps +@end smallexample + +@item --stop-delta=@var{N} +@cindex @option{--stop-delta} option +Stop the simulation after @var{N} delta cycles in the same current time. +@c Delta cycles is a simulation technic used by VHDL to + +@item --disp-time +@cindex @option{--disp-time} option +@cindex display time +Display the time and delta cycle number as simulation advances. + +@item --disp-tree[@var{=KIND}] +@cindex @option{--disp-tree} option +@cindex display design hierarchy +Display the design hierarchy as a tree of instantiated design entities. +This may be useful to understand the structure of a complex +design. @var{KIND} is optional, but if set must be one of: +@table @samp +@item none +Do not display hierarchy. Same as if the option was not present. +@item inst +Display entities, architectures, instances, blocks and generates statements. +@item proc +Like @samp{inst} but also display processes. +@item port +Like @samp{proc} but display ports and signals too. +@end table +If @var{KIND} is not specified, the hierarchy is displayed with the +@samp{port} mode. + +@item --no-run +@cindex @option{--no-run} option +Do not simulate, only elaborate. This may be used with +@option{--disp-tree} to display the tree without simulating the whole +design. + +@item --vcd=@var{FILENAME} +@cindex @option{--vcd} option +@cindex vcd +@cindex value change dump +@cindex dump of signals +Dump into the VCD file @var{FILENAME} the signal values before each +non-delta cycle. If @var{FILENAME} is @samp{-}, then the standard output is +used, otherwise a file is created or overwritten. + +@dfn{VCD} (value change dump) is a file format defined +by the @code{verilog} standard and used by virtually any wave viewer. + +Since it comes from @code{verilog}, only a few VHDL types can be dumped. GHDL +dumps only signals whose base type is of the following: +@itemize @bullet +@item +types defined in the @samp{std.standard} package: +@itemize @bullet +@item +@samp{bit} +@item +@samp{bit_vector} +@end itemize +@item +types defined in the @samp{ieee.std_logic_1164} package: +@itemize @bullet +@item +@samp{std_ulogic} +@item +@samp{std_logic} (because it is a subtype of @samp{std_ulogic}) +@item +@samp{std_ulogic_vector} +@item +@samp{std_logic_vector} +@end itemize +@item +any integer type +@end itemize + +I have successfully used @code{gtkwave} to view VCD files. + +Currently, there is no way to select signals to be dumped: all signals are +dumped, which can generate big files. + +It is very unfortunate there is no standard or well-known wave file +format supporting VHDL types. If you are aware of such a free format, +please mail me (@pxref{Reporting bugs}). + +@item --wave=@var{FILENAME} +@cindex @option{--wave} option +Write the waveforms into a @code{ghw} (GHdl Waveform) file. Currently, all +the signals are dumped into the waveform file, you cannot select a hierarchy +of signals to be dumped. + +The format of this file was defined by myself and is not yet completly fixed. +It may change slightly. + +There is a patch against @code{gtkwave 1.3.56} on the ghdl website at +@uref{ghdl.free.fr}, so that it can read such files. + +Contrary to VCD files, any VHDL type can be dumped into a GHW file. + +@item --sdf=@var{PATH}=@var{FILENAME} +@item --sdf=min=@var{PATH}=@var{FILENAME} +@item --sdf=typ=@var{PATH}=@var{FILENAME} +@item --sdf=max=@var{PATH}=@var{FILENAME} +@cindex @option{--sdf} option +Do VITAL annotation on @var{PATH} with SDF file @var{FILENAME}. + +@var{PATH} is a path of instances, separated with @samp{.} or @samp{/}. +Any separator can be used. Instances are component instantiation labels, +generate labels or block labels. Currently, you cannot use an indexed name. + +If the option contains a type of delay, that is @option{min=}, +@option{typ=} or @option{max=}, the annotator use respectively minimum, +typical or maximum values. If the option does not contain a type of delay, +the annotator use the typical delay. + +@xref{Backannotation}, for more details. + +@item --stack-max-size=@var{SIZE} +@cindex @option{--stack-max-size} option +Set the maximum size in bytes of the non-sensitized processes stacks. + +If the value @var{SIZE} is followed (without any space) by the @samp{k}, +@samp{K}, @samp{kb}, @samp{Kb}, @samp{ko} or @samp{Ko} multiplier, then +the size is the numeric value multiplied by 1024. + +If the value @var{SIZE} is followed (without any space) by the @samp{m}, +@samp{M}, @samp{mb}, @samp{Mb}, @samp{mo} or @samp{Mo} multiplier, then +the size is the numeric value multiplied by 1024 * 1024 = 1048576. + +Each non-sensitized process has its own stack, while the sensitized processes +share the same and main stack. This stack is the stack created by the +operating system. + +Using too small stacks may result in simulation failure due to lack of memory. +Using too big stacks may reduce the maximum number of processes. + +@item --stack-size=@var{SIZE} +@cindex @option{--stack-size} option +Set the initial size in bytes of the non-sensitized processes stack. +The @var{SIZE} value has the same format as the previous option. + +The stack of the non-sensitized processes grows until reaching the +maximum size limit. + +@item --help +Display a short description of the options accepted by the run time library. +@end table + +@node Debugging VHDL programs, , Simulation options, Simulation and run time +@comment node-name, next, previous, up +@section Debugging VHDL programs +@cindex debugging +@cindex @code{__ghdl_fatal} +@code{GDB} is a general purpose debugger for programs compiled by @code{GCC}. +Currently, there is no VHDL support for @code{GDB}. It may be difficult +to inspect variables or signals in @code{GDB}, however, @code{GDB} is +still able to display the stack frame in case of error or to set a breakpoint +at a specified line. + +@code{GDB} can be useful to precisely catch a run-time error, such as indexing +an array beyond its bounds. All error check subprograms call the +@code{__ghdl_fatal} procedure. Therefore, to catch run-time error, set +a breakpoint like this: +@smallexample +(gdb) break __ghdl_fatal +@end smallexample +When the breakpoint is hit, use the @code{where} or @code{bt} command to +display the stack frames. + +@node GHDL implementation of VHDL, GHDL implementation of VITAL, Simulation and run time, Top +@comment node-name, next, previous, up +@chapter GHDL implementation of VHDL + +This chapter describes several implementation defined aspect of VHDL in GHDL. + +@menu +* VHDL standards:: +* Source representation:: +* Library database:: +* VHDL files format:: +* Top entity:: +* Interfacing to other languages:: +@end menu + +@node VHDL standards, Source representation, GHDL implementation of VHDL, GHDL implementation of VHDL +@comment node-name, next, previous, up +@section VHDL standards +@cindex VHDL standards +@cindex IEEE 1076 +@cindex IEEE 1076a +@cindex 1076 +@cindex 1076a +@cindex v87 +@cindex v93 +@cindex v93c +@cindex v00 +@cindex v02 +This is very unfortunate, but there are many versions of the VHDL language. + +The VHDL language was first standardized in 1987 by IEEE as IEEE 1076-1987, and +is commonly referred as VHDL-87. This is certainly the most important version, +since most of the VHDL tools are still based on this standard. + +Various problems of this first standard have been analyzed by experts groups +to give reasonable ways of interpreting the unclear portions of the standard. + +VHDL was revised in 1993 by IEEE as IEEE 1076-1993. This revision is still +well-known. + +Unfortunatly, VHDL-93 is not fully compatible with VHDL-87, ie some perfectly +valid VHDL-87 programs are invalid VHDL-93 programs. Here are some of the +reasons: + +@itemize @bullet +@item +the syntax of file declaration has changed (this is the most visible source +of incompatibility), +@item +new keywords were introduced (group, impure, inertial, literal, +postponed, pure, reject, rol, ror, shared, sla, sll, sra, srl, +unaffected, xnor), +@item +some dynamic behaviours have changed (the concatenation is one of them), +@item +rules have been added. +@end itemize + +Shared variables were replaced by protected types in the 2000 revision of +the VHDL standard. This modification is also known as 1076a. Note that this +standard is not fully backward compatible with VHDL-93, since the type of a +shared variable must now be a protected type (there was no such restriction +before). + +Minors corrections were added by the 2002 revision of the VHDL standard. This +revision is not fully backward compatible with VHDL-00 since, for example, +the value of the @code{'instance_name} attribute has slighly changed. + +You can select the VHDL standard expected by GHDL with the +@samp{--std=VER} option, where @var{VER} is one of the left column of the +table below: + +@table @samp +@item 87 +Select VHDL-87 standard as defined by IEEE 1076-1987. LRM bugs corrected by +later revisions are taken into account. +@item 93 +Select VHDL-93; VHDL-87 file declarations are not accepted. +@item 93c +Select VHDL-93 standard with relaxed rules: +@itemize @bullet +@item +VHDL-87 file declarations are accepted; +@item +default binding indication rules of VHDL-02 are used. Default binding rules +are often used, but they are particulary obscure before VHDL-02. +@end itemize +@item 00 +Select VHDL-2000 standard, which adds protected types. +@item 02 +Select VHDL-2002 standard (partially implemented). +@end table + +You cannot mix VHDL-87 and VHDL-93 units. A design hierarchy must have been +completly analyzed using either the 87 or the 93 version of the VHDL standard. + +@node Source representation, Library database, VHDL standards, GHDL implementation of VHDL +@comment node-name, next, previous, up +@section Source representation +According to the VHDL standard, design units (i.e. entities, +architectures, packages, package bodies and configurations) may be +independently analyzed. + +Several design units may be grouped into a design file. + +In GHDL, a system file represents a design file. That is, a file compiled by +GHDL may contain one or more design units. + +It is common to have several design units in a design file. + +GHDL does not impose any restriction on the name of a design file +(except that the file name may not contain any control character or +spaces). + +GHDL do not keep a binary representation of the design units analyzed like +other VHDL analyzers. The sources of the design units are re-read when +needed (for example, an entity is re-read when one of its architecture is +analyzed). Therefore, if you delete or modify a source file of a unit +analyzed, GHDL will refuse to use it. + +@node Library database, VHDL files format, Source representation, GHDL implementation of VHDL +@section Library database +Each design unit analyzed is placed into a design library. By default, +the name of this design library is @samp{work}; however, this can be +changed with the @option{--work=NAME} option of GHDL. + +To keep the list of design units in a design library, GHDL creates +library files. The name of these files is @samp{NAME-objVER.cf}, where +@var{NAME} is the name of the library, and @var{VER} the VHDL version (87 +or 93) used to analyze the design units. + +You don't have to know how to read a library file. You can display it +using the @option{-d} of @code{ghdl}. The file contains the name of the +design units, as well as the location and the dependences. + +The format may change with the next version of GHDL. + +@node VHDL files format, Top entity, Library database, GHDL implementation of VHDL +@comment node-name, next, previous, up +@section VHDL files format +@cindex file format +@cindex logical name +VHDL has features to handle files. + +GHDL associates a file logical name (the VHDL file name) to an operating +system file name. The logical name @samp{STD_INPUT} is associated to +the standard input as defined by @samp{stdin} stream of the C library, +while the logical name @samp{STD_OUTPUT} is associated to the standard +output, as defined by the @samp{stdout} stream of the C library. Other +logical name are directly mapped to a file name as defined by the first +(@samp{path}) argument of the @samp{fopen} function of the C library. +For a binary file, the @samp{b} character is appended to the mode argument +(binary mode). + +If multiple file objects are associated with the same external file, a stream +is created for each object, except for the standard input or output. + +GHDL has no internal restrictions on the number of file objects that are +associated at one time with a given external file, but the operating system +may restrict the maximum number of file open at the same time. + +For more details about these point, please refer to your operation system +documentation. + +@c tell more about possible errors. + +There are two kinds of files: binary or text files. + +Text files are files of type @samp{std.textio.text}. The format is the +same as the format of any ascii file. In VHDL-87, only the first 128 +characters (7 bits) are allowed, since the character type has only 128 +literals. The end of line is system dependent. Note that the stdio +functions with the text mode are used to handle text files: the fgets +function is used to read lines. Please, refer to the manual of your C +library for more information. + +There are two kind of binary files, according to the type mark of the +file. According to the VHDL standard, binary files must be read using +the same type they are written. + +If the type mark is a non-composite type (integer, floating type +enumeration, physical), the file is a raw stream: +elements are read or written using the same format as is used to represent +the data in memory. This is highly non-portable, but you should be able +to read file written by a non-@code{GHDL} program. + +If the type mark is a composite type (record or array), the file is composed +of a 2 lines signature, followed by a raw stream. + +@node Top entity, Interfacing to other languages, VHDL files format, GHDL implementation of VHDL +@comment node-name, next, previous, up +@section Top entity +There are some restrictions on the entity being at the apex of a design +hierarchy: + +@itemize @bullet +@item +The generic must have a default value, and the value of a generic is its +default value; +@item +The ports type must be constrained. +@end itemize + +@node Interfacing to other languages, , Top entity, GHDL implementation of VHDL +@comment node-name, next, previous, up@section Interfacing with other languages +@section Interfacing to other languages +@cindex interfacing +@cindex other languages +@cindex foreign +@cindex VHPI +@cindex VHPIDIRECT +You can define a subprogram in a foreign language (such as @code{C} or +@code{Ada}) and import it in a VHDL design. + +@subsection Foreign declarations +Only subprograms (functions or procedures) can be imported, using the foreign +attribute. In this example, the @code{sin} function is imported: + +@example +package math is + function sin (v : real) return real; + attribute foreign of sin : function is "VHPIDIRECT sin"; +end math; + +package body math is + function sin (v : real) return real is + begin + assert false severity failure; + end sin; +end math; +@end example + +A subprogram is made foreign if the @var{foreign} attribute decorates +it. This attribute is declared in the 1993 revision of the +@samp{std.standard} package. Therefore, you cannot use this feature in +VHDL 1987. + +The decoration is achived through an attribute specification. The +attribute specification must be in the same declarative part as the +subprogram and must be after it. This is a general rule for specifications. +The value of the specification must be a locally static string. + +Even when a subprogram is foreign, its body must be present. However, since +it won't be called, you can made it empty or simply but an assertion. + +The value of the attribute must start with @samp{VHPIDIRECT } (an +upper-case keyword followed by one or more blanks). The linkage name of the +subprogram follows. + + +@menu +* Restrictions on foreign declarations:: +* Linking with foreign object files:: +* Starting a simulation from a foreign program:: +* Linking with Ada:: +* Using GRT from Ada:: +@end menu + +@node Restrictions on foreign declarations, Linking with foreign object files, Interfacing to other languages, Interfacing to other languages +@subsection Restrictions on foreign declarations + +Any subprogram can be imported. GHDL puts no restrictions on foreign +subprograms. However, the representation of a type or of an interface in a +foreign language may be obscur. Most of non-composite types are easily imported: +@table @samp +@item integer types +They are represented on a 32 bits word. This generally corresponds to +@code{int} for @code{C} or @code{Integer} for @code{Ada}. +@item physical types +They are represented on a 64 bits word. This generally corresponds to the +@code{long long} for @code{C} or @code{Long_Long_Integer} for @code{Ada}. +@item floating point types +They are represented on a 64 bits floating point word. This generally +corresponds to @code{double} for @code{C} or @code{Long_Float} for @code{Ada}. +@item enumeration types +They are represented on 8 bits or 32 bits word, if the number of literals is +greater than 256. There is no corresponding C types, since arguments are +not promoted. +@end table + +Non-composite types are passed by value. For the @code{in} mode, this +corresponds to the @code{C} or @code{Ada} mechanism. The @code{out} and +@code{inout} interfaces of non-composite types are gathered in a record +and this record is passed by reference as the first argument to the +subprogram. As a consequence, you shouldn't use @code{in} and +@code{inout} modes in foreign subprograms, since they are not portable. + +Records are represented like a @code{C} structure and are passed by reference +to subprograms. + +Arrays with static bounds are represented like a @code{C} array, whose +length is the number of elements, and are passed by reference to subprograms. + +Unconstrained array are represented by a fat pointer. Do not use unconstrained +arrays in foreign subprograms. + +Accesses to an unconstrained array is a fat pointer. Other accesses corresponds a an address and are passed to a subprogram like other non-composite types. + +Files are represented by a 32 bits word, which corresponds to an index +in a table. + +@node Linking with foreign object files, Starting a simulation from a foreign program, Restrictions on foreign declarations, Interfacing to other languages +@subsection Linking with foreign object files +You may add additionnal files or options during the link using the +@option{-Wl,} of @code{GHDL}, as described in @ref{Elaboration command}. +For example: + +@example +$ ghdl -e -Wl,-lm math_tb +@end example +will create the @file{math_tb} executable with the @file{lm} (mathematical) +library. + +Note the @file{c} library is always linked with an executable. + +@node Starting a simulation from a foreign program, Linking with Ada, Linking with foreign object files, Interfacing to other languages +@subsection Starting a simulation from a foreign program +You main run your design from an external program. You just have to call +the @samp{ghdl_main} function which can be defined: + +in C: +@smallexample +extern int ghdl_main (int argc, char **argv); +@end smallexample + +in Ada: +@smallexample +with System; +@dots{} +function Ghdl_Main (Argc : Integer; Argv : System.Address) + return Integer; +pragma import (C, Ghdl_Main, "ghdl_main"); +@end smallexample + +This function must be called once, and returns 0 at the end of the simulation. +In case of failure, this function does not return. This has to be fixed. + +@node Linking with Ada, Using GRT from Ada, Starting a simulation from a foreign program, Interfacing to other languages +@subsection Linking with Ada +As explained previously in @ref{Starting a simulation from a foreign program}, +you can start a simulation from an @code{Ada} program. However the build +process is not trivial: you have to elaborate your @code{Ada} program and your +@code{VHDL} design. + +First, you have to analyze all your design files. In this example, we +suppose there is only one design file, @file{design.vhdl}. +@smallexample +$ ghdl -a design.vhdl +@end smallexample +Then, bind your design. In this example, we suppose the entity at the +design apex is @samp{design}. +@smallexample +$ ghdl --bind design +@end smallexample +Finally, compile, bind your @code{Ada} program at link it with your @code{VHDL} +design: +@smallexample +$ gnatmake my_prog -largs `ghdl --list-link design` +@end smallexample + +@node Using GRT from Ada, , Linking with Ada, Interfacing to other languages +@comment node-name, next, previous, up +@subsection Using GRT from Ada +@quotation Warning +This topic is only for advanced users knowing how to use @code{Ada} +and @code{GNAT}. This is provided only for reference, I have tested +this once before releasing @code{GHDL} 0.19 but this is not checked at +each release. +@end quotation + +The simulator kernel of @code{GHDL} named @dfn{GRT} is written in +@code{Ada95} and contains a very light and slighly adapted version +of @code{VHPI}. Since it is an @code{Ada} implementation it is +called @dfn{AVHPI}. Although being tough, you may interface to @code{AVHPI}. + +For using @code{AVHPI}, you need the sources of @code{GHDL} and to recompile +them (at least the @code{GRT} library). This library is usually compiled with +a @code{No_Run_Time} pragma, so that the user does not need to install the +@code{GNAT} run time library. However, you certainly want to use the usual +run time library and want to avoid this pragma. For this, reset the +@var{GRT_PRAGMA_FLAG} variable. +@smallexample +$ make GRT_PRAGMA_FLAG= grt-all +@end smallexample + +Since @code{GRT} is a self-contained library, you don't want +@code{gnatlink} to fetch individual object files (furthermore this +doesn't always work due to tricks used in @code{GRT}). For this, +remove all the object files and make the @file{.ali} files read-only. +@smallexample +$ rm *.o +$ chmod -w *.ali +@end smallexample + +You may then install the sources files and the @file{.ali} files. I have never +tested this step. + +You are now ready to use it. + +For example, here is an example, @file{test_grt.adb} which displays the top +level design name. +@example +with System; use System; +with Grt.Avhpi; use Grt.Avhpi; +with Ada.Text_IO; use Ada.Text_IO; +with Ghdl_Main; + +procedure Test_Grt is + -- VHPI handle. + H : VhpiHandleT; + Status : Integer; + + -- Name. + Name : String (1 .. 64); + Name_Len : Integer; +begin + -- Elaborate and run the design. + Status := Ghdl_Main (0, Null_Address); + + -- Display the status of the simulation. + Put_Line ("Status is " & Integer'Image (Status)); + + -- Get the root instance. + Get_Root_Inst(H); + + -- Disp its name using vhpi API. + Vhpi_Get_Str (VhpiNameP, H, Name, Name_Len); + Put_Line ("Root instance name: " & Name (1 .. Name_Len)); +end Test_Grt; +@end example + +First, analyze and bind your design: +@smallexample +$ ghdl -a counter.vhdl +$ ghdl --bind counter +@end smallexample + +Then build the whole: +@smallexample +$ gnatmake test_grt -aL@var{grt_ali_path} -aI@var{grt_src_path} -largs + `ghdl --list-link counter` +@end smallexample + +Finally, run your design: +@smallexample +$ ./test_grt +Status is 0 +Root instance name: counter +@end smallexample + +@node GHDL implementation of VITAL, Flaws and bugs report, GHDL implementation of VHDL, Top +@comment node-name, next, previous, up +@chapter GHDL implementation of VITAL +@cindex VITAL +@cindex IEEE 1076.4 +@cindex 1076.4 +This chapter describes how VITAL is implemented in GHDL. Support of VITAL is +really in a preliminary stage. Do not expect too much of it as now. + +@menu +* VITAL packages:: +* VHDL restrictions for VITAL:: +* Backannotation:: +* Negative constraint calculation:: +@end menu + +@node VITAL packages, VHDL restrictions for VITAL, GHDL implementation of VITAL, GHDL implementation of VITAL +@comment node-name, next, previous, up +@section VITAL packages +The VITAL standard or IEEE 1076.4 was first published in 1995, and revised in +2000. + +The version of the VITAL packages depends on the VHDL standard. VITAL +1995 packages are used with the VHDL 1987 standard, while VITAL 2000 +packages are used with other standards. This choice is based on the +requirements of VITAL: VITAL 1995 requires the models follow the VHDL +1987 standard, while VITAL 2000 requires the models follow VHDL 1993. + +The VITAL 2000 packages were slighly modified so that they conform to +the VHDL 1993 standard (a few functions are made pure and a few one +impure). + +@node VHDL restrictions for VITAL, Backannotation, VITAL packages, GHDL implementation of VITAL +@comment node-name, next, previous, up +@section VHDL restrictions for VITAL +The VITAL standard (partially) implemented is the IEEE 1076.4 standard +published in 1995. + +This standard defines restriction of the VHDL language usage on VITAL +model. A @dfn{VITAL model} is a design unit (entity or architecture) +decorated by the @code{VITAL_Level0} or @code{VITAL_Level1} attribute. +These attributes are defined in the @code{ieee.VITAL_Timing} package. + +Currently, only VITAL level 0 checks are implemented. VITAL level 1 models +can be analyzed, but GHDL doesn't check they comply with the VITAL standard. + +Moreover, GHDL doesn't check (yet) that timing generics are not read inside +a VITAL level 0 model prior the VITAL annotation. + +The analysis of a non-conformant VITAL model fails. You can disable the +checks of VITAL restrictions with the @option{--no-vital-checks}. Even when +restrictions are not checked, SDF annotation can be performed. + +@node Backannotation, Negative constraint calculation, VHDL restrictions for VITAL, GHDL implementation of VITAL +@comment node-name, next, previous, up +@section Backannotation +@cindex SDF +@dfn{Backannotation} is the process of setting VITAL generics with timing +information provided by an external files. + +The external files must be SDF (Standard Delay Format) files. GHDL +supports a tiny subset of SDF version 2.1, other version number can be +used, provided no features added by the next version are used. + +Hierarchical instance names are not supported. However you can use a list of +instances. If there is no instance, the top entity will be annotated and +the celltype must be the name of the top entity. If there is at least one +instance, the last instance name must be a component instantiation labe, and +the celltype must be the name of the component declaration instantiated. + +Instances being annotated are not required to be VITAL compliant. However +generics being annotated must follow rules of VITAL (eg, type must be a +suitable vital delay type). + +Currently, only timing constraints applying on a timing generic of type +@code{VitalDelayType01} has been implemented. This SDF annotator is +just a proof of concept. Features will be added with the following GHDL +release. + +@node Negative constraint calculation, , Backannotation, GHDL implementation of VITAL +@comment node-name, next, previous, up +@section Negative constraint calculation +Negative constraint delay adjustement are necessary to handle negative +constraint such as a negative setup time. This step is defined in the VITAL +standard and should occurs after backannotation. + +GHDL does not do negative constraint calculation. It fails to handle models +with negative constraint. I hope to be able to add this phase soon. + +@node Flaws and bugs report, Copyrights, GHDL implementation of VITAL, Top +@comment node-name, next, previous, up +@chapter Flaws and bugs report + +The current version of GHDL is really a beta version. Some features of +VHDL have not been implemented or are only partially implemented. Besides, +GHDL has not been extensively tested yet. + +@menu +* Deficiencies:: +* Reporting bugs:: +* Future improvements:: +@end menu + +@node Deficiencies, Reporting bugs, Flaws and bugs report, Flaws and bugs report +@comment node-name, next, previous, up +@section Deficiencies +Here is the non-exhaustive list of flaws: + +@itemize @bullet +@item +So far, @code{GHDL} has been compiled and tested only on @samp{i386-linux} systems. +@item +Overflow detection is not yet implemented. +@item +Some contraint checks are missing. +@item +VHDL-93 is not completly implemented. +@item +There are no checks for elaboration order. +@item +This list is not exhaustive. +@item +@dots{} +@end itemize + +@node Reporting bugs, Future improvements, Deficiencies, Flaws and bugs report +@comment node-name, next, previous, up +@section Reporting bugs +In order to improve GHDL, we welcome bugs report and suggestions for any +aspect of GHDL. Please email them to @email{ghdl@@free.fr}. + +If the compiler crashes, this is a bug. Reliable tools never crash. + +If your compiled VHDL executable crashes, this may be a bug at +run time or the code produced may be wrong. However, since VHDL +has a notion of pointers, an erroneous VHDL program (using invalid +pointers for example) may crash. + +If the compiler emits an error message for a perfectly valid input or +does not emit an error message for an invalid input, this may be a bug. +Please send the input file and what you expected. If you know the LRM +well enough, please specify the paragraph which has not been well +implemented. If you don't know the LRM, maybe your bug report will be +rejected simply because there is no bug. In the latter case, it may be +difficult to discuss the issue; and comparisons with other VHDL tools +is not a very strong argument. + +If a compiler message is not clear enough for you, please tell me. The +error messages can be improved, but I have not enough experience with +them. + +If you have found a mistake in the manual, please send a comment. If +you have not understood some parts of this manual, please tell me. +English is not my mother tongue, so this manual may not be well-written. +Again, rewriting part of it is a good way to improve it. + +If you send a @code{VHDL} file producing a bug, it is a good idea to try +to make it as short as possible. It is also a good idea to make it +looking like a test: write a comment which explains wether the file +should compile, and if yes, whether or not it should run successfully. +In the latter case, an assert statement should finish the test; the +severity level note indicates success, while a severity level failure +indicates failure. + +For bug reports, please include enough information for the maintainers to +reproduce the problem. This includes: + +@itemize @bullet +@item +the version of @code{GHDL} (you can get it with @samp{ghdl --version}). +@item +the operating system +@item +whether you have built @code{GHDL} from sources or used the binary +distribution. +@item +the content of the input files +@item +a description of the problem and samples of any erroneous input +@item +anything else that you think would be helpful. +@end itemize + +@node Future improvements, , Reporting bugs, Flaws and bugs report +@comment node-name, next, previous, up +@section Future improvements +I have several axes for @code{GHDL} improvements: +@itemize @bullet +@item +Documentation. +@item +Better diagnostics messages (warning and error). +@item +Full support of VHDL-87 and VHDL-93. +@item +Support of VHDL-02. +@item +Optimization (simulation speed). +@item +Graphical tools (to see waves and to debug) +@item +Style checks +@item +VITAL acceleration +@end itemize + +@c And without any order: +@c VHPI +@c FOREIGN +@c AMS +@c verilog + +@node Copyrights, Index, Flaws and bugs report, Top +@comment node-name, next, previous, up +@chapter Copyrights + +The GHDL front-end, the @samp{std.textio} package and the run-time +library (grt) are copyrighted Tristan Gingold, come with @emph{absolutely +no warranty}, and are distributed under the conditions of the General +Public License. + +The @samp{ieee.numeric_bit} and @samp{ieee.numeric_std} packages are +copyrighted by the IEEE. The source files may be distributed without +change, except as permitted by the standard. +@comment FIXME: this sounds strange +This source file may not be +sold or distributed for profit. See the source file and the IEEE 1076.3 +standard for more information. + +The @samp{ieee.std_logic_1164} package is copyrighted by the IEEE. See +source file and the IEEE 1164 standard for more information. + +The @samp{ieee.VITAL_Primitives}, @samp{ieee.VITAL_Timing} and +@samp{ieee.VITAL_Memory} packages are copyrighted by IEEE. See source +file and the IEEE 1076.4 standards for more information. + +The @samp{ieee.Math_Real} and @samp{ieee.Math_Complex} packages are +copyrighted by IEEE. These are draft versions which may used and distributed +without restriction. These packages cannot be sold or distributed for profit. +See source files for more information. + +The packages @samp{std_logic_arith}, @c @samp{std_logic_misc}, +@samp{std_logic_signed}, @samp{std_logic_unsigned} and +@samp{std_logic_textio} contained in the @samp{synopsys} directory are +copyrighted by Synopsys, Inc. The source files may be used and +distributed without restriction provided that the copyright statements +are not removed from the files and that any derivative work contains the +copyright notice. See the source files for more information. + +The package @samp{std_logic_arith} contained in the @samp{mentor} +directory is copyrighted by Mentor Graphics. The source files may be +distributed in whole without restriction provided that the copyright +statement is not removed from the file and that any derivative work +contains this copyright notice. See the source files for more information. + +As a consequence of the run-time copyright, you may not be allowed to +distribute an executable produced by @code{GHDL} without the VHDL +sources. To my mind, this is not a real restriction, since there is no +points in distributing VHDL executable. Please, send a comment +(@pxref{Reporting bugs}) if you don't like this policy. + +@node Index, , Copyrights, Top +@unnumbered Index +@printindex cp + +@bye diff --git a/errorout.adb b/errorout.adb new file mode 100644 index 000000000..e5ba40d54 --- /dev/null +++ b/errorout.adb @@ -0,0 +1,1055 @@ +-- Error message handling. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Text_IO; +with Ada.Command_Line; +with Types; use Types; +with Iirs; use Iirs; +with Scan; +with Tokens; use Tokens; +with Name_Table; +with Iirs_Utils; +with Files_Map; use Files_Map; +with Ada.Strings.Unbounded; +with Std_Names; +with Flags; + +package body Errorout is + procedure Put (Str : String) + is + use Ada.Text_IO; + begin + Put (Standard_Error, Str); + end Put; + + procedure Put (C : Character) + is + use Ada.Text_IO; + begin + Put (Standard_Error, C); + end Put; + + procedure Put_Line (Str : String) + is + use Ada.Text_IO; + begin + Put_Line (Standard_Error, Str); + end Put_Line; + + procedure Disp_Natural (Val: Natural) is + Str: String := Natural'Image (Val); + begin + Put (Str(Str'First + 1 .. Str'Last)); + end Disp_Natural; + + procedure Error_Msg (Msg: String) is + begin + Put (Ada.Command_Line.Command_Name); + Put (": "); + Put_Line (Msg); + end Error_Msg; + + procedure Error_Kind (Msg : String; An_Iir : Iir) is + begin + Put_Line (Msg & ": can't handle " + & Iir_Kind'Image (Get_Kind (An_Iir)) + & " (" & Disp_Location (An_Iir) & ')'); + raise Internal_Error; + end Error_Kind; + + procedure Error_Kind (Msg : String; Def : Iir_Predefined_Functions) is + begin + Put_Line (Msg & ": can't handle " + & Iir_Predefined_Functions'Image (Def)); + raise Internal_Error; + end Error_Kind; + + -- Disp an error, prepended with program name. + -- This is used for errors before initialisation, such as bad option or + -- bad filename. + procedure Error_Msg_Option (Msg: String) is + begin + Put (Ada.Command_Line.Command_Name); + Put (":*command-line*: "); + Put_Line (Msg); + raise Option_Error; + end Error_Msg_Option; + + procedure Disp_Location + (File: Name_Id; Line: Natural; Col: Natural) is + begin + Put (Name_Table.Image (File)); + Put (':'); + Disp_Natural (Line); + Put (':'); + Disp_Natural (Col); + Put (':'); + end Disp_Location; + + procedure Disp_Current_Location is + begin + Disp_Location (Scan.Get_Current_File, + Scan.Get_Current_Line, + Scan.Get_Current_Column); + end Disp_Current_Location; + + procedure Disp_Token_Location is + begin + Disp_Location (Scan.Get_Current_File, + Scan.Get_Current_Line, + Scan.Get_Token_Column); + end Disp_Token_Location; + + procedure Disp_Location (Loc : Location_Type) + is + Name : Name_Id; + Line : Natural; + Col : Natural; + begin + if Loc = Location_Nil then + -- Avoid a crash, but should not happen. + Put ("??:??:??:"); + else + Location_To_Position (Loc, Name, Line, Col); + Disp_Location (Name, Line, Col); + end if; + end Disp_Location; + + function Get_Location_Safe (N : Iir) return Location_Type is + begin + if N = Null_Iir then + return Location_Nil; + else + return Get_Location (N); + end if; + end Get_Location_Safe; + + procedure Disp_Iir_Location (An_Iir: Iir) is + begin + Disp_Location (Get_Location_Safe (An_Iir)); + end Disp_Iir_Location; + + procedure Warning_Msg (Msg: String) is + begin + Put ("warning: "); + Put_Line (Msg); + end Warning_Msg; + + procedure Warning_Msg_Parse (Msg: String) is + begin + if Flags.Flag_Only_Elab_Warnings then + return; + end if; + Disp_Token_Location; + if Flags.Warn_Error then + Nbr_Errors := Nbr_Errors + 1; + Put (" "); + else + Put ("warning: "); + end if; + Put_Line (Msg); + end Warning_Msg_Parse; + + procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type) is + begin + if Flags.Flag_Only_Elab_Warnings then + return; + end if; + Disp_Location (Loc); + if Flags.Warn_Error then + Nbr_Errors := Nbr_Errors + 1; + Put (" "); + else + Put ("warning: "); + end if; + Put_Line (Msg); + end Warning_Msg_Sem; + + procedure Warning_Msg_Sem (Msg: String; Loc : Iir) is + begin + Warning_Msg_Sem (Msg, Get_Location_Safe (Loc)); + end Warning_Msg_Sem; + + procedure Warning_Msg_Elab (Msg: String; Loc : Location_Type) is + begin + Disp_Location (Loc); + if Flags.Warn_Error then + Nbr_Errors := Nbr_Errors + 1; + Put (" "); + else + Put ("warning: "); + end if; + Put_Line (Msg); + end Warning_Msg_Elab; + + procedure Warning_Msg_Elab (Msg: String; Loc : Iir) is + begin + Warning_Msg_Elab (Msg, Get_Location_Safe (Loc)); + end Warning_Msg_Elab; + + procedure Disp_Current_Token; + pragma Unreferenced (Disp_Current_Token); + + procedure Disp_Current_Token is + begin + case Scan.Current_Token is + when Tok_Identifier => + Put ("identifier """ + & Name_Table.Image (Scan.Current_Identifier) & """"); + when others => + Put (Token_Type'Image (Scan.Current_Token)); + end case; + end Disp_Current_Token; + + -- Disp a message during scan. + procedure Error_Msg_Scan (Msg: String) is + begin + Nbr_Errors := Nbr_Errors + 1; + Disp_Current_Location; + Put (' '); + Put_Line (Msg); + end Error_Msg_Scan; + + -- Disp a message during scan. + procedure Warning_Msg_Scan (Msg: String) is + begin + Disp_Current_Location; + Put ("warning: "); + Put_Line (Msg); + end Warning_Msg_Scan; + + -- Disp a message during scan. + procedure Error_Msg_Parse (Msg: String) is + begin + Nbr_Errors := Nbr_Errors + 1; + Disp_Token_Location; + Put (' '); + Put_Line (Msg); + end Error_Msg_Parse; + + procedure Error_Msg_Parse (Msg: String; Loc : Iir) is + begin + Nbr_Errors := Nbr_Errors + 1; + Disp_Iir_Location (Loc); + Put (' '); + Put_Line (Msg); + end Error_Msg_Parse; + + procedure Error_Msg_Parse (Msg: String; Loc : Location_Type) is + begin + Nbr_Errors := Nbr_Errors + 1; + Disp_Location (Loc); + Put (' '); + Put_Line (Msg); + end Error_Msg_Parse; + + -- Disp a message during semantic analysis. + -- LOC is used for location and current token. + procedure Error_Msg_Sem (Msg: String; Loc: in Iir) is + begin + Nbr_Errors := Nbr_Errors + 1; + if Loc /= Null_Iir then + Disp_Iir_Location (Loc); + Put (' '); + end if; + Put_Line (Msg); + end Error_Msg_Sem; + + procedure Error_Msg_Sem (Msg: String; Loc : Location_Type) is + begin + Nbr_Errors := Nbr_Errors + 1; + Disp_Location (Loc); + Put (' '); + Put_Line (Msg); + end Error_Msg_Sem; + + -- Disp a message during elaboration. + procedure Error_Msg_Elab (Msg: String) is + begin + Nbr_Errors := Nbr_Errors + 1; + Put ("error: "); + Put_Line (Msg); + end Error_Msg_Elab; + + procedure Error_Msg_Elab (Msg: String; Loc : Iir) is + begin + Nbr_Errors := Nbr_Errors + 1; + Disp_Iir_Location (Loc); + Put (' '); + Put_Line (Msg); + end Error_Msg_Elab; + + -- Disp a message during execution. + procedure Error_Msg_Exec (Msg: String; Loc: in Iir) is + begin + Nbr_Errors := Nbr_Errors + 1; + Disp_Iir_Location (Loc); + Put (' '); + Put_Line (Msg); + raise Simulation_Error; + end Error_Msg_Exec; + + procedure Warning_Msg_Exec (Msg: String; Loc: Iir) is + begin + Disp_Iir_Location (Loc); + Put ("warning: "); + Put_Line (Msg); + end Warning_Msg_Exec; + + -- Disp a message for a constraint error. + procedure Error_Msg_Constraint (Expr: in Iir) is + begin + Nbr_Errors := Nbr_Errors + 1; + if Expr /= Null_Iir then + Disp_Iir_Location (Expr); + end if; + Put ("constraint violation"); + if Expr /= Null_Iir then + case Get_Kind (Expr) is + when Iir_Kind_Addition_Operator => + Put_Line (" in the ""+"" operation"); + when Iir_Kind_Substraction_Operator => + Put_Line (" in the ""-"" operation"); + when Iir_Kind_Integer_Literal => + Put_Line (", literal out of range"); + when Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Signal_Declaration => + Put_Line (" for " & Disp_Node (Expr)); + when others => + Put_Line (""); + end case; + end if; + raise Execution_Constraint_Error; + end Error_Msg_Constraint; + + -- Disp a bug message. + procedure Error_Internal (Expr: in Iir; Msg: String := "") + is + pragma Unreferenced (Expr); + begin + Put ("internal error: "); + Put_Line (Msg); + raise Internal_Error; + end Error_Internal; + + function Disp_Label (Node : Iir; Str : String) return String + is + Id : Name_Id; + begin + Id := Get_Label (Node); + if Id = Null_Identifier then + return "(unlabeled) " & Str; + else + return Str & " labeled """ & Name_Table.Image (Id) & """"; + end if; + end Disp_Label; + + + -- Disp a node. + -- Used for output of message. + function Disp_Node (Node: Iir) return String is + function Disp_Identifier (Node : Iir; Str : String) return String + is + Id : Name_Id; + begin + Id := Get_Identifier (Node); + return Str & " """ & Name_Table.Image (Id) & """"; + end Disp_Identifier; + + function Disp_Type (Node : Iir; Str : String) return String + is + Decl: Iir; + begin + Decl := Get_Type_Declarator (Node); + if Decl = Null_Iir then + return "the anonymous " & Str + & " defined at " & Disp_Location (Node); + else + return Disp_Identifier (Decl, Str); + end if; + end Disp_Type; + + begin + case Get_Kind (Node) is + when Iir_Kind_String_Literal => + return "string literal """ + & Iirs_Utils.Image_String_Lit (Node) & """"; + when Iir_Kind_Bit_String_Literal => + return "bit string literal """ + & Iirs_Utils.Image_String_Lit (Node) & """"; + when Iir_Kind_Character_Literal => + return "character literal " & Iirs_Utils.Image_Identifier (Node); + when Iir_Kind_Integer_Literal => + return "integer literal"; + when Iir_Kind_Floating_Point_Literal => + return "floating point literal"; + when Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal => + return "physical literal"; + when Iir_Kind_Enumeration_Literal => + return "enumeration literal " & Iirs_Utils.Image_Identifier (Node); + when Iir_Kind_Element_Declaration => + return Disp_Identifier (Node, "element"); + when Iir_Kind_Null_Literal => + return "null literal"; + when Iir_Kind_Aggregate => + return "aggregate"; + when Iir_Kind_Unit_Declaration => + return Disp_Identifier (Node, "physical unit"); + when Iir_Kind_Simple_Aggregate => + return "locally static array literal"; + + -- Should never be displayed, but for completness... + when Iir_Kind_Proxy => + return "proxy"; + when Iir_Kind_Operator_Symbol => + return "operator name"; + when Iir_Kind_Aggregate_Info => + return "aggregate info"; + when Iir_Kind_Signature => + return "signature"; + when Iir_Kind_Waveform_Element => + return "waveform element"; + when Iir_Kind_Conditional_Waveform => + return "conditional waveform"; + when Iir_Kind_Association_Element_Open => + return "open association element"; + when Iir_Kind_Association_Element_By_Individual => + return "individual association element"; + when Iir_Kind_Association_Element_By_Expression => + return "association element"; + when Iir_Kind_Overload_List => + return "overloaded name or expression"; + + when Iir_Kind_Array_Type_Definition => + return Disp_Type (Node, "array type"); + when Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition => + return Disp_Type (Node, "array subtype"); + when Iir_Kind_Record_Type_Definition => + return Disp_Type (Node, "record type"); + when Iir_Kind_Record_Subtype_Definition => + return Disp_Type (Node, "record subtype"); + when Iir_Kind_Enumeration_Subtype_Definition => + return Disp_Type (Node, "enumeration subtype"); + when Iir_Kind_Integer_Subtype_Definition => + return Disp_Type (Node, "integer subtype"); + when Iir_Kind_Physical_Type_Definition => + return Disp_Type (Node, "physical type"); + when Iir_Kind_Physical_Subtype_Definition => + return Disp_Type (Node, "physical subtype"); + when Iir_Kind_File_Type_Definition => + return Disp_Type (Node, "file type"); + when Iir_Kind_Access_Type_Definition => + return Disp_Type (Node, "access type"); + when Iir_Kind_Access_Subtype_Definition => + return Disp_Type (Node, "access subtype"); + when Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Floating_Type_Definition => + return Disp_Type (Node, "floating type"); + when Iir_Kind_Incomplete_Type_Definition => + return Disp_Type (Node, "incomplete type"); + when Iir_Kind_Protected_Type_Declaration => + return Disp_Type (Node, "protected type"); + when Iir_Kind_Protected_Type_Body => + return Disp_Type (Node, "protected type body"); + when Iir_Kind_Subtype_Definition => + return "subtype definition"; + + when Iir_Kind_Choice_By_Expression => + return "choice by expression"; + when Iir_Kind_Choice_By_Range => + return "choice by range"; + when Iir_Kind_Choice_By_Name => + return "choice by name"; + when Iir_Kind_Choice_By_Others => + return "others choice"; + when Iir_Kind_Choice_By_None => + return "positionnal choice"; + + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition => + return Iirs_Utils.Image_Identifier (Get_Type_Declarator (Node)); + when Iir_Kind_Function_Call => + return "function call"; + when Iir_Kind_Procedure_Call_Statement => + return "procedure call statement"; + when Iir_Kind_Procedure_Call => + return "procedure call"; + when Iir_Kind_Selected_Name => + Name_Table.Image (Get_Suffix_Identifier (Node)); + return ''' + & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length) + & '''; + when Iir_Kind_Simple_Name => + Name_Table.Image (Get_Identifier (Node)); + return ''' + & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length) + & '''; + when Iir_Kind_Entity_Aspect_Entity => + return Disp_Node (Get_Entity (Node)) + & '(' & Iirs_Utils.Image_Identifier (Get_Architecture (Node)) + & ')'; + when Iir_Kind_Entity_Aspect_Configuration => + return "configuration entity aspect"; + when Iir_Kind_Entity_Aspect_Open => + return "open entity aspect"; + + when Iir_Kinds_Monadic_Operator + | Iir_Kinds_Dyadic_Operator => + return "operator """ + & Name_Table.Image (Iirs_Utils.Get_Operator_Name (Node)) + & """"; + when Iir_Kind_Qualified_Expression => + return "qualified expression"; + when Iir_Kind_Type_Conversion => + return "type conversion"; + when Iir_Kind_Allocator_By_Subtype + | Iir_Kind_Allocator_By_Expression => + return "allocator"; + when Iir_Kind_Indexed_Name => + return "indexed name"; + when Iir_Kind_Range_Expression => + return "range expression"; + when Iir_Kind_Implicit_Dereference => + return "implicit access dereference"; + when Iir_Kind_Dereference => + return "access dereference"; + when Iir_Kind_Selected_Element => + return "selected element"; + when Iir_Kind_Selected_By_All_Name => + return ".all name"; + + when Iir_Kind_Constant_Interface_Declaration => + case Get_Kind (Get_Parent (Node)) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Block_Statement + | Iir_Kind_Block_Header => + return Disp_Identifier (Node, "generic"); + when others => + return Disp_Identifier (Node, "constant interface"); + end case; + when Iir_Kind_Signal_Interface_Declaration => + case Get_Kind (Get_Parent (Node)) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Block_Statement + | Iir_Kind_Block_Header => + return Disp_Identifier (Node, "port"); + when others => + return Disp_Identifier (Node, "signal interface"); + end case; + when Iir_Kind_Variable_Interface_Declaration => + return Disp_Identifier (Node, "variable interface"); + when Iir_Kind_File_Interface_Declaration => + return Disp_Identifier (Node, "file interface"); + when Iir_Kind_Signal_Declaration => + return Disp_Identifier (Node, "signal"); + when Iir_Kind_Variable_Declaration => + return Disp_Identifier (Node, "variable"); + when Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Declaration => + return Disp_Identifier (Node, "constant"); + when Iir_Kind_File_Declaration => + return Disp_Identifier (Node, "file"); + when Iir_Kind_Object_Alias_Declaration => + return Disp_Identifier (Node, "alias"); + when Iir_Kind_Non_Object_Alias_Declaration => + return Disp_Identifier (Node, "non-object alias"); + when Iir_Kind_Guard_Signal_Declaration => + return "GUARD signal"; + when Iir_Kind_Group_Template_Declaration => + return Disp_Identifier (Node, "group template"); + when Iir_Kind_Group_Declaration => + return Disp_Identifier (Node, "group"); + + when Iir_Kind_Library_Declaration + | Iir_Kind_Library_Clause => + return Disp_Identifier (Node, "library"); + when Iir_Kind_Design_File => + return "design file"; + + when Iir_Kind_Procedure_Declaration => + return Disp_Identifier (Node, "procedure"); + when Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + return "subprogram body"; + when Iir_Kind_Function_Declaration => + return Disp_Identifier (Node, "function"); + + when Iir_Kind_Package_Declaration => + return Disp_Identifier (Node, "package"); + when Iir_Kind_Package_Body => + return Disp_Identifier (Node, "package body"); + when Iir_Kind_Entity_Declaration => + return Disp_Identifier (Node, "entity"); + when Iir_Kind_Architecture_Declaration => + return Disp_Identifier (Node, "architecture") & + " of" & Disp_Identifier (Get_Entity (Node), ""); + when Iir_Kind_Configuration_Declaration => + declare + Id : Name_Id; + Ent : Iir; + Arch : Iir; + begin + Id := Get_Identifier (Node); + if Id /= Null_Identifier then + return Disp_Identifier (Node, "configuration"); + else + Ent := Get_Library_Unit (Get_Entity (Node)); + Arch := Get_Block_Specification + (Get_Block_Configuration (Node)); + return "default configuration of " + & Iirs_Utils.Image_Identifier (Ent) + & '(' & Iirs_Utils.Image_Identifier (Arch) & ')'; + end if; + end; + when Iir_Kind_Component_Declaration => + return Disp_Identifier (Node, "component"); + + when Iir_Kind_Design_Unit => + return Disp_Node (Get_Library_Unit (Node)); + when Iir_Kind_Use_Clause => + return "use clause"; + when Iir_Kind_Disconnection_Specification => + return "disconnection specification"; + + when Iir_Kind_Slice_Name => + return "slice"; + when Iir_Kind_Parenthesis_Name => + return "function call, slice or indexed name"; + when Iir_Kind_Type_Declaration => + return Disp_Identifier (Node, "type"); + when Iir_Kind_Anonymous_Type_Declaration => + return Disp_Identifier (Node, "type"); + when Iir_Kind_Subtype_Declaration => + return Disp_Identifier (Node, "subtype"); + + when Iir_Kind_Component_Instantiation_Statement => + return Disp_Identifier (Node, "component instance"); + when Iir_Kind_Configuration_Specification => + return "configuration specification"; + when Iir_Kind_Component_Configuration => + return "component configuration"; + when Iir_Kind_Implicit_Function_Declaration => + return Disp_Identifier (Node, "implicit function") + & Disp_Identifier (Get_Type_Reference (Node), " of type"); +-- return "implicit function " +-- & Iirs_Utils.Get_Predefined_Function_Name +-- (Get_Implicit_Definition (Node)); + when Iir_Kind_Implicit_Procedure_Declaration => + return "implicit procedure " + & Iirs_Utils.Get_Predefined_Function_Name + (Get_Implicit_Definition (Node)); + + when Iir_Kind_Concurrent_Procedure_Call_Statement => + return "concurrent procedure call"; + when Iir_Kind_Generate_Statement => + return "generate statement"; + + when Iir_Kind_Attribute_Declaration => + return Disp_Identifier (Node, "attribute"); + when Iir_Kind_Attribute_Specification => + return "attribute specification"; + when Iir_Kind_Entity_Class => + return "entity class"; + when Iir_Kind_Attribute_Value => + return "attribute value"; + when Iir_Kind_Attribute_Name => + return "attribute"; + when Iir_Kind_Base_Attribute => + return "'base attribute"; + when Iir_Kind_Length_Array_Attribute => + return "'length attribute"; + when Iir_Kind_Range_Array_Attribute => + return "'range attribute"; + when Iir_Kind_Reverse_Range_Array_Attribute => + return "'reverse_range attribute"; + when Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Ascending_Array_Attribute => + return "'ascending attribute"; + when Iir_Kind_Left_Type_Attribute + | Iir_Kind_Left_Array_Attribute => + return "'left attribute"; + when Iir_Kind_Right_Type_Attribute + | Iir_Kind_Right_Array_Attribute => + return "'right attribute"; + when Iir_Kind_Low_Type_Attribute + | Iir_Kind_Low_Array_Attribute => + return "'low attribute"; + when Iir_Kind_Leftof_Attribute => + return "'leftof attribute"; + when Iir_Kind_Rightof_Attribute => + return "'rightof attribute"; + when Iir_Kind_Pred_Attribute => + return "'pred attribute"; + when Iir_Kind_Succ_Attribute => + return "'succ attribute"; + when Iir_Kind_Pos_Attribute => + return "'pos attribute"; + when Iir_Kind_Val_Attribute => + return "'val attribute"; + when Iir_Kind_Image_Attribute => + return "'image attribute"; + when Iir_Kind_Value_Attribute => + return "'value attribute"; + when Iir_Kind_High_Type_Attribute + | Iir_Kind_High_Array_Attribute => + return "'high attribute"; + when Iir_Kind_Transaction_Attribute => + return "'transaction attribute"; + when Iir_Kind_Stable_Attribute => + return "'stable attribute"; + when Iir_Kind_Quiet_Attribute => + return "'quiet attribute"; + when Iir_Kind_Delayed_Attribute => + return "'delayed attribute"; + when Iir_Kind_Driving_Attribute => + return "'driving attribute"; + when Iir_Kind_Driving_Value_Attribute => + return "'driving_value attribute"; + when Iir_Kind_Event_Attribute => + return "'event attribute"; + when Iir_Kind_Active_Attribute => + return "'active attribute"; + when Iir_Kind_Last_Event_Attribute => + return "'last_event attribute"; + when Iir_Kind_Last_Active_Attribute => + return "'last_active attribute"; + when Iir_Kind_Last_Value_Attribute => + return "'last_value attribute"; + when Iir_Kind_Behavior_Attribute => + return "'behavior attribute"; + when Iir_Kind_Structure_Attribute => + return "'structure attribute"; + + when Iir_Kind_Path_Name_Attribute => + return "'path_name attribute"; + when Iir_Kind_Instance_Name_Attribute => + return "'instance_name attribute"; + when Iir_Kind_Simple_Name_Attribute => + return "'simple_name attribute"; + + when Iir_Kind_For_Loop_Statement => + return Disp_Label (Node, "for loop statement"); + when Iir_Kind_While_Loop_Statement => + return Disp_Label (Node, "loop statement"); + when Iir_Kind_Process_Statement + | Iir_Kind_Sensitized_Process_Statement => + return Disp_Label (Node, "process"); + when Iir_Kind_Block_Statement => + return Disp_Label (Node, "block statement"); + when Iir_Kind_Block_Header => + return "block header"; + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + return Disp_Label + (Node, "concurrent conditional signal assignment"); + when Iir_Kind_Concurrent_Selected_Signal_Assignment => + return Disp_Label + (Node, "concurrent selected signal assignment"); + when Iir_Kind_Concurrent_Assertion_Statement => + return Disp_Label (Node, "concurrent assertion"); + + when Iir_Kind_If_Statement => + return Disp_Label (Node, "if statement"); + when Iir_Kind_Elsif => + return Disp_Label (Node, "else/elsif statement"); + when Iir_Kind_Next_Statement => + return Disp_Label (Node, "next statement"); + when Iir_Kind_Exit_Statement => + return Disp_Label (Node, "exit statement"); + when Iir_Kind_Case_Statement => + return Disp_Label (Node, "case statement"); + when Iir_Kind_Return_Statement => + return Disp_Label (Node, "return statement"); + when Iir_Kind_Signal_Assignment_Statement => + return Disp_Label (Node, "signal assignment statement"); + when Iir_Kind_Variable_Assignment_Statement => + return Disp_Label (Node, "variable assignment statement"); + when Iir_Kind_Null_Statement => + return Disp_Label (Node, "null statement"); + when Iir_Kind_Wait_Statement => + return Disp_Label (Node, "wait statement"); + when Iir_Kind_Assertion_Statement => + return Disp_Label (Node, "assertion statement"); + when Iir_Kind_Report_Statement => + return Disp_Label (Node, "report statement"); + + when Iir_Kind_Block_Configuration => + return "block configuration"; + when Iir_Kind_Binding_Indication => + return "binding indication"; + + + when Iir_Kind_Error => + return "error"; + +-- when others => +-- Error_Kind ("disp_node", Node); +-- return "???"; + end case; + end Disp_Node; + + -- Disp a node location. + -- Used for output of message. + + function Get_Location_Str + (Name : Name_Id; Line, Col : Natural; Filename : Boolean) + return String + is + Line_Str : String := Natural'Image (Line); + Col_Str : String := Natural'Image (Col); + begin + if Filename then + return Name_Table.Image (Name) + & ':' & Line_Str (Line_Str'First + 1 .. Line_Str'Last) + & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last); + else + return Line_Str (Line_Str'First + 1 .. Line_Str'Last) + & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last); + end if; + end Get_Location_Str; + + function Get_Location_Str (Loc : Location_Type; Filename : Boolean := True) + return string + is + Line, Col : Natural; + Name : Name_Id; + begin + if Loc = Location_Nil then + -- Avoid a crash. + return "??:??:??:"; + else + Location_To_Position (Loc, Name, Line, Col); + return Get_Location_Str (Name, Line, Col, Filename); + end if; + end Get_Location_Str; + + function Disp_Location (Node: Iir) return String is + begin + return Get_Location_Str (Get_Location (Node)); + end Disp_Location; + + function Disp_Name (Kind : Iir_Kind) return String is + begin + case Kind is + when Iir_Kind_Constant_Declaration => + return "constant declaration"; + when Iir_Kind_Signal_Declaration => + return "signal declaration"; + when Iir_Kind_Variable_Declaration => + return "variable declaration"; + when Iir_Kind_File_Declaration => + return "file declaration"; + when others => + return "???" & Iir_Kind'Image (Kind); + end case; + end Disp_Name; + + function Image (N : Iir_Int64) return String + is + Res : String := Iir_Int64'Image (N); + begin + if Res (1) = ' ' then + return Res (2 .. Res'Last); + else + return Res; + end if; + end Image; + + function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String is + begin + case Get_Kind (Dtype) is + when Iir_Kind_Integer_Type_Definition => + return Image (Pos); + when Iir_Kind_Enumeration_Type_Definition => + return Name_Table.Image + (Get_Identifier (Get_Nth_Element + (Get_Enumeration_Literal_List (Dtype), + Natural (Pos)))); + when others => + Error_Kind ("disp_discrete", Dtype); + end case; + end Disp_Discrete; + + function Disp_Subprg (Subprg : Iir) return String + is + use Ada.Strings.Unbounded; + Res : Unbounded_String; + + procedure Append_Type (Def : Iir) + is + use Name_Table; + begin + Image (Get_Identifier (Get_Type_Declarator (Def))); + Append (Res, Name_Buffer (1 .. Name_Length)); + end Append_Type; + + begin + case Get_Kind (Subprg) is + when Iir_Kind_Enumeration_Literal => + Append (Res, "enumeration literal "); + when Iir_Kind_Implicit_Function_Declaration => + Append (Res, "implicit function "); + when Iir_Kind_Implicit_Procedure_Declaration => + Append (Res, "implicit procedure "); + when Iir_Kind_Function_Declaration => + Append (Res, "function "); + when Iir_Kind_Procedure_Declaration => + Append (Res, "procedure "); + when others => + Error_Kind ("disp_subprg", Subprg); + end case; + + declare + use Name_Table; + + Id : Name_Id := Get_Identifier (Subprg); + begin + Image (Id); + case Id is + when Std_Names.Name_Id_Operators + | Std_Names.Name_Word_Operators + | Std_Names.Name_Xnor + | Std_Names.Name_Shift_Operators => + Append (Res, """"); + Append (Res, Name_Buffer (1 .. Name_Length)); + Append (Res, """"); + when others => + Append (Res, Name_Buffer (1 .. Name_Length)); + end case; + end; + + Append (Res, " ["); + + case Get_Kind (Subprg) is + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + declare + El : Iir; + begin + El := Get_Interface_Declaration_Chain (Subprg); + while El /= Null_Iir loop + Append_Type (Get_Type (El)); + El := Get_Chain (El); + exit when El = Null_Iir; + Append (Res, ", "); + end loop; + end; + when others => + null; + end case; + + case Get_Kind (Subprg) is + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Enumeration_Literal => + Append (Res, " return "); + Append_Type (Get_Return_Type (Subprg)); + when others => + null; + end case; + + Append (Res, "]"); + + return To_String (Res); + end Disp_Subprg; + + -- DEF must be any type definition. + -- Return the type name of DEF, handle anonymous subtypes. + function Disp_Type_Name (Def : Iir) return String + is + use Iirs_Utils; + Decl : Iir; + begin + Decl := Get_Type_Declarator (Def); + if Decl /= Null_Iir then + return Image_Identifier (Decl); + else + Decl := Get_Type_Declarator (Get_Base_Type (Def)); + return "a subtype of " & Image_Identifier (Decl); + end if; + end Disp_Type_Name; + + function Disp_Type_Of (Node : Iir) return String + is + A_Type : Iir; + begin + A_Type := Get_Type (Node); + if A_Type = Null_Iir then + return "unknown"; + elsif Get_Kind (A_Type) = Iir_Kind_Overload_List then + declare + use Ada.Strings.Unbounded; + Res : Unbounded_String; + List : Iir_List; + El : Iir; + Nbr : Natural; + begin + List := Get_Overload_List (A_Type); + Nbr := Get_Nbr_Elements (List); + if Nbr = 0 then + return "unknown"; + elsif Nbr = 1 then + return Disp_Type_Name (Get_First_Element (List)); + else + Append (Res, "one of "); + for I in 0 .. Nbr - 1 loop + El := Get_Nth_Element (List, I); + Append (Res, Disp_Type_Name (El)); + if I < Nbr - 2 then + Append (Res, ", "); + elsif I = Nbr - 2 then + Append (Res, " or "); + end if; + end loop; + return To_String (Res); + end if; + end; + else + return Disp_Type_Name (A_Type); + end if; + end Disp_Type_Of; + + procedure Error_Pure (Caller : Iir; Callee : Iir; Loc : Iir) + is + L : Location_Type; + begin + if Loc = Null_Iir then + L := Get_Location (Caller); + else + L := Get_Location (Loc); + end if; + Error_Msg_Sem + ("pure " & Disp_Node (Caller) & " cannot call (impure) " + & Disp_Node (Callee), L); + Error_Msg_Sem + ("(" & Disp_Node (Callee) & " is defined here)", Callee); + end Error_Pure; + + procedure Error_Not_Match (Expr: Iir; A_Type: Iir; Loc : Iir) + is + begin + Error_Msg_Sem ("can't match " & Disp_Node (Expr) & " with type " + & Disp_Node (A_Type), Loc); + if Loc /= Expr then + Error_Msg_Sem ("(location of " & Disp_Node (Expr) & ")", Expr); + end if; + end Error_Not_Match; + +end Errorout; diff --git a/errorout.ads b/errorout.ads new file mode 100644 index 000000000..8707d2d7f --- /dev/null +++ b/errorout.ads @@ -0,0 +1,137 @@ +-- Error message handling. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Iirs; use Iirs; + +package Errorout is + Option_Error: exception; + Parse_Error: exception; + Compilation_Error: exception; + Simulation_Error: exception; + Elaboration_Error : exception; + + -- This exception is raised when a constraint error is detected during + -- an evaluation of an expression. + Execution_Constraint_Error: exception; + + -- This kind can't be handled. + --procedure Error_Kind (Msg: String; Kind: Iir_Kind); + procedure Error_Kind (Msg: String; An_Iir: in Iir); + procedure Error_Kind (Msg: String; Def : Iir_Predefined_Functions); + pragma No_Return (Error_Kind); + + -- Raise when an assertion of failure severity error fails. + Assertion_Failure: exception; + + -- The number of errors (ie, number of calls to error_msg*). + Nbr_Errors: Natural := 0; + + -- Disp an error, prepended with program name. + procedure Error_Msg (Msg: String); + + -- Disp an error, prepended with program name, and raise option_error. + -- This is used for errors before initialisation, such as bad option or + -- bad filename. + procedure Error_Msg_Option (Msg: String); + + -- Disp an error location (using AN_IIR location) using the standard + -- format `file:line:col: '. + procedure Disp_Iir_Location (An_Iir: Iir); + + -- Disp a warning. + procedure Warning_Msg (Msg: String); + procedure Warning_Msg_Parse (Msg: String); + procedure Warning_Msg_Sem (Msg: String; Loc : Iir); + procedure Warning_Msg_Elab (Msg: String; Loc : Iir); + procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type); + + -- Disp a message during scan. + -- The current location is automatically displayed before the message. + procedure Error_Msg_Scan (Msg: String); + procedure Warning_Msg_Scan (Msg: String); + + -- Disp a message during parse + -- The location of the current token is automatically displayed before + -- the message. + procedure Error_Msg_Parse (Msg: String); + procedure Error_Msg_Parse (Msg: String; Loc : Iir); + procedure Error_Msg_Parse (Msg: String; Loc : Location_Type); + + -- Disp a message during semantic analysis. + -- an_iir is used for location and current token. + procedure Error_Msg_Sem (Msg: String; Loc: Iir); + procedure Error_Msg_Sem (Msg: String; Loc: Location_Type); + + -- Disp a message during elaboration. + procedure Error_Msg_Elab (Msg: String); + procedure Error_Msg_Elab (Msg: String; Loc: Iir); + + -- Disp a message during execution. + procedure Error_Msg_Exec (Msg: String; Loc: Iir); + pragma No_Return (Error_Msg_Exec); + + procedure Warning_Msg_Exec (Msg: String; Loc: Iir); + + -- Disp a message for a constraint error. + -- And raise the exception execution_constraint_error. + procedure Error_Msg_Constraint (Expr: Iir); + + -- Disp a bug message. + procedure Error_Internal (Expr: Iir; Msg: String := ""); + pragma No_Return (Error_Internal); + + -- Disp a node. + -- Used for output of message. + function Disp_Node (Node: Iir) return String; + + -- Disp a node location. + -- Used for output of message. + function Disp_Location (Node: Iir) return String; + function Get_Location_Str (Loc : Location_Type; Filename : Boolean := True) + return String; + + -- Disp non-terminal name from KIND. + function Disp_Name (Kind : Iir_Kind) return String; + + -- SUBPRG must be a subprogram declaration or an enumeration literal + -- declaration. + -- Returns: + -- "enumeration literal XX [ return TYPE ]" + -- "function XXX [ TYPE1, TYPE2 return TYPE ]" + -- "procedure XXX [ TYPE1, TYPE2 ]" + -- "implicit function XXX [ TYPE1, TYPE2 return TYPE ]" + -- "implicit procedure XXX [ TYPE1, TYPE2 ]" + function Disp_Subprg (Subprg : Iir) return String; + + -- Print element POS of discrete type DTYPE. + function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String; + + -- Disp the name of the type of NODE if known. + -- Disp "unknown" if it is not known. + -- Disp all possible types if it is an overload list. + function Disp_Type_Of (Node : Iir) return String; + + -- Disp an error message when a pure function CALLER calls impure CALLEE. + procedure Error_Pure (Caller : Iir; Callee : Iir; Loc : Iir); + + -- Report an error message as type of EXPR does not match A_TYPE. + -- Location is LOC. + procedure Error_Not_Match (Expr: Iir; A_Type: Iir; Loc : Iir); + + +end Errorout; diff --git a/evaluation.adb b/evaluation.adb new file mode 100644 index 000000000..c64eea451 --- /dev/null +++ b/evaluation.adb @@ -0,0 +1,2030 @@ +-- Evaluation of static expressions. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Errorout; use Errorout; +with Name_Table; use Name_Table; +with Str_Table; +with Iirs_Utils; use Iirs_Utils; +with Std_Package; use Std_Package; +with Flags; +with Std_Names; + +package body Evaluation is + function Get_Physical_Value (Expr : Iir) return Iir_Int64 is + begin + case Get_Kind (Expr) is + when Iir_Kind_Physical_Int_Literal => + return Get_Value (Expr) + * Get_Value (Get_Physical_Unit_Value (Get_Unit_Name (Expr))); + when Iir_Kind_Unit_Declaration => + return Get_Value (Get_Physical_Unit_Value (Expr)); + when others => + Error_Kind ("get_physical_value", Expr); + end case; + end Get_Physical_Value; + + function Build_Integer (Val : Iir_Int64; Origin : Iir) + return Iir_Integer_Literal + is + Res : Iir_Integer_Literal; + begin + Res := Create_Iir (Iir_Kind_Integer_Literal); + Location_Copy (Res, Origin); + Set_Value (Res, Val); + Set_Type (Res, Get_Type (Origin)); + Set_Literal_Origin (Res, Origin); + Set_Expr_Staticness (Res, Locally); + return Res; + end Build_Integer; + + function Build_Floating (Val : Iir_Fp64; Origin : Iir) + return Iir_Floating_Point_Literal + is + Res : Iir_Floating_Point_Literal; + begin + Res := Create_Iir (Iir_Kind_Floating_Point_Literal); + Location_Copy (Res, Origin); + Set_Fp_Value (Res, Val); + Set_Type (Res, Get_Type (Origin)); + Set_Literal_Origin (Res, Origin); + Set_Expr_Staticness (Res, Locally); + return Res; + end Build_Floating; + + function Build_Enumeration (Val : Iir_Index32; Origin : Iir) + return Iir_Enumeration_Literal + is + Res : Iir_Enumeration_Literal; + Enum_Type : Iir; + Enum_List : Iir_List; + Lit : Iir_Enumeration_Literal; + begin + Enum_Type := Get_Base_Type (Get_Type (Origin)); + Enum_List := Get_Enumeration_Literal_List (Enum_Type); + Lit := Get_Nth_Element (Enum_List, Integer (Val)); + + Res := Create_Iir (Iir_Kind_Enumeration_Literal); + Set_Identifier (Res, Get_Identifier (Lit)); + Location_Copy (Res, Origin); + Set_Enum_Pos (Res, Iir_Int32 (Val)); + Set_Type (Res, Get_Type (Origin)); + Set_Literal_Origin (Res, Origin); + Set_Expr_Staticness (Res, Locally); + Set_Enumeration_Decl (Res, Lit); + return Res; + end Build_Enumeration; + + function Build_Boolean (Cond : Boolean; Origin : Iir) return Iir is + begin + return Build_Enumeration (Boolean'Pos (Cond), Origin); + end Build_Boolean; + + function Build_Physical (Val : Iir_Int64; Origin : Iir) + return Iir_Physical_Int_Literal + is + Res : Iir_Physical_Int_Literal; + begin + Res := Create_Iir (Iir_Kind_Physical_Int_Literal); + Location_Copy (Res, Origin); + Set_Unit_Name (Res, Get_Primary_Unit (Get_Type (Origin))); + Set_Value (Res, Val); + Set_Type (Res, Get_Type (Origin)); + Set_Literal_Origin (Res, Origin); + Set_Expr_Staticness (Res, Locally); + return Res; + end Build_Physical; + + function Build_Discrete (Val : Iir_Int64; Origin : Iir) + return Iir + is + begin + case Get_Kind (Get_Type (Origin)) is + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + return Build_Enumeration (Iir_Index32 (Val), Origin); + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Integer_Subtype_Definition => + return Build_Integer (Val, Origin); + when others => + Error_Kind ("build_discrete", Get_Type (Origin)); + end case; + end Build_Discrete; + + function Build_String (Val : String_Id; Len : Nat32; Origin : Iir) + return Iir_String_Literal + is + Res : Iir_String_Literal; + begin + Res := Create_Iir (Iir_Kind_String_Literal); + Location_Copy (Res, Origin); + Set_String_Id (Res, Val); + Set_String_Length (Res, Len); + Set_Type (Res, Get_Type (Origin)); + Set_Literal_Origin (Res, Origin); + Set_Expr_Staticness (Res, Locally); + return Res; + end Build_String; + + function Build_Simple_Aggregate + (El_List : Iir_List; Origin : Iir; Stype : Iir) + return Iir_Simple_Aggregate + is + Res : Iir_Simple_Aggregate; + begin + Res := Create_Iir (Iir_Kind_Simple_Aggregate); + Location_Copy (Res, Origin); + Set_Simple_Aggregate_List (Res, El_List); + Set_Type (Res, Stype); + Set_Literal_Origin (Res, Origin); + Set_Expr_Staticness (Res, Locally); + return Res; + end Build_Simple_Aggregate; + + function Build_Constant (Val : Iir; Origin : Iir) return Iir + is + Res : Iir; + begin + -- Note: this must work for any literals, because it may be used to + -- replace a locally static constant by its initial value. + case Get_Kind (Val) is + when Iir_Kind_Integer_Literal => + Res := Create_Iir (Iir_Kind_Integer_Literal); + Set_Value (Res, Get_Value (Val)); + when Iir_Kind_Floating_Point_Literal => + Res := Create_Iir (Iir_Kind_Floating_Point_Literal); + Set_Fp_Value (Res, Get_Fp_Value (Val)); + when Iir_Kind_Enumeration_Literal => + return Get_Nth_Element + (Get_Enumeration_Literal_List + (Get_Base_Type (Get_Type (Origin))), + Integer (Get_Enum_Pos (Val))); + when Iir_Kind_Physical_Int_Literal => + declare + Prim : Iir; + begin + Res := Create_Iir (Iir_Kind_Physical_Int_Literal); + Prim := Get_Primary_Unit (Get_Base_Type (Get_Type (Origin))); + Set_Unit_Name (Res, Prim); + if Get_Unit_Name (Val) = Prim then + Set_Value (Res, Get_Value (Val)); + else + raise Internal_Error; + --Set_Abstract_Literal (Res, Get_Abstract_Literal (Val) + -- * Get_Value (Get_Name (Val))); + end if; + end; + when Iir_Kind_Unit_Declaration => + Res := Create_Iir (Iir_Kind_Physical_Int_Literal); + Set_Value (Res, Get_Physical_Value (Val)); + Set_Unit_Name (Res, Get_Primary_Unit (Get_Type (Val))); + + when Iir_Kind_String_Literal => + Res := Create_Iir (Iir_Kind_String_Literal); + Set_String_Id (Res, Get_String_Id (Val)); + Set_String_Length (Res, Get_String_Length (Val)); + + when Iir_Kind_Bit_String_Literal => + Res := Create_Iir (Iir_Kind_Bit_String_Literal); + Set_String_Id (Res, Get_String_Id (Val)); + Set_String_Length (Res, Get_String_Length (Val)); + Set_Bit_String_Base (Res, Get_Bit_String_Base (Val)); + Set_Bit_String_0 (Res, Get_Bit_String_0 (Val)); + Set_Bit_String_1 (Res, Get_Bit_String_1 (Val)); + + when Iir_Kind_Simple_Aggregate => + Res := Create_Iir (Iir_Kind_Simple_Aggregate); + Set_Simple_Aggregate_List (Res, Get_Simple_Aggregate_List (Val)); + + when Iir_Kind_Error => + return Val; + + when others => + Error_Kind ("build_constant", Val); + end case; + Location_Copy (Res, Origin); + Set_Type (Res, Get_Type (Origin)); + Set_Literal_Origin (Res, Origin); + Set_Expr_Staticness (Res, Locally); + return Res; + end Build_Constant; + + -- A_RANGE is a range expression, whose type, location, expr_staticness, + -- left_limit and direction are set. + -- Type of A_RANGE must have a range_constraint. + -- Set the right limit of A_RANGE from LEN. + procedure Set_Right_Limit_By_Length (A_Range : Iir; Len : Iir_Int64) + is + Left, Right : Iir; + Pos : Iir_Int64; + A_Type : Iir; + begin + if Get_Expr_Staticness (A_Range) /= Locally then + raise Internal_Error; + end if; + A_Type := Get_Type (A_Range); + + Left := Get_Left_Limit (A_Range); + + Pos := Eval_Pos (Left); + case Get_Direction (A_Range) is + when Iir_To => + Pos := Pos + Len -1; + when Iir_Downto => + Pos := Pos - Len + 1; + end case; + if Len > 0 + and then not Eval_Int_In_Range (Pos, Get_Range_Constraint (A_Type)) + then + Error_Msg_Sem ("range length is beyond subtype length", A_Range); + Right := Left; + else + -- FIXME: what about nul range? + Right := Build_Discrete (Pos, A_Range); + Set_Literal_Origin (Right, Null_Iir); + end if; + Set_Right_Limit (A_Range, Right); + end Set_Right_Limit_By_Length; + + -- Create a range of type A_TYPE whose length is LEN. + -- Note: only two nodes are created: + -- * the range_expression (node returned) + -- * the right bound + -- The left bound *IS NOT* created, but points to the left bound of A_TYPE. + function Create_Range_By_Length + (A_Type : Iir; Len : Iir_Int64; Loc : Location_Type) + return Iir + is + Index_Constraint : Iir; + Constraint : Iir; + begin + if Get_Type_Staticness (A_Type) /= Locally then + raise Internal_Error; + end if; + + Index_Constraint := Get_Range_Constraint (A_Type); + Constraint := Create_Iir (Iir_Kind_Range_Expression); + Set_Location (Constraint, Loc); + Set_Expr_Staticness (Constraint, Locally); + Set_Type (Constraint, A_Type); + Set_Left_Limit (Constraint, Get_Left_Limit (Index_Constraint)); + Set_Direction (Constraint, Get_Direction (Index_Constraint)); + Set_Right_Limit_By_Length (Constraint, Len); + return Constraint; + end Create_Range_By_Length; + + function Create_Range_Subtype_From_Type (A_Type : Iir; Loc : Location_Type) + return Iir + is + Res : Iir; + begin + if Get_Type_Staticness (A_Type) /= Locally then + raise Internal_Error; + end if; + + case Get_Kind (A_Type) is + when Iir_Kind_Enumeration_Type_Definition => + Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + Res := Create_Iir (Get_Kind (A_Type)); + when others => + Error_Kind ("create_range_subtype_by_length", A_Type); + end case; + Set_Location (Res, Loc); + Set_Base_Type (Res, Get_Base_Type (A_Type)); + Set_Type_Staticness (Res, Locally); + + return Res; + end Create_Range_Subtype_From_Type; + + -- Create a subtype of A_TYPE whose length is LEN. + -- This is used to create subtypes for strings or aggregates. + function Create_Range_Subtype_By_Length + (A_Type : Iir; Len : Iir_Int64; Loc : Location_Type) + return Iir + is + Res : Iir; + begin + Res := Create_Range_Subtype_From_Type (A_Type, Loc); + + Set_Range_Constraint (Res, Create_Range_By_Length (A_Type, Len, Loc)); + return Res; + end Create_Range_Subtype_By_Length; + + function Create_Unidim_Array_From_Index + (Base_Type : Iir; Index_Type : Iir; Loc : Iir) + return Iir_Array_Subtype_Definition + is + Res : Iir_Array_Subtype_Definition; + begin + Res := Create_Array_Subtype (Base_Type, Get_Location (Loc)); + Append_Element (Get_Index_Subtype_List (Res), Index_Type); + Set_Type_Staticness (Res, Min (Get_Type_Staticness (Res), + Get_Type_Staticness (Index_Type))); + return Res; + end Create_Unidim_Array_From_Index; + + function Create_Unidim_Array_By_Length + (Base_Type : Iir; Len : Iir_Int64; Loc : Iir) + return Iir_Array_Subtype_Definition + is + Index_Type : Iir; + N_Index_Type : Iir; + begin + Index_Type := Get_First_Element (Get_Index_Subtype_List (Base_Type)); + N_Index_Type := Create_Range_Subtype_By_Length + (Index_Type, Len, Get_Location (Loc)); + return Create_Unidim_Array_From_Index (Base_Type, N_Index_Type, Loc); + end Create_Unidim_Array_By_Length; + + function Eval_String_Literal (Str : Iir) return Iir + is + use Name_Table; + Ptr : String_Fat_Acc; + Len : Natural; + begin + case Get_Kind (Str) is + when Iir_Kind_String_Literal => + declare + Element_Type : Iir; + Literal_List : Iir_List; + Lit : Iir; + + List : Iir_List; + begin + Element_Type := Get_Base_Type + (Get_Element_Subtype (Get_Base_Type (Get_Type (Str)))); + Literal_List := Get_Enumeration_Literal_List (Element_Type); + List := Create_Iir_List; + + Ptr := Get_String_Fat_Acc (Str); + Len := Get_String_Length (Str); + + for I in 1 .. Len loop + Lit := Find_Name_In_List + (Literal_List, + Name_Table.Get_Identifier (Ptr (I))); + Append_Element (List, Lit); + end loop; + return Build_Simple_Aggregate (List, Str, Get_Type (Str)); + end; + when Iir_Kind_Bit_String_Literal => + declare + Str_Type : Iir; + List : Iir_List; + Lit_0 : Iir; + Lit_1 : Iir; + begin + Str_Type := Get_Type (Str); + List := Create_Iir_List; + Lit_0 := Get_Bit_String_0 (Str); + Lit_1 := Get_Bit_String_1 (Str); + + Ptr := Get_String_Fat_Acc (Str); + Len := Get_String_Length (Str); + + for I in 1 .. Len loop + case Ptr (I) is + when '0' => + Append_Element (List, Lit_0); + when '1' => + Append_Element (List, Lit_1); + when others => + raise Internal_Error; + end case; + end loop; + return Build_Simple_Aggregate (List, Str, Str_Type); + end; + when Iir_Kind_Simple_Aggregate => + return Str; + when others => + Error_Kind ("eval_string_literal", Str); + end case; + end Eval_String_Literal; + + function Eval_Monadic_Operator (Orig : Iir; Operand : Iir) return Iir + is + pragma Unsuppress (Overflow_Check); + + Func : Iir_Predefined_Functions; + begin + Func := Get_Implicit_Definition (Get_Implementation (Orig)); + case Func is + when Iir_Predefined_Integer_Negation => + return Build_Integer (-Get_Value (Operand), Orig); + when Iir_Predefined_Integer_Identity => + return Build_Integer (Get_Value (Operand), Orig); + when Iir_Predefined_Integer_Absolute => + return Build_Integer (abs Get_Value (Operand), Orig); + + when Iir_Predefined_Floating_Negation => + return Build_Floating (-Get_Fp_Value (Operand), Orig); + when Iir_Predefined_Floating_Identity => + return Build_Floating (Get_Fp_Value (Operand), Orig); + when Iir_Predefined_Floating_Absolute => + return Build_Floating (abs Get_Fp_Value (Operand), Orig); + + when Iir_Predefined_Physical_Negation => + return Build_Physical (-Get_Physical_Value (Operand), Orig); + when Iir_Predefined_Physical_Identity => + return Build_Physical (Get_Physical_Value (Operand), Orig); + when Iir_Predefined_Physical_Absolute => + return Build_Physical (abs Get_Physical_Value (Operand), Orig); + + when Iir_Predefined_Boolean_Not + | Iir_Predefined_Bit_Not => + return Build_Enumeration + (Boolean'Pos (Get_Enum_Pos (Operand) = 0), Orig); + + when Iir_Predefined_Bit_Array_Not => + declare + O_List : Iir_List; + R_List : Iir_List; + El : Iir; + Lit : Iir; + begin + O_List := Get_Simple_Aggregate_List + (Eval_String_Literal (Operand)); + R_List := Create_Iir_List; + + for I in Natural loop + El := Get_Nth_Element (O_List, I); + exit when El = Null_Iir; + case Get_Enum_Pos (El) is + when 0 => + Lit := Bit_1; + when 1 => + Lit := Bit_0; + when others => + raise Internal_Error; + end case; + Append_Element (R_List, Lit); + end loop; + return Build_Simple_Aggregate + (R_List, Orig, Get_Type (Operand)); + end; + when others => + Error_Internal (Orig, "eval_monadic_operator: " & + Iir_Predefined_Functions'Image (Func)); + end case; + exception + when Constraint_Error => + Error_Msg_Sem ("arithmetic overflow in static expression", Orig); + return Orig; + end Eval_Monadic_Operator; + + function Eval_Dyadic_Bit_Array_Operator + (Expr : Iir; + Left, Right : Iir; + Func : Iir_Predefined_Dyadic_Bit_Array_Functions) + return Iir + is + use Str_Table; + L_Str : String_Fat_Acc := Get_String_Fat_Acc (Left); + R_Str : String_Fat_Acc := Get_String_Fat_Acc (Right); + Len : Natural; + Id : String_Id; + begin + Len := Get_String_Length (Left); + if Len /= Get_String_Length (Right) then + Error_Msg_Sem ("length of left and right operands mismatch", Expr); + return Left; + else + Id := Start; + case Func is + when Iir_Predefined_Bit_Array_And => + for I in 1 .. Len loop + case L_Str (I) is + when '0' => + Append ('0'); + when '1' => + Append (R_Str (I)); + when others => + raise Internal_Error; + end case; + end loop; + when Iir_Predefined_Bit_Array_Nand => + for I in 1 .. Len loop + case L_Str (I) is + when '0' => + Append ('1'); + when '1' => + case R_Str (I) is + when '0' => + Append ('1'); + when '1' => + Append ('0'); + when others => + raise Internal_Error; + end case; + when others => + raise Internal_Error; + end case; + end loop; + when Iir_Predefined_Bit_Array_Or => + for I in 1 .. Len loop + case L_Str (I) is + when '1' => + Append ('1'); + when '0' => + Append (R_Str (I)); + when others => + raise Internal_Error; + end case; + end loop; + when Iir_Predefined_Bit_Array_Nor => + for I in 1 .. Len loop + case L_Str (I) is + when '1' => + Append ('0'); + when '0' => + case R_Str (I) is + when '0' => + Append ('1'); + when '1' => + Append ('0'); + when others => + raise Internal_Error; + end case; + when others => + raise Internal_Error; + end case; + end loop; + when Iir_Predefined_Bit_Array_Xor => + for I in 1 .. Len loop + case L_Str (I) is + when '1' => + case R_Str (I) is + when '0' => + Append ('1'); + when '1' => + Append ('0'); + when others => + raise Internal_Error; + end case; + when '0' => + case R_Str (I) is + when '0' => + Append ('0'); + when '1' => + Append ('1'); + when others => + raise Internal_Error; + end case; + when others => + raise Internal_Error; + end case; + end loop; + when others => + Error_Internal (Expr, "eval_dyadic_bit_array_functions: " & + Iir_Predefined_Functions'Image (Func)); + end case; + Finish; + return Build_String (Id, Nat32 (Len), Left); + end if; + end Eval_Dyadic_Bit_Array_Operator; + + -- Return TRUE if VAL /= 0. + function Check_Integer_Division_By_Zero (Expr : Iir; Val : Iir) + return Boolean + is + begin + if Get_Value (Val) = 0 then + Error_Msg_Sem ("division by 0", Expr); + return False; + else + return True; + end if; + end Check_Integer_Division_By_Zero; + + function Eval_Shift_Operator + (Left, Right : Iir; Origin : Iir; Func : Iir_Predefined_Shift_Functions) + return Iir + is + Count : Iir_Int64; + Cnt : Natural; + Len : Natural; + Arr_List : Iir_List; + Res_List : Iir_List; + Dir_Left : Boolean; + E : Iir; + begin + Count := Get_Value (Right); + Arr_List := Get_Simple_Aggregate_List (Left); + Len := Get_Nbr_Elements (Arr_List); + -- LRM93 7.2.3 + -- That is, if R is 0 or if L is a null array, the return value is L. + if Count = 0 or Len = 0 then + return Build_Simple_Aggregate (Arr_List, Origin, Get_Type (Left)); + end if; + case Func is + when Iir_Predefined_Array_Sll + | Iir_Predefined_Array_Sla + | Iir_Predefined_Array_Rol => + Dir_Left := True; + when Iir_Predefined_Array_Srl + | Iir_Predefined_Array_Sra + | Iir_Predefined_Array_Ror => + Dir_Left := False; + end case; + if Count < 0 then + Cnt := Natural (-Count); + Dir_Left := not Dir_Left; + else + Cnt := Natural (Count); + end if; + + case Func is + when Iir_Predefined_Array_Sll + | Iir_Predefined_Array_Srl => + declare + Enum_List : Iir_List; + begin + Enum_List := Get_Enumeration_Literal_List + (Get_Base_Type (Get_Element_Subtype (Get_Type (Left)))); + E := Get_Nth_Element (Enum_List, 0); + end; + when Iir_Predefined_Array_Sla + | Iir_Predefined_Array_Sra => + if Dir_Left then + E := Get_Nth_Element (Arr_List, Len - 1); + else + E := Get_Nth_Element (Arr_List, 0); + end if; + when Iir_Predefined_Array_Rol + | Iir_Predefined_Array_Ror => + Cnt := Cnt mod Len; + if not Dir_Left then + Cnt := Len - Cnt; + end if; + when others => + raise Internal_Error; + end case; + + Res_List := Create_Iir_List; + + case Func is + when Iir_Predefined_Array_Sll + | Iir_Predefined_Array_Srl + | Iir_Predefined_Array_Sla + | Iir_Predefined_Array_Sra => + if Dir_Left then + if Cnt < Len then + for I in Cnt .. Len - 1 loop + Append_Element + (Res_List, Get_Nth_Element (Arr_List, I)); + end loop; + else + Cnt := Len; + end if; + for I in 0 .. Cnt - 1 loop + Append_Element (Res_List, E); + end loop; + else + if Cnt > Len then + Cnt := Len; + end if; + for I in 0 .. Cnt - 1 loop + Append_Element (Res_List, E); + end loop; + for I in Cnt .. Len - 1 loop + Append_Element + (Res_List, Get_Nth_Element (Arr_List, I - Cnt)); + end loop; + end if; + when Iir_Predefined_Array_Rol + | Iir_Predefined_Array_Ror => + for I in 1 .. Len loop + Append_Element + (Res_List, Get_Nth_Element (Arr_List, Cnt)); + Cnt := Cnt + 1; + if Cnt = Len then + Cnt := 0; + end if; + end loop; + end case; + return Build_Simple_Aggregate (Res_List, Origin, Get_Type (Left)); + end Eval_Shift_Operator; + + -- Note: operands must be locally static. + function Eval_Concatenation + (Left, Right : Iir; Orig : Iir; Func : Iir_Predefined_Concat_Functions) + return Iir + is + Res_List : Iir_List; + L : Natural; + Res_Type : Iir; + Origin_Type : Iir; + Left_List, Right_List : Iir_List; + begin + Res_List := Create_Iir_List; + -- Do the concatenation. + -- Left: + case Func is + when Iir_Predefined_Element_Array_Concat + | Iir_Predefined_Element_Element_Concat => + Append_Element (Res_List, Left); + when Iir_Predefined_Array_Element_Concat + | Iir_Predefined_Array_Array_Concat => + Left_List := + Get_Simple_Aggregate_List (Eval_String_Literal (Left)); + L := Get_Nbr_Elements (Left_List); + for I in 0 .. L - 1 loop + Append_Element (Res_List, Get_Nth_Element (Left_List, I)); + end loop; + end case; + -- Right: + case Func is + when Iir_Predefined_Array_Element_Concat + | Iir_Predefined_Element_Element_Concat => + Append_Element (Res_List, Right); + when Iir_Predefined_Element_Array_Concat + | Iir_Predefined_Array_Array_Concat => + Right_List := + Get_Simple_Aggregate_List (Eval_String_Literal (Right)); + L := Get_Nbr_Elements (Right_List); + for I in 0 .. L - 1 loop + Append_Element (Res_List, Get_Nth_Element (Right_List, I)); + end loop; + end case; + L := Get_Nbr_Elements (Res_List); + + -- Compute subtype... + Origin_Type := Get_Type (Orig); + Res_Type := Null_Iir; + if Func = Iir_Predefined_Array_Array_Concat + and then Get_Nbr_Elements (Left_List) = 0 + then + if Flags.Vhdl_Std = Vhdl_87 then + -- LRM87 7.2.4 + -- [...], unless the left operand is a null array, in which case + -- the result of the concatenation is the right operand. + Res_Type := Get_Type (Right); + else + -- LRM93 7.2.4 + -- If both operands are null arrays, then the result of the + -- concatenation is the right operand. + if Get_Nbr_Elements (Right_List) = 0 then + Res_Type := Get_Type (Right); + end if; + end if; + end if; + if Res_Type = Null_Iir then + if Flags.Vhdl_Std = Vhdl_87 + and then (Func = Iir_Predefined_Array_Array_Concat + or Func = Iir_Predefined_Array_Element_Concat) + then + -- LRM87 7.2.4 + -- The left bound of the result is the left operand, [...] + -- + -- LRM87 7.2.4 + -- The direction of the result is the direction of the left + -- operand, [...] + declare + A_Range : Iir; + Left_Index : Iir; + Left_Range : Iir; + Index_Type : Iir; + Ret_Type : Iir; + begin + Left_Index := Get_Nth_Element + (Get_Index_Subtype_List (Get_Type (Left)), 0); + Left_Range := Get_Range_Constraint (Left_Index); + + A_Range := Create_Iir (Iir_Kind_Range_Expression); + Ret_Type := Get_Return_Type (Get_Implementation (Orig)); + Set_Type + (A_Range, + Get_First_Element (Get_Index_Subtype_List (Ret_Type))); + Set_Expr_Staticness (A_Range, Locally); + Set_Left_Limit (A_Range, Get_Left_Limit (Left_Range)); + Set_Direction (A_Range, Get_Direction (Left_Range)); + Location_Copy (A_Range, Orig); + Set_Right_Limit_By_Length (A_Range, Iir_Int64 (L)); + Index_Type := Create_Range_Subtype_From_Type + (Left_Index, Get_Location (Orig)); + Set_Range_Constraint (Index_Type, A_Range); + Res_Type := Create_Unidim_Array_From_Index + (Origin_Type, Index_Type, Orig); + end; + else + -- LRM93 7.2.4 + -- Otherwise, the direction and bounds of the result are + -- determined as follows: let S be the index subtype of the base + -- type of the result. The direction of the result of the + -- concatenation is the direction of S, and the left bound of the + -- result is S'LEFT. + Res_Type := Create_Unidim_Array_By_Length + (Origin_Type, Iir_Int64 (L), Orig); + end if; + end if; + -- FIXME: this is not necessarily a string, it may be an aggregate if + -- element type is not a character type. + return Build_Simple_Aggregate (Res_List, Orig, Res_Type); + end Eval_Concatenation; + + -- ORIG is either a dyadic operator or a function call. + function Eval_Dyadic_Operator (Orig : Iir; Left, Right : Iir) + return Iir + is + pragma Unsuppress (Overflow_Check); + Func : Iir_Predefined_Functions; + begin + if Get_Kind (Left) = Iir_Kind_Error + or else Get_Kind (Right) = Iir_Kind_Error + then + return Null_Iir; + end if; + + Func := Get_Implicit_Definition (Get_Implementation (Orig)); + case Func is + when Iir_Predefined_Integer_Plus => + return Build_Integer (Get_Value (Left) + Get_Value (Right), Orig); + when Iir_Predefined_Integer_Minus => + return Build_Integer (Get_Value (Left) - Get_Value (Right), Orig); + when Iir_Predefined_Integer_Mul => + return Build_Integer (Get_Value (Left) * Get_Value (Right), Orig); + when Iir_Predefined_Integer_Div => + if Check_Integer_Division_By_Zero (Orig, Right) then + return Build_Integer + (Get_Value (Left) / Get_Value (Right), Orig); + else + return Null_Iir; + end if; + when Iir_Predefined_Integer_Mod => + if Check_Integer_Division_By_Zero (Orig, Right) then + return Build_Integer + (Get_Value (Left) mod Get_Value (Right), Orig); + else + return Null_Iir; + end if; + when Iir_Predefined_Integer_Rem => + if Check_Integer_Division_By_Zero (Orig, Right) then + return Build_Integer + (Get_Value (Left) rem Get_Value (Right), Orig); + else + return Null_Iir; + end if; + when Iir_Predefined_Integer_Exp => + return Build_Integer + (Get_Value (Left) ** Integer (Get_Value (Right)), Orig); + + when Iir_Predefined_Integer_Equality => + return Build_Boolean (Get_Value (Left) = Get_Value (Right), Orig); + when Iir_Predefined_Integer_Inequality => + return Build_Boolean (Get_Value (Left) /= Get_Value (Right), Orig); + when Iir_Predefined_Integer_Greater_Equal => + return Build_Boolean (Get_Value (Left) >= Get_Value (Right), Orig); + when Iir_Predefined_Integer_Greater => + return Build_Boolean (Get_Value (Left) > Get_Value (Right), Orig); + when Iir_Predefined_Integer_Less_Equal => + return Build_Boolean (Get_Value (Left) <= Get_Value (Right), Orig); + when Iir_Predefined_Integer_Less => + return Build_Boolean (Get_Value (Left) < Get_Value (Right), Orig); + + when Iir_Predefined_Floating_Equality => + return Build_Boolean + (Get_Fp_Value (Left) = Get_Fp_Value (Right), Orig); + when Iir_Predefined_Floating_Inequality => + return Build_Boolean + (Get_Fp_Value (Left) /= Get_Fp_Value (Right), Orig); + when Iir_Predefined_Floating_Greater => + return Build_Boolean + (Get_Fp_Value (Left) > Get_Fp_Value (Right), Orig); + when Iir_Predefined_Floating_Greater_Equal => + return Build_Boolean + (Get_Fp_Value (Left) >= Get_Fp_Value (Right), Orig); + when Iir_Predefined_Floating_Less => + return Build_Boolean + (Get_Fp_Value (Left) < Get_Fp_Value (Right), Orig); + when Iir_Predefined_Floating_Less_Equal => + return Build_Boolean + (Get_Fp_Value (Left) <= Get_Fp_Value (Right), Orig); + + when Iir_Predefined_Floating_Minus => + return Build_Floating + (Get_Fp_Value (Left) - Get_Fp_Value (Right), Orig); + when Iir_Predefined_Floating_Plus => + return Build_Floating + (Get_Fp_Value (Left) + Get_Fp_Value (Right), Orig); + when Iir_Predefined_Floating_Mul => + return Build_Floating + (Get_Fp_Value (Left) * Get_Fp_Value (Right), Orig); + when Iir_Predefined_Floating_Div => + if Get_Fp_Value (Right) = 0.0 then + Error_Msg_Sem ("right operand of division is 0", Orig); + return Build_Floating (0.0, Orig); + else + return Build_Floating + (Get_Fp_Value (Left) / Get_Fp_Value (Right), Orig); + end if; + when Iir_Predefined_Floating_Exp => + declare + Exp : Iir_Int64; + Res : Iir_Fp64; + Val : Iir_Fp64; + begin + Res := 1.0; + Val := Get_Fp_Value (Left); + Exp := abs Get_Value (Right); + while Exp /= 0 loop + if Exp mod 2 = 1 then + Res := Res * Val; + end if; + Exp := Exp / 2; + Val := Val * Val; + end loop; + if Get_Value (Right) < 0 then + Res := 1.0 / Res; + end if; + return Build_Floating (Res, Orig); + end; + + when Iir_Predefined_Physical_Equality => + return Build_Boolean + (Get_Physical_Value (Left) = Get_Physical_Value (Right), Orig); + when Iir_Predefined_Physical_Inequality => + return Build_Boolean + (Get_Physical_Value (Left) /= Get_Physical_Value (Right), Orig); + when Iir_Predefined_Physical_Greater_Equal => + return Build_Boolean + (Get_Physical_Value (Left) >= Get_Physical_Value (Right), Orig); + when Iir_Predefined_Physical_Greater => + return Build_Boolean + (Get_Physical_Value (Left) > Get_Physical_Value (Right), Orig); + when Iir_Predefined_Physical_Less_Equal => + return Build_Boolean + (Get_Physical_Value (Left) <= Get_Physical_Value (Right), Orig); + when Iir_Predefined_Physical_Less => + return Build_Boolean + (Get_Physical_Value (Left) < Get_Physical_Value (Right), Orig); + + when Iir_Predefined_Physical_Physical_Div => + return Build_Integer + (Get_Physical_Value (Left) / Get_Physical_Value (Right), Orig); + when Iir_Predefined_Physical_Integer_Div => + return Build_Physical + (Get_Physical_Value (Left) / Get_Value (Right), Orig); + when Iir_Predefined_Physical_Minus => + return Build_Physical + (Get_Physical_Value (Left) - Get_Physical_Value (Right), Orig); + when Iir_Predefined_Physical_Plus => + return Build_Physical + (Get_Physical_Value (Left) + Get_Physical_Value (Right), Orig); + when Iir_Predefined_Integer_Physical_Mul => + return Build_Physical + (Get_Value (Left) * Get_Physical_Value (Right), Orig); + when Iir_Predefined_Physical_Integer_Mul => + return Build_Physical + (Get_Physical_Value (Left) * Get_Value (Right), Orig); + when Iir_Predefined_Real_Physical_Mul => + -- FIXME: overflow?? + return Build_Physical + (Iir_Int64 (Get_Fp_Value (Left) + * Iir_Fp64 (Get_Physical_Value (Right))), Orig); + when Iir_Predefined_Physical_Real_Mul => + -- FIXME: overflow?? + return Build_Physical + (Iir_Int64 (Iir_Fp64 (Get_Physical_Value (Left)) + * Get_Fp_Value (Right)), Orig); + when Iir_Predefined_Physical_Real_Div => + -- FIXME: overflow?? + return Build_Physical + (Iir_Int64 (Iir_Fp64 (Get_Physical_Value (Left)) + / Get_Fp_Value (Right)), Orig); + + when Iir_Predefined_Element_Array_Concat + | Iir_Predefined_Array_Element_Concat + | Iir_Predefined_Array_Array_Concat + | Iir_Predefined_Element_Element_Concat => + return Eval_Concatenation (Left, Right, Orig, Func); + + when Iir_Predefined_Enum_Equality => + return Build_Boolean + (Get_Enum_Pos (Left) = Get_Enum_Pos (Right), Orig); + when Iir_Predefined_Enum_Inequality => + return Build_Boolean + (Get_Enum_Pos (Left) /= Get_Enum_Pos (Right), Orig); + when Iir_Predefined_Enum_Greater_Equal => + return Build_Boolean + (Get_Enum_Pos (Left) >= Get_Enum_Pos (Right), Orig); + when Iir_Predefined_Enum_Greater => + return Build_Boolean + (Get_Enum_Pos (Left) > Get_Enum_Pos (Right), Orig); + when Iir_Predefined_Enum_Less_Equal => + return Build_Boolean + (Get_Enum_Pos (Left) <= Get_Enum_Pos (Right), Orig); + when Iir_Predefined_Enum_Less => + return Build_Boolean + (Get_Enum_Pos (Left) < Get_Enum_Pos (Right), Orig); + + when Iir_Predefined_Boolean_And + | Iir_Predefined_Bit_And => + return Build_Boolean + (Get_Enum_Pos (Left) = 1 and Get_Enum_Pos (Right) = 1, Orig); + when Iir_Predefined_Boolean_Nand + | Iir_Predefined_Bit_Nand => + return Build_Boolean + (not (Get_Enum_Pos (Left) = 1 and Get_Enum_Pos (Right) = 1), + Orig); + when Iir_Predefined_Boolean_Or + | Iir_Predefined_Bit_Or => + return Build_Boolean + (Get_Enum_Pos (Left) = 1 or Get_Enum_Pos (Right) = 1, Orig); + when Iir_Predefined_Boolean_Nor + | Iir_Predefined_Bit_Nor => + return Build_Boolean + (not (Get_Enum_Pos (Left) = 1 or Get_Enum_Pos (Right) = 1), + Orig); + when Iir_Predefined_Boolean_Xor + | Iir_Predefined_Bit_Xor => + return Build_Boolean + (Get_Enum_Pos (Left) = 1 xor Get_Enum_Pos (Right) = 1, Orig); + when Iir_Predefined_Boolean_Xnor + | Iir_Predefined_Bit_Xnor => + return Build_Boolean + (not (Get_Enum_Pos (Left) = 1 xor Get_Enum_Pos (Right) = 1), + Orig); + + when Iir_Predefined_Dyadic_Bit_Array_Functions => + return Eval_Dyadic_Bit_Array_Operator (Orig, Left, Right, Func); + + when Iir_Predefined_Universal_R_I_Mul => + return Build_Floating + (Get_Fp_Value (Left) * Iir_Fp64 (Get_Value (Right)), Orig); + when Iir_Predefined_Universal_I_R_Mul => + return Build_Floating + (Iir_Fp64 (Get_Value (Left)) * Get_Fp_Value (Right), Orig); + + when Iir_Predefined_Array_Equality => + declare + L_List : Iir_List; + R_List : Iir_List; + R : Boolean; + N : Natural; + begin + -- FIXME: the simple aggregates are lost. + L_List := + Get_Simple_Aggregate_List (Eval_String_Literal (Left)); + R_List := + Get_Simple_Aggregate_List (Eval_String_Literal (Right)); + N := Get_Nbr_Elements (L_List); + if N /= Get_Nbr_Elements (R_List) then + R := False; + else + R := True; + for I in 0 .. N - 1 loop + -- FIXME: this is wrong: (eg: evaluated lit) + if Get_Nth_Element (L_List, I) + /= Get_Nth_Element (R_List, I) + then + R := False; + exit; + end if; + end loop; + end if; + return Build_Boolean (R, Orig); + end; + + when Iir_Predefined_Array_Sll + | Iir_Predefined_Array_Srl + | Iir_Predefined_Array_Sla + | Iir_Predefined_Array_Sra + | Iir_Predefined_Array_Rol + | Iir_Predefined_Array_Ror => + return Eval_Shift_Operator + (Eval_String_Literal (Left), Right, Orig, Func); + + when Iir_Predefined_Boolean_Not + | Iir_Predefined_Bit_Not + | Iir_Predefined_Integer_Absolute + | Iir_Predefined_Integer_Identity + | Iir_Predefined_Integer_Negation + | Iir_Predefined_Floating_Absolute + | Iir_Predefined_Floating_Negation + | Iir_Predefined_Floating_Identity + | Iir_Predefined_Physical_Absolute + | Iir_Predefined_Physical_Identity + | Iir_Predefined_Physical_Negation + | Iir_Predefined_Error + | Iir_Predefined_Record_Equality + | Iir_Predefined_Record_Inequality + | Iir_Predefined_Access_Equality + | Iir_Predefined_Access_Inequality => + -- Not binary or never locally static. + Error_Internal (Orig, "eval_dyadic_operator: " & + Iir_Predefined_Functions'Image (Func)); + when others => + Error_Internal (Orig, "eval_dyadic_operator: " & + Iir_Predefined_Functions'Image (Func)); + end case; + exception + when Constraint_Error => + Error_Msg_Sem ("arithmetic overflow in static expression", Orig); + return Null_Iir; + end Eval_Dyadic_Operator; + + -- Evaluate any array attribute + function Eval_Array_Attribute (Attr : Iir) return Iir + is + Prefix : Iir; + Prefix_Type : Iir; + begin + Prefix := Get_Prefix (Attr); + case Get_Kind (Prefix) is + when Iir_Kinds_Object_Declaration + | Iir_Kind_Selected_Element + | Iir_Kind_Indexed_Name + | Iir_Kind_Slice_Name + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Type_Declaration + | Iir_Kind_Implicit_Dereference => + Prefix_Type := Get_Type (Prefix); + when Iir_Kind_Attribute_Value => + -- The type of the attribute declaration may be unconstrained. + Prefix_Type := Get_Type + (Get_Expression (Get_Attribute_Specification (Prefix))); + when Iir_Kinds_Subtype_Definition => + Prefix_Type := Prefix; + when others => + Error_Kind ("eval_array_attribute", Prefix); + end case; + if Get_Kind (Prefix_Type) /= Iir_Kind_Array_Subtype_Definition then + Error_Kind ("eval_array_attribute(2)", Prefix_Type); + end if; + return Get_Nth_Element (Get_Index_Subtype_List (Prefix_Type), + Natural (Get_Value (Get_Parameter (Attr)) - 1)); + end Eval_Array_Attribute; + + function Eval_Incdec (Expr : Iir; N : Iir_Int64) return Iir + is + P : Iir_Int64; + begin + case Get_Kind (Expr) is + when Iir_Kind_Integer_Literal => + return Build_Integer (Get_Value (Expr) + N, Expr); + when Iir_Kind_Enumeration_Literal => + P := Iir_Int64 (Get_Enum_Pos (Expr)) + N; + if P < 0 then + Error_Msg_Sem ("static constant violates bounds", Expr); + return Expr; + else + return Build_Enumeration (Iir_Index32 (P), Expr); + end if; + when Iir_Kind_Physical_Int_Literal => + return Build_Physical (Get_Value (Expr) + N, Expr); + when others => + Error_Kind ("eval_incdec", Expr); + end case; + end Eval_Incdec; + + function Convert_Range (Rng : Iir; Res_Type : Iir; Loc : Iir) return Iir + is + Res_Btype : Iir; + + function Create_Bound (Val : Iir) return Iir + is + R : Iir; + begin + R := Create_Iir (Iir_Kind_Integer_Literal); + Location_Copy (R, Loc); + Set_Value (R, Get_Value (Val)); + Set_Type (R, Res_Btype); + Set_Expr_Staticness (R, Locally); + return R; + end Create_Bound; + + Res : Iir; + begin + Res_Btype := Get_Base_Type (Res_Type); + Res := Create_Iir (Iir_Kind_Range_Expression); + Location_Copy (Res, Loc); + Set_Type (Res, Res_Btype); + Set_Left_Limit (Res, Create_Bound (Get_Left_Limit (Rng))); + Set_Right_Limit (Res, Create_Bound (Get_Right_Limit (Rng))); + Set_Direction (Res, Get_Direction (Rng)); + Set_Expr_Staticness (Res, Locally); + return Res; + end Convert_Range; + + function Eval_Array_Type_Conversion (Conv : Iir; Val : Iir) return Iir + is + Conv_Type : Iir; + Res : Iir; + Val_Type : Iir; + Conv_Index_Type : Iir; + Val_Index_Type : Iir; + Index_Type : Iir; + Rng : Iir; + begin + Conv_Type := Get_Type (Conv); + Conv_Index_Type := Get_Nth_Element + (Get_Index_Subtype_List (Conv_Type), 0); + Val_Type := Get_Type (Val); + Val_Index_Type := Get_Nth_Element + (Get_Index_Subtype_List (Val_Type), 0); + + -- The expression is either a simple aggregate or a (bit) string. + Res := Build_Constant (Val, Conv); + case Get_Kind (Conv_Type) is + when Iir_Kind_Array_Subtype_Definition => + Set_Type (Res, Conv_Type); + if Eval_Discrete_Type_Length (Conv_Index_Type) + /= Eval_Discrete_Type_Length (Val_Index_Type) + then + Error_Msg_Sem ("non matching length in type convertion", Conv); + end if; + return Res; + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition => + if Get_Base_Type (Conv_Index_Type) = Get_Base_Type (Val_Index_Type) + then + Index_Type := Val_Index_Type; + else + -- Convert the index range. + -- It is an integer type. + Rng := Convert_Range (Get_Range_Constraint (Val_Index_Type), + Conv_Index_Type, Conv); + Index_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition); + Location_Copy (Index_Type, Conv); + Set_Range_Constraint (Index_Type, Rng); + Set_Base_Type (Index_Type, Get_Base_Type (Conv_Index_Type)); + Set_Type_Staticness (Index_Type, Locally); + end if; + Set_Type (Res, + Create_Unidim_Array_From_Index + (Get_Base_Type (Conv_Type), Index_Type, Conv)); + return Res; + when others => + Error_Kind ("eval_array_type_conversion", Conv_Type); + end case; + end Eval_Array_Type_Conversion; + + function Eval_Type_Conversion (Expr : Iir) return Iir + is + Val : Iir; + Val_Type : Iir; + Conv_Type : Iir; + begin + Val := Eval_Expr (Get_Expression (Expr)); + Set_Expression (Expr, Val); + Val_Type := Get_Base_Type (Get_Type (Val)); + Conv_Type := Get_Base_Type (Get_Type (Expr)); + if Conv_Type = Val_Type then + return Build_Constant (Val, Expr); + end if; + case Get_Kind (Conv_Type) is + when Iir_Kind_Integer_Type_Definition => + case Get_Kind (Val_Type) is + when Iir_Kind_Integer_Type_Definition => + return Build_Integer (Get_Value (Val), Expr); + when Iir_Kind_Floating_Type_Definition => + return Build_Integer (Iir_Int64 (Get_Fp_Value (Val)), Expr); + when others => + Error_Kind ("eval_type_conversion(1)", Val_Type); + end case; + when Iir_Kind_Floating_Type_Definition => + case Get_Kind (Val_Type) is + when Iir_Kind_Integer_Type_Definition => + return Build_Floating (Iir_Fp64 (Get_Value (Val)), Expr); + when Iir_Kind_Floating_Type_Definition => + return Build_Floating (Get_Fp_Value (Val), Expr); + when others => + Error_Kind ("eval_type_conversion(2)", Val_Type); + end case; + when Iir_Kind_Array_Type_Definition => + return Eval_Array_Type_Conversion (Expr, Val); + when others => + Error_Kind ("eval_type_conversion(3)", Conv_Type); + end case; + end Eval_Type_Conversion; + + function Eval_Static_Expr (Expr: Iir) return Iir + is + Res : Iir; + Val : Iir; + begin + case Get_Kind (Expr) is + when Iir_Kind_Integer_Literal => + return Expr; + when Iir_Kind_Enumeration_Literal => + return Expr; + when Iir_Kind_Floating_Point_Literal => + return Expr; + when Iir_Kind_String_Literal => + return Expr; + when Iir_Kind_Bit_String_Literal => + return Expr; + when Iir_Kind_Physical_Int_Literal => + if Get_Unit_Name (Expr) + = Get_Primary_Unit (Get_Base_Type (Get_Type (Expr))) + then + return Expr; + else + return Build_Physical (Get_Physical_Value (Expr), Expr); + end if; + when Iir_Kind_Physical_Fp_Literal => + return Build_Physical + (Iir_Int64 (Get_Fp_Value (Expr) + * Iir_Fp64 (Get_Value (Get_Physical_Unit_Value + (Get_Unit_Name (Expr))))), + Expr); + when Iir_Kind_Constant_Declaration => + Val := Get_Default_Value (Expr); + Res := Build_Constant (Val, Expr); + Set_Type (Res, Get_Type (Val)); + return Res; + when Iir_Kind_Object_Alias_Declaration => + return Build_Constant (Eval_Static_Expr (Get_Name (Expr)), Expr); + when Iir_Kind_Unit_Declaration => + return Expr; + when Iir_Kind_Simple_Aggregate => + return Expr; + + when Iir_Kind_Qualified_Expression => + return Build_Constant (Eval_Expr (Get_Expression (Expr)), Expr); + when Iir_Kind_Type_Conversion => + return Eval_Type_Conversion (Expr); + when Iir_Kind_Range_Expression => + Set_Left_Limit (Expr, Eval_Expr (Get_Left_Limit (Expr))); + Set_Right_Limit (Expr, Eval_Expr (Get_Right_Limit (Expr))); + return Expr; + + when Iir_Kinds_Monadic_Operator => + declare + Operand : Iir; + begin + Operand := Eval_Expr (Get_Operand (Expr)); + Set_Operand (Expr, Operand); + return Eval_Monadic_Operator (Expr, Operand); + end; + when Iir_Kinds_Dyadic_Operator => + declare + Left, Right : Iir; + begin + Left := Eval_Expr (Get_Left (Expr)); + Right := Eval_Expr (Get_Right (Expr)); + + Set_Left (Expr, Left); + Set_Right (Expr, Right); + return Eval_Dyadic_Operator (Expr, Left, Right); + end; + + when Iir_Kind_Attribute_Value => + -- FIXME. + -- Currently, this avoids weird nodes, such as a string literal + -- whose type is an unconstrained array type. + Val := Get_Expression (Get_Attribute_Specification (Expr)); + Res := Build_Constant (Val, Expr); + Set_Type (Res, Get_Type (Val)); + return Res; + + when Iir_Kind_Pos_Attribute => + declare + Val : Iir; + begin + Val := Eval_Expr (Get_Parameter (Expr)); + Set_Parameter (Expr, Val); + return Build_Integer (Eval_Pos (Val), Expr); + end; + when Iir_Kind_Val_Attribute => + declare + Val_Expr : Iir; + Val : Iir_Int64; + Expr_Type : Iir; + begin + Val_Expr := Eval_Expr (Get_Parameter (Expr)); + Set_Parameter (Expr, Val_Expr); + Val := Eval_Pos (Val_Expr); + -- Note: the type of 'val is a base type. + Expr_Type := Get_Type (Expr); + -- FIXME: handle VHDL93 restrictions. + if Get_Kind (Expr_Type) = Iir_Kind_Enumeration_Type_Definition + and then + not Eval_Int_In_Range (Val, Get_Range_Constraint (Expr_Type)) + then + Error_Msg_Sem + ("static argument out of the type range", Expr); + Val := 0; + end if; + if Get_Kind (Get_Base_Type (Get_Type (Expr))) + = Iir_Kind_Physical_Type_Definition + then + return Build_Physical (Val, Expr); + else + return Build_Discrete (Val, Expr); + end if; + end; + + when Iir_Kind_Left_Type_Attribute => + return Build_Constant + (Get_Left_Limit (Eval_Range (Get_Type (Expr))), Expr); + when Iir_Kind_Right_Type_Attribute => + return Build_Constant + (Get_Right_Limit (Eval_Range (Get_Type (Expr))), Expr); + when Iir_Kind_High_Type_Attribute => + return Build_Constant + (Get_High_Limit (Eval_Range (Get_Type (Expr))), Expr); + when Iir_Kind_Low_Type_Attribute => + return Build_Constant + (Get_Low_Limit (Eval_Range (Get_Type (Expr))), Expr); + when Iir_Kind_Ascending_Type_Attribute => + return Build_Boolean + (Get_Direction (Eval_Range (Get_Type (Expr))) = Iir_To, Expr); + + when Iir_Kind_Range_Array_Attribute => + declare + Index : Iir; + begin + Index := Eval_Array_Attribute (Expr); + return Get_Range_Constraint (Index); + end; + when Iir_Kind_Reverse_Range_Array_Attribute => + declare + Res : Iir; + Rng : Iir; + begin + Rng := Get_Range_Constraint (Eval_Array_Attribute (Expr)); + Res := Create_Iir (Iir_Kind_Range_Expression); + Location_Copy (Res, Rng); + Set_Type (Res, Get_Type (Rng)); + case Get_Direction (Rng) is + when Iir_To => + Set_Direction (Res, Iir_Downto); + when Iir_Downto => + Set_Direction (Res, Iir_To); + end case; + Set_Left_Limit (Res, Get_Right_Limit (Rng)); + Set_Right_Limit (Res, Get_Left_Limit (Rng)); + -- FIXME: todo. + --Set_Literal_Origin (Res, Rng); + Set_Expr_Staticness (Res, Get_Expr_Staticness (Rng)); + return Res; + end; + when Iir_Kind_Length_Array_Attribute => + declare + Index : Iir; + begin + Index := Eval_Array_Attribute (Expr); + return Build_Discrete (Eval_Discrete_Type_Length (Index), Expr); + end; + when Iir_Kind_Left_Array_Attribute => + declare + Index : Iir; + begin + Index := Eval_Array_Attribute (Expr); + return Build_Constant + (Get_Left_Limit (Get_Range_Constraint (Index)), Expr); + end; + when Iir_Kind_Right_Array_Attribute => + declare + Index : Iir; + begin + Index := Eval_Array_Attribute (Expr); + return Build_Constant + (Get_Right_Limit (Get_Range_Constraint (Index)), Expr); + end; + when Iir_Kind_Low_Array_Attribute => + declare + Index : Iir; + begin + Index := Eval_Array_Attribute (Expr); + return Build_Constant + (Get_Low_Limit (Get_Range_Constraint (Index)), Expr); + end; + when Iir_Kind_High_Array_Attribute => + declare + Index : Iir; + begin + Index := Eval_Array_Attribute (Expr); + return Build_Constant + (Get_High_Limit (Get_Range_Constraint (Index)), Expr); + end; + when Iir_Kind_Ascending_Array_Attribute => + declare + Index : Iir; + begin + Index := Eval_Array_Attribute (Expr); + return Build_Boolean + (Get_Direction (Get_Range_Constraint (Index)) = Iir_To, Expr); + end; + + when Iir_Kind_Pred_Attribute => + Res := Eval_Incdec (Eval_Static_Expr (Get_Parameter (Expr)), -1); + Eval_Check_Bound (Res, Get_Type (Get_Prefix (Expr))); + return Res; + when Iir_Kind_Succ_Attribute => + Res := Eval_Incdec (Eval_Static_Expr (Get_Parameter (Expr)), +1); + Eval_Check_Bound (Res, Get_Type (Get_Prefix (Expr))); + return Res; + when Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute => + declare + Rng : Iir; + N : Iir_Int64; + Prefix_Type : Iir; + Res : Iir; + begin + Prefix_Type := Get_Type (Get_Prefix (Expr)); + Rng := Eval_Range (Prefix_Type); + case Get_Direction (Rng) is + when Iir_To => + N := 1; + when Iir_Downto => + N := -1; + end case; + case Get_Kind (Expr) is + when Iir_Kind_Leftof_Attribute => + N := -N; + when Iir_Kind_Rightof_Attribute => + null; + when others => + raise Internal_Error; + end case; + Res := Eval_Incdec (Eval_Static_Expr (Get_Parameter (Expr)), N); + Eval_Check_Bound (Res, Prefix_Type); + return Res; + end; + + when Iir_Kind_Simple_Name_Attribute => + declare + use Str_Table; + Id : String_Id; + begin + Id := Start; + Image (Get_Simple_Name_Identifier (Expr)); + for I in 1 .. Name_Length loop + Append (Name_Buffer (I)); + end loop; + Finish; + return Build_String (Id, Nat32 (Name_Length), Expr); + end; + + when Iir_Kind_Null_Literal => + return Expr; + + when Iir_Kind_Function_Call => + declare + Left, Right : Iir; + begin + -- Note: there can't be association by name. + Left := Get_Parameter_Association_Chain (Expr); + Right := Get_Chain (Left); + if Right = Null_Iir then + return Eval_Monadic_Operator (Expr, Get_Actual (Left)); + else + return Eval_Dyadic_Operator + (Expr, Get_Actual (Left), Get_Actual (Right)); + end if; + end; + + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + declare + Res : Iir; + Orig : Iir; + begin + Orig := Get_Named_Entity (Expr); + Res := Eval_Static_Expr (Orig); + if Res /= Orig then + Location_Copy (Res, Expr); + end if; + Free_Name (Expr); + return Res; + end; + when Iir_Kind_Error => + return Expr; + when others => + Error_Kind ("eval_static_expr", Expr); + end case; + end Eval_Static_Expr; + + function Eval_Expr (Expr: Iir) return Iir is + begin + if Get_Expr_Staticness (Expr) /= Locally then + Error_Msg_Sem ("expression must be locally static", Expr); + return Expr; + else + return Eval_Static_Expr (Expr); + end if; + end Eval_Expr; + + function Eval_Expr_If_Static (Expr : Iir) return Iir is + begin + if Expr /= Null_Iir and then Get_Expr_Staticness (Expr) = Locally then + return Eval_Static_Expr (Expr); + else + return Expr; + end if; + end Eval_Expr_If_Static; + + function Eval_Int_In_Range (Val : Iir_Int64; Bound : Iir) return Boolean is + begin + case Get_Kind (Bound) is + when Iir_Kind_Range_Expression => + case Get_Direction (Bound) is + when Iir_To => + if Val < Eval_Pos (Get_Left_Limit (Bound)) + or else Val > Eval_Pos (Get_Right_Limit (Bound)) + then + return False; + end if; + when Iir_Downto => + if Val > Eval_Pos (Get_Left_Limit (Bound)) + or else Val < Eval_Pos (Get_Right_Limit (Bound)) + then + return False; + end if; + end case; + when others => + Error_Kind ("eval_int_in_range", Bound); + end case; + return True; + end Eval_Int_In_Range; + + function Eval_Phys_In_Range (Val : Iir_Int64; Bound : Iir) return Boolean + is + Left, Right : Iir_Int64; + begin + case Get_Kind (Bound) is + when Iir_Kind_Range_Expression => + case Get_Kind (Get_Type (Get_Left_Limit (Bound))) is + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Integer_Subtype_Definition => + Left := Get_Value (Get_Left_Limit (Bound)); + Right := Get_Value (Get_Right_Limit (Bound)); + when Iir_Kind_Physical_Type_Definition + | Iir_Kind_Physical_Subtype_Definition => + Left := Get_Physical_Value (Get_Left_Limit (Bound)); + Right := Get_Physical_Value (Get_Right_Limit (Bound)); + when others => + Error_Kind ("eval_phys_in_range(1)", Get_Type (Bound)); + end case; + case Get_Direction (Bound) is + when Iir_To => + if Val < Left or else Val > Right then + return False; + end if; + when Iir_Downto => + if Val > Left or else Val < Right then + return False; + end if; + end case; + when others => + Error_Kind ("eval_phys_in_range", Bound); + end case; + return True; + end Eval_Phys_In_Range; + + function Eval_Fp_In_Range (Val : Iir_Fp64; Bound : Iir) return Boolean is + begin + case Get_Kind (Bound) is + when Iir_Kind_Range_Expression => + case Get_Direction (Bound) is + when Iir_To => + if Val < Get_Fp_Value (Get_Left_Limit (Bound)) + or else Val > Get_Fp_Value (Get_Right_Limit (Bound)) + then + return False; + end if; + when Iir_Downto => + if Val > Get_Fp_Value (Get_Left_Limit (Bound)) + or else Val < Get_Fp_Value (Get_Right_Limit (Bound)) + then + return False; + end if; + end case; + when others => + Error_Kind ("eval_fp_in_range", Bound); + end case; + return True; + end Eval_Fp_In_Range; + + -- Return TRUE if literal EXPR is in SUB_TYPE bounds. + function Eval_Is_In_Bound (Expr : Iir; Sub_Type : Iir) + return Boolean + is + Type_Range : Iir; + begin + if Get_Kind (Expr) = Iir_Kind_Error then + return True; + end if; + + case Get_Kind (Sub_Type) is + when Iir_Kind_Integer_Subtype_Definition => + Type_Range := Get_Range_Constraint (Sub_Type); + return Eval_Int_In_Range (Get_Value (Expr), Type_Range); + when Iir_Kind_Floating_Subtype_Definition => + Type_Range := Get_Range_Constraint (Sub_Type); + return Eval_Fp_In_Range (Get_Fp_Value (Expr), Type_Range); + when Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition => + -- A check is required for an enumeration type definition for + -- 'val attribute. + Type_Range := Get_Range_Constraint (Sub_Type); + return Eval_Int_In_Range + (Iir_Int64 (Get_Enum_Pos (Expr)), Type_Range); + when Iir_Kind_Physical_Subtype_Definition => + Type_Range := Get_Range_Constraint (Sub_Type); + return Eval_Phys_In_Range (Get_Physical_Value (Expr), Type_Range); + + when Iir_Kind_Base_Attribute => + return Eval_Is_In_Bound (Expr, Get_Type (Sub_Type)); + + when Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Record_Type_Definition => + -- FIXME: do it. + return True; + + --when Iir_Kind_Integer_Type_Definition => + -- This case should not happen but it may be called to check a + -- simple choice value belongs to the *type* of the case + -- expression. + -- Of course, this is always true. + -- return True; + + when others => + Error_Kind ("eval_is_in_bound", Sub_Type); + return False; + end case; + end Eval_Is_In_Bound; + + procedure Eval_Check_Bound (Expr : Iir; Sub_Type : Iir) + is + begin + if not Eval_Is_In_Bound (Expr, Sub_Type) then + Error_Msg_Sem ("static constant violates bounds", Expr); + end if; + end Eval_Check_Bound; + + function Eval_Is_Range_In_Bound (A_Range : Iir; Sub_Type : Iir) + return Boolean + is + Type_Range : Iir; + begin + Type_Range := Get_Range_Constraint (Sub_Type); + if Get_Direction (Type_Range) /= Get_Direction (A_Range) then + return True; + end if; + + case Get_Kind (Sub_Type) is + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition => + declare + L, R : Iir_Int64; + begin + -- Check for null range. + L := Eval_Pos (Get_Left_Limit (A_Range)); + R := Eval_Pos (Get_Right_Limit (A_Range)); + case Get_Direction (A_Range) is + when Iir_To => + if L > R then + return True; + end if; + when Iir_Downto => + if L < R then + return True; + end if; + end case; + return Eval_Int_In_Range (L, Type_Range) + and then Eval_Int_In_Range (R, Type_Range); + end; + when Iir_Kind_Floating_Subtype_Definition => + declare + L, R : Iir_Fp64; + begin + -- Check for null range. + L := Get_Fp_Value (Get_Left_Limit (A_Range)); + R := Get_Fp_Value (Get_Right_Limit (A_Range)); + case Get_Direction (A_Range) is + when Iir_To => + if L > R then + return True; + end if; + when Iir_Downto => + if L < R then + return True; + end if; + end case; + return Eval_Fp_In_Range (L, Type_Range) + and then Eval_Fp_In_Range (R, Type_Range); + end; + when others => + Error_Kind ("eval_is_range_in_bound", Sub_Type); + end case; + + -- Should check L <= R or L >= R according to direction. + --return Eval_Is_In_Bound (Get_Left_Limit (A_Range), Sub_Type) + -- and then Eval_Is_In_Bound (Get_Right_Limit (A_Range), Sub_Type); + end Eval_Is_Range_In_Bound; + + procedure Eval_Check_Range (A_Range : Iir; Sub_Type : Iir) + is + begin + if not Eval_Is_Range_In_Bound (A_Range, Sub_Type) then + Error_Msg_Sem ("static range violates bounds", A_Range); + end if; + end Eval_Check_Range; + + function Eval_Expr_Check (Expr : Iir; Sub_Type : Iir) return Iir + is + Res : Iir; + begin + Res := Eval_Expr (Expr); + Eval_Check_Bound (Res, Sub_Type); + return Res; + end Eval_Expr_Check; + + function Eval_Discrete_Range_Length (Constraint : Iir) return Iir_Int64 + is + Res : Iir_Int64; + Left, Right : Iir_Int64; + begin + Left := Eval_Pos (Get_Left_Limit (Constraint)); + Right := Eval_Pos (Get_Right_Limit (Constraint)); + case Get_Direction (Constraint) is + when Iir_To => + if Right < Left then + -- Null range. + return 0; + else + Res := Right - Left + 1; + end if; + when Iir_Downto => + if Left < Right then + -- Null range + return 0; + else + Res := Left - Right + 1; + end if; + end case; + return Res; + end Eval_Discrete_Range_Length; + + function Eval_Discrete_Type_Length (Sub_Type : Iir) return Iir_Int64 + is + begin + case Get_Kind (Sub_Type) is + when Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Subtype_Definition => + return Eval_Discrete_Range_Length + (Get_Range_Constraint (Sub_Type)); + when others => + Error_Kind ("eval_discrete_type_length", Sub_Type); + end case; + end Eval_Discrete_Type_Length; + + function Eval_Pos (Expr : Iir) return Iir_Int64 is + begin + case Get_Kind (Expr) is + when Iir_Kind_Integer_Literal => + return Get_Value (Expr); + when Iir_Kind_Enumeration_Literal => + return Iir_Int64 (Get_Enum_Pos (Expr)); + when Iir_Kind_Physical_Int_Literal => + return Get_Physical_Value (Expr); + when Iir_Kind_Unit_Declaration => + return Get_Value (Get_Physical_Unit_Value (Expr)); + when others => + Error_Kind ("eval_pos", Expr); + end case; + end Eval_Pos; + + function Eval_Range (Rng : Iir) return Iir + is + Expr : Iir; + begin + Expr := Rng; + loop + case Get_Kind (Expr) is + when Iir_Kind_Range_Expression => + return Expr; + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition => + Expr := Get_Range_Constraint (Expr); + when Iir_Kind_Range_Array_Attribute => + declare + Prefix : Iir; + begin + Prefix := Get_Prefix (Expr); + if Get_Kind (Prefix) /= Iir_Kind_Array_Subtype_Definition + then + Prefix := Get_Type (Prefix); + end if; + if Get_Kind (Prefix) /= Iir_Kind_Array_Subtype_Definition + then + -- Unconstrained object. + return Null_Iir; + end if; + Expr := Get_Nth_Element + (Get_Index_Subtype_List (Prefix), + Natural (Eval_Pos (Get_Parameter (Expr))) - 1); + end; + when others => + Error_Kind ("eval_range", Expr); + end case; + end loop; + end Eval_Range; + + -- Return the range constraint of a discrete range. + function Eval_Discrete_Range_Expression (Constraint : Iir) return Iir + is + Res : Iir; + begin + Res := Eval_Range (Constraint); + if Res = Null_Iir then + Error_Kind ("eval_range_expression", Constraint); + else + return Res; + end if; + end Eval_Discrete_Range_Expression; + + function Eval_Discrete_Range_Left (Constraint : Iir) return Iir + is + Range_Expr : Iir; + begin + Range_Expr := Eval_Discrete_Range_Expression (Constraint); + return Get_Left_Limit (Range_Expr); + end Eval_Discrete_Range_Left; + + procedure Eval_Operator_Symbol_Name (Id : Name_Id) + is + begin + Image (Id); + Name_Buffer (2 .. Name_Length + 1) := Name_Buffer (1 .. Name_Length); + Name_Buffer (1) := '"'; --" + Name_Length := Name_Length + 2; + Name_Buffer (Name_Length) := '"'; --" + end Eval_Operator_Symbol_Name; + + procedure Eval_Simple_Name (Id : Name_Id) + is + begin + -- LRM 14.1 + -- E'SIMPLE_NAME + -- Result: [...] but with apostrophes (in the case of a character + -- literal) + if Is_Character (Id) then + Name_Buffer (1) := '''; + Name_Buffer (2) := Get_Character (Id); + Name_Buffer (3) := '''; + Name_Length := 3; + return; + end if; + case Id is + when Std_Names.Name_Word_Operators + | Std_Names.Name_First_Operator .. Std_Names.Name_Last_Operator => + Eval_Operator_Symbol_Name (Id); + return; + when Std_Names.Name_Xnor + | Std_Names.Name_Shift_Operators => + if Flags.Vhdl_Std > Vhdl_87 then + Eval_Operator_Symbol_Name (Id); + return; + end if; + when others => + null; + end case; + Image (Id); +-- if Name_Buffer (1) = '\' then +-- declare +-- I : Natural; +-- begin +-- I := 2; +-- while I <= Name_Length loop +-- if Name_Buffer (I) = '\' then +-- Name_Length := Name_Length + 1; +-- Name_Buffer (I + 1 .. Name_Length) := +-- Name_Buffer (I .. Name_Length - 1); +-- I := I + 1; +-- end if; +-- I := I + 1; +-- end loop; +-- Name_Length := Name_Length + 1; +-- Name_Buffer (Name_Length) := '\'; +-- end; +-- end if; + end Eval_Simple_Name; +end Evaluation; diff --git a/evaluation.ads b/evaluation.ads new file mode 100644 index 000000000..a36286372 --- /dev/null +++ b/evaluation.ads @@ -0,0 +1,98 @@ +-- Evaluation of static expressions. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Iirs; use Iirs; + +package Evaluation is + + -- Get the value of a physical integer literal or unit. + function Get_Physical_Value (Expr : Iir) return Iir_Int64; + + -- Evaluate (ie compute) expression EXPR. + -- EXPR is required to be a locally static expression, otherwise an error + -- message is generated. + -- The result is a literal. + function Eval_Expr (Expr: Iir) return Iir; + + -- Same as Eval_Expr, but do not check that EXPR is locally static. + -- May be used instead of Eval_Expr if you know than EXPR is locally + -- static, or for literals of type std.time. + function Eval_Static_Expr (Expr: Iir) return Iir; + + -- Same as Eval_Expr, but if EXPR is not locally static, the result is + -- EXPR. Also, if EXPR is null_iir, then null_iir is returned. + -- The purpose of this function is to evaluate an expression only if it + -- is locally static. + function Eval_Expr_If_Static (Expr : Iir) return Iir; + + -- Return TRUE if literal EXPR is in SUB_TYPE bounds. + function Eval_Is_In_Bound (Expr : Iir; Sub_Type : Iir) return Boolean; + + -- Emit an error if EXPR violates SUB_TYPE bounds. + procedure Eval_Check_Bound (Expr : Iir; Sub_Type : Iir); + + -- Return TRUE if range expression A_RANGE is not included in SUB_TYPE. + function Eval_Is_Range_In_Bound (A_Range : Iir; Sub_Type : Iir) + return Boolean; + + -- Emit an error if A_RANGE is not included in SUB_TYPE. + procedure Eval_Check_Range (A_Range : Iir; Sub_Type : Iir); + + -- Same as Eval_Expr, but a range check with SUB_TYPE is performed after + -- computation. + function Eval_Expr_Check (Expr : Iir; Sub_Type : Iir) return Iir; + + -- Return TRUE iff VAL belongs to BOUND. + function Eval_Int_In_Range (Val : Iir_Int64; Bound : Iir) return Boolean; + + -- Return the length of the discrete range CONSTRAINT. + function Eval_Discrete_Range_Length (Constraint : Iir) return Iir_Int64; + + -- Return the length of SUB_TYPE. + function Eval_Discrete_Type_Length (Sub_Type : Iir) return Iir_Int64; + + -- Get the left bound of a range constraint. + -- Note: the range constraint may be an attribute or a subtype. + function Eval_Discrete_Range_Left (Constraint : Iir) return Iir; + + -- Return the range_expression of RNG, which is a range or a subtype. + -- Return NULL_IIR if the range constraint is not a range_expression. + function Eval_Range (Rng : Iir) return Iir; + + -- Return the position of EXPR, ie the result of sub_type'pos (EXPR), where + -- sub_type is the type of expr. + -- EXPR must be of a discrete subtype. + function Eval_Pos (Expr : Iir) return Iir_Int64; + + -- Create an array subtype from LEN and BASE_TYPE, according to rules + -- of LRM93 7.3.2.2. (which are the same as LRM93 7.2.4). + function Create_Unidim_Array_By_Length + (Base_Type : Iir; Len : Iir_Int64; Loc : Iir) + return Iir_Array_Subtype_Definition; + + -- Create a subtype of A_TYPE whose length is LEN. + -- This is used to create subtypes for strings or aggregates. + function Create_Range_Subtype_By_Length + (A_Type : Iir; Len : Iir_Int64; Loc : Location_Type) + return Iir; + + -- Store into NAME_BUFFER,NAME_LENGTH the simple name, character literal + -- or operator sumbol of ID, using the same format as SIMPLE_NAME + -- attribute. + procedure Eval_Simple_Name (Id : Name_Id); +end Evaluation; diff --git a/files_map.adb b/files_map.adb new file mode 100644 index 000000000..629911aef --- /dev/null +++ b/files_map.adb @@ -0,0 +1,943 @@ +-- Loading of source files. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Interfaces.C; +with Ada.Characters.Latin_1; +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Unchecked_Deallocation; +with GNAT.Table; +with GNAT.OS_Lib; +with GNAT.Directory_Operations; +with System; +with Name_Table; use Name_Table; +with Str_Table; +with Ada.Calendar; + +package body Files_Map is + + -- Check validity of FILE. + -- Raise an exception in case of error. + procedure Check_File (File: in Source_File_Entry); + + type Lines_Table_Type is array (Positive) of Source_Ptr; + type Lines_Table_Ptr is access all Lines_Table_Type; + + -- Data associed with a file. + type Source_File_Record is record + -- All location between first and last belong to this file. + First_Location : Location_Type; + Last_Location : Location_Type; + + -- The name_id that identify this file. + -- FIXME: what about file aliasing (links) ? + File_Name: Name_Id; + + Directory : Name_Id; + + -- The buffer containing the file. + Source: File_Buffer_Acc; + + -- Length of the file, which is also the length of the buffer. + File_Length: Natural; + + Time_Stamp: Time_Stamp_Id; + + -- Current number of line in Lines_Table. + Nbr_Lines: Natural; + + Lines_Table: Lines_Table_Ptr; + + -- Current size of Lines_Table. + Lines_Table_Max: Natural; + + -- Cache. + Cache_Line : Natural; + Cache_Pos : Source_Ptr; + end record; + + -- Next location to use. + Next_Location : Location_Type := Location_Nil + 1; + + package Source_Files is new GNAT.Table + (Table_Index_Type => Source_File_Entry, + Table_Component_Type => Source_File_Record, + Table_Low_Bound => No_Source_File_Entry + 1, + Table_Initial => 16, + Table_Increment => 100); + + function Get_Last_Source_File_Entry return Source_File_Entry is + begin + return Source_Files.Last; + end Get_Last_Source_File_Entry; + + Home_Dir : Name_Id := Null_Identifier; + + function Get_Home_Directory return Name_Id is + begin + if Home_Dir = Null_Identifier then + GNAT.Directory_Operations.Get_Current_Dir (Name_Buffer, Name_Length); + Home_Dir := Get_Identifier; + end if; + return Home_Dir; + end Get_Home_Directory; + + function Is_Absolute_Pathname (Path : String) return Boolean is + begin + -- This is the POSIX rule. + if Path'Length = 0 then + return False; + end if; + return Path (Path'First) = GNAT.OS_Lib.Directory_Separator; + end Is_Absolute_Pathname; + + -- Note: BUF must be 1 based. +-- procedure Get_Directory_Path (Dir : Directory_Index; +-- Buf : out String; +-- Len : out Natural) +-- is +-- begin +-- if Dir < Pathes.First or else Dir > Pathes.Last then +-- raise Constraint_Error; +-- end if; +-- Len := Pathes.Table (Dir).all'Length; +-- if Len > Buf'Length then +-- raise Constraint_Error; +-- end if; +-- Buf (1 .. Len) := Pathes.Table (Dir).all; +-- end Get_Directory_Path; + +-- -- Revert path of directory DIR into BUF of length LEN. +-- -- If DIR is a relative path, compute the relative path from DIR to the +-- -- current directory. +-- -- If DIR is an absolute path, then return DIR. +-- procedure Revert_Pathname (Dir : Directory_Index; +-- Buf : out String; +-- Len : out Natural) +-- is +-- Dir_Path : String (1 .. Max_Path_Len); +-- Dir_Len : Natural; +-- Cur_Path : String (1 .. Max_Path_Len); +-- Cur_Len : Natural; +-- Cur_S, Cur_L : Natural; +-- S, L : Natural; + +-- begin +-- Get_Directory_Path (Dir, Buf, Len); +-- -- Easy case: DIR is empty (ie, is the local directory) or an absolute +-- -- path. +-- if Len = 0 or else Is_Absolute_Pathname (Buf (1 .. Len)) then +-- return; +-- end if; + +-- -- Copy the path to revert into Dir_Path. +-- Dir_Len := Len; +-- Dir_Path (1 .. Dir_Len) := Buf (1 .. Len); +-- S := 1; +-- L := 1; + +-- -- Get the local path. +-- Get_Current_Dir (Cur_Path, Cur_Len); +-- Cur_S := Cur_Len; +-- Cur_L := Cur_Len; + +-- -- Start to revert. +-- -- Step 1: +-- -- ../ -> Y/ where Y is taken from CUR_PATH +-- -- ./ -> (none) +-- loop +-- while S <= Dir_Len and then Dir_Path (S) = Directory_Separator loop +-- S := S + 1; +-- end loop; +-- -- Exit when no more components. +-- exit when S > Dir_Len; +-- L := S; + +-- -- Look for a path component. +-- -- At the end of the loop, Dir_Path (S .. L) is a path component, +-- -- without any directory_separator. +-- loop +-- if Dir_Path (L) = Directory_Separator then +-- L := L - 1; +-- exit; +-- end if; +-- exit when L = Dir_Len; +-- L := L + 1; +-- end loop; + +-- if S = L and Dir_Path (S) = '.' then +-- null; +-- elsif L = S + 1 +-- and then Dir_Path (S) = '.' +-- and then Dir_Path (S + 1) = '.' +-- then +-- Xxxx; +-- else +-- Yyy; +-- end if; +-- end Revert_Pathname; + +-- function Get_Directory_Path (Dir : Directory_Index) return String +-- is +-- begin +-- if Dir < Pathes.First or else Dir > Pathes.Last then +-- raise Constraint_Error; +-- end if; +-- return Pathes.Table (Dir).all; +-- end Get_Directory_Path; + + + procedure Location_To_File_Pos (Location : Location_Type; + File : out Source_File_Entry; + Pos : out Source_Ptr) + is + begin + -- FIXME: use a cache + -- FIXME: dicotomy + for I in Source_Files.First .. Source_Files.Last loop + declare + F : Source_File_Record renames Source_Files.Table (I); + begin + if Location >= F.First_Location + and then Location <= F.Last_Location + then + File := I; + Pos := Source_Ptr (Location - F.First_Location); + return; + end if; + end; + end loop; + -- File not found, location must be bad... + raise Internal_Error; + end Location_To_File_Pos; + + function File_Pos_To_Location (File : Source_File_Entry; Pos : Source_Ptr) + return Location_Type + is + begin + if Source_Files.Table (File).Source = null then + raise Internal_Error; + else + return Source_Files.Table (File).First_Location + Location_Type (Pos); + end if; + end File_Pos_To_Location; + + function Source_File_To_Location (File : Source_File_Entry) + return Location_Type + is + begin + return Source_Files.Table (File).First_Location; + end Source_File_To_Location; + + procedure Reallocate_Lines_Table + (File: in out Source_File_Record; New_Size: Natural) is + use Interfaces.C; + + function realloc + (memblock : Lines_Table_Ptr; + size : size_t) + return Lines_Table_Ptr; + pragma Import (C, realloc); + + function malloc + (size : size_t) + return Lines_Table_Ptr; + pragma Import (C, malloc); + + New_Table: Lines_Table_Ptr; + New_Byte_Size : size_t; + begin + New_Byte_Size := + size_t(New_Size * + Lines_Table_Type'Component_Size / System.Storage_Unit); + if File.Lines_Table = null then + New_Table := malloc (New_Byte_Size); + else + New_Table := realloc (File.Lines_Table, New_Byte_Size); + end if; + if New_Table = null then + raise Storage_Error; + else + File.Lines_Table := New_Table; + File.Lines_Table (File.Lines_Table_Max + 1 .. New_Size) := + (others => Source_Ptr_Bad); + File.Lines_Table_Max := New_Size; + end if; + end Reallocate_Lines_Table; + + -- Add a new entry in the lines_table. + -- The new entry must be the next one after the last entry. + procedure File_Add_Line_Number + (File: Source_File_Entry; Line: Natural; Pos: Source_Ptr) is + Source_File: Source_File_Record renames Source_Files.Table (File); + begin + -- Just check File is not out of bounds. + if File > Source_Files.Last then + raise Internal_Error; + end if; + + if Line = 1 then + -- The position of the first line is well-known. + if Pos /= Source_Ptr_Org then + raise Internal_Error; + end if; + else + -- The position of a non first line is not the well-known value. + if Pos <= Source_Ptr_Org then + raise Internal_Error; + end if; + -- Take care of scan backtracking. + if Line <= Source_File.Nbr_Lines then + if Source_File.Lines_Table (Line) = Source_Ptr_Bad then + Source_File.Lines_Table (Line) := Pos; + elsif Pos /= Source_File.Lines_Table (Line) then + Put_Line ("file" & Source_File_Entry'Image (File) + & " for line" & Natural'Image (Line) + & " pos =" & Source_Ptr'Image (Pos) + & ", lines_table = " + & Source_Ptr'Image (Source_File.Lines_Table (Line))); + raise Internal_Error; + end if; + return; + end if; + -- The new entry must just follow the last entry. +-- if Line /= Source_File.Nbr_Lines + 1 then +-- raise Internal_Error; +-- end if; + end if; + if Line > Source_File.Lines_Table_Max then + Reallocate_Lines_Table (Source_File, (Line / 128 + 1) * 128); + end if; + Source_File.Lines_Table (Line) := Pos; + if Line > Source_File.Nbr_Lines then + Source_File.Nbr_Lines := Line; + end if; + -- Source_File.Nbr_Lines := Source_File.Nbr_Lines + 1; + if False then + Put_Line ("file" & Source_File_Entry'Image (File) + & " line" & Natural'Image (Line) + & " at position" & Source_Ptr'Image (Pos)); + end if; + end File_Add_Line_Number; + + -- Convert a physical column to a logical column. + -- A physical column is the offset in byte from the first byte of the line. + -- A logical column is the position of the character when displayed. + -- A HT (tabulation) moves the cursor to the next position multiple of 8. + -- The first character is at position 1 and at offset 0. + procedure Coord_To_Position + (File : Source_File_Entry; + Line_Pos : Source_Ptr; + Offset : Natural; + Name : out Name_Id; + Col : out Natural) + is + Source_File: Source_File_Record renames Source_Files.Table (File); + Res : Positive := 1; + begin + Name := Source_File.File_Name; + for I in Line_Pos .. Line_Pos + Source_Ptr (Offset) - 1 loop + if Source_File.Source (I) = Ada.Characters.Latin_1.HT then + Res := Res + 8 - Res mod 8; + else + Res := Res + 1; + end if; + end loop; + Col := Res; + end Coord_To_Position; + + -- Should only be called by Location_To_Coord. + function Location_To_Line + (Source_File : Source_File_Record; Pos : Source_Ptr) + return Natural + is + Low, Hi, Mid : Natural; + Mid1 : Natural; + Lines_Table : constant Lines_Table_Ptr := Source_File.Lines_Table; + begin + -- Look in the cache. + if Pos >= Source_File.Cache_Pos then + Low := Source_File.Cache_Line; + Hi := Source_File.Nbr_Lines; + else + Low := 1; + Hi := Source_File.Cache_Line; + end if; + + loop + << Again >> null; + Mid := (Hi + Low) / 2; + if Lines_Table (Mid) = Source_Ptr_Bad then + -- There is a hole: no position for this line. + -- Set MID1 to a line which has a position. + -- Try downward. + Mid1 := Mid; + while Lines_Table (Mid1) = Source_Ptr_Bad loop + -- Note: Low may have no line. + exit when Mid1 = Low; + Mid1 := Mid1 - 1; + end loop; + if Mid1 /= Low then + -- Mid1 has a line. + if Pos < Lines_Table (Mid1) then + Hi := Mid1; + goto Again; + end if; + if Pos > Lines_Table (Mid1) then + Low := Mid1; + goto Again; + end if; + -- Found, handled just below. + else + -- Failed (downward is LOW): try upward. + Mid1 := Mid; + while Lines_Table (Mid1) = Source_Ptr_Bad loop + Mid1 := Mid1 + 1; + end loop; + if Mid1 = Hi then + -- Failed: no lines between LOW and HI. + if Pos >= Lines_Table (Hi) then + Mid1 := Hi; + else + Mid1 := Low; + end if; + return Mid1; + end if; + -- Mid1 has a line. + if Pos < Lines_Table (Mid1) then + Hi := Mid1; + goto Again; + end if; + if Pos > Lines_Table (Mid1) then + Low := Mid1; + goto Again; + end if; + end if; + Mid := Mid1; + end if; + if Pos >= Lines_Table (Mid) then + if Mid = Source_File.Nbr_Lines + or else Pos < Lines_Table (Mid + 1) + or else Pos = Lines_Table (Mid) + or else (Hi <= Mid + 1 + and Lines_Table (Mid + 1) = Source_Ptr_Bad) + then + return Mid; + end if; + end if; + if Pos < Lines_Table (Mid) then + Hi := Mid - 1; + else + if Lines_Table (Mid + 1) /= Source_Ptr_Bad then + Low := Mid + 1; + else + Low := Mid; + end if; + end if; + end loop; + end Location_To_Line; + + procedure Location_To_Coord + (Source_File : in out Source_File_Record; + Pos : Source_Ptr; + Line_Pos : out Source_Ptr; + Line : out Natural; + Offset : out Natural) + is + Line_P : Source_Ptr; + Line_Threshold : constant Natural := 4; + Low, Hi : Natural; + begin + -- Look in the cache. + if Pos >= Source_File.Cache_Pos then + Low := Source_File.Cache_Line; + Hi := Source_File.Nbr_Lines; + + -- Maybe adjust the threshold. + -- Quick look. + if Pos - Source_File.Cache_Pos <= 120 + and then Low + Line_Threshold <= Hi + then + for I in 1 .. Line_Threshold loop + Line_P := Source_File.Lines_Table (Low + I); + if Line_P > Pos then + Line := Low + I - 1; + goto Found; + else + exit when Line_P = Source_Ptr_Bad; + end if; + end loop; + end if; + end if; + + Line := Location_To_Line (Source_File, Pos); + + << Found >> null; + + Line_Pos := Source_File.Lines_Table (Line); + Offset := Natural (Pos - Source_File.Lines_Table (Line)); + + -- Update cache. + Source_File.Cache_Pos := Pos; + Source_File.Cache_Line := Line; + end Location_To_Coord; + + procedure Location_To_Position + (Location : Location_Type; + Name : out Name_Id; + Line : out Natural; + Col : out Natural) + is + File : Source_File_Entry; + Line_Pos : Source_Ptr; + Offset : Natural; + begin + Location_To_Coord (Location, File, Line_Pos, Line, Offset); + Coord_To_Position (File, Line_Pos, Offset, Name, Col); + end Location_To_Position; + + procedure Location_To_Coord + (Location : Location_Type; + File : out Source_File_Entry; + Line_Pos : out Source_Ptr; + Line : out Natural; + Offset : out Natural) + is + Pos : Source_Ptr; + begin + Location_To_File_Pos (Location, File, Pos); + Location_To_Coord (Source_Files.Table (File), Pos, + Line_Pos, Line, Offset); + end Location_To_Coord; + + -- Convert the first digit of VAL into a character (base 10). + function Digit_To_Char (Val: Natural) return Character is + begin + return Character'Val (Character'Pos ('0') + Val mod 10); + end Digit_To_Char; + + -- Format: YYYYMMDDHHmmsscc + -- Y: year, M: month, D: day, H: hour, m: minute, s: second, cc:100th sec + function Os_Time_To_Time_Stamp_Id (Time: GNAT.OS_Lib.OS_Time) + return Time_Stamp_Id + is + use GNAT.OS_Lib; + use Str_Table; + Res: Time_Stamp_Id; + Year: Year_Type; + Month: Month_Type; + Day: Day_Type; + Hour: Hour_Type; + Minute: Minute_Type; + Second: Second_Type; + begin + GM_Split (Time, Year, Month, Day, Hour, Minute, Second); + Res := Time_Stamp_Id (Start); + Append (Digit_To_Char (Year / 1000)); + Append (Digit_To_Char (Year / 100)); + Append (Digit_To_Char (Year / 10)); + Append (Digit_To_Char (Year / 1)); + Append (Digit_To_Char (Month / 10)); + Append (Digit_To_Char (Month / 1)); + Append (Digit_To_Char (Day / 10)); + Append (Digit_To_Char (Day / 1)); + Append (Digit_To_Char (Hour / 10)); + Append (Digit_To_Char (Hour / 1)); + Append (Digit_To_Char (Minute / 10)); + Append (Digit_To_Char (Minute / 1)); + Append (Digit_To_Char (Second / 10)); + Append (Digit_To_Char (Second / 1)); + Append ('.'); + Append ('0'); + Append ('0'); + Append ('0'); + Finish; + return Res; + end Os_Time_To_Time_Stamp_Id; + + function Get_File_Time_Stamp (Filename : System.Address) + return Time_Stamp_Id + is + use GNAT.OS_Lib; + Fd : File_Descriptor; + Res : Time_Stamp_Id; + begin + Fd := Open_Read (Filename, Binary); + if Fd = Invalid_FD then + return Null_Time_Stamp; + end if; + Res := Os_Time_To_Time_Stamp_Id (File_Time_Stamp (Fd)); + Close (Fd); + return Res; + end Get_File_Time_Stamp; + + function Get_File_Time_Stamp (FD : GNAT.OS_Lib.File_Descriptor) + return Time_Stamp_Id + is + begin + return Os_Time_To_Time_Stamp_Id (GNAT.OS_Lib.File_Time_Stamp (FD)); + end Get_File_Time_Stamp; + + function Get_Os_Time_Stamp return Time_Stamp_Id + is + use Ada.Calendar; + use Str_Table; + + Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Sec : Day_Duration; + S : Integer; + S1 : Integer; + M : Integer; + Res: Time_Stamp_Id; + begin + -- FIXME: Clock is local time, while get_file_time_stamp returns + -- GMT time. + Split (Clock, Year, Month, Day, Sec); + + Res := Time_Stamp_Id (Start); + Append (Digit_To_Char (Year / 1000)); + Append (Digit_To_Char (Year / 100)); + Append (Digit_To_Char (Year / 10)); + Append (Digit_To_Char (Year / 1)); + Append (Digit_To_Char (Month / 10)); + Append (Digit_To_Char (Month / 1)); + Append (Digit_To_Char (Day / 10)); + Append (Digit_To_Char (Day / 1)); + S := Integer (Sec); + if Day_Duration (S) > Sec then + -- We need a truncation. + S := S - 1; + end if; + S1 := S / 3600; + Append (Digit_To_Char (S1 / 10)); + Append (Digit_To_Char (S1)); + S1 := (S / 60) mod 60; + Append (Digit_To_Char (S1 / 10)); + Append (Digit_To_Char (S1)); + S1 := S mod 60; + Append (Digit_To_Char (S1 / 10)); + Append (Digit_To_Char (S1)); + + Append ('.'); + Sec := Sec - Day_Duration (S); + M := Integer (Sec * 1000); + if M = 1000 then + -- We need truncation. + M := 999; + end if; + Append (Digit_To_Char (M / 100)); + Append (Digit_To_Char (M / 10)); + Append (Digit_To_Char (M)); + Finish; + return Res; + end Get_Os_Time_Stamp; + + function Get_Pathname (Directory : Name_Id; + Name: Name_Id; + Add_Nul : Boolean) + return String + is + L : Natural; + begin + Image (Name); + if not Is_Absolute_Pathname (Name_Buffer (1 .. Name_Length)) then + L := Name_Length; + Image (Directory); + Name_Buffer (Name_Length + 1 .. Name_Length + L) := Image (Name); + Name_Length := Name_Length + L; + end if; + if Add_Nul then + Name_Length := Name_Length + 1; + Name_Buffer (Name_Length) := Character'Val (0); + end if; + return Name_Buffer (1 .. Name_Length); + end Get_Pathname; + + -- Find a source_file by DIRECTORY and NAME. + -- Return NO_SOURCE_FILE_ENTRY if not already opened. + function Find_Source_File (Directory : Name_Id; Name: Name_Id) + return Source_File_Entry + is + begin + for I in Source_Files.First .. Source_Files.Last loop + if Source_Files.Table (I).File_Name = Name + and then Source_Files.Table (I).Directory = Directory + then + return I; + end if; + end loop; + return No_Source_File_Entry; + end Find_Source_File; + + -- Return an entry for a filename. + -- The file is not loaded. + function Create_Source_File_Entry (Directory : Name_Id; Name: Name_Id) + return Source_File_Entry + is + Res: Source_File_Entry; + begin + if Find_Source_File (Directory, Name) /= No_Source_File_Entry then + raise Internal_Error; + end if; + + -- Create a new entry. + Res := Source_Files.Allocate; + Source_Files.Table (Res) := (First_Location => Next_Location, + Last_Location => Next_Location, + File_Name => Name, + Directory => Directory, + Time_Stamp => Null_Time_Stamp, + Source => null, + File_Length => 0, + Nbr_Lines => 0, + Lines_Table_Max => 0, + Lines_Table => null, + Cache_Pos => Source_Ptr_Org, + Cache_Line => 1); + File_Add_Line_Number (Res, 1, Source_Ptr_Org); + return Res; + end Create_Source_File_Entry; + + function Create_Virtual_Source_File (Name: Name_Id) + return Source_File_Entry + is + Res : Source_File_Entry; + Buffer: File_Buffer_Acc; + begin + Res := Create_Source_File_Entry (Null_Identifier, Name); + + Buffer := new File_Buffer (Source_Ptr_Org .. Source_Ptr_Org + 1); + + Buffer (Source_Ptr_Org) := EOT; + Buffer (Source_Ptr_Org + 1) := EOT; + + Source_Files.Table (Res).Last_Location := Next_Location + 1; + Next_Location := Next_Location + 2; + Source_Files.Table (Res).Source := Buffer; + Source_Files.Table (Res).File_Length := 0; + return Res; + end Create_Virtual_Source_File; + + -- Return an entry for a filename. + -- Load the filename if necessary. + function Load_Source_File (Directory : Name_Id; Name: Name_Id) + return Source_File_Entry + is + use GNAT.OS_Lib; + Fd: File_Descriptor; + + Res: Source_File_Entry; + + Length: Source_Ptr; + Buffer: File_Buffer_Acc; + begin + -- If the file is already loaded, nothing to do! + Res := Find_Source_File (Directory, Name); + if Res /= No_Source_File_Entry then + if Source_Files.Table (Res).Source = null then + raise Internal_Error; + end if; + return Res; + end if; + + declare + Filename : String := Get_Pathname (Directory, Name, True); + begin + Fd := Open_Read (Filename'Address, Binary); + if Fd = Invalid_FD then + return No_Source_File_Entry; + end if; + end; + + Res := Create_Source_File_Entry (Directory, Name); + + Source_Files.Table (Res).Time_Stamp := Get_File_Time_Stamp (Fd); + + Length := Source_Ptr (File_Length (Fd)); + + Buffer := + new File_Buffer (Source_Ptr_Org .. Source_Ptr_Org + Length + 1); + + if Read (Fd, Buffer (Source_Ptr_Org)'Address, Integer (Length)) + /= Integer (Length) + then + Close (Fd); + raise Internal_Error; + end if; + Buffer (Length) := EOT; + Buffer (Length + 1) := EOT; + + if Source_Files.Table (Res).First_Location /= Next_Location then + -- Load_Source_File call must follow its Create_Source_File. + raise Internal_Error; + end if; + + Source_Files.Table (Res).Last_Location := + Next_Location + Location_Type (Length) + 1; + Next_Location := Source_Files.Table (Res).Last_Location + 1; + Source_Files.Table (Res).Source := Buffer; + Source_Files.Table (Res).File_Length := Integer (Length); + + Close (Fd); + + return Res; + end Load_Source_File; + + -- Check validity of FILE. + -- Raise an exception in case of error. + procedure Check_File (File: in Source_File_Entry) is + begin + if File > Source_Files.Last then + raise Internal_Error; + end if; + end Check_File; + + -- Return a buffer (access to the contents of the file) for a file entry. + function Get_File_Source (File: Source_File_Entry) + return File_Buffer_Acc is + begin + Check_File (File); + return Source_Files.Table (File).Source; + end Get_File_Source; + + -- Return the length of the file (which is the size of the file buffer). + function Get_File_Length (File: Source_File_Entry) return Source_Ptr is + begin + Check_File (File); + return Source_Ptr (Source_Files.Table (File).File_Length); + end Get_File_Length; + + -- Return the name of the file. + function Get_File_Name (File: Source_File_Entry) return Name_Id is + begin + Check_File (File); + return Source_Files.Table (File).File_Name; + end Get_File_Name; + + -- Return the date of the file (last modification date) as a string. + function Get_File_Time_Stamp (File: Source_File_Entry) + return Time_Stamp_Id is + begin + Check_File (File); + return Source_Files.Table (File).Time_Stamp; + end Get_File_Time_Stamp; + + function Get_Source_File_Directory (File : Source_File_Entry) + return Name_Id is + begin + Check_File (File); + return Source_Files.Table (File).Directory; + end Get_Source_File_Directory; + + function Line_To_Position (File : Source_File_Entry; Line : Natural) + return Source_Ptr + is + begin + Check_File (File); + if Line > Source_Files.Table (File).Nbr_Lines then + return Source_Ptr_Bad; + else + return Source_Files.Table (File).Lines_Table (Line); + end if; + end Line_To_Position; + + function Is_Eq (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean + is + use Str_Table; + L_Str : String_Fat_Acc := Get_String_Fat_Acc (String_Id (L)); + R_Str : String_Fat_Acc := Get_String_Fat_Acc (String_Id (R)); + begin + return L_Str (1 .. Time_Stamp_String'Length) + = R_Str (1 .. Time_Stamp_String'Length); + end Is_Eq; + + function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean + is + use Str_Table; + L_Str : String_Fat_Acc := Get_String_Fat_Acc (String_Id (L)); + R_Str : String_Fat_Acc := Get_String_Fat_Acc (String_Id (R)); + begin + return L_Str (1 .. Time_Stamp_String'Length) + > R_Str (1 .. Time_Stamp_String'Length); + end Is_Gt; + + function Get_Time_Stamp_String (Ts : Time_Stamp_Id) return String is + begin + if Ts = Null_Time_Stamp then + return "NULL_TS"; + else + return Str_Table.Get_String_Fat_Acc (String_Id (Ts)) + (1 .. Time_Stamp_String'Length); + end if; + end Get_Time_Stamp_String; + + -- Debug procedures. + procedure Debug_Source_Lines (File: Source_File_Entry); + pragma Unreferenced (Debug_Source_Lines); + + procedure Debug_Source_File; + pragma Unreferenced (Debug_Source_File); + + -- Disp sources lines of a file. + procedure Debug_Source_Lines (File: Source_File_Entry) is + Source_File: Source_File_Record renames Source_Files.Table (File); + begin + Check_File (File); + for I in Positive'First .. Source_File.Nbr_Lines loop + Put_Line ("line" & Natural'Image (I) & " at offset" + & Source_Ptr'Image (Source_File.Lines_Table (I))); + end loop; + end Debug_Source_Lines; + + procedure Debug_Source_File is + begin + for I in Source_Files.First .. Source_Files.Last loop + declare + F : Source_File_Record renames Source_Files.Table(I); + begin + Put ("file" & Source_File_Entry'Image (I)); + Put (" name: " & Image (F.File_Name)); + Put (" dir:" & Image (F.Directory)); + Put (" length:" & Natural'Image (F.File_Length)); + New_Line; + if F.Time_Stamp /= Null_Time_Stamp then + Put (" time_stamp: " & Get_Time_Stamp_String (F.Time_Stamp)); + end if; + Put (" nbr lines:" & Natural'Image (F.Nbr_Lines)); + Put (" lines_table_max:" & Natural'Image (F.Lines_Table_Max)); + New_Line; + end; + end loop; + end Debug_Source_File; + + procedure Initialize + is + procedure free (Ptr : Lines_Table_Ptr); + pragma Import (C, free); + + procedure Free is new Ada.Unchecked_Deallocation + (File_Buffer, File_Buffer_Acc); + begin + for I in Source_Files.First .. Source_Files.Last loop + free (Source_Files.Table (I).Lines_Table); + Free (Source_Files.Table (I).Source); + end loop; + Source_Files.Free; + Source_Files.Init; + end Initialize; +end Files_Map; diff --git a/files_map.ads b/files_map.ads new file mode 100644 index 000000000..4bcf8772d --- /dev/null +++ b/files_map.ads @@ -0,0 +1,150 @@ +-- Loading of source files. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with System; + +package Files_Map is + + -- Source file handling + ----------------------- + + -- Create the path from DIRECTORY and NAME: + -- If NAME is an absolute pathname, then return NAME. + -- Otherwise, return the concatenation of DIRECTORY and NAME. + -- If ADD_NUL is TRUE, then a trailing '\0' is appended. + function Get_Pathname (Directory : Name_Id; + Name: Name_Id; + Add_Nul : Boolean) + return String; + + -- Return an entry for a filename. + -- Load the filename if necessary. + -- Return No_Source_File_Entry if the file does not exist. + function Load_Source_File (Directory : Name_Id; Name: Name_Id) + return Source_File_Entry; + + -- Each file in memory has two terminal EOT. + EOT : constant Character := Character'Val (4); + + -- Create a Source_File for a virtual file name. Used for implicit, + -- command-line and std.standard library. + function Create_Virtual_Source_File (Name: Name_Id) + return Source_File_Entry; + + -- Return a buffer (access to the contents of the file) for a file entry. + function Get_File_Source (File: Source_File_Entry) + return File_Buffer_Acc; + + -- Return the length of the file (which is the size of the file buffer). + function Get_File_Length (File: Source_File_Entry) return Source_Ptr; + + -- Return the entry of the last known file. + -- This allow the user to create a table of Source_File_Entry. + function Get_Last_Source_File_Entry return Source_File_Entry; + + -- Time stamp handling. + function Is_Eq (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean; + function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean; + function Get_Time_Stamp_String (Ts : Time_Stamp_Id) return String; + + -- Return the date of the file (last modification date) as a string. + function Get_File_Time_Stamp (File: Source_File_Entry) + return Time_Stamp_Id; + function Get_File_Time_Stamp (Filename : System.Address) + return Time_Stamp_Id; + + -- Return the current date of the system. + function Get_Os_Time_Stamp return Time_Stamp_Id; + + -- Return the home directory (current directory). + function Get_Home_Directory return Name_Id; + + -- Return the directory of the file. + function Get_Source_File_Directory (File : Source_File_Entry) + return Name_Id; + + -- Return the name of the file. + function Get_File_Name (File: Source_File_Entry) return Name_Id; + + -- Get the path of directory DIR. + --function Get_Directory_Path (Dir : Directory_Index) return String; + + -- Return TRUE is PATH is an absolute pathname. + function Is_Absolute_Pathname (Path : String) return Boolean; + + -- Add a new entry in the lines_table. + -- The new entry must be the next one after the last entry. + procedure File_Add_Line_Number + (File: Source_File_Entry; Line: Natural; Pos: Source_Ptr); + + -- Convert LOCATION into a source file FILE and an offset POS in the + -- file. + procedure Location_To_File_Pos (Location : Location_Type; + File : out Source_File_Entry; + Pos : out Source_Ptr); + -- Convert a FILE and an offset POS in the file into a location. + function File_Pos_To_Location (File : Source_File_Entry; Pos : Source_Ptr) + return Location_Type; + -- Convert a FILE into a location. + function Source_File_To_Location (File : Source_File_Entry) + return Location_Type; + + -- Convert a FILE+LINE into a position. + -- Return Source_Ptr_Bad in case of error (LINE out of bounds). + function Line_To_Position (File : Source_File_Entry; Line : Natural) + return Source_Ptr; + + -- Translate LOCATION into coordinate (physical position). + -- FILE identifies the filename. + -- LINE_POS is the offset in the file of the first character of the line, + -- LINE is the line number (first line is 1), + -- OFFSET is the offset of the location in the line (first character is 0, + -- a tabulation is one character), + procedure Location_To_Coord + (Location : Location_Type; + File : out Source_File_Entry; + Line_Pos : out Source_Ptr; + Line : out Natural; + Offset : out Natural); + + -- Translate coordinate into logical position. + -- NAME is the name of the file, + -- COL is the column (first character is 1, tabulation are at every 8 + -- positions). + procedure Coord_To_Position + (File : Source_File_Entry; + Line_Pos : Source_Ptr; + Offset : Natural; + Name : out Name_Id; + Col : out Natural); + + -- Translate LOCATION to NAME, LINE and COL. + -- It is like to two procedures above. + procedure Location_To_Position + (Location : Location_Type; + Name : out Name_Id; + Line : out Natural; + Col : out Natural); + + -- Get LINE and COL from LOCATION. + --procedure Get_Source_File_Line_And_Column + -- (Location: Location_Type; Line, Col: out Natural; Name : out Name_Id); + + -- Free all memory and reinitialize. + procedure Initialize; +end Files_Map; diff --git a/flags.adb b/flags.adb new file mode 100644 index 000000000..73a1454ce --- /dev/null +++ b/flags.adb @@ -0,0 +1,241 @@ +-- Command line flags. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Text_IO; use Ada.Text_IO; +with Name_Table; +with Libraries; +with Scan; + +package body Flags is + function Option_Warning (Opt: String; Val : Boolean) return Boolean is + begin +-- if Opt = "undriven" then +-- Warn_Undriven := True; + if Opt = "library" then + Warn_Library := Val; + elsif Opt = "default-binding" then + Warn_Default_Binding := Val; + elsif Opt = "binding" then + Warn_Binding := Val; + elsif Opt = "reserved" then + Warn_Reserved_Word := Val; + elsif Opt = "vital-generic" then + Warn_Vital_Generic := Val; + elsif Opt = "delayed-checks" then + Warn_Delayed_Checks := Val; + elsif Opt = "body" then + Warn_Body := Val; + elsif Opt = "specs" then + Warn_Specs := Val; + elsif Opt = "unused" then + Warn_Unused := Val; + elsif Opt = "error" then + Warn_Error := Val; + else + return False; + end if; + return True; + end Option_Warning; + + function Parse_Option (Opt: String) return Boolean is + Beg: Integer := Opt'First; + begin + if Opt'Length > 5 and then Opt (Beg .. Beg + 5) = "--std=" then + if Opt'Length = 8 then + if Opt (Beg + 6 .. Beg + 7) = "87" then + Vhdl_Std := Vhdl_87; + elsif Opt (Beg + 6 .. Beg + 7) = "93" then + Vhdl_Std := Vhdl_93; + elsif Opt (Beg + 6 .. Beg + 7) = "00" then + Vhdl_Std := Vhdl_00; + elsif Opt (Beg + 6 .. Beg + 7) = "02" then + Vhdl_Std := Vhdl_02; + else + return False; + end if; + elsif Opt'Length = 9 and then Opt (Beg + 6 .. Beg + 8) = "93c" then + Vhdl_Std := Vhdl_93c; + else + return False; + end if; + elsif Opt'Length > 2 and then Opt (Beg .. Beg + 1) = "-P" then + Libraries.Add_Library_Path (Opt (Beg + 2 .. Opt'Last)); + elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--workdir=" then + Libraries.Set_Work_Library_Path (Opt (Beg + 10 .. Opt'Last)); + elsif Opt'Length > 7 and then Opt (Beg .. Beg + 6) = "--warn-" then + return Option_Warning (Opt (Beg + 7 .. Opt'Last), True); + elsif Opt'Length > 10 and then Opt (Beg .. Beg + 9) = "--warn-no-" then + return Option_Warning (Opt (Beg + 10 .. Opt'Last), False); + elsif Opt'Length > 7 and then Opt (Beg .. Beg + 6) = "--work=" then + declare + use Name_Table; + begin + Name_Length := Opt'Last - (Beg + 7) + 1; + Name_Buffer (1 .. Name_Length) := Opt (Beg + 7 .. Opt'Last); + Scan.Convert_Identifier; + Libraries.Work_Library_Name := Get_Identifier; + end; + elsif Opt = "-C" or else Opt = "--mb-comments" then + Mb_Comment := True; + elsif Opt = "--bootstrap" then + Bootstrap := True; + elsif Opt = "-fexplicit" then + Flag_Explicit := True; + elsif Opt = "--syn-binding" then + Flag_Syn_Binding := True; + elsif Opt = "--no-vital-checks" then + Flag_Vital_Checks := False; + elsif Opt = "--vital-checks" then + Flag_Vital_Checks := True; + elsif Opt = "-dp" then + Dump_Parse := True; + elsif Opt = "-ds" then + Dump_Sem := True; + elsif Opt = "-dc" then + Dump_Canon := True; + elsif Opt = "-da" then + Dump_Annotate := True; + elsif Opt = "--dall" then + Dump_All := True; + elsif Opt = "-dstats" then + Dump_Stats := True; + elsif Opt = "--lall" then + List_All := True; + elsif Opt = "-lv" then + List_Verbose := True; + elsif Opt = "-ls" then + List_Sem := True; + elsif Opt = "-lc" then + List_Canon := True; + elsif Opt = "-la" then + List_Annotate := True; + elsif Opt = "-v" then + Verbose := True; + elsif Opt = "--finteger64" then + Flag_Integer_64 := True; + elsif Opt = "--ftime32" then + Flag_Time_64 := False; +-- elsif Opt'Length > 17 +-- and then Opt (Beg .. Beg + 17) = "--time-resolution=" +-- then +-- Beg := Beg + 18; +-- if Opt (Beg .. Beg + 1) = "fs" then +-- Time_Resolution := 'f'; +-- elsif Opt (Beg .. Beg + 1) = "ps" then +-- Time_Resolution := 'p'; +-- elsif Opt (Beg .. Beg + 1) = "ns" then +-- Time_Resolution := 'n'; +-- elsif Opt (Beg .. Beg + 1) = "us" then +-- Time_Resolution := 'u'; +-- elsif Opt (Beg .. Beg + 1) = "ms" then +-- Time_Resolution := 'm'; +-- elsif Opt (Beg .. Beg + 2) = "sec" then +-- Time_Resolution := 's'; +-- elsif Opt (Beg .. Beg + 2) = "min" then +-- Time_Resolution := 'M'; +-- elsif Opt (Beg .. Beg + 1) = "hr" then +-- Time_Resolution := 'h'; +-- else +-- return False; +-- end if; + else + return False; + end if; + return True; + end Parse_Option; + + -- Disp help about these options. + procedure Disp_Options_Help + is + procedure P (S : String) renames Put_Line; + begin + P ("Main options:"); + P (" --work=LIB use LIB as work library"); + P (" --workdir=DIR use DIR for the file library"); + P (" -PPATH add PATH in the library path list"); + P (" --std=87 select vhdl 87 standard"); + P (" --std=93 select vhdl 93 standard"); + P (" --std=93c select vhdl 93 standard and allow 87 syntax"); + P (" --[no-]vital-checks do [not] check VITAL restrictions"); + P ("Warnings:"); +-- P (" --warn-undriven disp undriven signals"); + P (" --warn-binding warns for component not bound"); + P (" --warn-reserved warns use of 93 reserved words in vhdl87"); + P (" --warn-library warns for redefinition of a design unit"); + P (" --warn-vital-generic warns of non-vital generic names"); + P (" --warn-delayed-checks warns for checks performed at elaboration"); + P (" --warn-body warns for not necessary package body"); + P (" --warn-specs warns if a all/others spec does not apply"); + P (" --warn-unused warns if a subprogram is never used"); + P (" --warn-error turns warnings into errors"); +-- P ("Simulation option:"); +-- P (" --time-resolution=UNIT set the resolution of type time"); +-- P (" UNIT can be fs, ps, ns, us, ms, sec, min or hr"); +-- P (" --assert-level=LEVEL set the level which stop the"); +-- P (" simulation. LEVEL is note, warning, error,"); +-- P (" failure or none"); + P ("Illegal extensions:"); + P (" -fexplicit give priority to explicitly declared operator"); + P (" -C --mb-comments allow multi-bytes chars in a comment"); + P (" --bootstrap allow --work=std"); + P (" --syn-binding use synthesis default binding rule"); + P ("Compilation dump:"); + P (" -dp dump tree after parsing"); + P (" -ds dump tree after semantics"); + P (" -da dump tree after annotate"); + P (" --dall -dX options apply to all files"); + P ("Compilation list:"); + P (" -ls after semantics"); + P (" -lc after canon"); + P (" -la after annotation"); + P (" --lall -lX options apply to all files"); + P (" -lv verbose list"); + P (" -v disp compilation stages"); + end Disp_Options_Help; + + procedure Create_Flag_String is + begin + case Vhdl_Std is + when Vhdl_87 => + Flag_String (1 .. 2) := "87"; + when Vhdl_93c + | Vhdl_93 + | Vhdl_00 + | Vhdl_02 => + Flag_String (1 .. 2) := "93"; + end case; + if Flag_Integer_64 then + Flag_String (3) := 'I'; + else + Flag_String (3) := 'i'; + end if; + if Flag_Time_64 then + Flag_String (4) := 'T'; + else + Flag_String (4) := 't'; + end if; + if not Flag_Time_64 and Vhdl_Std = Vhdl_87 then + Flag_String (5) := Time_Resolution; + else + if Flag_Time_64 then + Flag_String (5) := '-'; + else + Flag_String (5) := '?'; + end if; + end if; + end Create_Flag_String; +end Flags; diff --git a/flags.ads b/flags.ads new file mode 100644 index 000000000..d047ba2d5 --- /dev/null +++ b/flags.ads @@ -0,0 +1,183 @@ +-- Command line flags. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- All the variables declared in this package are set by Parse_Option function +-- and can by read as soon as the command line is parsed. +-- +-- Since the names are not prefixed, this package is expected to be with'ed +-- but not to be use'd. + +with Types; use Types; + +package Flags is + -- Standard accepted. + Vhdl_Std: Vhdl_Std_Type := Vhdl_93c; + + -- Return true if opt is recognize by flags. + -- Note: std_names.std_names_initialize and files_map.init_pathes must have + -- been called before this subprogram. + function Parse_Option (Opt: String) return Boolean; + + -- Disp help about these options. + procedure Disp_Options_Help; + + -- Some flags (such as vhdl version) must be the same for every design + -- units of a hierarchy. + -- The Flag_String is a signature of all these flags. + Flag_String : String (1 .. 5); + procedure Create_Flag_String; + + -- If set, a multi-bytes sequence can appear in a comment, ie, all + -- characters except VT, CR, LF and FF are allowed in a comment. + -- Set by -C and --mb-comments + Mb_Comment: Boolean := False; + + -- If set, relax rules about std library: working library can be std. + Bootstrap : Boolean := False; + + -- Options -dX + -- -dp: disp tree after parsing + Dump_Parse: Boolean := False; + + -- -ds: disp tree after semantic + Dump_Sem: Boolean := False; + + -- -dc: disp tree after canon + Dump_Canon : Boolean := False; + + -- -da: disp tree after annotation + Dump_Annotate: Boolean := False; + + -- --dall: makes -dX options to apply to all files. + Dump_All: Boolean := False; + + -- -dstats: disp statistics. + Dump_Stats : Boolean := False; + + -- -lX options: list tree as a vhdl file. + + -- --lall option: makes -lX options to apply to all files + List_All: Boolean := False; + + -- -lv: list verbose + List_Verbose: Boolean := False; + + -- -ls: list tree after semantic. + List_Sem: Boolean := False; + + -- -lc: list tree after canon. + List_Canon: Boolean := False; + + -- -la: list tree after back-end annotation. + List_Annotate: Boolean := False; + + -- -v: disp phase of compilation. + Verbose : Boolean := False; + + -- If set to true, it means that analyze is done for elaboration. + -- The purpose is to avoid spurious warning "will be checked + -- at elaboration" + Flag_Elaborate : Boolean := False; + + -- If set, a default aspect entity aspect might be an outdated unit. + -- Used by ghdldrv. + Flag_Elaborate_With_Outdated : Boolean := False; + + -- Do not display parse and sem warnings. Used during elaboration. + Flag_Only_Elab_Warnings : Boolean := False; + + -- If set, explicit subprogram declarations take precedence over + -- implicit declarations, even through use clauses. + Flag_Explicit : Boolean := False; + + -- If set, use 'L.C' rule from VHDL02 to do default component binding. + Flag_Syn_Binding : Boolean := False; + + -- If set, performs VITAL checks. + Flag_Vital_Checks : Boolean := True; + + -- --time-resolution=X + -- Where X corresponds to: + -- fs => 'f' + -- ps => 'p' + -- ns => 'n' + -- us => 'u' + -- ms => 'm' + -- sec => 's' + -- min => 'M' + -- hr => 'h' + Time_Resolution: Character := 'f'; + + -- Integer and time types can be either 32 bits or 64 bits values. + -- The default is 32 bits for Integer and 64 bits for Time. + -- Be very careful: if you don't use the default sizes, you may have to + -- change other parts of your systems (such as GRT). + Flag_Integer_64 : Boolean := False; + Flag_Time_64 : Boolean := True; + + -- If set, generate cross-references during sem. + Flag_Xref : Boolean := False; + + -- --warn-undriven + --Warn_Undriven : Boolean := False; + + -- --warn-default-binding + -- Should emit a warning when there is no default binding for a component + -- instantiation. + Warn_Default_Binding : Boolean := False; + + -- --warn-binding + -- Emit a warning at elaboration for unbound component. + Warn_Binding : Boolean := True; + + -- --warn-reserved + -- Emit a warning when a vhdl93 reserved word is used as a + -- vhdl87 identifier. + Warn_Reserved_Word : Boolean := False; + + -- --warn-library + -- Emit a warning when a design unit redefines another design unit. + Warn_Library : Boolean := False; + + -- --warn-vital-generic + -- Emit a warning when a generic of a vital entity is not a vital name. + Warn_Vital_Generic : Boolean := True; + + -- --warn-delayed-checks + -- Emit warnings about delayed checks (checks performed at elaboration + -- time). + Warn_Delayed_Checks : Boolean := True; + + -- --warn-body + -- Emit a warning when a package body is not required but is analyzed. + Warn_Body : Boolean := True; + + -- --warn-specs + -- Emit a warning when an all/others specification does not apply, because + -- there is no such named entities. + Warn_Specs : Boolean := True; + + -- --warn-unused + -- Emit a warning when a declaration is never used. + -- FIXME: currently only subprograms are handled. + Warn_Unused : Boolean := True; + + -- --warn-error + -- Turns warnings into errors. + Warn_Error : Boolean := False; +end Flags; diff --git a/ieee-std_logic_1164.adb b/ieee-std_logic_1164.adb new file mode 100644 index 000000000..625888a09 --- /dev/null +++ b/ieee-std_logic_1164.adb @@ -0,0 +1,161 @@ +-- Nodes recognizer for ieee.std_logic_1164. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Std_Names; use Std_Names; +with Errorout; use Errorout; + +package body Ieee.Std_Logic_1164 is + function Skip_Implicit (Decl : Iir) return Iir + is + Res : Iir; + begin + Res := Decl; + loop + exit when Res = Null_Iir; + exit when Get_Kind (Res) /= Iir_Kind_Implicit_Function_Declaration; + Res := Get_Chain (Res); + end loop; + return Res; + end Skip_Implicit; + + procedure Extract_Declarations (Pkg : Iir_Package_Declaration) + is + Error : exception; + + Decl : Iir; + Def : Iir; + begin + Std_Logic_1164_Pkg := Pkg; + + Decl := Get_Declaration_Chain (Pkg); + + -- The first declaration should be type std_ulogic. + if Decl = Null_Iir + or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration + or else Get_Identifier (Decl) /= Name_Std_Ulogic + then + raise Error; + end if; + + Def := Get_Type (Decl); + if Get_Kind (Def) /= Iir_Kind_Enumeration_Type_Definition then + raise Error; + end if; + Std_Ulogic_Type := Def; + + -- The second declaration should be std_ulogic_vector. + Decl := Get_Chain (Decl); + Decl := Skip_Implicit (Decl); + if Decl = Null_Iir + or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration + or else Get_Identifier (Decl) /= Name_Std_Ulogic_Vector + then + raise Error; + end if; + Def := Get_Type (Decl); + if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then + raise Error; + end if; + Std_Ulogic_Vector_Type := Def; + + -- The third declaration should be resolved. + Decl := Get_Chain (Decl); + Decl := Skip_Implicit (Decl); + if Decl = Null_Iir + or else Get_Kind (Decl) /= Iir_Kind_Function_Declaration + then + -- FIXME: check name ? + raise Error; + end if; + Resolved := Decl; + + -- The fourth declaration should be std_logic. + Decl := Get_Chain (Decl); + Decl := Skip_Implicit (Decl); + if Decl = Null_Iir + or else Get_Kind (Decl) /= Iir_Kind_Subtype_Declaration + or else Get_Identifier (Decl) /= Name_Std_Logic + then + raise Error; + end if; + Def := Get_Type (Decl); + if Get_Kind (Def) /= Iir_Kind_Enumeration_Subtype_Definition then + raise Error; + end if; + Std_Logic_Type := Def; + + -- The fifth declaration should be std_logic_vector. + Decl := Get_Chain (Decl); + Decl := Skip_Implicit (Decl); + if Decl = Null_Iir + or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration + or else Get_Identifier (Decl) /= Name_Std_Logic_Vector + then + raise Error; + end if; + Def := Get_Type (Decl); + if Get_Kind (Def) /= Iir_Kind_Array_Type_Definition then + raise Error; + end if; + Std_Logic_Vector_Type := Def; + + -- Skip any declarations but functions. + loop + Decl := Get_Chain (Decl); + exit when Decl = Null_Iir; + + if Get_Kind (Decl) = Iir_Kind_Function_Declaration then + if Get_Identifier (Decl) = Name_Rising_Edge then + Rising_Edge := Decl; + elsif Get_Identifier (Decl) = Name_Falling_Edge then + Falling_Edge := Decl; + end if; + end if; + end loop; + + -- Since rising_edge and falling_edge do not read activity of its + -- parameter, clear the flag to allow more optimizations. + if Rising_Edge /= Null_Iir then + Set_Has_Active_Flag + (Get_Interface_Declaration_Chain (Rising_Edge), False); + else + raise Error; + end if; + if Falling_Edge /= Null_Iir then + Set_Has_Active_Flag + (Get_Interface_Declaration_Chain (Falling_Edge), False); + else + raise Error; + end if; + + exception + when Error => + Error_Msg_Sem ("package ieee.std_logic_1164 is ill-formed", Pkg); + + -- Clear all definitions. + Std_Logic_1164_Pkg := Null_Iir; + Std_Ulogic_Type := Null_Iir; + Std_Ulogic_Vector_Type := Null_Iir; + Std_Logic_Type := Null_Iir; + Std_Logic_Vector_Type := Null_Iir; + Rising_Edge := Null_Iir; + Falling_Edge := Null_Iir; + end Extract_Declarations; +end Ieee.Std_Logic_1164; + + diff --git a/ieee-std_logic_1164.ads b/ieee-std_logic_1164.ads new file mode 100644 index 000000000..e1325c378 --- /dev/null +++ b/ieee-std_logic_1164.ads @@ -0,0 +1,35 @@ +-- Nodes recognizer for ieee.std_logic_1164. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Iirs; use Iirs; + +package Ieee.Std_Logic_1164 is + -- Nodes corresponding to declarations in the package. + Std_Logic_1164_Pkg : Iir_Package_Declaration := Null_Iir; + Std_Ulogic_Type : Iir_Enumeration_Type_Definition := Null_Iir; + Std_Ulogic_Vector_Type : Iir_Array_Type_Definition := Null_Iir; + Std_Logic_Type : Iir_Enumeration_Subtype_Definition := Null_Iir; + Std_Logic_Vector_Type : Iir_Array_Type_Definition := Null_Iir; + Resolved : Iir_Function_Declaration := Null_Iir; + Rising_Edge : Iir_Function_Declaration := Null_Iir; + Falling_Edge : Iir_Function_Declaration := Null_Iir; + + -- Extract declarations from PKG. + -- PKG is the package declaration for ieee.std_logic_1164 package. + -- Fills the node aboves. + procedure Extract_Declarations (Pkg : Iir_Package_Declaration); +end Ieee.Std_Logic_1164; diff --git a/ieee-vital_timing.adb b/ieee-vital_timing.adb new file mode 100644 index 000000000..88f39bcf4 --- /dev/null +++ b/ieee-vital_timing.adb @@ -0,0 +1,1369 @@ +-- Nodes recognizer for ieee.vital_timing. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Std_Names; +with Errorout; use Errorout; +with Std_Package; use Std_Package; +with Tokens; use Tokens; +with Name_Table; +with Ieee.Std_Logic_1164; use Ieee.Std_Logic_1164; +with Sem_Scopes; +with Evaluation; +with Sem; +with Flags; + +package body Ieee.Vital_Timing is + -- This package is based on IEEE 1076.4 1995. + + -- Control generics identifier. + InstancePath_Id : Name_Id; + TimingChecksOn_Id : Name_Id; + XOn_Id : Name_Id; + MsgOn_Id : Name_Id; + + -- Extract declarations from package IEEE.VITAL_Timing. + procedure Extract_Declarations (Pkg : Iir_Package_Declaration) + is + use Name_Table; + + Ill_Formed : exception; + + Decl : Iir; + Id : Name_Id; + + VitalDelayType_Id : Name_Id; + VitalDelayType01_Id : Name_Id; + VitalDelayType01Z_Id : Name_Id; + VitalDelayType01ZX_Id : Name_Id; + + VitalDelayArrayType_Id : Name_Id; + VitalDelayArrayType01_Id : Name_Id; + VitalDelayArrayType01Z_Id : Name_Id; + VitalDelayArrayType01ZX_Id : Name_Id; + begin + -- Get Vital delay type identifiers. + Name_Buffer (1 .. 18) := "vitaldelaytype01zx"; + Name_Length := 14; + VitalDelayType_Id := Get_Identifier_No_Create; + if VitalDelayType_Id = Null_Identifier then + raise Ill_Formed; + end if; + Name_Length := 16; + VitalDelayType01_Id := Get_Identifier_No_Create; + if VitalDelayType01_Id = Null_Identifier then + raise Ill_Formed; + end if; + Name_Length := 17; + VitalDelayType01Z_Id := Get_Identifier_No_Create; + if VitalDelayType01Z_Id = Null_Identifier then + raise Ill_Formed; + end if; + Name_Length := 18; + VitalDelayType01ZX_Id := Get_Identifier_No_Create; + if VitalDelayType01ZX_Id = Null_Identifier then + raise Ill_Formed; + end if; + + Name_Buffer (1 .. 23) := "vitaldelayarraytype01zx"; + Name_Length := 19; + VitalDelayArrayType_Id := Get_Identifier_No_Create; + if VitalDelayArrayType_Id = Null_Identifier then + raise Ill_Formed; + end if; + Name_Length := 21; + VitalDelayArrayType01_Id := Get_Identifier_No_Create; + if VitalDelayArrayType01_Id = Null_Identifier then + raise Ill_Formed; + end if; + Name_Length := 22; + VitalDelayArrayType01Z_Id := Get_Identifier_No_Create; + if VitalDelayArrayType01Z_Id = Null_Identifier then + raise Ill_Formed; + end if; + Name_Length := 23; + VitalDelayArrayType01ZX_Id := Get_Identifier_No_Create; + if VitalDelayArrayType01ZX_Id = Null_Identifier then + raise Ill_Formed; + end if; + + -- Iterate on every declaration. + -- Do name-matching. + Decl := Get_Declaration_Chain (Pkg); + while Decl /= Null_Iir loop + case Get_Kind (Decl) is + when Iir_Kind_Attribute_Declaration => + Id := Get_Identifier (Decl); + if Id = Std_Names.Name_VITAL_Level0 then + Vital_Level0_Attribute := Decl; + elsif Id = Std_Names.Name_VITAL_Level1 then + Vital_Level1_Attribute := Decl; + end if; + when Iir_Kind_Subtype_Declaration => + Id := Get_Identifier (Decl); + if Id = VitalDelayType_Id then + VitalDelayType := Get_Type (Decl); + end if; + when Iir_Kind_Type_Declaration => + Id := Get_Identifier (Decl); + if Id = VitalDelayArrayType_Id then + VitalDelayArrayType := Get_Type (Decl); + elsif Id = VitalDelayArrayType01_Id then + VitalDelayArrayType01 := Get_Type (Decl); + elsif Id = VitalDelayArrayType01Z_Id then + VitalDelayArrayType01Z := Get_Type (Decl); + elsif Id = VitalDelayArrayType01ZX_Id then + VitalDelayArrayType01ZX := Get_Type (Decl); + end if; + when Iir_Kind_Anonymous_Type_Declaration => + Id := Get_Identifier (Decl); + if Id = VitalDelayType01_Id then + VitalDelayType01 := Get_Type (Decl); + elsif Id = VitalDelayType01Z_Id then + VitalDelayType01Z := Get_Type (Decl); + elsif Id = VitalDelayType01ZX_Id then + VitalDelayType01ZX := Get_Type (Decl); + end if; + when others => + null; + end case; + Decl := Get_Chain (Decl); + end loop; + + -- If a declaration was not found, then the package is not the expected + -- one. + if Vital_Level0_Attribute = Null_Iir + or Vital_Level1_Attribute = Null_Iir + or VitalDelayType = Null_Iir + or VitalDelayType01 = Null_Iir + or VitalDelayType01Z = Null_Iir + or VitalDelayType01ZX = Null_Iir + or VitalDelayArrayType = Null_Iir + or VitalDelayArrayType01 = Null_Iir + or VitalDelayArrayType01Z = Null_Iir + or VitalDelayArrayType01ZX = Null_Iir + then + raise Ill_Formed; + end if; + + -- Create identifier for control generics. + InstancePath_Id := Get_Identifier ("instancepath"); + TimingChecksOn_Id := Get_Identifier ("timingcheckson"); + XOn_Id := Get_Identifier ("xon"); + MsgOn_Id := Get_Identifier ("msgon"); + + exception + when Ill_Formed => + Error_Msg_Sem ("package ieee.vital_timing is ill-formed", Pkg); + + Vital_Level0_Attribute := Null_Iir; + Vital_Level1_Attribute := Null_Iir; + + VitalDelayType := Null_Iir; + VitalDelayType01 := Null_Iir; + VitalDelayType01Z := Null_Iir; + VitalDelayType01ZX := Null_Iir; + + VitalDelayArrayType := Null_Iir; + VitalDelayArrayType01 := Null_Iir; + VitalDelayArrayType01Z := Null_Iir; + VitalDelayArrayType01ZX := Null_Iir; + end Extract_Declarations; + + procedure Error_Vital (Msg : String; Loc : Iir) renames Error_Msg_Sem; + procedure Error_Vital (Msg : String; Loc : Location_Type) + renames Error_Msg_Sem; + procedure Warning_Vital (Msg : String; Loc : Iir) renames Warning_Msg_Sem; + + -- Check DECL is the VITAL level 0 attribute specification. + procedure Check_Level0_Attribute_Specification (Decl : Iir) + is + Expr : Iir; + begin + if Get_Kind (Decl) /= Iir_Kind_Attribute_Specification + or else Get_Attribute_Designator (Decl) /= Vital_Level0_Attribute + then + Error_Vital + ("first declaration must be the VITAL attribute specification", + Decl); + return; + end if; + + -- IEEE 1076.4 4.1 + -- The expression in the VITAL_Level0 attribute specification shall be + -- the Boolean literal TRUE. + Expr := Get_Expression (Decl); + if Expr /= Boolean_True then + Error_Vital + ("the expression in the VITAL_Level0 attribute specification shall " + & "be the Boolean literal TRUE", Decl); + end if; + + -- IEEE 1076.4 4.1 + -- The entity specification of the decorating attribute specification + -- shall be such that the enclosing entity or architecture inherits the + -- VITAL_Level0 attribute. + case Get_Entity_Class (Decl) is + when Tok_Entity + | Tok_Architecture => + null; + when others => + Error_Vital ("VITAL attribute specification does not decorate the " + & "enclosing entity or architecture", Decl); + end case; + end Check_Level0_Attribute_Specification; + + procedure Check_Entity_Port_Declaration + (Decl : Iir_Signal_Interface_Declaration) + is + use Name_Table; + + Atype : Iir; + Base_Type : Iir; + Type_Decl : Iir; + begin + -- IEEE 1076.4 4.3.1 + -- The identifiers in an entity port declaration shall not contain + -- underscore characters. + Image (Get_Identifier (Decl)); + if Name_Buffer (1) = '/' then + Error_Vital ("VITAL entity port shall not be an extended identifier", + Decl); + end if; + for I in 1 .. Name_Length loop + if Name_Buffer (I) = '_' then + Error_Vital + ("VITAL entity port shall not contain underscore", Decl); + exit; + end if; + end loop; + + -- IEEE 1076.4 4.3.1 + -- A port that is declared in an entity port declaration shall not be + -- of mode LINKAGE. + if Get_Mode (Decl) = Iir_Linkage_Mode then + Error_Vital ("VITAL entity port shall not be of mode LINKAGE", Decl); + end if; + + -- IEEE 1076.4 4.3.1 + -- The type mark in an entity port declaration shall denote a type or + -- a subtype that is declared in package Std_Logic_1164. The type + -- mark in the declaration of a scalar port shall denote the subtype + -- Std_Ulogic or a subtype of Std_Ulogic. The type mark in the + -- declaration of an array port shall denote the type Std_Logic_Vector. + Atype := Get_Type (Decl); + Base_Type := Get_Base_Type (Atype); + Type_Decl := Get_Type_Declarator (Atype); + if Base_Type = Std_Logic_Vector_Type then + if Get_Resolution_Function (Atype) /= Null_Iir then + Error_Vital + ("VITAL array port type cannot override resolution function", + Decl); + end if; + -- FIXME: is an unconstrained array port allowed ? + -- FIXME: what about staticness of the index_constraint ? + elsif Base_Type = Std_Ulogic_Type then + if Type_Decl = Null_Iir + or else Get_Parent (Type_Decl) /= Std_Logic_1164_Pkg + then + Error_Vital + ("VITAL entity port type mark shall be one of Std_Logic_1164", + Decl); + end if; + else + Error_Vital ("VITAL port type must be Std_Logic_Vector or Std_Ulogic", + Decl); + end if; + + if Get_Signal_Kind (Decl) /= Iir_No_Signal_Kind then + Error_Vital ("VITAL entity port cannot be guarded", Decl); + end if; + end Check_Entity_Port_Declaration; + + -- Current position in the generic name, stored into + -- name_table.name_buffer. + Gen_Name_Pos : Natural; + + -- Length of the generic name. + Gen_Name_Length : Natural; + + -- The generic being analyzed. + Gen_Decl : Iir; + Gen_Chain : Iir; + + procedure Error_Vital_Name (Str : String) + is + Loc : Location_Type; + begin + Loc := Get_Location (Gen_Decl); + Error_Vital (Str, Loc + Location_Type (Gen_Name_Pos - 1)); + end Error_Vital_Name; + + -- Check the next sub-string in the generic name is a port. + -- Returns the port. + function Check_Port return Iir + is + use Sem_Scopes; + use Name_Table; + + C : Character; + Res : Iir; + Id : Name_Id; + Inter : Name_Interpretation_Type; + begin + Name_Length := 0; + while Gen_Name_Pos <= Gen_Name_Length loop + C := Name_Buffer (Gen_Name_Pos); + Gen_Name_Pos := Gen_Name_Pos + 1; + exit when C = '_'; + Name_Length := Name_Length + 1; + Name_Buffer (Name_Length) := C; + end loop; + + if Name_Length = 0 then + Error_Vital_Name ("port expected in VITAL generic name"); + return Null_Iir; + end if; + + Id := Get_Identifier_No_Create; + Res := Null_Iir; + if Id /= Null_Identifier then + Inter := Get_Interpretation (Id); + if Valid_Interpretation (Inter) then + Res := Get_Declaration (Inter); + end if; + end if; + if Res = Null_Iir then + Warning_Vital ("'" & Name_Buffer (1 .. Name_Length) + & "' is not a port name (in VITAL generic name)", + Gen_Decl); + end if; + return Res; + end Check_Port; + + -- Checks the port is an input port. + function Check_Input_Port return Iir + is + use Name_Table; + + Res : Iir; + begin + Res := Check_Port; + if Res /= Null_Iir then + -- IEEE 1076.4 4.3.2.1.3 + -- an input port is a VHDL port of mode IN or INOUT. + case Get_Mode (Res) is + when Iir_In_Mode + | Iir_Inout_Mode => + null; + when others => + Error_Vital ("'" & Name_Buffer (1 .. Name_Length) + & "' must be an input port", Gen_Decl); + end case; + end if; + return Res; + end Check_Input_Port; + + -- Checks the port is an output port. + function Check_Output_Port return Iir + is + use Name_Table; + + Res : Iir; + begin + Res := Check_Port; + if Res /= Null_Iir then + -- IEEE 1076.4 4.3.2.1.3 + -- An output port is a VHDL port of mode OUT, INOUT or BUFFER. + case Get_Mode (Res) is + when Iir_Out_Mode + | Iir_Inout_Mode + | Iir_Buffer_Mode => + null; + when others => + Error_Vital ("'" & Name_Buffer (1 .. Name_Length) + & "' must be an output port", Gen_Decl); + end case; + end if; + return Res; + end Check_Output_Port; + + -- Extract a suffix from the generic name. + type Suffixes_Kind is + ( + Suffix_Name, -- [a-z]* + Suffix_Num_Name, -- [0-9]* + Suffix_Edge, -- posedge, negedge, 01, 10, 0z, z1, 1z, z0 + Suffix_Noedge, -- noedge + Suffix_Eon -- End of name + ); + + function Get_Next_Suffix_Kind return Suffixes_Kind + is + use Name_Table; + + Len : Natural; + P : Natural := Gen_Name_Pos; + C : Character; + begin + Len := 0; + while Gen_Name_Pos <= Gen_Name_Length loop + C := Name_Buffer (Gen_Name_Pos); + Gen_Name_Pos := Gen_Name_Pos + 1; + exit when C = '_'; + Len := Len + 1; + end loop; + if Len = 0 then + return Suffix_Eon; + end if; + + case Name_Buffer (P) is + when '0' => + if Len = 2 and then (Name_Buffer (P + 1) = '1' + or Name_Buffer (P + 1) = 'z') + then + return Suffix_Edge; + else + return Suffix_Num_Name; + end if; + when '1' => + if Len = 2 and then (Name_Buffer (P + 1) = '0' + or Name_Buffer (P + 1) = 'z') + then + return Suffix_Edge; + else + return Suffix_Num_Name; + end if; + when '2' .. '9' => + return Suffix_Num_Name; + when 'z' => + if Len = 2 and then (Name_Buffer (P + 1) = '0' + or Name_Buffer (P + 1) = '1') + then + return Suffix_Edge; + else + return Suffix_Name; + end if; + when 'p' => + if Len = 7 and then Name_Buffer (P .. P + 6) = "posedge" then + return Suffix_Edge; + else + return Suffix_Name; + end if; + when 'n' => + if Len = 7 and then Name_Buffer (P .. P + 6) = "negedge" then + return Suffix_Edge; + elsif Len = 6 and then Name_Buffer (P .. P + 5) = "noedge" then + return Suffix_Edge; + else + return Suffix_Name; + end if; + when 'a' .. 'm' + | 'o' + | 'q' .. 'y' => + return Suffix_Name; + when others => + raise Internal_Error; + end case; + end Get_Next_Suffix_Kind; + + -- ::= + -- + -- | + -- | _ + procedure Check_Simple_Condition_And_Or_Edge + is + First : Boolean := True; + begin + loop + case Get_Next_Suffix_Kind is + when Suffix_Eon => + -- Simple condition is optional. + return; + when Suffix_Edge => + if Get_Next_Suffix_Kind /= Suffix_Eon then + Error_Vital_Name ("garbage after edge"); + end if; + return; + when Suffix_Num_Name => + if First then + Error_Vital_Name ("condition is a simple name"); + end if; + when Suffix_Noedge => + Error_Vital_Name ("'noedge' not allowed in simple condition"); + when Suffix_Name => + null; + end case; + First := False; + end loop; + end Check_Simple_Condition_And_Or_Edge; + + -- ::= + -- [_] + -- + -- ::= + -- [_] + -- | [_]noedge + procedure Check_Full_Condition_And_Or_Edge + is + begin + case Get_Next_Suffix_Kind is + when Suffix_Eon => + -- FullCondition is always optional. + return; + when Suffix_Edge + | Suffix_Noedge => + Check_Simple_Condition_And_Or_Edge; + return; + when Suffix_Num_Name => + Error_Vital_Name ("condition is a simple name"); + when Suffix_Name => + null; + end case; + + loop + case Get_Next_Suffix_Kind is + when Suffix_Eon => + Error_Vital_Name ("missing edge or noedge"); + return; + when Suffix_Edge + | Suffix_Noedge => + Check_Simple_Condition_And_Or_Edge; + return; + when Suffix_Num_Name + | Suffix_Name => + null; + end case; + end loop; + end Check_Full_Condition_And_Or_Edge; + + procedure Check_End is + begin + if Get_Next_Suffix_Kind /= Suffix_Eon then + Error_Vital_Name ("garbage at end of name"); + end if; + end Check_End; + + -- Return the length of a port P. + -- If P is a scalar port, return PORT_LENGTH_SCALAR + -- If P is a vector, return the length of the vector (>= 0) + -- Otherwise, return PORT_LENGTH_ERROR. + Port_Length_Unknown : constant Iir_Int64 := -1; + Port_Length_Scalar : constant Iir_Int64 := -2; + Port_Length_Error : constant Iir_Int64 := -3; + function Get_Port_Length (P : Iir) return Iir_Int64 + is + Ptype : Iir; + Itype : Iir; + begin + Ptype := Get_Type (P); + if Get_Base_Type (Ptype) = Std_Ulogic_Type then + return Port_Length_Scalar; + elsif Get_Kind (Ptype) = Iir_Kind_Array_Subtype_Definition + and then Get_Base_Type (Ptype) = Std_Logic_Vector_Type + then + Itype := Get_First_Element (Get_Index_Subtype_List (Ptype)); + if Get_Type_Staticness (Itype) /= Locally then + return Port_Length_Unknown; + end if; + return Evaluation.Eval_Discrete_Type_Length (Itype); + else + return Port_Length_Error; + end if; + end Get_Port_Length; + + -- IEEE 1076.4 9.1 VITAL delay types and subtypes. + -- The transition dependent delay types are + -- VitalDelayType01, VitalDelayType01Z, VitalDelayType01ZX, + -- VitalDelayArrayType01, VitalDelayArrayType01Z, VitalDelayArrayType01ZX. + -- The first three are scalar forms, the last three are vector forms. + -- + -- The simple delay types and subtypes include + -- Time, VitalDelayType, and VitalDelayArrayType. + -- The first two are scalar forms, and the latter is the vector form. + type Timing_Generic_Type_Kind is + ( + Timing_Type_Simple_Scalar, + Timing_Type_Simple_Vector, + Timing_Type_Trans_Scalar, + Timing_Type_Trans_Vector, + Timing_Type_Bad + ); + + function Get_Timing_Generic_Type_Kind return Timing_Generic_Type_Kind + is + Gtype : Iir; + Btype : Iir; + begin + Gtype := Get_Type (Gen_Decl); + Btype := Get_Base_Type (Gtype); + case Get_Kind (Gtype) is + when Iir_Kind_Array_Subtype_Definition => + if Btype = VitalDelayArrayType then + return Timing_Type_Simple_Vector; + end if; + if Btype = VitalDelayType01 + or Btype = VitalDelayType01Z + or Btype = VitalDelayType01ZX + then + return Timing_Type_Trans_Scalar; + end if; + if Btype = VitalDelayArrayType01 + or Btype = VitalDelayArrayType01Z + or Btype = VitalDelayArrayType01ZX + then + return Timing_Type_Trans_Vector; + end if; + when Iir_Kind_Physical_Subtype_Definition => + if Gtype = Time_Subtype_Definition + or else Gtype = VitalDelayType + then + return Timing_Type_Simple_Scalar; + end if; + when others => + null; + end case; + Error_Vital ("type of timing generic is not a VITAL delay type", + Gen_Decl); + return Timing_Type_Bad; + end Get_Timing_Generic_Type_Kind; + + function Get_Timing_Generic_Type_Length return Iir_Int64 + is + Itype : Iir; + begin + Itype := Get_First_Element + (Get_Index_Subtype_List (Get_Type (Gen_Decl))); + if Get_Type_Staticness (Itype) /= Locally then + return Port_Length_Unknown; + else + return Evaluation.Eval_Discrete_Type_Length (Itype); + end if; + end Get_Timing_Generic_Type_Length; + + -- IEEE 1076.4 4.3.2.1.2 Timing generic subtypes + -- * If the timing generic is associated with a single port and that port + -- is a scalar, then the type of the timing generic shall be a scalar + -- form of delay type. + -- * If such a timing generic is associated with a single port and that + -- port is a vector, then the type of the timing generic shall be a + -- vector form of delay type, and the constraint on the generic shall + -- match that on the associated port. + procedure Check_Vital_Delay_Type (P : Iir; + Is_Simple : Boolean := False; + Is_Scalar : Boolean := False) + is + Kind : Timing_Generic_Type_Kind; + Len : Iir_Int64; + Len1 : Iir_Int64; + begin + Kind := Get_Timing_Generic_Type_Kind; + if P = Null_Iir or Kind = Timing_Type_Bad then + return; + end if; + Len := Get_Port_Length (P); + if Len = Port_Length_Scalar then + case Kind is + when Timing_Type_Simple_Scalar => + null; + when Timing_Type_Trans_Scalar => + if Is_Simple then + Error_Vital + ("VITAL simple scalar timing type expected", Gen_Decl); + return; + end if; + when others => + Error_Vital ("VITAL scalar timing type expected", Gen_Decl); + return; + end case; + elsif Len >= Port_Length_Unknown then + if Is_Scalar then + Error_Vital ("VITAL scalar timing type expected", Gen_Decl); + return; + end if; + + case Kind is + when Timing_Type_Simple_Vector => + null; + when Timing_Type_Trans_Vector => + if Is_Simple then + Error_Vital + ("VITAL simple vector timing type expected", Gen_Decl); + return; + end if; + when others => + Error_Vital ("VITAL vector timing type expected", Gen_Decl); + return; + end case; + Len1 := Get_Timing_Generic_Type_Length; + if Len1 /= Len then + Error_Vital ("length of port and VITAL vector timing subtype " + & "does not match", Gen_Decl); + end if; + end if; + end Check_Vital_Delay_Type; + + -- IEEE 1076.4 4.3.2.1.2 Timing generic subtypes + -- * If the timing generic is associated with two scalar ports, then the + -- type of the timing generic shall be a scalar form of delay type. + -- * If the timing generic is associated with two ports, one or more of + -- which is a vector, then the type of the timing generic shall be a + -- vector form of delay type, and the length of the index range of the + -- generic shall be equal to the product of the number of scalar + -- subelements in the first port and the number of scalar subelements + -- in the second port. + procedure Check_Vital_Delay_Type + (P1, P2 : Iir; + Is_Simple : Boolean := False; + Is_Scalar : Boolean := False) + is + Kind : Timing_Generic_Type_Kind; + Len1 : Iir_Int64; + Len2 : Iir_Int64; + Lenp : Iir_Int64; + begin + Kind := Get_Timing_Generic_Type_Kind; + if P1 = Null_Iir or P2 = Null_Iir or Kind = Timing_Type_Bad then + return; + end if; + Len1 := Get_Port_Length (P1); + Len2 := Get_Port_Length (P2); + if Len1 = Port_Length_Scalar and Len2 = Port_Length_Scalar then + case Kind is + when Timing_Type_Simple_Scalar => + null; + when Timing_Type_Trans_Scalar => + if Is_Simple then + Error_Vital + ("VITAL simple scalar timing type expected", Gen_Decl); + return; + end if; + when others => + Error_Vital ("VITAL scalar timing type expected", Gen_Decl); + return; + end case; + elsif Len1 >= Port_Length_Unknown or Len2 >= Port_Length_Unknown then + if Is_Scalar then + Error_Vital ("VITAL scalar timing type expected", Gen_Decl); + return; + end if; + case Kind is + when Timing_Type_Simple_Vector => + null; + when Timing_Type_Trans_Vector => + if Is_Simple then + Error_Vital + ("VITAL simple vector timing type expected", Gen_Decl); + return; + end if; + when others => + Error_Vital ("VITAL vector timing type expected", Gen_Decl); + return; + end case; + if Len1 = Port_Length_Scalar then + Len1 := 1; + elsif Len1 = Port_Length_Error then + return; + end if; + if Len2 = Port_Length_Scalar then + Len2 := 1; + elsif Len2 = Port_Length_Error then + return; + end if; + Lenp := Get_Timing_Generic_Type_Length; + if Lenp /= Len1 * Len2 then + Error_Vital ("length of port and VITAL vector timing subtype " + & "does not match", Gen_Decl); + end if; + end if; + end Check_Vital_Delay_Type; + + function Check_Timing_Generic_Prefix + (Decl : Iir_Constant_Interface_Declaration; Length : Natural) + return Boolean + is + use Name_Table; + begin + -- IEEE 1076.4 4.3.1 + -- It is an error for a model to use a timing generic prefix to begin + -- the simple name of an entity generic that is not a timing generic. + if Name_Length < Length or Name_Buffer (Length) /= '_' then + Error_Vital ("invalid use of a VITAL timing generic prefix", Decl); + return False; + end if; + Gen_Name_Pos := Length + 1; + Gen_Name_Length := Name_Length; + Gen_Decl := Decl; + return True; + end Check_Timing_Generic_Prefix; + + -- IEEE 1076.4 4.3.2.1.3.1 Propagation Delay + -- ::= + -- TPD__[_] + procedure Check_Propagation_Delay_Name + (Decl : Iir_Constant_Interface_Declaration) + is + Iport : Iir; + Oport : Iir; + begin + if not Check_Timing_Generic_Prefix (Decl, 4) then + return; + end if; + Iport := Check_Input_Port; + Oport := Check_Output_Port; + Check_Simple_Condition_And_Or_Edge; + Check_Vital_Delay_Type (Iport, Oport); + end Check_Propagation_Delay_Name; + + procedure Check_Test_Reference + is + Tport : Iir; + Rport : Iir; + begin + Tport := Check_Input_Port; + Rport := Check_Input_Port; + Check_Full_Condition_And_Or_Edge; + Check_Vital_Delay_Type (Tport, Rport, Is_Simple => True); + end Check_Test_Reference; + + -- tsetup + procedure Check_Input_Setup_Time_Name + (Decl : Iir_Constant_Interface_Declaration) + is + begin + if not Check_Timing_Generic_Prefix (Decl, 7) then + return; + end if; + Check_Test_Reference; + end Check_Input_Setup_Time_Name; + + -- thold + procedure Check_Input_Hold_Time_Name + (Decl : Iir_Constant_Interface_Declaration) + is + begin + if not Check_Timing_Generic_Prefix (Decl, 6) then + return; + end if; + Check_Test_Reference; + end Check_Input_Hold_Time_Name; + + -- trecovery + procedure Check_Input_Recovery_Time_Name + (Decl : Iir_Constant_Interface_Declaration) + is + begin + if not Check_Timing_Generic_Prefix (Decl, 10) then + return; + end if; + Check_Test_Reference; + end Check_Input_Recovery_Time_Name; + + -- tremoval + procedure Check_Input_Removal_Time_Name + (Decl : Iir_Constant_Interface_Declaration) + is + begin + if not Check_Timing_Generic_Prefix (Decl, 9) then + return; + end if; + Check_Test_Reference; + end Check_Input_Removal_Time_Name; + + -- tperiod + procedure Check_Input_Period_Name + (Decl : Iir_Constant_Interface_Declaration) + is + Iport : Iir; + begin + if not Check_Timing_Generic_Prefix (Decl, 8) then + return; + end if; + Iport := Check_Input_Port; + Check_Simple_Condition_And_Or_Edge; + Check_Vital_Delay_Type (Iport, Is_Simple => True); + end Check_Input_Period_Name; + + -- tpw + procedure Check_Pulse_Width_Name + (Decl : Iir_Constant_Interface_Declaration) + is + Iport : Iir; + begin + if not Check_Timing_Generic_Prefix (Decl, 4) then + return; + end if; + Iport := Check_Input_Port; + Check_Simple_Condition_And_Or_Edge; + Check_Vital_Delay_Type (Iport, Is_Simple => True); + end Check_Pulse_Width_Name; + + -- tskew + procedure Check_Input_Skew_Time_Name + (Decl : Iir_Constant_Interface_Declaration) + is + Fport : Iir; + Sport : Iir; + begin + if not Check_Timing_Generic_Prefix (Decl, 6) then + return; + end if; + Fport := Check_Port; + Sport := Check_Port; + Check_Full_Condition_And_Or_Edge; + Check_Vital_Delay_Type (Fport, Sport, Is_Simple => True); + end Check_Input_Skew_Time_Name; + + -- tncsetup + procedure Check_No_Change_Setup_Time_Name + (Decl : Iir_Constant_Interface_Declaration) + is + begin + if not Check_Timing_Generic_Prefix (Decl, 9) then + return; + end if; + Check_Test_Reference; + end Check_No_Change_Setup_Time_Name; + + -- tnchold + procedure Check_No_Change_Hold_Time_Name + (Decl : Iir_Constant_Interface_Declaration) + is + begin + if not Check_Timing_Generic_Prefix (Decl, 8) then + return; + end if; + Check_Test_Reference; + end Check_No_Change_Hold_Time_Name; + + -- tipd + procedure Check_Interconnect_Path_Delay_Name + (Decl : Iir_Constant_Interface_Declaration) + is + Iport : Iir; + begin + if not Check_Timing_Generic_Prefix (Decl, 5) then + return; + end if; + Iport := Check_Input_Port; + Check_End; + Check_Vital_Delay_Type (Iport); + end Check_Interconnect_Path_Delay_Name; + + -- tdevice + procedure Check_Device_Delay_Name + (Decl : Iir_Constant_Interface_Declaration) + is + Oport : Iir; + Pos : Natural; + Kind : Timing_Generic_Type_Kind; + begin + if not Check_Timing_Generic_Prefix (Decl, 8) then + return; + end if; + if Get_Next_Suffix_Kind /= Suffix_Name then + Error_Vital_Name ("instance_name expected in VITAL generic name"); + return; + end if; + Pos := Gen_Name_Pos; + if Get_Next_Suffix_Kind /= Suffix_Eon then + Gen_Name_Pos := Pos; + Oport := Check_Output_Port; + Check_End; + end if; + Kind := Get_Timing_Generic_Type_Kind; + end Check_Device_Delay_Name; + + -- tisd + procedure Check_Internal_Signal_Delay_Name + (Decl : Iir_Constant_Interface_Declaration) + is + Iport : Iir; + Cport : Iir; + begin + if not Check_Timing_Generic_Prefix (Decl, 5) then + return; + end if; + Iport := Check_Input_Port; + Cport := Check_Input_Port; + Check_End; + Check_Vital_Delay_Type (Iport, Cport, + Is_Simple => True, Is_Scalar => True); + end Check_Internal_Signal_Delay_Name; + + -- tbpd + procedure Check_Biased_Propagation_Delay_Name + (Decl : Iir_Constant_Interface_Declaration) + is + Iport : Iir; + Oport : Iir; + Cport : Iir; + Clock_Start : Natural; + Clock_End : Natural; + begin + if not Check_Timing_Generic_Prefix (Decl, 5) then + return; + end if; + Iport := Check_Input_Port; + Oport := Check_Output_Port; + Clock_Start := Gen_Name_Pos - 1; -- At the '_'. + Cport := Check_Input_Port; + Clock_End := Gen_Name_Pos; + Check_Simple_Condition_And_Or_Edge; + Check_Vital_Delay_Type (Iport, Oport); + + -- IEEE 1076.4 4.3.2.1.3.14 Biased propagation delay + -- There shall exit, in the same entity generic clause, a corresponding + -- propagation delay generic denoting the same ports, condition name, + -- and edge. + declare + use Name_Table; + + -- '-1' is for the missing 'b' in 'tpd'. + Tpd_Name : String + (1 .. Gen_Name_Length - 1 - (Clock_End - Clock_Start)); + Tpd_Decl : Iir; + begin + Image (Get_Identifier (Decl)); + Tpd_Name (1) := 't'; + -- The part before '_'. + Tpd_Name (2 .. Clock_Start - 2) := Name_Buffer (3 .. Clock_Start - 1); + Tpd_Name (Clock_Start - 1 .. Tpd_Name'Last) := + Name_Buffer (Clock_End .. Name_Length); + + Tpd_Decl := Gen_Chain; + loop + exit when Tpd_Decl = Null_Iir; + Image (Get_Identifier (Tpd_Decl)); + exit when Name_Length = Tpd_Name'Length + and then Name_Buffer (1 .. Name_Length) = Tpd_Name; + Tpd_Decl := Get_Chain (Tpd_Decl); + end loop; + + if Tpd_Decl = Null_Iir then + Error_Vital + ("no matching 'tpd' generic for VITAL 'tbpd' timing generic", + Decl); + else + -- IEEE 1076.4 4.3.2.1.3.14 Biased propagation delay + -- Furthermore, the type of the biased propagation generic shall + -- be the same as the type of the corresponding delay generic. + if not Sem.Are_Trees_Equal (Get_Type (Decl), Get_Type (Tpd_Decl)) + then + Error_Vital + ("type of VITAL 'tbpd' generic mismatch type of " + & "'tpd' generic", Decl); + Error_Vital + ("(corresponding 'tpd' timing generic)", Tpd_Decl); + end if; + end if; + end; + end Check_Biased_Propagation_Delay_Name; + + -- ticd + procedure Check_Internal_Clock_Delay_Generic_Name + (Decl : Iir_Constant_Interface_Declaration) + is + Cport : Iir; + P_Start : Natural; + P_End : Natural; + begin + if not Check_Timing_Generic_Prefix (Decl, 5) then + return; + end if; + P_Start := Gen_Name_Pos; + Cport := Check_Input_Port; + P_End := Gen_Name_Pos; + Check_End; + Check_Vital_Delay_Type (Cport, Is_Simple => True, Is_Scalar => True); + + -- IEEE 1076.4 4.3.2.1.3.15 Internal clock delay + -- It is an error for a clocks signal name to appear as one of the + -- following elements in the name of a timing generic: + -- * As either the input port in the name of a biased propagation + -- delay generic. + -- * As the input signal name in an internal delay timing generic. + -- * As the test port in a timing check or recovery removal timing + -- generic. + -- FIXME: recovery OR removal ? + + if P_End - 1 /= Gen_Name_Length then + -- Do not check in case of error. + return; + end if; + declare + use Name_Table; + Port : String (1 .. Name_Length); + El : Iir; + Offset : Natural; + + procedure Check_Not_Clock + is + S : Natural; + begin + S := Offset; + loop + Offset := Offset + 1; + exit when Offset > Name_Length + or else Name_Buffer (Offset) = '_'; + end loop; + if Offset - S = Port'Length + and then Name_Buffer (S .. Offset - 1) = Port + then + Error_Vital ("clock port name of 'ticd' VITAL generic must not" + & " appear here", El); + end if; + end Check_Not_Clock; + begin + Port := Name_Buffer (P_Start .. Gen_Name_Length); + + El := Gen_Chain; + while El /= Null_Iir loop + Image (Get_Identifier (El)); + if Name_Length > 5 + and then Name_Buffer (1) = 't' + then + if Name_Buffer (2 .. 5) = "bpd_" then + Offset := 6; + Check_Not_Clock; -- input + Check_Not_Clock; -- output + elsif Name_Buffer (2 .. 5) = "isd_" then + Offset := 6; + Check_Not_Clock; -- input + elsif Name_Length > 10 + and then Name_Buffer (2 .. 10) = "recovery_" + then + Offset := 11; + Check_Not_Clock; -- test port + elsif Name_Length > 9 + and then Name_Buffer (2 .. 9) = "removal_" + then + Offset := 10; + Check_Not_Clock; + end if; + end if; + El := Get_Chain (El); + end loop; + end; + end Check_Internal_Clock_Delay_Generic_Name; + + procedure Check_Entity_Generic_Declaration + (Decl : Iir_Constant_Interface_Declaration) + is + use Name_Table; + Id : Name_Id; + begin + Id := Get_Identifier (Decl); + Image (Id); + + -- Extract prefix. + if Name_Buffer (1) = 't' and Name_Length >= 3 then + -- Timing generic names. + if Name_Buffer (2) = 'p' then + if Name_Buffer (3) = 'd' then + Check_Propagation_Delay_Name (Decl); -- tpd + return; + elsif Name_Buffer (3) = 'w' then + Check_Pulse_Width_Name (Decl); -- tpw + return; + elsif Name_Length >= 7 + and then Name_Buffer (3 .. 7) = "eriod" + then + Check_Input_Period_Name (Decl); -- tperiod + return; + end if; + elsif Name_Buffer (2) = 'i' + and then Name_Length >= 4 + and then Name_Buffer (4) = 'd' + then + if Name_Buffer (3) = 'p' then + Check_Interconnect_Path_Delay_Name (Decl); -- tipd + return; + elsif Name_Buffer (3) = 's' then + Check_Internal_Signal_Delay_Name (Decl); -- tisd + return; + elsif Name_Buffer (3) = 'c' then + Check_Internal_Clock_Delay_Generic_Name (Decl); -- ticd + return; + end if; + elsif Name_Length >= 6 and then Name_Buffer (2 .. 6) = "setup" then + Check_Input_Setup_Time_Name (Decl); -- tsetup + return; + elsif Name_Length >= 5 and then Name_Buffer (2 .. 5) = "hold" then + Check_Input_Hold_Time_Name (Decl); -- thold + return; + elsif Name_Length >= 9 and then Name_Buffer (2 .. 9) = "recovery" then + Check_Input_Recovery_Time_Name (Decl); -- trecovery + return; + elsif Name_Length >= 8 and then Name_Buffer (2 .. 8) = "removal" then + Check_Input_Removal_Time_Name (Decl); -- tremoval + return; + elsif Name_Length >= 5 and then Name_Buffer (2 .. 5) = "skew" then + Check_Input_Skew_Time_Name (Decl); -- tskew + return; + elsif Name_Length >= 8 and then Name_Buffer (2 .. 8) = "ncsetup" then + Check_No_Change_Setup_Time_Name (Decl); -- tncsetup + return; + elsif Name_Length >= 7 and then Name_Buffer (2 .. 7) = "nchold" then + Check_No_Change_Hold_Time_Name (Decl); -- tnchold + return; + elsif Name_Length >= 7 and then Name_Buffer (2 .. 7) = "device" then + Check_Device_Delay_Name (Decl); -- tdevice + return; + elsif Name_Length >= 4 and then Name_Buffer (2 .. 4) = "bpd" then + Check_Biased_Propagation_Delay_Name (Decl); -- tbpd + return; + end if; + end if; + + if Id = InstancePath_Id then + if Get_Type (Decl) /= String_Type_Definition then + Error_Vital + ("InstancePath VITAL generic must be of type String", Decl); + end if; + return; + elsif Id = TimingChecksOn_Id + or Id = XOn_Id + or Id = MsgOn_Id + then + if Get_Type (Decl) /= Boolean_Type_Definition then + Error_Vital + (Image (Id) & " VITAL generic must be of type Boolean", Decl); + end if; + return; + end if; + + if Flags.Warn_Vital_Generic then + Warning_Vital ("generic is not a VITAL generic", Decl); + end if; + end Check_Entity_Generic_Declaration; + + -- Checks rules for a VITAL level 0 entity. + procedure Check_Vital_Level0_Entity (Ent : Iir_Entity_Declaration) + is + use Sem_Scopes; + Decl : Iir; + begin + -- IEEE 1076.4 4.3.1 + -- The only form of declaration allowed in the entity declarative part + -- is the specification of the VITAL_Level0 attribute. + Decl := Get_Declaration_Chain (Ent); + if Decl = Null_Iir then + -- Cannot happen, since there is at least the attribute spec. + raise Internal_Error; + end if; + Check_Level0_Attribute_Specification (Decl); + Decl := Get_Chain (Decl); + if Decl /= Null_Iir then + Error_Vital ("VITAL entity declarative part must only contain the " + & "attribute specification", Decl); + end if; + + -- IEEE 1076.4 4.3.1 + -- No statements are allowed in the entity statement part. + Decl := Get_Concurrent_Statement_Chain (Ent); + if Decl /= Null_Iir then + Error_Vital ("VITAL entity must not have concurrent statement", Decl); + end if; + + -- Check ports. + Name_Table.Assert_No_Infos; + Open_Declarative_Region; + Decl := Get_Port_Chain (Ent); + while Decl /= Null_Iir loop + Check_Entity_Port_Declaration (Decl); + Add_Name (Decl); + Decl := Get_Chain (Decl); + end loop; + + -- Check generics. + Gen_Chain := Get_Generic_Chain (Ent); + Decl := Gen_Chain; + while Decl /= Null_Iir loop + Check_Entity_Generic_Declaration (Decl); + Decl := Get_Chain (Decl); + end loop; + Close_Declarative_Region; + end Check_Vital_Level0_Entity; + + -- Return TRUE if UNIT was decorated with attribute VITAL_Level0. + function Is_Vital_Level0 (Unit : Iir_Design_Unit) return Boolean + is + Value : Iir_Attribute_Value; + Spec : Iir_Attribute_Specification; + begin + Value := Get_Attribute_Value_Chain (Unit); + while Value /= Null_Iir loop + Spec := Get_Attribute_Specification (Value); + if Get_Attribute_Designator (Spec) = Vital_Level0_Attribute then + return True; + end if; + Value := Get_Chain (Value); + end loop; + + return False; + end Is_Vital_Level0; + + procedure Check_Vital_Level0_Architecture + (Arch : Iir_Architecture_Declaration) + is + Decl : Iir; + begin + -- IEEE 1076.4 4.1 + -- The entity associated with a Level 0 architecture shall be a VITAL + -- Level 0 entity. + if not Is_Vital_Level0 (Get_Design_Unit (Get_Entity (Arch))) then + Error_Vital ("entity associated with a VITAL level 0 architecture " + & "shall be a VITAL level 0 entity", Arch); + end if; + + -- VITAL_Level_0_architecture_declarative_part ::= + -- VITAL_Level0_attribute_specification { block_declarative_item } + Decl := Get_Declaration_Chain (Arch); + Check_Level0_Attribute_Specification (Decl); + end Check_Vital_Level0_Architecture; + + -- Check a VITAL level 0 decorated design unit. + procedure Check_Vital_Level0 (Unit : Iir_Design_Unit) + is + Lib_Unit : Iir; + begin + Lib_Unit := Get_Library_Unit (Unit); + case Get_Kind (Lib_Unit) is + when Iir_Kind_Entity_Declaration => + Check_Vital_Level0_Entity (Lib_Unit); + when Iir_Kind_Architecture_Declaration => + Check_Vital_Level0_Architecture (Lib_Unit); + when others => + Error_Vital + ("only entity or architecture can be VITAL_Level0", Lib_Unit); + end case; + end Check_Vital_Level0; + + procedure Check_Vital_Level1 (Unit : Iir_Design_Unit) + is + Arch : Iir; + begin + Arch := Get_Library_Unit (Unit); + if Get_Kind (Arch) /= Iir_Kind_Architecture_Declaration then + Error_Vital ("only architecture can be VITAL_Level1", Arch); + return; + end if; + -- FIXME: todo + end Check_Vital_Level1; + +end Ieee.Vital_Timing; diff --git a/ieee-vital_timing.ads b/ieee-vital_timing.ads new file mode 100644 index 000000000..b67271c19 --- /dev/null +++ b/ieee-vital_timing.ads @@ -0,0 +1,41 @@ +-- Nodes recognizer for ieee.vital_timing. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Iirs; use Iirs; + +package Ieee.Vital_Timing is + -- Attribute declarations. + Vital_Level0_Attribute : Iir_Attribute_Declaration := Null_Iir; + Vital_Level1_Attribute : Iir_Attribute_Declaration := Null_Iir; + + -- Vital delay types. + VitalDelayType : Iir := Null_Iir; + VitalDelayType01 : Iir_Array_Type_Definition := Null_Iir; + VitalDelayType01Z : Iir_Array_Type_Definition := Null_Iir; + VitalDelayType01ZX : Iir_Array_Type_Definition := Null_Iir; + + VitalDelayArrayType : Iir_Array_Type_Definition := Null_Iir; + VitalDelayArrayType01 : Iir_Array_Type_Definition := Null_Iir; + VitalDelayArrayType01Z : Iir_Array_Type_Definition := Null_Iir; + VitalDelayArrayType01ZX : Iir_Array_Type_Definition := Null_Iir; + + -- Extract declarations from IEEE.VITAL_Timing package. + procedure Extract_Declarations (Pkg : Iir_Package_Declaration); + + procedure Check_Vital_Level0 (Unit : Iir_Design_Unit); + procedure Check_Vital_Level1 (Unit : Iir_Design_Unit); +end Ieee.Vital_Timing; diff --git a/ieee.ads b/ieee.ads new file mode 100644 index 000000000..48ab37630 --- /dev/null +++ b/ieee.ads @@ -0,0 +1,5 @@ +-- Top of ieee hierarchy. +-- Too small to be copyrighted. +package Ieee is + pragma Pure (Ieee); +end Ieee; diff --git a/iir_chain_handling.adb b/iir_chain_handling.adb new file mode 100644 index 000000000..b660d5d2d --- /dev/null +++ b/iir_chain_handling.adb @@ -0,0 +1,68 @@ +-- Generic package to handle chains. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +package body Iir_Chain_Handling is + procedure Build_Init (Last : out Iir) is + begin + Last := Null_Iir; + end Build_Init; + + procedure Build_Init (Last : out Iir; Parent : Iir) + is + El : Iir; + begin + El := Get_Chain_Start (Parent); + if El /= Null_Iir then + loop + Last := El; + El := Get_Chain (El); + exit when El = Null_Iir; + end loop; + else + Last := Null_Iir; + end if; + end Build_Init; + + procedure Append (Last : in out Iir; Parent : Iir; El : Iir) is + begin + if Last = Null_Iir then + Set_Chain_Start (Parent, El); + else + Set_Chain (Last, El); + end if; + Last := El; + end Append; + + procedure Append_Subchain (Last : in out Iir; Parent : Iir; Els : Iir) + is + El : Iir; + begin + if Last = Null_Iir then + Set_Chain_Start (Parent, Els); + else + Set_Chain (Last, Els); + end if; + El := Els; + loop + Set_Parent (El, Parent); + Last := El; + El := Get_Chain (El); + exit when El = Null_Iir; + end loop; + end Append_Subchain; +end Iir_Chain_Handling; + diff --git a/iir_chain_handling.ads b/iir_chain_handling.ads new file mode 100644 index 000000000..0ba70ae66 --- /dev/null +++ b/iir_chain_handling.ads @@ -0,0 +1,47 @@ +-- Generic package to handle chains. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Iirs; use Iirs; + +-- The generic package Chain_Handling can be used to build or modify +-- chains. +-- The formals are the subprograms to get and set the first element +-- from the parent. +generic + with function Get_Chain_Start (Parent : Iir) return Iir; + with procedure Set_Chain_Start (Parent : Iir; First : Iir); +package Iir_Chain_Handling is + + -- Building a chain: + -- Initialize (set LAST to NULL_IIR). + procedure Build_Init (Last : out Iir); + -- Set LAST with the last element of the chain. + -- This is an initialization for an already built chain. + procedure Build_Init (Last : out Iir; Parent : Iir); + + -- Append element EL to the chain, whose parent is PARENT and last + -- element LAST. + procedure Append (Last : in out Iir; Parent : Iir; El : Iir); + + -- Append a subchain whose first element is ELS to a chain, whose + -- parent is PARENT and last element LAST. + -- The Parent field of each elements of Els is set to PARENT. + -- Note: the Append procedure declared just above is an optimization + -- of this subprogram if ELS has no next element. However, the + -- above subprogram does not set the Parent field of EL. + procedure Append_Subchain (Last : in out Iir; Parent : Iir; Els : Iir); +end Iir_Chain_Handling; diff --git a/iir_chains.adb b/iir_chains.adb new file mode 100644 index 000000000..984ab9909 --- /dev/null +++ b/iir_chains.adb @@ -0,0 +1,64 @@ +-- Chain handling. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +package body Iir_Chains is + function Get_Chain_Length (First : Iir) return Natural + is + Res : Natural := 0; + El : Iir := First; + begin + while El /= Null_Iir loop + Res := Res + 1; + El := Get_Chain (El); + end loop; + return Res; + end Get_Chain_Length; + + procedure Sub_Chain_Init (First, Last : out Iir) is + begin + First := Null_Iir; + Last := Null_Iir; + end Sub_Chain_Init; + + procedure Sub_Chain_Append (First, Last : in out Iir; El : Iir) is + begin + if First = Null_Iir then + First := El; + else + Set_Chain (Last, El); + end if; + Last := El; + end Sub_Chain_Append; + + function Is_Chain_Length_One (Chain : Iir) return Boolean is + begin + return Chain /= Null_Iir and then Get_Chain (Chain) = Null_Iir; + end Is_Chain_Length_One; + + procedure Insert (Last : Iir; El : Iir) is + begin + Set_Chain (El, Get_Chain (Last)); + Set_Chain (Last, El); + end Insert; + + procedure Insert_Incr (Last : in out Iir; El : Iir) is + begin + Set_Chain (El, Get_Chain (Last)); + Set_Chain (Last, El); + Last := El; + end Insert_Incr; +end Iir_Chains; diff --git a/iir_chains.ads b/iir_chains.ads new file mode 100644 index 000000000..f853df4b4 --- /dev/null +++ b/iir_chains.ads @@ -0,0 +1,117 @@ +-- Chain handling. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Iirs; use Iirs; +with Iir_Chain_Handling; +pragma Elaborate (Iir_Chain_Handling); + +package Iir_Chains is + -- Chains are simply linked list of iirs. + -- Elements of the chain are ordered. + -- Each element of a chain have a Chain field, which points to the next + -- element. + -- All elements of a chain have the same parent. This parent contains + -- a field which points to the first element of the chain. + -- Note: the parent is often the value of the Parent field, but sometimes + -- not. + + -- Chains can be covered very simply: + -- El : Iir; + -- begin + -- El := Get_xxx_Chain (Parent); + -- while El /= Null_Iir loop + -- * Handle element EL of the chain. + -- El := Get_Chain (El); + -- end loop; + + -- However, building a chain is a little bit more difficult if elements + -- have to be appended. Indeed, there is no direct access to the last + -- element of a chain. + -- An efficient way to build a chain is to keep the last element of it. + -- See Iir_Chain_Handling package. + + package Declaration_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Declaration_Chain, + Set_Chain_Start => Set_Declaration_Chain); + + package Interface_Declaration_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Interface_Declaration_Chain, + Set_Chain_Start => Set_Interface_Declaration_Chain); + + package Context_Items_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Context_Items, + Set_Chain_Start => Set_Context_Items); + + package Unit_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Unit_Chain, + Set_Chain_Start => Set_Unit_Chain); + + package Element_Declaration_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Element_Declaration_Chain, + Set_Chain_Start => Set_Element_Declaration_Chain); + + package Configuration_Item_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Configuration_Item_Chain, + Set_Chain_Start => Set_Configuration_Item_Chain); + + package Entity_Class_Entry_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Entity_Class_Entry_Chain, + Set_Chain_Start => Set_Entity_Class_Entry_Chain); + + package Conditional_Waveform_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Conditional_Waveform_Chain, + Set_Chain_Start => Set_Conditional_Waveform_Chain); + + package Selected_Waveform_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Selected_Waveform_Chain, + Set_Chain_Start => Set_Selected_Waveform_Chain); + + package Association_Choices_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Association_Choices_Chain, + Set_Chain_Start => Set_Association_Choices_Chain); + + package Case_Statement_Alternative_Chain_Handling is new Iir_Chain_Handling + (Get_Chain_Start => Get_Case_Statement_Alternative_Chain, + Set_Chain_Start => Set_Case_Statement_Alternative_Chain); + + -- Return the number of elements in a chain starting with FIRST. + -- Not very efficient since O(N). + function Get_Chain_Length (First : Iir) return Natural; + + -- These two subprograms can be used to build a sub-chain. + -- FIRST and LAST designates respectively the first and last element of + -- the sub-chain. + + -- Set FIRST and LAST to Null_Iir. + procedure Sub_Chain_Init (First, Last : out Iir); + pragma Inline (Sub_Chain_Init); + + -- Append element EL to the sub-chain. + procedure Sub_Chain_Append (First, Last : in out Iir; El : Iir); + pragma Inline (Sub_Chain_Append); + + -- Return TRUE iff CHAIN is of length one, ie CHAIN is not NULL_IIR + -- and chain (CHAIN) is NULL_IIR. + function Is_Chain_Length_One (Chain : Iir) return Boolean; + pragma Inline (Is_Chain_Length_One); + + -- Insert EL after LAST. + procedure Insert (Last : Iir; El : Iir); + + -- Insert EL after LAST and set LAST to EL. + procedure Insert_Incr (Last : in out Iir; El : Iir); +end Iir_Chains; diff --git a/iirs.adb b/iirs.adb new file mode 100644 index 000000000..a529828c5 --- /dev/null +++ b/iirs.adb @@ -0,0 +1,6572 @@ +-- Tree node definitions. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Unchecked_Deallocation; +with Ada.Unchecked_Conversion; +with Ada.Text_IO; +with Errorout; use Errorout; +with Nodes; use Nodes; +with Lists; use Lists; + +package body Iirs is + function Is_Null (Node : Iir) return Boolean is + begin + return Node = Null_Iir; + end Is_Null; + + function Is_Null_List (Node : Iir_List) return Boolean is + begin + return Node = Null_Iir_List; + end Is_Null_List; + + --------------------------------------------------- + -- General subprograms that operate on every iir -- + --------------------------------------------------- + + -- This is the procedure to call when an internal consistancy test has + -- failed. + -- The main idea is the consistancy test *MUST* have no side effect, + -- except calling this procedure. To speed up, this procedure could + -- be a no-op. + procedure Failed (Func: String := ""; Node : Iir := Null_Iir) + is + begin + if Func /= "" then + Error_Kind (Func, Node); + end if; + raise Internal_Error; + end Failed; + + function Get_Format (Kind : Iir_Kind) return Format_Type; + + -- Statistics. + procedure Disp_Stats + is + use Ada.Text_IO; + type Num_Array is array (Iir_Kind) of Natural; + Num : Num_Array := (others => 0); + type Format_Array is array (Format_Type) of Natural; + Formats : Format_Array := (others => 0); + Kind : Iir_Kind; + I : Iir; + Last_I : Iir; + Format : Format_Type; + begin + I := Error_Node + 1; + Last_I := Get_Last_Node; + while I < Last_I loop + Kind := Get_Kind (I); + Num (Kind) := Num (Kind) + 1; + Format := Get_Format (Kind); + Formats (Format) := Formats (Format) + 1; + case Format is + when Format_Medium => + I := I + 2; + when Format_Short + | Format_Fp + | Format_Int => + I := I + 1; + end case; + end loop; + + Put_Line ("Stats per iir_kind:"); + for J in Iir_Kind loop + if Num (J) /= 0 then + Put_Line (' ' & Iir_Kind'Image (J) & ':' + & Natural'Image (Num (J))); + end if; + end loop; + Put_Line ("Stats per formats:"); + for J in Format_Type loop + Put_Line (' ' & Format_Type'Image (J) & ':' + & Natural'Image (Formats (J))); + end loop; + end Disp_Stats; + + function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions) + return Boolean is + begin + case Func is + when Iir_Predefined_Bit_And + | Iir_Predefined_Bit_Or + | Iir_Predefined_Bit_Nand + | Iir_Predefined_Bit_Nor + | Iir_Predefined_Boolean_And + | Iir_Predefined_Boolean_Or + | Iir_Predefined_Boolean_Nand + | Iir_Predefined_Boolean_Nor => + return True; + when others => + return False; + end case; + end Iir_Predefined_Shortcut_P; + + function Create_Proxy (Proxy: Iir) return Iir_Proxy is + Res : Iir_Proxy; + begin + Res := Create_Iir (Iir_Kind_Proxy); + Set_Proxy (Res, Proxy); + return Res; + end Create_Proxy; + + -- + + function Create_Iir_Error return Iir + is + Res : Iir; + begin + Res := Create_Node (Format_Short); + Set_Nkind (Res, Iir_Kind'Pos (Iir_Kind_Error)); + Set_Base_Type (Res, Res); + return Res; + end Create_Iir_Error; + + procedure Location_Copy (Target: Iir; Src: Iir) is + begin + Set_Location (Target, Get_Location (Src)); + end Location_Copy; + + -- Get kind + function Get_Kind (An_Iir: Iir) return Iir_Kind + is + -- Speed up: avoid to check that nkind is in the bounds of Iir_Kind. + pragma Suppress (Range_Check); + begin + return Iir_Kind'Val (Get_Nkind (An_Iir)); + end Get_Kind; + +-- function Clone_Iir (Src : Iir; New_Kind : Iir_Kind) return Iir +-- is +-- Res : Iir; +-- begin +-- Res := new Iir_Node (New_Kind); +-- Res.Flag1 := Src.Flag1; +-- Res.Flag2 := Src.Flag2; +-- Res.Flag3 := Src.Flag3; +-- Res.Flag4 := Src.Flag4; +-- Res.Flag5 := Src.Flag5; +-- Res.Flag6 := Src.Flag6; +-- Res.Flag7 := Src.Flag7; +-- Res.Flag8 := Src.Flag8; +-- Res.State1 := Src.State1; +-- Res.State2 := Src.State2; +-- Res.State3 := Src.State3; +-- Res.Staticness1 := Src.Staticness1; +-- Res.Staticness2 := Src.Staticness2; +-- Res.Odigit1 := Src.Odigit1; +-- Res.Odigit2 := Src.Odigit2; +-- Res.Location := Src.Location; +-- Res.Back_End_Info := Src.Back_End_Info; +-- Res.Identifier := Src.Identifier; +-- Res.Field1 := Src.Field1; +-- Res.Field2 := Src.Field2; +-- Res.Field3 := Src.Field3; +-- Res.Field4 := Src.Field4; +-- Res.Field5 := Src.Field5; +-- Res.Nbr2 := Src.Nbr2; +-- Res.Nbr3 := Src.Nbr3; + +-- Src.Identifier := Null_Identifier; +-- Src.Field1 := null; +-- Src.Field2 := null; +-- Src.Field3 := null; +-- Src.Field4 := null; +-- Src.Field5 := null; +-- return Res; +-- end Clone_Iir; + + + ----------------- + -- design file -- + ----------------- + + -- Iir_Design_File + +-- type Int_Access_Type is new Integer; +-- for Int_Access_Type'Size use System.Word_Size; --Iir_Identifier_Acc'Size; + + -- Safe conversions. +-- function Iir_To_Int_Access_Type is +-- new Ada.Unchecked_Conversion (Source => Iir, +-- Target => Int_Access_Type); +-- function Int_Access_Type_To_Iir is +-- new Ada.Unchecked_Conversion (Source => Int_Access_Type, +-- Target => Iir); + +-- function To_Iir (V : Integer) return Iir is +-- begin +-- return Int_Access_Type_To_Iir (Int_Access_Type (V)); +-- end To_Iir; + +-- function To_Integer (N : Iir) return Integer is +-- begin +-- return Integer (Iir_To_Int_Access_Type (N)); +-- end To_Integer; + + procedure Set_Pos_Line_Off (Design_Unit: Iir_Design_Unit; + Pos : Source_Ptr; Line, Off: Natural) is + begin + Set_Field1 (Design_Unit, Node_Type (Pos)); + Set_Field11 (Design_Unit, Node_Type (Off)); + Set_Field12 (Design_Unit, Node_Type (Line)); + end Set_Pos_Line_Off; + + procedure Get_Pos_Line_Off (Design_Unit: Iir_Design_Unit; + Pos : out Source_Ptr; Line, Off: out Natural) is + begin + Pos := Source_Ptr (Get_Field1 (Design_Unit)); + Off := Natural (Get_Field11 (Design_Unit)); + Line := Natural (Get_Field12 (Design_Unit)); + end Get_Pos_Line_Off; + + ----------- + -- Lists -- + ----------- + -- Layout of lists: + -- A list is stored into an IIR. + -- There are two bounds for a list: + -- the current number of elements + -- the maximum number of elements. + -- Using a maximum number of element bound (which can be increased) avoid + -- to reallocating memory at each insertion. + + function Time_Stamp_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => Time_Stamp_Id, Target => Iir); + + function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => Time_Stamp_Id); + + function Iir_To_Iir_List is new Ada.Unchecked_Conversion + (Source => Iir, Target => Iir_List); + function Iir_List_To_Iir is new Ada.Unchecked_Conversion + (Source => Iir_List, Target => Iir); + + function Iir_To_Token_Type (N : Iir) return Token_Type is + begin + return Token_Type'Val (N); + end Iir_To_Token_Type; + + function Token_Type_To_Iir (T : Token_Type) return Iir is + begin + return Token_Type'Pos (T); + end Token_Type_To_Iir; + + function Iir_To_Iir_Index32 (N : Iir) return Iir_Index32 is + begin + return Iir_Index32 (N); + end Iir_To_Iir_Index32; + + function Iir_Index32_To_Iir (V : Iir_Index32) return Iir is + begin + return Iir_Index32'Pos (V); + end Iir_Index32_To_Iir; + + function Iir_To_Name_Id (N : Iir) return Name_Id is + begin + return Iir'Pos (N); + end Iir_To_Name_Id; + pragma Inline (Iir_To_Name_Id); + + function Name_Id_To_Iir (V : Name_Id) return Iir is + begin + return Name_Id'Pos (V); + end Name_Id_To_Iir; + + function Iir_To_Iir_Int32 is new Ada.Unchecked_Conversion + (Source => Iir, Target => Iir_Int32); + + function Iir_Int32_To_Iir is new Ada.Unchecked_Conversion + (Source => Iir_Int32, Target => Iir); + + function Iir_To_Location_Type (N : Iir) return Location_Type is + begin + return Location_Type (N); + end Iir_To_Location_Type; + + function Location_Type_To_Iir (L : Location_Type) return Iir is + begin + return Iir (L); + end Location_Type_To_Iir; + + function Iir_To_String_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => String_Id); + function String_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => String_Id, Target => Iir); + + function Iir_To_Int32 is new Ada.Unchecked_Conversion + (Source => Iir, Target => Int32); + function Int32_To_Iir is new Ada.Unchecked_Conversion + (Source => Int32, Target => Iir); + + -- Subprograms + function Get_Format (Kind : Iir_Kind) return Format_Type is + begin + case Kind is + when Iir_Kind_Error + | Iir_Kind_Library_Clause + | Iir_Kind_Use_Clause + | Iir_Kind_Character_Literal + | Iir_Kind_Null_Literal + | Iir_Kind_String_Literal + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Proxy + | Iir_Kind_Waveform_Element + | Iir_Kind_Conditional_Waveform + | Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open + | Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name + | Iir_Kind_Entity_Aspect_Entity + | Iir_Kind_Entity_Aspect_Configuration + | Iir_Kind_Entity_Aspect_Open + | Iir_Kind_Block_Configuration + | Iir_Kind_Component_Configuration + | Iir_Kind_Entity_Class + | Iir_Kind_Attribute_Value + | Iir_Kind_Signature + | Iir_Kind_Aggregate_Info + | Iir_Kind_Procedure_Call + | Iir_Kind_Operator_Symbol + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Configuration_Specification + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition + | Iir_Kind_Range_Expression + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Subtype_Definition + | Iir_Kind_Overload_List + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_Identity_Operator + | Iir_Kind_Negation_Operator + | Iir_Kind_Absolute_Operator + | Iir_Kind_Not_Operator + | Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator + | Iir_Kind_Function_Call + | Iir_Kind_Aggregate + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_Simple_Name + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Base_Attribute + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute + | Iir_Kind_Behavior_Attribute + | Iir_Kind_Structure_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Attribute_Name => + return Format_Short; + when Iir_Kind_Design_File + | Iir_Kind_Design_Unit + | Iir_Kind_Bit_String_Literal + | Iir_Kind_Block_Header + | Iir_Kind_Binding_Indication + | Iir_Kind_Attribute_Specification + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kind_Library_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + return Format_Medium; + when Iir_Kind_Floating_Point_Literal + | Iir_Kind_Physical_Fp_Literal => + return Format_Fp; + when Iir_Kind_Integer_Literal + | Iir_Kind_Physical_Int_Literal => + return Format_Int; + end case; + end Get_Format; + + function Create_Iir (Kind : Iir_Kind) return Iir + is + Res : Iir; + Format : Format_Type; + begin + Format := Get_Format (Kind); + Res := Create_Node (Format); + Set_Nkind (Res, Iir_Kind'Pos (Kind)); + return Res; + end Create_Iir; + + procedure Check_Kind_For_First_Design_Unit (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File => + null; + when others => + Failed ("First_Design_Unit", Target); + end case; + end Check_Kind_For_First_Design_Unit; + + function Get_First_Design_Unit (Design : Iir) return Iir is + begin + Check_Kind_For_First_Design_Unit (Design); + return Get_Field5 (Design); + end Get_First_Design_Unit; + + procedure Set_First_Design_Unit (Design : Iir; Chain : Iir) is + begin + Check_Kind_For_First_Design_Unit (Design); + Set_Field5 (Design, Chain); + end Set_First_Design_Unit; + + procedure Check_Kind_For_Last_Design_Unit (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File => + null; + when others => + Failed ("Last_Design_Unit", Target); + end case; + end Check_Kind_For_Last_Design_Unit; + + function Get_Last_Design_Unit (Design : Iir) return Iir is + begin + Check_Kind_For_Last_Design_Unit (Design); + return Get_Field6 (Design); + end Get_Last_Design_Unit; + + procedure Set_Last_Design_Unit (Design : Iir; Chain : Iir) is + begin + Check_Kind_For_Last_Design_Unit (Design); + Set_Field6 (Design, Chain); + end Set_Last_Design_Unit; + + procedure Check_Kind_For_Library_Declaration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Library_Clause => + null; + when others => + Failed ("Library_Declaration", Target); + end case; + end Check_Kind_For_Library_Declaration; + + function Get_Library_Declaration (Design : Iir) return Iir is + begin + Check_Kind_For_Library_Declaration (Design); + return Get_Field1 (Design); + end Get_Library_Declaration; + + procedure Set_Library_Declaration (Design : Iir; Library : Iir) is + begin + Check_Kind_For_Library_Declaration (Design); + Set_Field1 (Design, Library); + end Set_Library_Declaration; + + procedure Check_Kind_For_File_Time_Stamp (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File => + null; + when others => + Failed ("File_Time_Stamp", Target); + end case; + end Check_Kind_For_File_Time_Stamp; + + function Get_File_Time_Stamp (Design : Iir) return Time_Stamp_Id is + begin + Check_Kind_For_File_Time_Stamp (Design); + return Iir_To_Time_Stamp_Id (Get_Field4 (Design)); + end Get_File_Time_Stamp; + + procedure Set_File_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id) is + begin + Check_Kind_For_File_Time_Stamp (Design); + Set_Field4 (Design, Time_Stamp_Id_To_Iir (Stamp)); + end Set_File_Time_Stamp; + + procedure Check_Kind_For_Analysis_Time_Stamp (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File => + null; + when others => + Failed ("Analysis_Time_Stamp", Target); + end case; + end Check_Kind_For_Analysis_Time_Stamp; + + function Get_Analysis_Time_Stamp (Design : Iir) return Time_Stamp_Id is + begin + Check_Kind_For_Analysis_Time_Stamp (Design); + return Iir_To_Time_Stamp_Id (Get_Field3 (Design)); + end Get_Analysis_Time_Stamp; + + procedure Set_Analysis_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id) is + begin + Check_Kind_For_Analysis_Time_Stamp (Design); + Set_Field3 (Design, Time_Stamp_Id_To_Iir (Stamp)); + end Set_Analysis_Time_Stamp; + + procedure Check_Kind_For_Library (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File => + null; + when others => + Failed ("Library", Target); + end case; + end Check_Kind_For_Library; + + function Get_Library (File : Iir_Design_File) return Iir is + begin + Check_Kind_For_Library (File); + return Get_Field0 (File); + end Get_Library; + + procedure Set_Library (File : Iir_Design_File; Lib : Iir) is + begin + Check_Kind_For_Library (File); + Set_Field0 (File, Lib); + end Set_Library; + + procedure Check_Kind_For_File_Dependence_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File => + null; + when others => + Failed ("File_Dependence_List", Target); + end case; + end Check_Kind_For_File_Dependence_List; + + function Get_File_Dependence_List (File : Iir_Design_File) return Iir_List + is + begin + Check_Kind_For_File_Dependence_List (File); + return Iir_To_Iir_List (Get_Field1 (File)); + end Get_File_Dependence_List; + + procedure Set_File_Dependence_List (File : Iir_Design_File; Lst : Iir_List) + is + begin + Check_Kind_For_File_Dependence_List (File); + Set_Field1 (File, Iir_List_To_Iir (Lst)); + end Set_File_Dependence_List; + + procedure Check_Kind_For_Design_File_Filename (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File => + null; + when others => + Failed ("Design_File_Filename", Target); + end case; + end Check_Kind_For_Design_File_Filename; + + function Get_Design_File_Filename (File : Iir_Design_File) return Name_Id + is + begin + Check_Kind_For_Design_File_Filename (File); + return Name_Id'Val (Get_Field12 (File)); + end Get_Design_File_Filename; + + procedure Set_Design_File_Filename (File : Iir_Design_File; Name : Name_Id) + is + begin + Check_Kind_For_Design_File_Filename (File); + Set_Field12 (File, Name_Id'Pos (Name)); + end Set_Design_File_Filename; + + procedure Check_Kind_For_Design_File_Directory (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File => + null; + when others => + Failed ("Design_File_Directory", Target); + end case; + end Check_Kind_For_Design_File_Directory; + + function Get_Design_File_Directory (File : Iir_Design_File) return Name_Id + is + begin + Check_Kind_For_Design_File_Directory (File); + return Name_Id'Val (Get_Field11 (File)); + end Get_Design_File_Directory; + + procedure Set_Design_File_Directory (File : Iir_Design_File; Dir : Name_Id) + is + begin + Check_Kind_For_Design_File_Directory (File); + Set_Field11 (File, Name_Id'Pos (Dir)); + end Set_Design_File_Directory; + + procedure Check_Kind_For_Design_File (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit => + null; + when others => + Failed ("Design_File", Target); + end case; + end Check_Kind_For_Design_File; + + function Get_Design_File (Unit : Iir_Design_Unit) return Iir_Design_File is + begin + Check_Kind_For_Design_File (Unit); + return Get_Field0 (Unit); + end Get_Design_File; + + procedure Set_Design_File (Unit : Iir_Design_Unit; File : Iir_Design_File) + is + begin + Check_Kind_For_Design_File (Unit); + Set_Field0 (Unit, File); + end Set_Design_File; + + procedure Check_Kind_For_Design_File_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Library_Declaration => + null; + when others => + Failed ("Design_File_Chain", Target); + end case; + end Check_Kind_For_Design_File_Chain; + + function Get_Design_File_Chain (Library : Iir) return Iir_Design_File is + begin + Check_Kind_For_Design_File_Chain (Library); + return Get_Field1 (Library); + end Get_Design_File_Chain; + + procedure Set_Design_File_Chain (Library : Iir; Chain : Iir_Design_File) is + begin + Check_Kind_For_Design_File_Chain (Library); + Set_Field1 (Library, Chain); + end Set_Design_File_Chain; + + procedure Check_Kind_For_Library_Directory (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Library_Declaration => + null; + when others => + Failed ("Library_Directory", Target); + end case; + end Check_Kind_For_Library_Directory; + + function Get_Library_Directory (Library : Iir) return Name_Id is + begin + Check_Kind_For_Library_Directory (Library); + return Name_Id'Val (Get_Field11 (Library)); + end Get_Library_Directory; + + procedure Set_Library_Directory (Library : Iir; Dir : Name_Id) is + begin + Check_Kind_For_Library_Directory (Library); + Set_Field11 (Library, Name_Id'Pos (Dir)); + end Set_Library_Directory; + + procedure Check_Kind_For_Date (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit + | Iir_Kind_Library_Declaration => + null; + when others => + Failed ("Date", Target); + end case; + end Check_Kind_For_Date; + + function Get_Date (Target : Iir) return Date_Type is + begin + Check_Kind_For_Date (Target); + return Date_Type'Val (Get_Field10 (Target)); + end Get_Date; + + procedure Set_Date (Target : Iir; Date : Date_Type) is + begin + Check_Kind_For_Date (Target); + Set_Field10 (Target, Date_Type'Pos (Date)); + end Set_Date; + + procedure Check_Kind_For_Context_Items (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit => + null; + when others => + Failed ("Context_Items", Target); + end case; + end Check_Kind_For_Context_Items; + + function Get_Context_Items (Design_Unit : Iir) return Iir is + begin + Check_Kind_For_Context_Items (Design_Unit); + return Get_Field1 (Design_Unit); + end Get_Context_Items; + + procedure Set_Context_Items (Design_Unit : Iir; Items_Chain : Iir) is + begin + Check_Kind_For_Context_Items (Design_Unit); + Set_Field1 (Design_Unit, Items_Chain); + end Set_Context_Items; + + procedure Check_Kind_For_Dependence_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit => + null; + when others => + Failed ("Dependence_List", Target); + end case; + end Check_Kind_For_Dependence_List; + + function Get_Dependence_List (Unit : Iir) return Iir_List is + begin + Check_Kind_For_Dependence_List (Unit); + return Iir_To_Iir_List (Get_Field8 (Unit)); + end Get_Dependence_List; + + procedure Set_Dependence_List (Unit : Iir; List : Iir_List) is + begin + Check_Kind_For_Dependence_List (Unit); + Set_Field8 (Unit, Iir_List_To_Iir (List)); + end Set_Dependence_List; + + procedure Check_Kind_For_Analysis_Checks_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit => + null; + when others => + Failed ("Analysis_Checks_List", Target); + end case; + end Check_Kind_For_Analysis_Checks_List; + + function Get_Analysis_Checks_List (Unit : Iir) return Iir_List is + begin + Check_Kind_For_Analysis_Checks_List (Unit); + return Iir_To_Iir_List (Get_Field9 (Unit)); + end Get_Analysis_Checks_List; + + procedure Set_Analysis_Checks_List (Unit : Iir; List : Iir_List) is + begin + Check_Kind_For_Analysis_Checks_List (Unit); + Set_Field9 (Unit, Iir_List_To_Iir (List)); + end Set_Analysis_Checks_List; + + procedure Check_Kind_For_Date_State (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit => + null; + when others => + Failed ("Date_State", Target); + end case; + end Check_Kind_For_Date_State; + + function Get_Date_State (Unit : Iir_Design_Unit) return Date_State_Type is + begin + Check_Kind_For_Date_State (Unit); + return Date_State_Type'Val (Get_State1 (Unit)); + end Get_Date_State; + + procedure Set_Date_State (Unit : Iir_Design_Unit; State : Date_State_Type) + is + begin + Check_Kind_For_Date_State (Unit); + Set_State1 (Unit, Date_State_Type'Pos (State)); + end Set_Date_State; + + procedure Check_Kind_For_Guarded_Target_State (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Signal_Assignment_Statement => + null; + when others => + Failed ("Guarded_Target_State", Target); + end case; + end Check_Kind_For_Guarded_Target_State; + + function Get_Guarded_Target_State (Stmt : Iir) return Tri_State_Type is + begin + Check_Kind_For_Guarded_Target_State (Stmt); + return Tri_State_Type'Val (Get_State4 (Stmt)); + end Get_Guarded_Target_State; + + procedure Set_Guarded_Target_State (Stmt : Iir; State : Tri_State_Type) is + begin + Check_Kind_For_Guarded_Target_State (Stmt); + Set_State4 (Stmt, Tri_State_Type'Pos (State)); + end Set_Guarded_Target_State; + + procedure Check_Kind_For_Library_Unit (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit => + null; + when others => + Failed ("Library_Unit", Target); + end case; + end Check_Kind_For_Library_Unit; + + function Get_Library_Unit (Design_Unit : Iir_Design_Unit) return Iir is + begin + Check_Kind_For_Library_Unit (Design_Unit); + return Get_Field5 (Design_Unit); + end Get_Library_Unit; + + procedure Set_Library_Unit (Design_Unit : Iir_Design_Unit; Lib_Unit : Iir) + is + begin + Check_Kind_For_Library_Unit (Design_Unit); + Set_Field5 (Design_Unit, Lib_Unit); + end Set_Library_Unit; + + procedure Check_Kind_For_Hash_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit => + null; + when others => + Failed ("Hash_Chain", Target); + end case; + end Check_Kind_For_Hash_Chain; + + function Get_Hash_Chain (Design_Unit : Iir_Design_Unit) return Iir is + begin + Check_Kind_For_Hash_Chain (Design_Unit); + return Get_Field7 (Design_Unit); + end Get_Hash_Chain; + + procedure Set_Hash_Chain (Design_Unit : Iir_Design_Unit; Chain : Iir) is + begin + Check_Kind_For_Hash_Chain (Design_Unit); + Set_Field7 (Design_Unit, Chain); + end Set_Hash_Chain; + + procedure Check_Kind_For_Value (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Integer_Literal + | Iir_Kind_Physical_Int_Literal => + null; + when others => + Failed ("Value", Target); + end case; + end Check_Kind_For_Value; + + function Get_Value (Lit : Iir) return Iir_Int64 is + begin + Check_Kind_For_Value (Lit); + return Get_Int64 (Lit); + end Get_Value; + + procedure Set_Value (Lit : Iir; Val : Iir_Int64) is + begin + Check_Kind_For_Value (Lit); + Set_Int64 (Lit, Val); + end Set_Value; + + procedure Check_Kind_For_Enum_Pos (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Enumeration_Literal => + null; + when others => + Failed ("Enum_Pos", Target); + end case; + end Check_Kind_For_Enum_Pos; + + function Get_Enum_Pos (Lit : Iir) return Iir_Int32 is + begin + Check_Kind_For_Enum_Pos (Lit); + return Iir_Int32'Val (Get_Field10 (Lit)); + end Get_Enum_Pos; + + procedure Set_Enum_Pos (Lit : Iir; Val : Iir_Int32) is + begin + Check_Kind_For_Enum_Pos (Lit); + Set_Field10 (Lit, Iir_Int32'Pos (Val)); + end Set_Enum_Pos; + + procedure Check_Kind_For_Physical_Literal (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Unit_Declaration => + null; + when others => + Failed ("Physical_Literal", Target); + end case; + end Check_Kind_For_Physical_Literal; + + function Get_Physical_Literal (Unit : Iir) return Iir is + begin + Check_Kind_For_Physical_Literal (Unit); + return Get_Field6 (Unit); + end Get_Physical_Literal; + + procedure Set_Physical_Literal (Unit : Iir; Lit : Iir) is + begin + Check_Kind_For_Physical_Literal (Unit); + Set_Field6 (Unit, Lit); + end Set_Physical_Literal; + + procedure Check_Kind_For_Physical_Unit_Value (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Unit_Declaration => + null; + when others => + Failed ("Physical_Unit_Value", Target); + end case; + end Check_Kind_For_Physical_Unit_Value; + + function Get_Physical_Unit_Value (Unit : Iir) return Iir is + begin + Check_Kind_For_Physical_Unit_Value (Unit); + return Get_Field7 (Unit); + end Get_Physical_Unit_Value; + + procedure Set_Physical_Unit_Value (Unit : Iir; Lit : Iir) is + begin + Check_Kind_For_Physical_Unit_Value (Unit); + Set_Field7 (Unit, Lit); + end Set_Physical_Unit_Value; + + procedure Check_Kind_For_Fp_Value (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Floating_Point_Literal + | Iir_Kind_Physical_Fp_Literal => + null; + when others => + Failed ("Fp_Value", Target); + end case; + end Check_Kind_For_Fp_Value; + + function Get_Fp_Value (Lit : Iir) return Iir_Fp64 is + begin + Check_Kind_For_Fp_Value (Lit); + return Get_Fp64 (Lit); + end Get_Fp_Value; + + procedure Set_Fp_Value (Lit : Iir; Val : Iir_Fp64) is + begin + Check_Kind_For_Fp_Value (Lit); + Set_Fp64 (Lit, Val); + end Set_Fp_Value; + + procedure Check_Kind_For_Enumeration_Decl (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Enumeration_Literal => + null; + when others => + Failed ("Enumeration_Decl", Target); + end case; + end Check_Kind_For_Enumeration_Decl; + + function Get_Enumeration_Decl (Target : Iir) return Iir is + begin + Check_Kind_For_Enumeration_Decl (Target); + return Get_Field6 (Target); + end Get_Enumeration_Decl; + + procedure Set_Enumeration_Decl (Target : Iir; Lit : Iir) is + begin + Check_Kind_For_Enumeration_Decl (Target); + Set_Field6 (Target, Lit); + end Set_Enumeration_Decl; + + procedure Check_Kind_For_Simple_Aggregate_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Simple_Aggregate => + null; + when others => + Failed ("Simple_Aggregate_List", Target); + end case; + end Check_Kind_For_Simple_Aggregate_List; + + function Get_Simple_Aggregate_List (Target : Iir) return Iir_List is + begin + Check_Kind_For_Simple_Aggregate_List (Target); + return Iir_To_Iir_List (Get_Field3 (Target)); + end Get_Simple_Aggregate_List; + + procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List) is + begin + Check_Kind_For_Simple_Aggregate_List (Target); + Set_Field3 (Target, Iir_List_To_Iir (List)); + end Set_Simple_Aggregate_List; + + procedure Check_Kind_For_Bit_String_Base (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Bit_String_Literal => + null; + when others => + Failed ("Bit_String_Base", Target); + end case; + end Check_Kind_For_Bit_String_Base; + + function Get_Bit_String_Base (Lit : Iir) return Base_Type is + begin + Check_Kind_For_Bit_String_Base (Lit); + return Base_Type'Val (Get_Field11 (Lit)); + end Get_Bit_String_Base; + + procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type) is + begin + Check_Kind_For_Bit_String_Base (Lit); + Set_Field11 (Lit, Base_Type'Pos (Base)); + end Set_Bit_String_Base; + + procedure Check_Kind_For_Bit_String_0 (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Bit_String_Literal => + null; + when others => + Failed ("Bit_String_0", Target); + end case; + end Check_Kind_For_Bit_String_0; + + function Get_Bit_String_0 (Lit : Iir) return Iir_Enumeration_Literal is + begin + Check_Kind_For_Bit_String_0 (Lit); + return Get_Field4 (Lit); + end Get_Bit_String_0; + + procedure Set_Bit_String_0 (Lit : Iir; El : Iir_Enumeration_Literal) is + begin + Check_Kind_For_Bit_String_0 (Lit); + Set_Field4 (Lit, El); + end Set_Bit_String_0; + + procedure Check_Kind_For_Bit_String_1 (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Bit_String_Literal => + null; + when others => + Failed ("Bit_String_1", Target); + end case; + end Check_Kind_For_Bit_String_1; + + function Get_Bit_String_1 (Lit : Iir) return Iir_Enumeration_Literal is + begin + Check_Kind_For_Bit_String_1 (Lit); + return Get_Field5 (Lit); + end Get_Bit_String_1; + + procedure Set_Bit_String_1 (Lit : Iir; El : Iir_Enumeration_Literal) is + begin + Check_Kind_For_Bit_String_1 (Lit); + Set_Field5 (Lit, El); + end Set_Bit_String_1; + + procedure Check_Kind_For_Literal_Origin (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Integer_Literal + | Iir_Kind_Floating_Point_Literal + | Iir_Kind_String_Literal + | Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal + | Iir_Kind_Bit_String_Literal + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Enumeration_Literal => + null; + when others => + Failed ("Literal_Origin", Target); + end case; + end Check_Kind_For_Literal_Origin; + + function Get_Literal_Origin (Lit : Iir) return Iir is + begin + Check_Kind_For_Literal_Origin (Lit); + return Get_Field2 (Lit); + end Get_Literal_Origin; + + procedure Set_Literal_Origin (Lit : Iir; Orig : Iir) is + begin + Check_Kind_For_Literal_Origin (Lit); + Set_Field2 (Lit, Orig); + end Set_Literal_Origin; + + procedure Check_Kind_For_Proxy (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Proxy => + null; + when others => + Failed ("Proxy", Target); + end case; + end Check_Kind_For_Proxy; + + function Get_Proxy (Target : Iir_Proxy) return Iir is + begin + Check_Kind_For_Proxy (Target); + return Get_Field1 (Target); + end Get_Proxy; + + procedure Set_Proxy (Target : Iir_Proxy; Proxy : Iir) is + begin + Check_Kind_For_Proxy (Target); + Set_Field1 (Target, Proxy); + end Set_Proxy; + + procedure Check_Kind_For_Entity_Class (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Entity_Class + | Iir_Kind_Attribute_Specification => + null; + when others => + Failed ("Entity_Class", Target); + end case; + end Check_Kind_For_Entity_Class; + + function Get_Entity_Class (Target : Iir) return Token_Type is + begin + Check_Kind_For_Entity_Class (Target); + return Iir_To_Token_Type (Get_Field3 (Target)); + end Get_Entity_Class; + + procedure Set_Entity_Class (Target : Iir; Kind : Token_Type) is + begin + Check_Kind_For_Entity_Class (Target); + Set_Field3 (Target, Token_Type_To_Iir (Kind)); + end Set_Entity_Class; + + procedure Check_Kind_For_Entity_Name_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Attribute_Specification => + null; + when others => + Failed ("Entity_Name_List", Target); + end case; + end Check_Kind_For_Entity_Name_List; + + function Get_Entity_Name_List (Target : Iir) return Iir_List is + begin + Check_Kind_For_Entity_Name_List (Target); + return Iir_To_Iir_List (Get_Field1 (Target)); + end Get_Entity_Name_List; + + procedure Set_Entity_Name_List (Target : Iir; Names : Iir_List) is + begin + Check_Kind_For_Entity_Name_List (Target); + Set_Field1 (Target, Iir_List_To_Iir (Names)); + end Set_Entity_Name_List; + + procedure Check_Kind_For_Attribute_Designator (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Attribute_Specification => + null; + when others => + Failed ("Attribute_Designator", Target); + end case; + end Check_Kind_For_Attribute_Designator; + + function Get_Attribute_Designator (Target : Iir) return Iir is + begin + Check_Kind_For_Attribute_Designator (Target); + return Get_Field6 (Target); + end Get_Attribute_Designator; + + procedure Set_Attribute_Designator (Target : Iir; Designator : Iir) is + begin + Check_Kind_For_Attribute_Designator (Target); + Set_Field6 (Target, Designator); + end Set_Attribute_Designator; + + procedure Check_Kind_For_Attribute_Specification_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Attribute_Specification => + null; + when others => + Failed ("Attribute_Specification_Chain", Target); + end case; + end Check_Kind_For_Attribute_Specification_Chain; + + function Get_Attribute_Specification_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Attribute_Specification_Chain (Target); + return Get_Field7 (Target); + end Get_Attribute_Specification_Chain; + + procedure Set_Attribute_Specification_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Attribute_Specification_Chain (Target); + Set_Field7 (Target, Chain); + end Set_Attribute_Specification_Chain; + + procedure Check_Kind_For_Attribute_Specification (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Attribute_Value => + null; + when others => + Failed ("Attribute_Specification", Target); + end case; + end Check_Kind_For_Attribute_Specification; + + function Get_Attribute_Specification (Val : Iir) return Iir is + begin + Check_Kind_For_Attribute_Specification (Val); + return Get_Field4 (Val); + end Get_Attribute_Specification; + + procedure Set_Attribute_Specification (Val : Iir; Attr : Iir) is + begin + Check_Kind_For_Attribute_Specification (Val); + Set_Field4 (Val, Attr); + end Set_Attribute_Specification; + + procedure Check_Kind_For_Signal_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Disconnection_Specification => + null; + when others => + Failed ("Signal_List", Target); + end case; + end Check_Kind_For_Signal_List; + + function Get_Signal_List (Target : Iir) return Iir_List is + begin + Check_Kind_For_Signal_List (Target); + return Iir_To_Iir_List (Get_Field4 (Target)); + end Get_Signal_List; + + procedure Set_Signal_List (Target : Iir; List : Iir_List) is + begin + Check_Kind_For_Signal_List (Target); + Set_Field4 (Target, Iir_List_To_Iir (List)); + end Set_Signal_List; + + procedure Check_Kind_For_Designated_Entity (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Attribute_Value => + null; + when others => + Failed ("Designated_Entity", Target); + end case; + end Check_Kind_For_Designated_Entity; + + function Get_Designated_Entity (Val : Iir_Attribute_Value) return Iir is + begin + Check_Kind_For_Designated_Entity (Val); + return Get_Field3 (Val); + end Get_Designated_Entity; + + procedure Set_Designated_Entity (Val : Iir_Attribute_Value; Entity : Iir) + is + begin + Check_Kind_For_Designated_Entity (Val); + Set_Field3 (Val, Entity); + end Set_Designated_Entity; + + procedure Check_Kind_For_Formal (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open => + null; + when others => + Failed ("Formal", Target); + end case; + end Check_Kind_For_Formal; + + function Get_Formal (Target : Iir) return Iir is + begin + Check_Kind_For_Formal (Target); + return Get_Field1 (Target); + end Get_Formal; + + procedure Set_Formal (Target : Iir; Formal : Iir) is + begin + Check_Kind_For_Formal (Target); + Set_Field1 (Target, Formal); + end Set_Formal; + + procedure Check_Kind_For_Actual (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Association_Element_By_Expression => + null; + when others => + Failed ("Actual", Target); + end case; + end Check_Kind_For_Actual; + + function Get_Actual (Target : Iir) return Iir is + begin + Check_Kind_For_Actual (Target); + return Get_Field3 (Target); + end Get_Actual; + + procedure Set_Actual (Target : Iir; Actual : Iir) is + begin + Check_Kind_For_Actual (Target); + Set_Field3 (Target, Actual); + end Set_Actual; + + procedure Check_Kind_For_In_Conversion (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Association_Element_By_Expression => + null; + when others => + Failed ("In_Conversion", Target); + end case; + end Check_Kind_For_In_Conversion; + + function Get_In_Conversion (Target : Iir) return Iir is + begin + Check_Kind_For_In_Conversion (Target); + return Get_Field4 (Target); + end Get_In_Conversion; + + procedure Set_In_Conversion (Target : Iir; Conv : Iir) is + begin + Check_Kind_For_In_Conversion (Target); + Set_Field4 (Target, Conv); + end Set_In_Conversion; + + procedure Check_Kind_For_Out_Conversion (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Association_Element_By_Expression => + null; + when others => + Failed ("Out_Conversion", Target); + end case; + end Check_Kind_For_Out_Conversion; + + function Get_Out_Conversion (Target : Iir) return Iir is + begin + Check_Kind_For_Out_Conversion (Target); + return Get_Field5 (Target); + end Get_Out_Conversion; + + procedure Set_Out_Conversion (Target : Iir; Conv : Iir) is + begin + Check_Kind_For_Out_Conversion (Target); + Set_Field5 (Target, Conv); + end Set_Out_Conversion; + + procedure Check_Kind_For_Whole_Association_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open => + null; + when others => + Failed ("Whole_Association_Flag", Target); + end case; + end Check_Kind_For_Whole_Association_Flag; + + function Get_Whole_Association_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Whole_Association_Flag (Target); + return Get_Flag1 (Target); + end Get_Whole_Association_Flag; + + procedure Set_Whole_Association_Flag (Target : Iir; Flag : Boolean) is + begin + Check_Kind_For_Whole_Association_Flag (Target); + Set_Flag1 (Target, Flag); + end Set_Whole_Association_Flag; + + procedure Check_Kind_For_Collapse_Signal_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open => + null; + when others => + Failed ("Collapse_Signal_Flag", Target); + end case; + end Check_Kind_For_Collapse_Signal_Flag; + + function Get_Collapse_Signal_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Collapse_Signal_Flag (Target); + return Get_Flag2 (Target); + end Get_Collapse_Signal_Flag; + + procedure Set_Collapse_Signal_Flag (Target : Iir; Flag : Boolean) is + begin + Check_Kind_For_Collapse_Signal_Flag (Target); + Set_Flag2 (Target, Flag); + end Set_Collapse_Signal_Flag; + + procedure Check_Kind_For_Artificial_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Association_Element_Open => + null; + when others => + Failed ("Artificial_Flag", Target); + end case; + end Check_Kind_For_Artificial_Flag; + + function Get_Artificial_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Artificial_Flag (Target); + return Get_Flag3 (Target); + end Get_Artificial_Flag; + + procedure Set_Artificial_Flag (Target : Iir; Flag : Boolean) is + begin + Check_Kind_For_Artificial_Flag (Target); + Set_Flag3 (Target, Flag); + end Set_Artificial_Flag; + + procedure Check_Kind_For_Open_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Signal_Interface_Declaration => + null; + when others => + Failed ("Open_Flag", Target); + end case; + end Check_Kind_For_Open_Flag; + + function Get_Open_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Open_Flag (Target); + return Get_Flag3 (Target); + end Get_Open_Flag; + + procedure Set_Open_Flag (Target : Iir; Flag : Boolean) is + begin + Check_Kind_For_Open_Flag (Target); + Set_Flag3 (Target, Flag); + end Set_Open_Flag; + + procedure Check_Kind_For_We_Value (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Waveform_Element => + null; + when others => + Failed ("We_Value", Target); + end case; + end Check_Kind_For_We_Value; + + function Get_We_Value (We : Iir_Waveform_Element) return Iir is + begin + Check_Kind_For_We_Value (We); + return Get_Field1 (We); + end Get_We_Value; + + procedure Set_We_Value (We : Iir_Waveform_Element; An_Iir : Iir) is + begin + Check_Kind_For_We_Value (We); + Set_Field1 (We, An_Iir); + end Set_We_Value; + + procedure Check_Kind_For_Time (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Waveform_Element => + null; + when others => + Failed ("Time", Target); + end case; + end Check_Kind_For_Time; + + function Get_Time (We : Iir_Waveform_Element) return Iir is + begin + Check_Kind_For_Time (We); + return Get_Field3 (We); + end Get_Time; + + procedure Set_Time (We : Iir_Waveform_Element; An_Iir : Iir) is + begin + Check_Kind_For_Time (We); + Set_Field3 (We, An_Iir); + end Set_Time; + + procedure Check_Kind_For_Associated (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name => + null; + when others => + Failed ("Associated", Target); + end case; + end Check_Kind_For_Associated; + + function Get_Associated (Target : Iir) return Iir is + begin + Check_Kind_For_Associated (Target); + return Get_Field1 (Target); + end Get_Associated; + + procedure Set_Associated (Target : Iir; Associated : Iir) is + begin + Check_Kind_For_Associated (Target); + Set_Field1 (Target, Associated); + end Set_Associated; + + procedure Check_Kind_For_Same_Alternative_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name => + null; + when others => + Failed ("Same_Alternative_Flag", Target); + end case; + end Check_Kind_For_Same_Alternative_Flag; + + function Get_Same_Alternative_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Same_Alternative_Flag (Target); + return Get_Flag1 (Target); + end Get_Same_Alternative_Flag; + + procedure Set_Same_Alternative_Flag (Target : Iir; Val : Boolean) is + begin + Check_Kind_For_Same_Alternative_Flag (Target); + Set_Flag1 (Target, Val); + end Set_Same_Alternative_Flag; + + procedure Check_Kind_For_Architecture (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Entity_Aspect_Entity => + null; + when others => + Failed ("Architecture", Target); + end case; + end Check_Kind_For_Architecture; + + function Get_Architecture (Target : Iir_Entity_Aspect_Entity) return Iir is + begin + Check_Kind_For_Architecture (Target); + return Get_Field2 (Target); + end Get_Architecture; + + procedure Set_Architecture (Target : Iir_Entity_Aspect_Entity; Arch : Iir) + is + begin + Check_Kind_For_Architecture (Target); + Set_Field2 (Target, Arch); + end Set_Architecture; + + procedure Check_Kind_For_Block_Specification (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Configuration => + null; + when others => + Failed ("Block_Specification", Target); + end case; + end Check_Kind_For_Block_Specification; + + function Get_Block_Specification (Target : Iir) return Iir is + begin + Check_Kind_For_Block_Specification (Target); + return Get_Field5 (Target); + end Get_Block_Specification; + + procedure Set_Block_Specification (Target : Iir; Block : Iir) is + begin + Check_Kind_For_Block_Specification (Target); + Set_Field5 (Target, Block); + end Set_Block_Specification; + + procedure Check_Kind_For_Prev_Block_Configuration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Configuration => + null; + when others => + Failed ("Prev_Block_Configuration", Target); + end case; + end Check_Kind_For_Prev_Block_Configuration; + + function Get_Prev_Block_Configuration (Target : Iir) return Iir is + begin + Check_Kind_For_Prev_Block_Configuration (Target); + return Get_Field4 (Target); + end Get_Prev_Block_Configuration; + + procedure Set_Prev_Block_Configuration (Target : Iir; Block : Iir) is + begin + Check_Kind_For_Prev_Block_Configuration (Target); + Set_Field4 (Target, Block); + end Set_Prev_Block_Configuration; + + procedure Check_Kind_For_Configuration_Item_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Configuration => + null; + when others => + Failed ("Configuration_Item_Chain", Target); + end case; + end Check_Kind_For_Configuration_Item_Chain; + + function Get_Configuration_Item_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Configuration_Item_Chain (Target); + return Get_Field3 (Target); + end Get_Configuration_Item_Chain; + + procedure Set_Configuration_Item_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Configuration_Item_Chain (Target); + Set_Field3 (Target, Chain); + end Set_Configuration_Item_Chain; + + procedure Check_Kind_For_Attribute_Value_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit + | Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement => + null; + when others => + Failed ("Attribute_Value_Chain", Target); + end case; + end Check_Kind_For_Attribute_Value_Chain; + + function Get_Attribute_Value_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Attribute_Value_Chain (Target); + return Get_Field4 (Target); + end Get_Attribute_Value_Chain; + + procedure Set_Attribute_Value_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Attribute_Value_Chain (Target); + Set_Field4 (Target, Chain); + end Set_Attribute_Value_Chain; + + procedure Check_Kind_For_Spec_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Attribute_Value => + null; + when others => + Failed ("Spec_Chain", Target); + end case; + end Check_Kind_For_Spec_Chain; + + function Get_Spec_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Spec_Chain (Target); + return Get_Field0 (Target); + end Get_Spec_Chain; + + procedure Set_Spec_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Spec_Chain (Target); + Set_Field0 (Target, Chain); + end Set_Spec_Chain; + + procedure Check_Kind_For_Attribute_Value_Spec_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Attribute_Specification => + null; + when others => + Failed ("Attribute_Value_Spec_Chain", Target); + end case; + end Check_Kind_For_Attribute_Value_Spec_Chain; + + function Get_Attribute_Value_Spec_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Attribute_Value_Spec_Chain (Target); + return Get_Field4 (Target); + end Get_Attribute_Value_Spec_Chain; + + procedure Set_Attribute_Value_Spec_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Attribute_Value_Spec_Chain (Target); + Set_Field4 (Target, Chain); + end Set_Attribute_Value_Spec_Chain; + + procedure Check_Kind_For_Entity (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Entity_Aspect_Entity + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Architecture_Declaration => + null; + when others => + Failed ("Entity", Target); + end case; + end Check_Kind_For_Entity; + + function Get_Entity (Decl : Iir) return Iir is + begin + Check_Kind_For_Entity (Decl); + return Get_Field4 (Decl); + end Get_Entity; + + procedure Set_Entity (Decl : Iir; Entity : Iir) is + begin + Check_Kind_For_Entity (Decl); + Set_Field4 (Decl, Entity); + end Set_Entity; + + procedure Check_Kind_For_Package (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Package_Body => + null; + when others => + Failed ("Package", Target); + end case; + end Check_Kind_For_Package; + + function Get_Package (Package_Body : Iir) return Iir_Package_Declaration is + begin + Check_Kind_For_Package (Package_Body); + return Get_Field4 (Package_Body); + end Get_Package; + + procedure Set_Package (Package_Body : Iir; Decl : Iir_Package_Declaration) + is + begin + Check_Kind_For_Package (Package_Body); + Set_Field4 (Package_Body, Decl); + end Set_Package; + + procedure Check_Kind_For_Package_Body (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Package_Declaration => + null; + when others => + Failed ("Package_Body", Target); + end case; + end Check_Kind_For_Package_Body; + + function Get_Package_Body (Pkg : Iir) return Iir_Package_Body is + begin + Check_Kind_For_Package_Body (Pkg); + return Get_Field4 (Pkg); + end Get_Package_Body; + + procedure Set_Package_Body (Pkg : Iir; Decl : Iir_Package_Body) is + begin + Check_Kind_For_Package_Body (Pkg); + Set_Field4 (Pkg, Decl); + end Set_Package_Body; + + procedure Check_Kind_For_Need_Body (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Package_Declaration => + null; + when others => + Failed ("Need_Body", Target); + end case; + end Check_Kind_For_Need_Body; + + function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean is + begin + Check_Kind_For_Need_Body (Decl); + return Get_Flag1 (Decl); + end Get_Need_Body; + + procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean) is + begin + Check_Kind_For_Need_Body (Decl); + Set_Flag1 (Decl, Flag); + end Set_Need_Body; + + procedure Check_Kind_For_Block_Configuration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Component_Configuration + | Iir_Kind_Configuration_Declaration => + null; + when others => + Failed ("Block_Configuration", Target); + end case; + end Check_Kind_For_Block_Configuration; + + function Get_Block_Configuration (Target : Iir) return Iir is + begin + Check_Kind_For_Block_Configuration (Target); + return Get_Field5 (Target); + end Get_Block_Configuration; + + procedure Set_Block_Configuration (Target : Iir; Block : Iir) is + begin + Check_Kind_For_Block_Configuration (Target); + Set_Field5 (Target, Block); + end Set_Block_Configuration; + + procedure Check_Kind_For_Concurrent_Statement_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement => + null; + when others => + Failed ("Concurrent_Statement_Chain", Target); + end case; + end Check_Kind_For_Concurrent_Statement_Chain; + + function Get_Concurrent_Statement_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Concurrent_Statement_Chain (Target); + return Get_Field5 (Target); + end Get_Concurrent_Statement_Chain; + + procedure Set_Concurrent_Statement_Chain (Target : Iir; First : Iir) is + begin + Check_Kind_For_Concurrent_Statement_Chain (Target); + Set_Field5 (Target, First); + end Set_Concurrent_Statement_Chain; + + procedure Check_Kind_For_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File + | Iir_Kind_Design_Unit + | Iir_Kind_Library_Clause + | Iir_Kind_Use_Clause + | Iir_Kind_Waveform_Element + | Iir_Kind_Conditional_Waveform + | Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open + | Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name + | Iir_Kind_Block_Configuration + | Iir_Kind_Component_Configuration + | Iir_Kind_Entity_Class + | Iir_Kind_Attribute_Value + | Iir_Kind_Attribute_Specification + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Configuration_Specification + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kind_Library_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Procedure_Body + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute => + null; + when others => + Failed ("Chain", Target); + end case; + end Check_Kind_For_Chain; + + function Get_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Chain (Target); + return Get_Field2 (Target); + end Get_Chain; + + procedure Set_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Chain (Target); + Set_Field2 (Target, Chain); + end Set_Chain; + + procedure Check_Kind_For_Port_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Header + | Iir_Kind_Entity_Declaration + | Iir_Kind_Component_Declaration => + null; + when others => + Failed ("Port_Chain", Target); + end case; + end Check_Kind_For_Port_Chain; + + function Get_Port_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Port_Chain (Target); + return Get_Field7 (Target); + end Get_Port_Chain; + + procedure Set_Port_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Port_Chain (Target); + Set_Field7 (Target, Chain); + end Set_Port_Chain; + + procedure Check_Kind_For_Generic_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Header + | Iir_Kind_Entity_Declaration + | Iir_Kind_Component_Declaration => + null; + when others => + Failed ("Generic_Chain", Target); + end case; + end Check_Kind_For_Generic_Chain; + + function Get_Generic_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Generic_Chain (Target); + return Get_Field6 (Target); + end Get_Generic_Chain; + + procedure Set_Generic_Chain (Target : Iir; Generics : Iir) is + begin + Check_Kind_For_Generic_Chain (Target); + Set_Field6 (Target, Generics); + end Set_Generic_Chain; + + procedure Check_Kind_For_Type (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Error + | Iir_Kind_Character_Literal + | Iir_Kind_Integer_Literal + | Iir_Kind_Floating_Point_Literal + | Iir_Kind_Null_Literal + | Iir_Kind_String_Literal + | Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal + | Iir_Kind_Bit_String_Literal + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Attribute_Value + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Range_Expression + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Identity_Operator + | Iir_Kind_Negation_Operator + | Iir_Kind_Absolute_Operator + | Iir_Kind_Not_Operator + | Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator + | Iir_Kind_Function_Call + | Iir_Kind_Aggregate + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Return_Statement + | Iir_Kind_Simple_Name + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Base_Attribute + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Attribute_Name => + null; + when others => + Failed ("Type", Target); + end case; + end Check_Kind_For_Type; + + function Get_Type (Target : Iir) return Iir is + begin + Check_Kind_For_Type (Target); + return Get_Field1 (Target); + end Get_Type; + + procedure Set_Type (Target : Iir; Atype : Iir) is + begin + Check_Kind_For_Type (Target); + Set_Field1 (Target, Atype); + end Set_Type; + + procedure Check_Kind_For_Subtype_Definition (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Anonymous_Type_Declaration => + null; + when others => + Failed ("Subtype_Definition", Target); + end case; + end Check_Kind_For_Subtype_Definition; + + function Get_Subtype_Definition (Target : Iir) return Iir is + begin + Check_Kind_For_Subtype_Definition (Target); + return Get_Field4 (Target); + end Get_Subtype_Definition; + + procedure Set_Subtype_Definition (Target : Iir; Def : Iir) is + begin + Check_Kind_For_Subtype_Definition (Target); + Set_Field4 (Target, Def); + end Set_Subtype_Definition; + + procedure Check_Kind_For_Mode (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_File_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => + null; + when others => + Failed ("Mode", Target); + end case; + end Check_Kind_For_Mode; + + function Get_Mode (Target : Iir) return Iir_Mode is + begin + Check_Kind_For_Mode (Target); + return Iir_Mode'Val (Get_Odigit2 (Target)); + end Get_Mode; + + procedure Set_Mode (Target : Iir; Mode : Iir_Mode) is + begin + Check_Kind_For_Mode (Target); + Set_Odigit2 (Target, Iir_Mode'Pos (Mode)); + end Set_Mode; + + procedure Check_Kind_For_Signal_Kind (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Signal_Interface_Declaration => + null; + when others => + Failed ("Signal_Kind", Target); + end case; + end Check_Kind_For_Signal_Kind; + + function Get_Signal_Kind (Target : Iir) return Iir_Signal_Kind is + begin + Check_Kind_For_Signal_Kind (Target); + return Iir_Signal_Kind'Val (Get_State4 (Target)); + end Get_Signal_Kind; + + procedure Set_Signal_Kind (Target : Iir; Signal_Kind : Iir_Signal_Kind) is + begin + Check_Kind_For_Signal_Kind (Target); + Set_State4 (Target, Iir_Signal_Kind'Pos (Signal_Kind)); + end Set_Signal_Kind; + + procedure Check_Kind_For_Base_Name (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Attribute_Value + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Function_Call + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute => + null; + when others => + Failed ("Base_Name", Target); + end case; + end Check_Kind_For_Base_Name; + + function Get_Base_Name (Target : Iir) return Iir is + begin + Check_Kind_For_Base_Name (Target); + return Get_Field5 (Target); + end Get_Base_Name; + + procedure Set_Base_Name (Target : Iir; Name : Iir) is + begin + Check_Kind_For_Base_Name (Target); + Set_Field5 (Target, Name); + end Set_Base_Name; + + procedure Check_Kind_For_Interface_Declaration_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration => + null; + when others => + Failed ("Interface_Declaration_Chain", Target); + end case; + end Check_Kind_For_Interface_Declaration_Chain; + + function Get_Interface_Declaration_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Interface_Declaration_Chain (Target); + return Get_Field5 (Target); + end Get_Interface_Declaration_Chain; + + procedure Set_Interface_Declaration_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Interface_Declaration_Chain (Target); + Set_Field5 (Target, Chain); + end Set_Interface_Declaration_Chain; + + procedure Check_Kind_For_Subprogram_Specification (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + null; + when others => + Failed ("Subprogram_Specification", Target); + end case; + end Check_Kind_For_Subprogram_Specification; + + function Get_Subprogram_Specification (Target : Iir) return Iir is + begin + Check_Kind_For_Subprogram_Specification (Target); + return Get_Field4 (Target); + end Get_Subprogram_Specification; + + procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir) is + begin + Check_Kind_For_Subprogram_Specification (Target); + Set_Field4 (Target, Spec); + end Set_Subprogram_Specification; + + procedure Check_Kind_For_Sequential_Statement_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + null; + when others => + Failed ("Sequential_Statement_Chain", Target); + end case; + end Check_Kind_For_Sequential_Statement_Chain; + + function Get_Sequential_Statement_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Sequential_Statement_Chain (Target); + return Get_Field5 (Target); + end Get_Sequential_Statement_Chain; + + procedure Set_Sequential_Statement_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Sequential_Statement_Chain (Target); + Set_Field5 (Target, Chain); + end Set_Sequential_Statement_Chain; + + procedure Check_Kind_For_Subprogram_Body (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + null; + when others => + Failed ("Subprogram_Body", Target); + end case; + end Check_Kind_For_Subprogram_Body; + + function Get_Subprogram_Body (Target : Iir) return Iir is + begin + Check_Kind_For_Subprogram_Body (Target); + return Get_Field6 (Target); + end Get_Subprogram_Body; + + procedure Set_Subprogram_Body (Target : Iir; A_Body : Iir) is + begin + Check_Kind_For_Subprogram_Body (Target); + Set_Field6 (Target, A_Body); + end Set_Subprogram_Body; + + procedure Check_Kind_For_Overload_Number (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration => + null; + when others => + Failed ("Overload_Number", Target); + end case; + end Check_Kind_For_Overload_Number; + + function Get_Overload_Number (Target : Iir) return Iir_Int32 is + begin + Check_Kind_For_Overload_Number (Target); + return Iir_Int32'Val (Get_Field9 (Target)); + end Get_Overload_Number; + + procedure Set_Overload_Number (Target : Iir; Val : Iir_Int32) is + begin + Check_Kind_For_Overload_Number (Target); + Set_Field9 (Target, Iir_Int32'Pos (Val)); + end Set_Overload_Number; + + procedure Check_Kind_For_Subprogram_Depth (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + null; + when others => + Failed ("Subprogram_Depth", Target); + end case; + end Check_Kind_For_Subprogram_Depth; + + function Get_Subprogram_Depth (Target : Iir) return Iir_Int32 is + begin + Check_Kind_For_Subprogram_Depth (Target); + return Iir_Int32'Val (Get_Field10 (Target)); + end Get_Subprogram_Depth; + + procedure Set_Subprogram_Depth (Target : Iir; Depth : Iir_Int32) is + begin + Check_Kind_For_Subprogram_Depth (Target); + Set_Field10 (Target, Iir_Int32'Pos (Depth)); + end Set_Subprogram_Depth; + + procedure Check_Kind_For_Subprogram_Hash (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Enumeration_Literal => + null; + when others => + Failed ("Subprogram_Hash", Target); + end case; + end Check_Kind_For_Subprogram_Hash; + + function Get_Subprogram_Hash (Target : Iir) return Iir_Int32 is + begin + Check_Kind_For_Subprogram_Hash (Target); + return Iir_Int32'Val (Get_Field11 (Target)); + end Get_Subprogram_Hash; + + procedure Set_Subprogram_Hash (Target : Iir; Val : Iir_Int32) is + begin + Check_Kind_For_Subprogram_Hash (Target); + Set_Field11 (Target, Iir_Int32'Pos (Val)); + end Set_Subprogram_Hash; + + procedure Check_Kind_For_Extra_Info (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + null; + when others => + Failed ("Extra_Info", Target); + end case; + end Check_Kind_For_Extra_Info; + + function Get_Extra_Info (Target : Iir) return Iir_Int32 is + begin + Check_Kind_For_Extra_Info (Target); + return Iir_Int32'Val (Get_Field12 (Target)); + end Get_Extra_Info; + + procedure Set_Extra_Info (Target : Iir; Info : Iir_Int32) is + begin + Check_Kind_For_Extra_Info (Target); + Set_Field12 (Target, Iir_Int32'Pos (Info)); + end Set_Extra_Info; + + procedure Check_Kind_For_Impure_Depth (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + null; + when others => + Failed ("Impure_Depth", Target); + end case; + end Check_Kind_For_Impure_Depth; + + function Get_Impure_Depth (Target : Iir) return Iir_Int32 is + begin + Check_Kind_For_Impure_Depth (Target); + return Iir_To_Iir_Int32 (Get_Field3 (Target)); + end Get_Impure_Depth; + + procedure Set_Impure_Depth (Target : Iir; Depth : Iir_Int32) is + begin + Check_Kind_For_Impure_Depth (Target); + Set_Field3 (Target, Iir_Int32_To_Iir (Depth)); + end Set_Impure_Depth; + + procedure Check_Kind_For_Return_Type (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Signature + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Enumeration_Literal => + null; + when others => + Failed ("Return_Type", Target); + end case; + end Check_Kind_For_Return_Type; + + function Get_Return_Type (Target : Iir) return Iir is + begin + Check_Kind_For_Return_Type (Target); + return Get_Field1 (Target); + end Get_Return_Type; + + procedure Set_Return_Type (Target : Iir; Decl : Iir) is + begin + Check_Kind_For_Return_Type (Target); + Set_Field1 (Target, Decl); + end Set_Return_Type; + + procedure Check_Kind_For_Implicit_Definition (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + null; + when others => + Failed ("Implicit_Definition", Target); + end case; + end Check_Kind_For_Implicit_Definition; + + function Get_Implicit_Definition (D : Iir) return Iir_Predefined_Functions + is + begin + Check_Kind_For_Implicit_Definition (D); + return Iir_Predefined_Functions'Val (Get_Field6 (D)); + end Get_Implicit_Definition; + + procedure Set_Implicit_Definition (D : Iir; Def : Iir_Predefined_Functions) + is + begin + Check_Kind_For_Implicit_Definition (D); + Set_Field6 (D, Iir_Predefined_Functions'Pos (Def)); + end Set_Implicit_Definition; + + procedure Check_Kind_For_Type_Reference (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + null; + when others => + Failed ("Type_Reference", Target); + end case; + end Check_Kind_For_Type_Reference; + + function Get_Type_Reference (Target : Iir) return Iir is + begin + Check_Kind_For_Type_Reference (Target); + return Get_Field8 (Target); + end Get_Type_Reference; + + procedure Set_Type_Reference (Target : Iir; Decl : Iir) is + begin + Check_Kind_For_Type_Reference (Target); + Set_Field8 (Target, Decl); + end Set_Type_Reference; + + procedure Check_Kind_For_Default_Value (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => + null; + when others => + Failed ("Default_Value", Target); + end case; + end Check_Kind_For_Default_Value; + + function Get_Default_Value (Target : Iir) return Iir is + begin + Check_Kind_For_Default_Value (Target); + return Get_Field6 (Target); + end Get_Default_Value; + + procedure Set_Default_Value (Target : Iir; Value : Iir) is + begin + Check_Kind_For_Default_Value (Target); + Set_Field6 (Target, Value); + end Set_Default_Value; + + procedure Check_Kind_For_Deferred_Declaration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Constant_Declaration => + null; + when others => + Failed ("Deferred_Declaration", Target); + end case; + end Check_Kind_For_Deferred_Declaration; + + function Get_Deferred_Declaration (Target : Iir) return Iir is + begin + Check_Kind_For_Deferred_Declaration (Target); + return Get_Field7 (Target); + end Get_Deferred_Declaration; + + procedure Set_Deferred_Declaration (Target : Iir; Decl : Iir) is + begin + Check_Kind_For_Deferred_Declaration (Target); + Set_Field7 (Target, Decl); + end Set_Deferred_Declaration; + + procedure Check_Kind_For_Deferred_Declaration_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Constant_Declaration => + null; + when others => + Failed ("Deferred_Declaration_Flag", Target); + end case; + end Check_Kind_For_Deferred_Declaration_Flag; + + function Get_Deferred_Declaration_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Deferred_Declaration_Flag (Target); + return Get_Flag1 (Target); + end Get_Deferred_Declaration_Flag; + + procedure Set_Deferred_Declaration_Flag (Target : Iir; Flag : Boolean) is + begin + Check_Kind_For_Deferred_Declaration_Flag (Target); + Set_Flag1 (Target, Flag); + end Set_Deferred_Declaration_Flag; + + procedure Check_Kind_For_Shared_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Variable_Declaration => + null; + when others => + Failed ("Shared_Flag", Target); + end case; + end Check_Kind_For_Shared_Flag; + + function Get_Shared_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Shared_Flag (Target); + return Get_Flag2 (Target); + end Get_Shared_Flag; + + procedure Set_Shared_Flag (Target : Iir; Shared : Boolean) is + begin + Check_Kind_For_Shared_Flag (Target); + Set_Flag2 (Target, Shared); + end Set_Shared_Flag; + + procedure Check_Kind_For_Design_Unit (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Architecture_Declaration => + null; + when others => + Failed ("Design_Unit", Target); + end case; + end Check_Kind_For_Design_Unit; + + function Get_Design_Unit (Target : Iir) return Iir_Design_Unit is + begin + Check_Kind_For_Design_Unit (Target); + return Get_Field0 (Target); + end Get_Design_Unit; + + procedure Set_Design_Unit (Target : Iir; Unit : Iir_Design_Unit) is + begin + Check_Kind_For_Design_Unit (Target); + Set_Field0 (Target, Unit); + end Set_Design_Unit; + + procedure Check_Kind_For_Block_Statement (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Guard_Signal_Declaration => + null; + when others => + Failed ("Block_Statement", Target); + end case; + end Check_Kind_For_Block_Statement; + + function Get_Block_Statement (Target : Iir) return Iir_Block_Statement is + begin + Check_Kind_For_Block_Statement (Target); + return Get_Field7 (Target); + end Get_Block_Statement; + + procedure Set_Block_Statement (Target : Iir; Block : Iir_Block_Statement) + is + begin + Check_Kind_For_Block_Statement (Target); + Set_Field7 (Target, Block); + end Set_Block_Statement; + + procedure Check_Kind_For_Signal_Driver (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Signal_Declaration => + null; + when others => + Failed ("Signal_Driver", Target); + end case; + end Check_Kind_For_Signal_Driver; + + function Get_Signal_Driver (Target : Iir_Signal_Declaration) return Iir is + begin + Check_Kind_For_Signal_Driver (Target); + return Get_Field7 (Target); + end Get_Signal_Driver; + + procedure Set_Signal_Driver (Target : Iir_Signal_Declaration; Driver : Iir) + is + begin + Check_Kind_For_Signal_Driver (Target); + Set_Field7 (Target, Driver); + end Set_Signal_Driver; + + procedure Check_Kind_For_Declaration_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Configuration + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement => + null; + when others => + Failed ("Declaration_Chain", Target); + end case; + end Check_Kind_For_Declaration_Chain; + + function Get_Declaration_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Declaration_Chain (Target); + return Get_Field1 (Target); + end Get_Declaration_Chain; + + procedure Set_Declaration_Chain (Target : Iir; Decls : Iir) is + begin + Check_Kind_For_Declaration_Chain (Target); + Set_Field1 (Target, Decls); + end Set_Declaration_Chain; + + procedure Check_Kind_For_File_Logical_Name (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_File_Declaration => + null; + when others => + Failed ("File_Logical_Name", Target); + end case; + end Check_Kind_For_File_Logical_Name; + + function Get_File_Logical_Name (Target : Iir_File_Declaration) return Iir + is + begin + Check_Kind_For_File_Logical_Name (Target); + return Get_Field6 (Target); + end Get_File_Logical_Name; + + procedure Set_File_Logical_Name (Target : Iir_File_Declaration; Name : Iir) + is + begin + Check_Kind_For_File_Logical_Name (Target); + Set_Field6 (Target, Name); + end Set_File_Logical_Name; + + procedure Check_Kind_For_File_Open_Kind (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_File_Declaration => + null; + when others => + Failed ("File_Open_Kind", Target); + end case; + end Check_Kind_For_File_Open_Kind; + + function Get_File_Open_Kind (Target : Iir_File_Declaration) return Iir is + begin + Check_Kind_For_File_Open_Kind (Target); + return Get_Field7 (Target); + end Get_File_Open_Kind; + + procedure Set_File_Open_Kind (Target : Iir_File_Declaration; Kind : Iir) is + begin + Check_Kind_For_File_Open_Kind (Target); + Set_Field7 (Target, Kind); + end Set_File_Open_Kind; + + procedure Check_Kind_For_Element_Position (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Element_Declaration => + null; + when others => + Failed ("Element_Position", Target); + end case; + end Check_Kind_For_Element_Position; + + function Get_Element_Position (Target : Iir) return Iir_Index32 is + begin + Check_Kind_For_Element_Position (Target); + return Iir_Index32'Val (Get_Field4 (Target)); + end Get_Element_Position; + + procedure Set_Element_Position (Target : Iir; Pos : Iir_Index32) is + begin + Check_Kind_For_Element_Position (Target); + Set_Field4 (Target, Iir_Index32'Pos (Pos)); + end Set_Element_Position; + + procedure Check_Kind_For_Selected_Element (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Selected_Element => + null; + when others => + Failed ("Selected_Element", Target); + end case; + end Check_Kind_For_Selected_Element; + + function Get_Selected_Element (Target : Iir) return Iir is + begin + Check_Kind_For_Selected_Element (Target); + return Get_Field2 (Target); + end Get_Selected_Element; + + procedure Set_Selected_Element (Target : Iir; El : Iir) is + begin + Check_Kind_For_Selected_Element (Target); + Set_Field2 (Target, El); + end Set_Selected_Element; + + procedure Check_Kind_For_Suffix_Identifier (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Selected_Name => + null; + when others => + Failed ("Suffix_Identifier", Target); + end case; + end Check_Kind_For_Suffix_Identifier; + + function Get_Suffix_Identifier (Target : Iir) return Name_Id is + begin + Check_Kind_For_Suffix_Identifier (Target); + return Iir_To_Name_Id (Get_Field2 (Target)); + end Get_Suffix_Identifier; + + procedure Set_Suffix_Identifier (Target : Iir; Ident : Name_Id) is + begin + Check_Kind_For_Suffix_Identifier (Target); + Set_Field2 (Target, Name_Id_To_Iir (Ident)); + end Set_Suffix_Identifier; + + procedure Check_Kind_For_Attribute_Identifier (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Attribute_Name => + null; + when others => + Failed ("Attribute_Identifier", Target); + end case; + end Check_Kind_For_Attribute_Identifier; + + function Get_Attribute_Identifier (Target : Iir) return Name_Id is + begin + Check_Kind_For_Attribute_Identifier (Target); + return Iir_To_Name_Id (Get_Field2 (Target)); + end Get_Attribute_Identifier; + + procedure Set_Attribute_Identifier (Target : Iir; Ident : Name_Id) is + begin + Check_Kind_For_Attribute_Identifier (Target); + Set_Field2 (Target, Name_Id_To_Iir (Ident)); + end Set_Attribute_Identifier; + + procedure Check_Kind_For_Use_Clause_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Use_Clause => + null; + when others => + Failed ("Use_Clause_Chain", Target); + end case; + end Check_Kind_For_Use_Clause_Chain; + + function Get_Use_Clause_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Use_Clause_Chain (Target); + return Get_Field3 (Target); + end Get_Use_Clause_Chain; + + procedure Set_Use_Clause_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Use_Clause_Chain (Target); + Set_Field3 (Target, Chain); + end Set_Use_Clause_Chain; + + procedure Check_Kind_For_Selected_Name (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Use_Clause => + null; + when others => + Failed ("Selected_Name", Target); + end case; + end Check_Kind_For_Selected_Name; + + function Get_Selected_Name (Target : Iir_Use_Clause) return Iir is + begin + Check_Kind_For_Selected_Name (Target); + return Get_Field1 (Target); + end Get_Selected_Name; + + procedure Set_Selected_Name (Target : Iir_Use_Clause; Name : Iir) is + begin + Check_Kind_For_Selected_Name (Target); + Set_Field1 (Target, Name); + end Set_Selected_Name; + + procedure Check_Kind_For_Type_Declarator (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Error + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + null; + when others => + Failed ("Type_Declarator", Target); + end case; + end Check_Kind_For_Type_Declarator; + + function Get_Type_Declarator (Target : Iir) return Iir is + begin + Check_Kind_For_Type_Declarator (Target); + return Get_Field3 (Target); + end Get_Type_Declarator; + + procedure Set_Type_Declarator (Target : Iir; Decl : Iir) is + begin + Check_Kind_For_Type_Declarator (Target); + Set_Field3 (Target, Decl); + end Set_Type_Declarator; + + procedure Check_Kind_For_Enumeration_Literal_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Enumeration_Type_Definition => + null; + when others => + Failed ("Enumeration_Literal_List", Target); + end case; + end Check_Kind_For_Enumeration_Literal_List; + + function Get_Enumeration_Literal_List (Target : Iir) return Iir_List is + begin + Check_Kind_For_Enumeration_Literal_List (Target); + return Iir_To_Iir_List (Get_Field2 (Target)); + end Get_Enumeration_Literal_List; + + procedure Set_Enumeration_Literal_List (Target : Iir; List : Iir_List) is + begin + Check_Kind_For_Enumeration_Literal_List (Target); + Set_Field2 (Target, Iir_List_To_Iir (List)); + end Set_Enumeration_Literal_List; + + procedure Check_Kind_For_Entity_Class_Entry_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Group_Template_Declaration => + null; + when others => + Failed ("Entity_Class_Entry_Chain", Target); + end case; + end Check_Kind_For_Entity_Class_Entry_Chain; + + function Get_Entity_Class_Entry_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Entity_Class_Entry_Chain (Target); + return Get_Field1 (Target); + end Get_Entity_Class_Entry_Chain; + + procedure Set_Entity_Class_Entry_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Entity_Class_Entry_Chain (Target); + Set_Field1 (Target, Chain); + end Set_Entity_Class_Entry_Chain; + + procedure Check_Kind_For_Group_Constituent_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Group_Declaration => + null; + when others => + Failed ("Group_Constituent_List", Target); + end case; + end Check_Kind_For_Group_Constituent_List; + + function Get_Group_Constituent_List (Group : Iir) return Iir_List is + begin + Check_Kind_For_Group_Constituent_List (Group); + return Iir_To_Iir_List (Get_Field1 (Group)); + end Get_Group_Constituent_List; + + procedure Set_Group_Constituent_List (Group : Iir; List : Iir_List) is + begin + Check_Kind_For_Group_Constituent_List (Group); + Set_Field1 (Group, Iir_List_To_Iir (List)); + end Set_Group_Constituent_List; + + procedure Check_Kind_For_Unit_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Physical_Type_Definition => + null; + when others => + Failed ("Unit_Chain", Target); + end case; + end Check_Kind_For_Unit_Chain; + + function Get_Unit_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Unit_Chain (Target); + return Get_Field1 (Target); + end Get_Unit_Chain; + + procedure Set_Unit_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Unit_Chain (Target); + Set_Field1 (Target, Chain); + end Set_Unit_Chain; + + procedure Check_Kind_For_Primary_Unit (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Physical_Type_Definition => + null; + when others => + Failed ("Primary_Unit", Target); + end case; + end Check_Kind_For_Primary_Unit; + + function Get_Primary_Unit (Target : Iir) return Iir is + begin + Check_Kind_For_Primary_Unit (Target); + return Get_Field1 (Target); + end Get_Primary_Unit; + + procedure Check_Kind_For_Identifier (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit + | Iir_Kind_Library_Clause + | Iir_Kind_Character_Literal + | Iir_Kind_Operator_Symbol + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kind_Library_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Simple_Name => + null; + when others => + Failed ("Identifier", Target); + end case; + end Check_Kind_For_Identifier; + + function Get_Identifier (Target : Iir) return Name_Id is + begin + Check_Kind_For_Identifier (Target); + return Iir_To_Name_Id (Get_Field3 (Target)); + end Get_Identifier; + + procedure Set_Identifier (Target : Iir; Identifier : Name_Id) is + begin + Check_Kind_For_Identifier (Target); + Set_Field3 (Target, Name_Id_To_Iir (Identifier)); + end Set_Identifier; + + procedure Check_Kind_For_Label (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement => + null; + when others => + Failed ("Label", Target); + end case; + end Check_Kind_For_Label; + + function Get_Label (Target : Iir) return Name_Id is + begin + Check_Kind_For_Label (Target); + return Iir_To_Name_Id (Get_Field3 (Target)); + end Get_Label; + + procedure Set_Label (Target : Iir; Label : Name_Id) is + begin + Check_Kind_For_Label (Target); + Set_Field3 (Target, Name_Id_To_Iir (Label)); + end Set_Label; + + procedure Check_Kind_For_Visible_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit + | Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kind_Library_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement => + null; + when others => + Failed ("Visible_Flag", Target); + end case; + end Check_Kind_For_Visible_Flag; + + function Get_Visible_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Visible_Flag (Target); + return Get_Flag4 (Target); + end Get_Visible_Flag; + + procedure Set_Visible_Flag (Target : Iir; Flag : Boolean) is + begin + Check_Kind_For_Visible_Flag (Target); + Set_Flag4 (Target, Flag); + end Set_Visible_Flag; + + procedure Check_Kind_For_Range_Constraint (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Subtype_Definition => + null; + when others => + Failed ("Range_Constraint", Target); + end case; + end Check_Kind_For_Range_Constraint; + + function Get_Range_Constraint (Target : Iir) return Iir is + begin + Check_Kind_For_Range_Constraint (Target); + return Get_Field1 (Target); + end Get_Range_Constraint; + + procedure Set_Range_Constraint (Target : Iir; Constraint : Iir) is + begin + Check_Kind_For_Range_Constraint (Target); + Set_Field1 (Target, Constraint); + end Set_Range_Constraint; + + procedure Check_Kind_For_Direction (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Range_Expression => + null; + when others => + Failed ("Direction", Target); + end case; + end Check_Kind_For_Direction; + + function Get_Direction (Decl : Iir) return Iir_Direction is + begin + Check_Kind_For_Direction (Decl); + return Iir_Direction'Val (Get_State2 (Decl)); + end Get_Direction; + + procedure Set_Direction (Decl : Iir; Dir : Iir_Direction) is + begin + Check_Kind_For_Direction (Decl); + Set_State2 (Decl, Iir_Direction'Pos (Dir)); + end Set_Direction; + + procedure Check_Kind_For_Left_Limit (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Range_Expression => + null; + when others => + Failed ("Left_Limit", Target); + end case; + end Check_Kind_For_Left_Limit; + + function Get_Left_Limit (Decl : Iir_Range_Expression) return Iir is + begin + Check_Kind_For_Left_Limit (Decl); + return Get_Field2 (Decl); + end Get_Left_Limit; + + procedure Set_Left_Limit (Decl : Iir_Range_Expression; Limit : Iir) is + begin + Check_Kind_For_Left_Limit (Decl); + Set_Field2 (Decl, Limit); + end Set_Left_Limit; + + procedure Check_Kind_For_Right_Limit (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Range_Expression => + null; + when others => + Failed ("Right_Limit", Target); + end case; + end Check_Kind_For_Right_Limit; + + function Get_Right_Limit (Decl : Iir_Range_Expression) return Iir is + begin + Check_Kind_For_Right_Limit (Decl); + return Get_Field3 (Decl); + end Get_Right_Limit; + + procedure Set_Right_Limit (Decl : Iir_Range_Expression; Limit : Iir) is + begin + Check_Kind_For_Right_Limit (Decl); + Set_Field3 (Decl, Limit); + end Set_Right_Limit; + + procedure Check_Kind_For_Base_Type (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Error + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + null; + when others => + Failed ("Base_Type", Target); + end case; + end Check_Kind_For_Base_Type; + + function Get_Base_Type (Decl : Iir) return Iir is + begin + Check_Kind_For_Base_Type (Decl); + return Get_Field4 (Decl); + end Get_Base_Type; + + procedure Set_Base_Type (Decl : Iir; Base_Type : Iir) is + begin + Check_Kind_For_Base_Type (Decl); + Set_Field4 (Decl, Base_Type); + end Set_Base_Type; + + procedure Check_Kind_For_Resolution_Function (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Unconstrained_Array_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Subtype_Definition => + null; + when others => + Failed ("Resolution_Function", Target); + end case; + end Check_Kind_For_Resolution_Function; + + function Get_Resolution_Function (Decl : Iir) return Iir is + begin + Check_Kind_For_Resolution_Function (Decl); + return Get_Field5 (Decl); + end Get_Resolution_Function; + + procedure Set_Resolution_Function (Decl : Iir; Func : Iir) is + begin + Check_Kind_For_Resolution_Function (Decl); + Set_Field5 (Decl, Func); + end Set_Resolution_Function; + + procedure Check_Kind_For_Text_File_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_File_Type_Definition => + null; + when others => + Failed ("Text_File_Flag", Target); + end case; + end Check_Kind_For_Text_File_Flag; + + function Get_Text_File_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Text_File_Flag (Target); + return Get_Flag3 (Target); + end Get_Text_File_Flag; + + procedure Set_Text_File_Flag (Target : Iir; Flag : Boolean) is + begin + Check_Kind_For_Text_File_Flag (Target); + Set_Flag3 (Target, Flag); + end Set_Text_File_Flag; + + procedure Check_Kind_For_Type_Staticness (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Error + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + null; + when others => + Failed ("Type_Staticness", Target); + end case; + end Check_Kind_For_Type_Staticness; + + function Get_Type_Staticness (Target : Iir) return Iir_Staticness is + begin + Check_Kind_For_Type_Staticness (Target); + return Iir_Staticness'Val (Get_State1 (Target)); + end Get_Type_Staticness; + + procedure Set_Type_Staticness (Target : Iir; Static : Iir_Staticness) is + begin + Check_Kind_For_Type_Staticness (Target); + Set_State1 (Target, Iir_Staticness'Pos (Static)); + end Set_Type_Staticness; + + procedure Check_Kind_For_Index_Subtype_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition => + null; + when others => + Failed ("Index_Subtype_List", Target); + end case; + end Check_Kind_For_Index_Subtype_List; + + function Get_Index_Subtype_List (Decl : Iir) return Iir_List is + begin + Check_Kind_For_Index_Subtype_List (Decl); + return Iir_To_Iir_List (Get_Field6 (Decl)); + end Get_Index_Subtype_List; + + procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List) is + begin + Check_Kind_For_Index_Subtype_List (Decl); + Set_Field6 (Decl, Iir_List_To_Iir (List)); + end Set_Index_Subtype_List; + + procedure Check_Kind_For_Index_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Indexed_Name => + null; + when others => + Failed ("Index_List", Target); + end case; + end Check_Kind_For_Index_List; + + function Get_Index_List (Decl : Iir) return Iir_List is + begin + Check_Kind_For_Index_List (Decl); + return Iir_To_Iir_List (Get_Field2 (Decl)); + end Get_Index_List; + + procedure Set_Index_List (Decl : Iir; List : Iir_List) is + begin + Check_Kind_For_Index_List (Decl); + Set_Field2 (Decl, Iir_List_To_Iir (List)); + end Set_Index_List; + + procedure Check_Kind_For_Element_Subtype (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition => + null; + when others => + Failed ("Element_Subtype", Target); + end case; + end Check_Kind_For_Element_Subtype; + + function Get_Element_Subtype (Decl : Iir) return Iir is + begin + Check_Kind_For_Element_Subtype (Decl); + return Get_Field1 (Decl); + end Get_Element_Subtype; + + procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir) is + begin + Check_Kind_For_Element_Subtype (Decl); + Set_Field1 (Decl, Sub_Type); + end Set_Element_Subtype; + + procedure Check_Kind_For_Element_Declaration_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Record_Type_Definition => + null; + when others => + Failed ("Element_Declaration_Chain", Target); + end case; + end Check_Kind_For_Element_Declaration_Chain; + + function Get_Element_Declaration_Chain (Decl : Iir) return Iir is + begin + Check_Kind_For_Element_Declaration_Chain (Decl); + return Get_Field2 (Decl); + end Get_Element_Declaration_Chain; + + procedure Set_Element_Declaration_Chain (Decl : Iir; Chain : Iir) is + begin + Check_Kind_For_Element_Declaration_Chain (Decl); + Set_Field2 (Decl, Chain); + end Set_Element_Declaration_Chain; + + procedure Check_Kind_For_Number_Element_Declaration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Record_Type_Definition => + null; + when others => + Failed ("Number_Element_Declaration", Target); + end case; + end Check_Kind_For_Number_Element_Declaration; + + function Get_Number_Element_Declaration (Decl : Iir) return Iir_Index32 is + begin + Check_Kind_For_Number_Element_Declaration (Decl); + return Iir_To_Iir_Index32 (Get_Field1 (Decl)); + end Get_Number_Element_Declaration; + + procedure Set_Number_Element_Declaration (Decl : Iir; Val : Iir_Index32) is + begin + Check_Kind_For_Number_Element_Declaration (Decl); + Set_Field1 (Decl, Iir_Index32_To_Iir (Val)); + end Set_Number_Element_Declaration; + + procedure Check_Kind_For_Designated_Type (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Access_Type_Definition => + null; + when others => + Failed ("Designated_Type", Target); + end case; + end Check_Kind_For_Designated_Type; + + function Get_Designated_Type (Target : Iir) return Iir is + begin + Check_Kind_For_Designated_Type (Target); + return Get_Field2 (Target); + end Get_Designated_Type; + + procedure Set_Designated_Type (Target : Iir; Dtype : Iir) is + begin + Check_Kind_For_Designated_Type (Target); + Set_Field2 (Target, Dtype); + end Set_Designated_Type; + + procedure Check_Kind_For_Target (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Variable_Assignment_Statement => + null; + when others => + Failed ("Target", Target); + end case; + end Check_Kind_For_Target; + + function Get_Target (Target : Iir) return Iir is + begin + Check_Kind_For_Target (Target); + return Get_Field1 (Target); + end Get_Target; + + procedure Set_Target (Target : Iir; Atarget : Iir) is + begin + Check_Kind_For_Target (Target); + Set_Field1 (Target, Atarget); + end Set_Target; + + procedure Check_Kind_For_Waveform_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Conditional_Waveform + | Iir_Kind_Signal_Assignment_Statement => + null; + when others => + Failed ("Waveform_Chain", Target); + end case; + end Check_Kind_For_Waveform_Chain; + + function Get_Waveform_Chain (Target : Iir) return Iir_Waveform_Element is + begin + Check_Kind_For_Waveform_Chain (Target); + return Get_Field5 (Target); + end Get_Waveform_Chain; + + procedure Set_Waveform_Chain (Target : Iir; Chain : Iir_Waveform_Element) + is + begin + Check_Kind_For_Waveform_Chain (Target); + Set_Field5 (Target, Chain); + end Set_Waveform_Chain; + + procedure Check_Kind_For_Guard (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment => + null; + when others => + Failed ("Guard", Target); + end case; + end Check_Kind_For_Guard; + + function Get_Guard (Target : Iir) return Iir is + begin + Check_Kind_For_Guard (Target); + return Get_Field8 (Target); + end Get_Guard; + + procedure Set_Guard (Target : Iir; Guard : Iir) is + begin + Check_Kind_For_Guard (Target); + Set_Field8 (Target, Guard); + end Set_Guard; + + procedure Check_Kind_For_Delay_Mechanism (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Signal_Assignment_Statement => + null; + when others => + Failed ("Delay_Mechanism", Target); + end case; + end Check_Kind_For_Delay_Mechanism; + + function Get_Delay_Mechanism (Target : Iir) return Iir_Delay_Mechanism is + begin + Check_Kind_For_Delay_Mechanism (Target); + return Iir_Delay_Mechanism'Val (Get_Field12 (Target)); + end Get_Delay_Mechanism; + + procedure Set_Delay_Mechanism (Target : Iir; Kind : Iir_Delay_Mechanism) is + begin + Check_Kind_For_Delay_Mechanism (Target); + Set_Field12 (Target, Iir_Delay_Mechanism'Pos (Kind)); + end Set_Delay_Mechanism; + + procedure Check_Kind_For_Reject_Time_Expression (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Signal_Assignment_Statement => + null; + when others => + Failed ("Reject_Time_Expression", Target); + end case; + end Check_Kind_For_Reject_Time_Expression; + + function Get_Reject_Time_Expression (Target : Iir) return Iir is + begin + Check_Kind_For_Reject_Time_Expression (Target); + return Get_Field6 (Target); + end Get_Reject_Time_Expression; + + procedure Set_Reject_Time_Expression (Target : Iir; Expr : Iir) is + begin + Check_Kind_For_Reject_Time_Expression (Target); + Set_Field6 (Target, Expr); + end Set_Reject_Time_Expression; + + procedure Check_Kind_For_Sensitivity_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Wait_Statement => + null; + when others => + Failed ("Sensitivity_List", Target); + end case; + end Check_Kind_For_Sensitivity_List; + + function Get_Sensitivity_List (Wait : Iir) return Iir_List is + begin + Check_Kind_For_Sensitivity_List (Wait); + return Iir_To_Iir_List (Get_Field6 (Wait)); + end Get_Sensitivity_List; + + procedure Set_Sensitivity_List (Wait : Iir; List : Iir_List) is + begin + Check_Kind_For_Sensitivity_List (Wait); + Set_Field6 (Wait, Iir_List_To_Iir (List)); + end Set_Sensitivity_List; + + procedure Check_Kind_For_Condition_Clause (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Wait_Statement => + null; + when others => + Failed ("Condition_Clause", Target); + end case; + end Check_Kind_For_Condition_Clause; + + function Get_Condition_Clause (Wait : Iir_Wait_Statement) return Iir is + begin + Check_Kind_For_Condition_Clause (Wait); + return Get_Field5 (Wait); + end Get_Condition_Clause; + + procedure Set_Condition_Clause (Wait : Iir_Wait_Statement; Cond : Iir) is + begin + Check_Kind_For_Condition_Clause (Wait); + Set_Field5 (Wait, Cond); + end Set_Condition_Clause; + + procedure Check_Kind_For_Timeout_Clause (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Wait_Statement => + null; + when others => + Failed ("Timeout_Clause", Target); + end case; + end Check_Kind_For_Timeout_Clause; + + function Get_Timeout_Clause (Wait : Iir_Wait_Statement) return Iir is + begin + Check_Kind_For_Timeout_Clause (Wait); + return Get_Field1 (Wait); + end Get_Timeout_Clause; + + procedure Set_Timeout_Clause (Wait : Iir_Wait_Statement; Timeout : Iir) is + begin + Check_Kind_For_Timeout_Clause (Wait); + Set_Field1 (Wait, Timeout); + end Set_Timeout_Clause; + + procedure Check_Kind_For_Postponed_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement => + null; + when others => + Failed ("Postponed_Flag", Target); + end case; + end Check_Kind_For_Postponed_Flag; + + function Get_Postponed_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Postponed_Flag (Target); + return Get_Flag3 (Target); + end Get_Postponed_Flag; + + procedure Set_Postponed_Flag (Target : Iir; Value : Boolean) is + begin + Check_Kind_For_Postponed_Flag (Target); + Set_Flag3 (Target, Value); + end Set_Postponed_Flag; + + procedure Check_Kind_For_Driver_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + null; + when others => + Failed ("Driver_List", Target); + end case; + end Check_Kind_For_Driver_List; + + function Get_Driver_List (Stmt : Iir) return Iir_List is + begin + Check_Kind_For_Driver_List (Stmt); + return Iir_To_Iir_List (Get_Field8 (Stmt)); + end Get_Driver_List; + + procedure Set_Driver_List (Stmt : Iir; List : Iir_List) is + begin + Check_Kind_For_Driver_List (Stmt); + Set_Field8 (Stmt, Iir_List_To_Iir (List)); + end Set_Driver_List; + + procedure Check_Kind_For_Callees_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + null; + when others => + Failed ("Callees_List", Target); + end case; + end Check_Kind_For_Callees_List; + + function Get_Callees_List (Proc : Iir) return Iir_List is + begin + Check_Kind_For_Callees_List (Proc); + return Iir_To_Iir_List (Get_Field7 (Proc)); + end Get_Callees_List; + + procedure Set_Callees_List (Proc : Iir; List : Iir_List) is + begin + Check_Kind_For_Callees_List (Proc); + Set_Field7 (Proc, Iir_List_To_Iir (List)); + end Set_Callees_List; + + procedure Check_Kind_For_Passive_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + null; + when others => + Failed ("Passive_Flag", Target); + end case; + end Check_Kind_For_Passive_Flag; + + function Get_Passive_Flag (Proc : Iir) return Boolean is + begin + Check_Kind_For_Passive_Flag (Proc); + return Get_Flag2 (Proc); + end Get_Passive_Flag; + + procedure Set_Passive_Flag (Proc : Iir; Flag : Boolean) is + begin + Check_Kind_For_Passive_Flag (Proc); + Set_Flag2 (Proc, Flag); + end Set_Passive_Flag; + + procedure Check_Kind_For_Wait_State (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + null; + when others => + Failed ("Wait_State", Target); + end case; + end Check_Kind_For_Wait_State; + + function Get_Wait_State (Proc : Iir) return Tri_State_Type is + begin + Check_Kind_For_Wait_State (Proc); + return Tri_State_Type'Val (Get_State1 (Proc)); + end Get_Wait_State; + + procedure Set_Wait_State (Proc : Iir; State : Tri_State_Type) is + begin + Check_Kind_For_Wait_State (Proc); + Set_State1 (Proc, Tri_State_Type'Pos (State)); + end Set_Wait_State; + + procedure Check_Kind_For_Seen_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + null; + when others => + Failed ("Seen_Flag", Target); + end case; + end Check_Kind_For_Seen_Flag; + + function Get_Seen_Flag (Proc : Iir) return Boolean is + begin + Check_Kind_For_Seen_Flag (Proc); + return Get_Flag1 (Proc); + end Get_Seen_Flag; + + procedure Set_Seen_Flag (Proc : Iir; Flag : Boolean) is + begin + Check_Kind_For_Seen_Flag (Proc); + Set_Flag1 (Proc, Flag); + end Set_Seen_Flag; + + procedure Check_Kind_For_Pure_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration => + null; + when others => + Failed ("Pure_Flag", Target); + end case; + end Check_Kind_For_Pure_Flag; + + function Get_Pure_Flag (Func : Iir) return Boolean is + begin + Check_Kind_For_Pure_Flag (Func); + return Get_Flag2 (Func); + end Get_Pure_Flag; + + procedure Set_Pure_Flag (Func : Iir; Flag : Boolean) is + begin + Check_Kind_For_Pure_Flag (Func); + Set_Flag2 (Func, Flag); + end Set_Pure_Flag; + + procedure Check_Kind_For_Foreign_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Architecture_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + null; + when others => + Failed ("Foreign_Flag", Target); + end case; + end Check_Kind_For_Foreign_Flag; + + function Get_Foreign_Flag (Decl : Iir) return Boolean is + begin + Check_Kind_For_Foreign_Flag (Decl); + return Get_Flag3 (Decl); + end Get_Foreign_Flag; + + procedure Set_Foreign_Flag (Decl : Iir; Flag : Boolean) is + begin + Check_Kind_For_Foreign_Flag (Decl); + Set_Flag3 (Decl, Flag); + end Set_Foreign_Flag; + + procedure Check_Kind_For_Resolved_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Error + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + null; + when others => + Failed ("Resolved_Flag", Target); + end case; + end Check_Kind_For_Resolved_Flag; + + function Get_Resolved_Flag (Atype : Iir) return Boolean is + begin + Check_Kind_For_Resolved_Flag (Atype); + return Get_Flag1 (Atype); + end Get_Resolved_Flag; + + procedure Set_Resolved_Flag (Atype : Iir; Flag : Boolean) is + begin + Check_Kind_For_Resolved_Flag (Atype); + Set_Flag1 (Atype, Flag); + end Set_Resolved_Flag; + + procedure Check_Kind_For_Signal_Type_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Error + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + null; + when others => + Failed ("Signal_Type_Flag", Target); + end case; + end Check_Kind_For_Signal_Type_Flag; + + function Get_Signal_Type_Flag (Atype : Iir) return Boolean is + begin + Check_Kind_For_Signal_Type_Flag (Atype); + return Get_Flag2 (Atype); + end Get_Signal_Type_Flag; + + procedure Set_Signal_Type_Flag (Atype : Iir; Flag : Boolean) is + begin + Check_Kind_For_Signal_Type_Flag (Atype); + Set_Flag2 (Atype, Flag); + end Set_Signal_Type_Flag; + + procedure Check_Kind_For_Purity_State (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Procedure_Declaration => + null; + when others => + Failed ("Purity_State", Target); + end case; + end Check_Kind_For_Purity_State; + + function Get_Purity_State (Proc : Iir) return Iir_Pure_State is + begin + Check_Kind_For_Purity_State (Proc); + return Iir_Pure_State'Val (Get_State3 (Proc)); + end Get_Purity_State; + + procedure Set_Purity_State (Proc : Iir; State : Iir_Pure_State) is + begin + Check_Kind_For_Purity_State (Proc); + Set_State3 (Proc, Iir_Pure_State'Pos (State)); + end Set_Purity_State; + + procedure Check_Kind_For_Elab_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File + | Iir_Kind_Design_Unit => + null; + when others => + Failed ("Elab_Flag", Target); + end case; + end Check_Kind_For_Elab_Flag; + + function Get_Elab_Flag (Design : Iir) return Boolean is + begin + Check_Kind_For_Elab_Flag (Design); + return Get_Flag3 (Design); + end Get_Elab_Flag; + + procedure Set_Elab_Flag (Design : Iir; Flag : Boolean) is + begin + Check_Kind_For_Elab_Flag (Design); + Set_Flag3 (Design, Flag); + end Set_Elab_Flag; + + procedure Check_Kind_For_Assertion_Condition (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Assertion_Statement => + null; + when others => + Failed ("Assertion_Condition", Target); + end case; + end Check_Kind_For_Assertion_Condition; + + function Get_Assertion_Condition (Target : Iir) return Iir is + begin + Check_Kind_For_Assertion_Condition (Target); + return Get_Field1 (Target); + end Get_Assertion_Condition; + + procedure Set_Assertion_Condition (Target : Iir; Cond : Iir) is + begin + Check_Kind_For_Assertion_Condition (Target); + Set_Field1 (Target, Cond); + end Set_Assertion_Condition; + + procedure Check_Kind_For_Report_Expression (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement => + null; + when others => + Failed ("Report_Expression", Target); + end case; + end Check_Kind_For_Report_Expression; + + function Get_Report_Expression (Target : Iir) return Iir is + begin + Check_Kind_For_Report_Expression (Target); + return Get_Field6 (Target); + end Get_Report_Expression; + + procedure Set_Report_Expression (Target : Iir; Expr : Iir) is + begin + Check_Kind_For_Report_Expression (Target); + Set_Field6 (Target, Expr); + end Set_Report_Expression; + + procedure Check_Kind_For_Severity_Expression (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement => + null; + when others => + Failed ("Severity_Expression", Target); + end case; + end Check_Kind_For_Severity_Expression; + + function Get_Severity_Expression (Target : Iir) return Iir is + begin + Check_Kind_For_Severity_Expression (Target); + return Get_Field5 (Target); + end Get_Severity_Expression; + + procedure Set_Severity_Expression (Target : Iir; Expr : Iir) is + begin + Check_Kind_For_Severity_Expression (Target); + Set_Field5 (Target, Expr); + end Set_Severity_Expression; + + procedure Check_Kind_For_Instantiated_Unit (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Component_Instantiation_Statement => + null; + when others => + Failed ("Instantiated_Unit", Target); + end case; + end Check_Kind_For_Instantiated_Unit; + + function Get_Instantiated_Unit (Target : Iir) return Iir is + begin + Check_Kind_For_Instantiated_Unit (Target); + return Get_Field1 (Target); + end Get_Instantiated_Unit; + + procedure Set_Instantiated_Unit (Target : Iir; Unit : Iir) is + begin + Check_Kind_For_Instantiated_Unit (Target); + Set_Field1 (Target, Unit); + end Set_Instantiated_Unit; + + procedure Check_Kind_For_Generic_Map_Aspect_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Header + | Iir_Kind_Binding_Indication + | Iir_Kind_Component_Instantiation_Statement => + null; + when others => + Failed ("Generic_Map_Aspect_Chain", Target); + end case; + end Check_Kind_For_Generic_Map_Aspect_Chain; + + function Get_Generic_Map_Aspect_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Generic_Map_Aspect_Chain (Target); + return Get_Field8 (Target); + end Get_Generic_Map_Aspect_Chain; + + procedure Set_Generic_Map_Aspect_Chain (Target : Iir; Generics : Iir) is + begin + Check_Kind_For_Generic_Map_Aspect_Chain (Target); + Set_Field8 (Target, Generics); + end Set_Generic_Map_Aspect_Chain; + + procedure Check_Kind_For_Port_Map_Aspect_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Header + | Iir_Kind_Binding_Indication + | Iir_Kind_Component_Instantiation_Statement => + null; + when others => + Failed ("Port_Map_Aspect_Chain", Target); + end case; + end Check_Kind_For_Port_Map_Aspect_Chain; + + function Get_Port_Map_Aspect_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Port_Map_Aspect_Chain (Target); + return Get_Field9 (Target); + end Get_Port_Map_Aspect_Chain; + + procedure Set_Port_Map_Aspect_Chain (Target : Iir; Port : Iir) is + begin + Check_Kind_For_Port_Map_Aspect_Chain (Target); + Set_Field9 (Target, Port); + end Set_Port_Map_Aspect_Chain; + + procedure Check_Kind_For_Configuration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Entity_Aspect_Configuration => + null; + when others => + Failed ("Configuration", Target); + end case; + end Check_Kind_For_Configuration; + + function Get_Configuration (Target : Iir) return Iir is + begin + Check_Kind_For_Configuration (Target); + return Get_Field1 (Target); + end Get_Configuration; + + procedure Set_Configuration (Target : Iir; Conf : Iir) is + begin + Check_Kind_For_Configuration (Target); + Set_Field1 (Target, Conf); + end Set_Configuration; + + procedure Check_Kind_For_Component_Configuration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Component_Instantiation_Statement => + null; + when others => + Failed ("Component_Configuration", Target); + end case; + end Check_Kind_For_Component_Configuration; + + function Get_Component_Configuration (Target : Iir) return Iir is + begin + Check_Kind_For_Component_Configuration (Target); + return Get_Field6 (Target); + end Get_Component_Configuration; + + procedure Set_Component_Configuration (Target : Iir; Conf : Iir) is + begin + Check_Kind_For_Component_Configuration (Target); + Set_Field6 (Target, Conf); + end Set_Component_Configuration; + + procedure Check_Kind_For_Configuration_Specification (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Component_Instantiation_Statement => + null; + when others => + Failed ("Configuration_Specification", Target); + end case; + end Check_Kind_For_Configuration_Specification; + + function Get_Configuration_Specification (Target : Iir) return Iir is + begin + Check_Kind_For_Configuration_Specification (Target); + return Get_Field7 (Target); + end Get_Configuration_Specification; + + procedure Set_Configuration_Specification (Target : Iir; Conf : Iir) is + begin + Check_Kind_For_Configuration_Specification (Target); + Set_Field7 (Target, Conf); + end Set_Configuration_Specification; + + procedure Check_Kind_For_Default_Binding_Indication (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Component_Instantiation_Statement => + null; + when others => + Failed ("Default_Binding_Indication", Target); + end case; + end Check_Kind_For_Default_Binding_Indication; + + function Get_Default_Binding_Indication (Target : Iir) return Iir is + begin + Check_Kind_For_Default_Binding_Indication (Target); + return Get_Field5 (Target); + end Get_Default_Binding_Indication; + + procedure Set_Default_Binding_Indication (Target : Iir; Conf : Iir) is + begin + Check_Kind_For_Default_Binding_Indication (Target); + Set_Field5 (Target, Conf); + end Set_Default_Binding_Indication; + + procedure Check_Kind_For_Default_Configuration_Declaration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Architecture_Declaration => + null; + when others => + Failed ("Default_Configuration_Declaration", Target); + end case; + end Check_Kind_For_Default_Configuration_Declaration; + + function Get_Default_Configuration_Declaration (Target : Iir) return Iir is + begin + Check_Kind_For_Default_Configuration_Declaration (Target); + return Get_Field6 (Target); + end Get_Default_Configuration_Declaration; + + procedure Set_Default_Configuration_Declaration (Target : Iir; Conf : Iir) + is + begin + Check_Kind_For_Default_Configuration_Declaration (Target); + Set_Field6 (Target, Conf); + end Set_Default_Configuration_Declaration; + + procedure Check_Kind_For_Expression (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Attribute_Specification + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_Case_Statement => + null; + when others => + Failed ("Expression", Target); + end case; + end Check_Kind_For_Expression; + + function Get_Expression (Target : Iir) return Iir is + begin + Check_Kind_For_Expression (Target); + return Get_Field5 (Target); + end Get_Expression; + + procedure Set_Expression (Target : Iir; Expr : Iir) is + begin + Check_Kind_For_Expression (Target); + Set_Field5 (Target, Expr); + end Set_Expression; + + procedure Check_Kind_For_Selected_Waveform_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Selected_Signal_Assignment => + null; + when others => + Failed ("Selected_Waveform_Chain", Target); + end case; + end Check_Kind_For_Selected_Waveform_Chain; + + function Get_Selected_Waveform_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Selected_Waveform_Chain (Target); + return Get_Field7 (Target); + end Get_Selected_Waveform_Chain; + + procedure Set_Selected_Waveform_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Selected_Waveform_Chain (Target); + Set_Field7 (Target, Chain); + end Set_Selected_Waveform_Chain; + + procedure Check_Kind_For_Conditional_Waveform_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + null; + when others => + Failed ("Conditional_Waveform_Chain", Target); + end case; + end Check_Kind_For_Conditional_Waveform_Chain; + + function Get_Conditional_Waveform_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Conditional_Waveform_Chain (Target); + return Get_Field7 (Target); + end Get_Conditional_Waveform_Chain; + + procedure Set_Conditional_Waveform_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Conditional_Waveform_Chain (Target); + Set_Field7 (Target, Chain); + end Set_Conditional_Waveform_Chain; + + procedure Check_Kind_For_Guard_Expression (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Guard_Signal_Declaration => + null; + when others => + Failed ("Guard_Expression", Target); + end case; + end Check_Kind_For_Guard_Expression; + + function Get_Guard_Expression (Target : Iir) return Iir is + begin + Check_Kind_For_Guard_Expression (Target); + return Get_Field2 (Target); + end Get_Guard_Expression; + + procedure Set_Guard_Expression (Target : Iir; Expr : Iir) is + begin + Check_Kind_For_Guard_Expression (Target); + Set_Field2 (Target, Expr); + end Set_Guard_Expression; + + procedure Check_Kind_For_Guard_Decl (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Statement => + null; + when others => + Failed ("Guard_Decl", Target); + end case; + end Check_Kind_For_Guard_Decl; + + function Get_Guard_Decl (Target : Iir_Block_Statement) return Iir is + begin + Check_Kind_For_Guard_Decl (Target); + return Get_Field8 (Target); + end Get_Guard_Decl; + + procedure Set_Guard_Decl (Target : Iir_Block_Statement; Decl : Iir) is + begin + Check_Kind_For_Guard_Decl (Target); + Set_Field8 (Target, Decl); + end Set_Guard_Decl; + + procedure Check_Kind_For_Guard_Sensitivity_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Guard_Signal_Declaration => + null; + when others => + Failed ("Guard_Sensitivity_List", Target); + end case; + end Check_Kind_For_Guard_Sensitivity_List; + + function Get_Guard_Sensitivity_List (Guard : Iir) return Iir_List is + begin + Check_Kind_For_Guard_Sensitivity_List (Guard); + return Iir_To_Iir_List (Get_Field6 (Guard)); + end Get_Guard_Sensitivity_List; + + procedure Set_Guard_Sensitivity_List (Guard : Iir; List : Iir_List) is + begin + Check_Kind_For_Guard_Sensitivity_List (Guard); + Set_Field6 (Guard, Iir_List_To_Iir (List)); + end Set_Guard_Sensitivity_List; + + procedure Check_Kind_For_Block_Block_Configuration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Statement => + null; + when others => + Failed ("Block_Block_Configuration", Target); + end case; + end Check_Kind_For_Block_Block_Configuration; + + function Get_Block_Block_Configuration (Block : Iir) return Iir is + begin + Check_Kind_For_Block_Block_Configuration (Block); + return Get_Field6 (Block); + end Get_Block_Block_Configuration; + + procedure Set_Block_Block_Configuration (Block : Iir; Conf : Iir) is + begin + Check_Kind_For_Block_Block_Configuration (Block); + Set_Field6 (Block, Conf); + end Set_Block_Block_Configuration; + + procedure Check_Kind_For_Block_Header (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Block_Statement => + null; + when others => + Failed ("Block_Header", Target); + end case; + end Check_Kind_For_Block_Header; + + function Get_Block_Header (Target : Iir) return Iir is + begin + Check_Kind_For_Block_Header (Target); + return Get_Field7 (Target); + end Get_Block_Header; + + procedure Set_Block_Header (Target : Iir; Header : Iir) is + begin + Check_Kind_For_Block_Header (Target); + Set_Field7 (Target, Header); + end Set_Block_Header; + + procedure Check_Kind_For_Generate_Block_Configuration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Generate_Statement => + null; + when others => + Failed ("Generate_Block_Configuration", Target); + end case; + end Check_Kind_For_Generate_Block_Configuration; + + function Get_Generate_Block_Configuration (Target : Iir) return Iir is + begin + Check_Kind_For_Generate_Block_Configuration (Target); + return Get_Field7 (Target); + end Get_Generate_Block_Configuration; + + procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir) is + begin + Check_Kind_For_Generate_Block_Configuration (Target); + Set_Field7 (Target, Conf); + end Set_Generate_Block_Configuration; + + procedure Check_Kind_For_Generation_Scheme (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Generate_Statement => + null; + when others => + Failed ("Generation_Scheme", Target); + end case; + end Check_Kind_For_Generation_Scheme; + + function Get_Generation_Scheme (Target : Iir) return Iir is + begin + Check_Kind_For_Generation_Scheme (Target); + return Get_Field6 (Target); + end Get_Generation_Scheme; + + procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir) is + begin + Check_Kind_For_Generation_Scheme (Target); + Set_Field6 (Target, Scheme); + end Set_Generation_Scheme; + + procedure Check_Kind_For_Condition (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Conditional_Waveform + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + null; + when others => + Failed ("Condition", Target); + end case; + end Check_Kind_For_Condition; + + function Get_Condition (Target : Iir) return Iir is + begin + Check_Kind_For_Condition (Target); + return Get_Field1 (Target); + end Get_Condition; + + procedure Set_Condition (Target : Iir; Condition : Iir) is + begin + Check_Kind_For_Condition (Target); + Set_Field1 (Target, Condition); + end Set_Condition; + + procedure Check_Kind_For_Else_Clause (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_If_Statement + | Iir_Kind_Elsif => + null; + when others => + Failed ("Else_Clause", Target); + end case; + end Check_Kind_For_Else_Clause; + + function Get_Else_Clause (Target : Iir) return Iir_Elsif is + begin + Check_Kind_For_Else_Clause (Target); + return Get_Field6 (Target); + end Get_Else_Clause; + + procedure Set_Else_Clause (Target : Iir; Clause : Iir_Elsif) is + begin + Check_Kind_For_Else_Clause (Target); + Set_Field6 (Target, Clause); + end Set_Else_Clause; + + procedure Check_Kind_For_Iterator_Scheme (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_For_Loop_Statement => + null; + when others => + Failed ("Iterator_Scheme", Target); + end case; + end Check_Kind_For_Iterator_Scheme; + + function Get_Iterator_Scheme (Target : Iir) return Iir is + begin + Check_Kind_For_Iterator_Scheme (Target); + return Get_Field1 (Target); + end Get_Iterator_Scheme; + + procedure Set_Iterator_Scheme (Target : Iir; Iterator : Iir) is + begin + Check_Kind_For_Iterator_Scheme (Target); + Set_Field1 (Target, Iterator); + end Set_Iterator_Scheme; + + procedure Check_Kind_For_Parent (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_File + | Iir_Kind_Design_Unit + | Iir_Kind_Library_Clause + | Iir_Kind_Use_Clause + | Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name + | Iir_Kind_Block_Configuration + | Iir_Kind_Component_Configuration + | Iir_Kind_Procedure_Call + | Iir_Kind_Attribute_Specification + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Configuration_Specification + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Procedure_Body + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + null; + when others => + Failed ("Parent", Target); + end case; + end Check_Kind_For_Parent; + + function Get_Parent (Target : Iir) return Iir is + begin + Check_Kind_For_Parent (Target); + return Get_Field0 (Target); + end Get_Parent; + + procedure Set_Parent (Target : Iir; Parent : Iir) is + begin + Check_Kind_For_Parent (Target); + Set_Field0 (Target, Parent); + end Set_Parent; + + procedure Check_Kind_For_Loop (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement => + null; + when others => + Failed ("Loop", Target); + end case; + end Check_Kind_For_Loop; + + function Get_Loop (Target : Iir) return Iir is + begin + Check_Kind_For_Loop (Target); + return Get_Field5 (Target); + end Get_Loop; + + procedure Set_Loop (Target : Iir; Stmt : Iir) is + begin + Check_Kind_For_Loop (Target); + Set_Field5 (Target, Stmt); + end Set_Loop; + + procedure Check_Kind_For_Component_Name (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Component_Configuration + | Iir_Kind_Configuration_Specification => + null; + when others => + Failed ("Component_Name", Target); + end case; + end Check_Kind_For_Component_Name; + + function Get_Component_Name (Target : Iir) return Iir is + begin + Check_Kind_For_Component_Name (Target); + return Get_Field4 (Target); + end Get_Component_Name; + + procedure Set_Component_Name (Target : Iir; Name : Iir) is + begin + Check_Kind_For_Component_Name (Target); + Set_Field4 (Target, Name); + end Set_Component_Name; + + procedure Check_Kind_For_Instantiation_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Component_Configuration + | Iir_Kind_Configuration_Specification => + null; + when others => + Failed ("Instantiation_List", Target); + end case; + end Check_Kind_For_Instantiation_List; + + function Get_Instantiation_List (Target : Iir) return Iir_List is + begin + Check_Kind_For_Instantiation_List (Target); + return Iir_To_Iir_List (Get_Field1 (Target)); + end Get_Instantiation_List; + + procedure Set_Instantiation_List (Target : Iir; List : Iir_List) is + begin + Check_Kind_For_Instantiation_List (Target); + Set_Field1 (Target, Iir_List_To_Iir (List)); + end Set_Instantiation_List; + + procedure Check_Kind_For_Entity_Aspect (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Binding_Indication => + null; + when others => + Failed ("Entity_Aspect", Target); + end case; + end Check_Kind_For_Entity_Aspect; + + function Get_Entity_Aspect (Target : Iir_Binding_Indication) return Iir is + begin + Check_Kind_For_Entity_Aspect (Target); + return Get_Field3 (Target); + end Get_Entity_Aspect; + + procedure Set_Entity_Aspect (Target : Iir_Binding_Indication; Entity : Iir) + is + begin + Check_Kind_For_Entity_Aspect (Target); + Set_Field3 (Target, Entity); + end Set_Entity_Aspect; + + procedure Check_Kind_For_Default_Entity_Aspect (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Binding_Indication => + null; + when others => + Failed ("Default_Entity_Aspect", Target); + end case; + end Check_Kind_For_Default_Entity_Aspect; + + function Get_Default_Entity_Aspect (Target : Iir) return Iir is + begin + Check_Kind_For_Default_Entity_Aspect (Target); + return Get_Field1 (Target); + end Get_Default_Entity_Aspect; + + procedure Set_Default_Entity_Aspect (Target : Iir; Aspect : Iir) is + begin + Check_Kind_For_Default_Entity_Aspect (Target); + Set_Field1 (Target, Aspect); + end Set_Default_Entity_Aspect; + + procedure Check_Kind_For_Default_Generic_Map_Aspect_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Binding_Indication => + null; + when others => + Failed ("Default_Generic_Map_Aspect_Chain", Target); + end case; + end Check_Kind_For_Default_Generic_Map_Aspect_Chain; + + function Get_Default_Generic_Map_Aspect_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Default_Generic_Map_Aspect_Chain (Target); + return Get_Field6 (Target); + end Get_Default_Generic_Map_Aspect_Chain; + + procedure Set_Default_Generic_Map_Aspect_Chain (Target : Iir; Chain : Iir) + is + begin + Check_Kind_For_Default_Generic_Map_Aspect_Chain (Target); + Set_Field6 (Target, Chain); + end Set_Default_Generic_Map_Aspect_Chain; + + procedure Check_Kind_For_Default_Port_Map_Aspect_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Binding_Indication => + null; + when others => + Failed ("Default_Port_Map_Aspect_Chain", Target); + end case; + end Check_Kind_For_Default_Port_Map_Aspect_Chain; + + function Get_Default_Port_Map_Aspect_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Default_Port_Map_Aspect_Chain (Target); + return Get_Field7 (Target); + end Get_Default_Port_Map_Aspect_Chain; + + procedure Set_Default_Port_Map_Aspect_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Default_Port_Map_Aspect_Chain (Target); + Set_Field7 (Target, Chain); + end Set_Default_Port_Map_Aspect_Chain; + + procedure Check_Kind_For_Binding_Indication (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Component_Configuration + | Iir_Kind_Configuration_Specification => + null; + when others => + Failed ("Binding_Indication", Target); + end case; + end Check_Kind_For_Binding_Indication; + + function Get_Binding_Indication (Target : Iir) return Iir is + begin + Check_Kind_For_Binding_Indication (Target); + return Get_Field3 (Target); + end Get_Binding_Indication; + + procedure Set_Binding_Indication (Target : Iir; Binding : Iir) is + begin + Check_Kind_For_Binding_Indication (Target); + Set_Field3 (Target, Binding); + end Set_Binding_Indication; + + procedure Check_Kind_For_Named_Entity (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Operator_Symbol + | Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Attribute_Name => + null; + when others => + Failed ("Named_Entity", Target); + end case; + end Check_Kind_For_Named_Entity; + + function Get_Named_Entity (Target : Iir) return Iir is + begin + Check_Kind_For_Named_Entity (Target); + return Get_Field4 (Target); + end Get_Named_Entity; + + procedure Set_Named_Entity (Target : Iir; Val : Iir) is + begin + Check_Kind_For_Named_Entity (Target); + Set_Field4 (Target, Val); + end Set_Named_Entity; + + procedure Check_Kind_For_Expr_Staticness (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Error + | Iir_Kind_Integer_Literal + | Iir_Kind_Floating_Point_Literal + | Iir_Kind_Null_Literal + | Iir_Kind_String_Literal + | Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal + | Iir_Kind_Bit_String_Literal + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Attribute_Value + | Iir_Kind_Range_Expression + | Iir_Kind_Unit_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Identity_Operator + | Iir_Kind_Negation_Operator + | Iir_Kind_Absolute_Operator + | Iir_Kind_Not_Operator + | Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator + | Iir_Kind_Function_Call + | Iir_Kind_Aggregate + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Simple_Name + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Attribute_Name => + null; + when others => + Failed ("Expr_Staticness", Target); + end case; + end Check_Kind_For_Expr_Staticness; + + function Get_Expr_Staticness (Target : Iir) return Iir_Staticness is + begin + Check_Kind_For_Expr_Staticness (Target); + return Iir_Staticness'Val (Get_State1 (Target)); + end Get_Expr_Staticness; + + procedure Set_Expr_Staticness (Target : Iir; Static : Iir_Staticness) is + begin + Check_Kind_For_Expr_Staticness (Target); + Set_State1 (Target, Iir_Staticness'Pos (Static)); + end Set_Expr_Staticness; + + procedure Check_Kind_For_Error_Origin (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Error => + null; + when others => + Failed ("Error_Origin", Target); + end case; + end Check_Kind_For_Error_Origin; + + function Get_Error_Origin (Target : Iir) return Iir is + begin + Check_Kind_For_Error_Origin (Target); + return Get_Field2 (Target); + end Get_Error_Origin; + + procedure Set_Error_Origin (Target : Iir; Origin : Iir) is + begin + Check_Kind_For_Error_Origin (Target); + Set_Field2 (Target, Origin); + end Set_Error_Origin; + + procedure Check_Kind_For_Operand (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Identity_Operator + | Iir_Kind_Negation_Operator + | Iir_Kind_Absolute_Operator + | Iir_Kind_Not_Operator => + null; + when others => + Failed ("Operand", Target); + end case; + end Check_Kind_For_Operand; + + function Get_Operand (Target : Iir) return Iir is + begin + Check_Kind_For_Operand (Target); + return Get_Field2 (Target); + end Get_Operand; + + procedure Set_Operand (Target : Iir; An_Iir : Iir) is + begin + Check_Kind_For_Operand (Target); + Set_Field2 (Target, An_Iir); + end Set_Operand; + + procedure Check_Kind_For_Left (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator => + null; + when others => + Failed ("Left", Target); + end case; + end Check_Kind_For_Left; + + function Get_Left (Target : Iir) return Iir is + begin + Check_Kind_For_Left (Target); + return Get_Field2 (Target); + end Get_Left; + + procedure Set_Left (Target : Iir; An_Iir : Iir) is + begin + Check_Kind_For_Left (Target); + Set_Field2 (Target, An_Iir); + end Set_Left; + + procedure Check_Kind_For_Right (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator => + null; + when others => + Failed ("Right", Target); + end case; + end Check_Kind_For_Right; + + function Get_Right (Target : Iir) return Iir is + begin + Check_Kind_For_Right (Target); + return Get_Field4 (Target); + end Get_Right; + + procedure Set_Right (Target : Iir; An_Iir : Iir) is + begin + Check_Kind_For_Right (Target); + Set_Field4 (Target, An_Iir); + end Set_Right; + + procedure Check_Kind_For_Unit_Name (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal => + null; + when others => + Failed ("Unit_Name", Target); + end case; + end Check_Kind_For_Unit_Name; + + function Get_Unit_Name (Target : Iir) return Iir is + begin + Check_Kind_For_Unit_Name (Target); + return Get_Field3 (Target); + end Get_Unit_Name; + + procedure Set_Unit_Name (Target : Iir; Name : Iir) is + begin + Check_Kind_For_Unit_Name (Target); + Set_Field3 (Target, Name); + end Set_Unit_Name; + + procedure Check_Kind_For_Name (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Choice_By_Name + | Iir_Kind_Signature + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Object_Alias_Declaration => + null; + when others => + Failed ("Name", Target); + end case; + end Check_Kind_For_Name; + + function Get_Name (Target : Iir) return Iir is + begin + Check_Kind_For_Name (Target); + return Get_Field4 (Target); + end Get_Name; + + procedure Set_Name (Target : Iir; Name : Iir) is + begin + Check_Kind_For_Name (Target); + Set_Field4 (Target, Name); + end Set_Name; + + procedure Check_Kind_For_Group_Template_Name (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Group_Declaration => + null; + when others => + Failed ("Group_Template_Name", Target); + end case; + end Check_Kind_For_Group_Template_Name; + + function Get_Group_Template_Name (Target : Iir) return Iir is + begin + Check_Kind_For_Group_Template_Name (Target); + return Get_Field5 (Target); + end Get_Group_Template_Name; + + procedure Set_Group_Template_Name (Target : Iir; Name : Iir) is + begin + Check_Kind_For_Group_Template_Name (Target); + Set_Field5 (Target, Name); + end Set_Group_Template_Name; + + procedure Check_Kind_For_Name_Staticness (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Attribute_Value + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Function_Call + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute => + null; + when others => + Failed ("Name_Staticness", Target); + end case; + end Check_Kind_For_Name_Staticness; + + function Get_Name_Staticness (Target : Iir) return Iir_Staticness is + begin + Check_Kind_For_Name_Staticness (Target); + return Iir_Staticness'Val (Get_State2 (Target)); + end Get_Name_Staticness; + + procedure Set_Name_Staticness (Target : Iir; Static : Iir_Staticness) is + begin + Check_Kind_For_Name_Staticness (Target); + Set_State2 (Target, Iir_Staticness'Pos (Static)); + end Set_Name_Staticness; + + procedure Check_Kind_For_Prefix (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Base_Attribute + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Attribute_Name => + null; + when others => + Failed ("Prefix", Target); + end case; + end Check_Kind_For_Prefix; + + function Get_Prefix (Target : Iir) return Iir is + begin + Check_Kind_For_Prefix (Target); + return Get_Field3 (Target); + end Get_Prefix; + + procedure Set_Prefix (Target : Iir; Prefix : Iir) is + begin + Check_Kind_For_Prefix (Target); + Set_Field3 (Target, Prefix); + end Set_Prefix; + + procedure Check_Kind_For_Suffix (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Slice_Name => + null; + when others => + Failed ("Suffix", Target); + end case; + end Check_Kind_For_Suffix; + + function Get_Suffix (Target : Iir) return Iir is + begin + Check_Kind_For_Suffix (Target); + return Get_Field2 (Target); + end Get_Suffix; + + procedure Set_Suffix (Target : Iir; Suffix : Iir) is + begin + Check_Kind_For_Suffix (Target); + Set_Field2 (Target, Suffix); + end Set_Suffix; + + procedure Check_Kind_For_Parameter (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute => + null; + when others => + Failed ("Parameter", Target); + end case; + end Check_Kind_For_Parameter; + + function Get_Parameter (Target : Iir) return Iir is + begin + Check_Kind_For_Parameter (Target); + return Get_Field4 (Target); + end Get_Parameter; + + procedure Set_Parameter (Target : Iir; Param : Iir) is + begin + Check_Kind_For_Parameter (Target); + Set_Field4 (Target, Param); + end Set_Parameter; + + procedure Check_Kind_For_Actual_Type (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Association_Element_By_Individual => + null; + when others => + Failed ("Actual_Type", Target); + end case; + end Check_Kind_For_Actual_Type; + + function Get_Actual_Type (Target : Iir) return Iir is + begin + Check_Kind_For_Actual_Type (Target); + return Get_Field3 (Target); + end Get_Actual_Type; + + procedure Set_Actual_Type (Target : Iir; Atype : Iir) is + begin + Check_Kind_For_Actual_Type (Target); + Set_Field3 (Target, Atype); + end Set_Actual_Type; + + procedure Check_Kind_For_Association_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Parenthesis_Name => + null; + when others => + Failed ("Association_Chain", Target); + end case; + end Check_Kind_For_Association_Chain; + + function Get_Association_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Association_Chain (Target); + return Get_Field2 (Target); + end Get_Association_Chain; + + procedure Set_Association_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Association_Chain (Target); + Set_Field2 (Target, Chain); + end Set_Association_Chain; + + procedure Check_Kind_For_Individual_Association_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Association_Element_By_Individual => + null; + when others => + Failed ("Individual_Association_Chain", Target); + end case; + end Check_Kind_For_Individual_Association_Chain; + + function Get_Individual_Association_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Individual_Association_Chain (Target); + return Get_Field4 (Target); + end Get_Individual_Association_Chain; + + procedure Set_Individual_Association_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Individual_Association_Chain (Target); + Set_Field4 (Target, Chain); + end Set_Individual_Association_Chain; + + procedure Check_Kind_For_Aggregate_Info (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate => + null; + when others => + Failed ("Aggregate_Info", Target); + end case; + end Check_Kind_For_Aggregate_Info; + + function Get_Aggregate_Info (Target : Iir) return Iir_Aggregate_Info is + begin + Check_Kind_For_Aggregate_Info (Target); + return Get_Field2 (Target); + end Get_Aggregate_Info; + + procedure Set_Aggregate_Info (Target : Iir; Info : Iir_Aggregate_Info) is + begin + Check_Kind_For_Aggregate_Info (Target); + Set_Field2 (Target, Info); + end Set_Aggregate_Info; + + procedure Check_Kind_For_Sub_Aggregate_Info (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate_Info => + null; + when others => + Failed ("Sub_Aggregate_Info", Target); + end case; + end Check_Kind_For_Sub_Aggregate_Info; + + function Get_Sub_Aggregate_Info (Target : Iir) return Iir_Aggregate_Info is + begin + Check_Kind_For_Sub_Aggregate_Info (Target); + return Get_Field1 (Target); + end Get_Sub_Aggregate_Info; + + procedure Set_Sub_Aggregate_Info (Target : Iir; Info : Iir_Aggregate_Info) + is + begin + Check_Kind_For_Sub_Aggregate_Info (Target); + Set_Field1 (Target, Info); + end Set_Sub_Aggregate_Info; + + procedure Check_Kind_For_Aggr_Dynamic_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate_Info => + null; + when others => + Failed ("Aggr_Dynamic_Flag", Target); + end case; + end Check_Kind_For_Aggr_Dynamic_Flag; + + function Get_Aggr_Dynamic_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Aggr_Dynamic_Flag (Target); + return Get_Flag3 (Target); + end Get_Aggr_Dynamic_Flag; + + procedure Set_Aggr_Dynamic_Flag (Target : Iir; Val : Boolean) is + begin + Check_Kind_For_Aggr_Dynamic_Flag (Target); + Set_Flag3 (Target, Val); + end Set_Aggr_Dynamic_Flag; + + procedure Check_Kind_For_Aggr_Max_Length (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate_Info => + null; + when others => + Failed ("Aggr_Max_Length", Target); + end case; + end Check_Kind_For_Aggr_Max_Length; + + function Get_Aggr_Max_Length (Info : Iir_Aggregate_Info) return Iir_Int32 + is + begin + Check_Kind_For_Aggr_Max_Length (Info); + return Iir_To_Iir_Int32 (Get_Field4 (Info)); + end Get_Aggr_Max_Length; + + procedure Set_Aggr_Max_Length (Info : Iir_Aggregate_Info; Nbr : Iir_Int32) + is + begin + Check_Kind_For_Aggr_Max_Length (Info); + Set_Field4 (Info, Iir_Int32_To_Iir (Nbr)); + end Set_Aggr_Max_Length; + + procedure Check_Kind_For_Aggr_Low_Limit (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate_Info => + null; + when others => + Failed ("Aggr_Low_Limit", Target); + end case; + end Check_Kind_For_Aggr_Low_Limit; + + function Get_Aggr_Low_Limit (Target : Iir_Aggregate_Info) return Iir is + begin + Check_Kind_For_Aggr_Low_Limit (Target); + return Get_Field2 (Target); + end Get_Aggr_Low_Limit; + + procedure Set_Aggr_Low_Limit (Target : Iir_Aggregate_Info; Limit : Iir) is + begin + Check_Kind_For_Aggr_Low_Limit (Target); + Set_Field2 (Target, Limit); + end Set_Aggr_Low_Limit; + + procedure Check_Kind_For_Aggr_High_Limit (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate_Info => + null; + when others => + Failed ("Aggr_High_Limit", Target); + end case; + end Check_Kind_For_Aggr_High_Limit; + + function Get_Aggr_High_Limit (Target : Iir_Aggregate_Info) return Iir is + begin + Check_Kind_For_Aggr_High_Limit (Target); + return Get_Field3 (Target); + end Get_Aggr_High_Limit; + + procedure Set_Aggr_High_Limit (Target : Iir_Aggregate_Info; Limit : Iir) is + begin + Check_Kind_For_Aggr_High_Limit (Target); + Set_Field3 (Target, Limit); + end Set_Aggr_High_Limit; + + procedure Check_Kind_For_Aggr_Others_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate_Info => + null; + when others => + Failed ("Aggr_Others_Flag", Target); + end case; + end Check_Kind_For_Aggr_Others_Flag; + + function Get_Aggr_Others_Flag (Target : Iir_Aggregate_Info) return Boolean + is + begin + Check_Kind_For_Aggr_Others_Flag (Target); + return Get_Flag2 (Target); + end Get_Aggr_Others_Flag; + + procedure Set_Aggr_Others_Flag (Target : Iir_Aggregate_Info; Val : Boolean) + is + begin + Check_Kind_For_Aggr_Others_Flag (Target); + Set_Flag2 (Target, Val); + end Set_Aggr_Others_Flag; + + procedure Check_Kind_For_Aggr_Named_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate_Info => + null; + when others => + Failed ("Aggr_Named_Flag", Target); + end case; + end Check_Kind_For_Aggr_Named_Flag; + + function Get_Aggr_Named_Flag (Target : Iir_Aggregate_Info) return Boolean + is + begin + Check_Kind_For_Aggr_Named_Flag (Target); + return Get_Flag4 (Target); + end Get_Aggr_Named_Flag; + + procedure Set_Aggr_Named_Flag (Target : Iir_Aggregate_Info; Val : Boolean) + is + begin + Check_Kind_For_Aggr_Named_Flag (Target); + Set_Flag4 (Target, Val); + end Set_Aggr_Named_Flag; + + procedure Check_Kind_For_Value_Staticness (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate => + null; + when others => + Failed ("Value_Staticness", Target); + end case; + end Check_Kind_For_Value_Staticness; + + function Get_Value_Staticness (Target : Iir) return Iir_Staticness is + begin + Check_Kind_For_Value_Staticness (Target); + return Iir_Staticness'Val (Get_State2 (Target)); + end Get_Value_Staticness; + + procedure Set_Value_Staticness (Target : Iir; Staticness : Iir_Staticness) + is + begin + Check_Kind_For_Value_Staticness (Target); + Set_State2 (Target, Iir_Staticness'Pos (Staticness)); + end Set_Value_Staticness; + + procedure Check_Kind_For_Association_Choices_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate => + null; + when others => + Failed ("Association_Choices_Chain", Target); + end case; + end Check_Kind_For_Association_Choices_Chain; + + function Get_Association_Choices_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Association_Choices_Chain (Target); + return Get_Field4 (Target); + end Get_Association_Choices_Chain; + + procedure Set_Association_Choices_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Association_Choices_Chain (Target); + Set_Field4 (Target, Chain); + end Set_Association_Choices_Chain; + + procedure Check_Kind_For_Case_Statement_Alternative_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Case_Statement => + null; + when others => + Failed ("Case_Statement_Alternative_Chain", Target); + end case; + end Check_Kind_For_Case_Statement_Alternative_Chain; + + function Get_Case_Statement_Alternative_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Case_Statement_Alternative_Chain (Target); + return Get_Field1 (Target); + end Get_Case_Statement_Alternative_Chain; + + procedure Set_Case_Statement_Alternative_Chain (Target : Iir; Chain : Iir) + is + begin + Check_Kind_For_Case_Statement_Alternative_Chain (Target); + Set_Field1 (Target, Chain); + end Set_Case_Statement_Alternative_Chain; + + procedure Check_Kind_For_Choice_Staticness (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range => + null; + when others => + Failed ("Choice_Staticness", Target); + end case; + end Check_Kind_For_Choice_Staticness; + + function Get_Choice_Staticness (Target : Iir) return Iir_Staticness is + begin + Check_Kind_For_Choice_Staticness (Target); + return Iir_Staticness'Val (Get_State2 (Target)); + end Get_Choice_Staticness; + + procedure Set_Choice_Staticness (Target : Iir; Staticness : Iir_Staticness) + is + begin + Check_Kind_For_Choice_Staticness (Target); + Set_State2 (Target, Iir_Staticness'Pos (Staticness)); + end Set_Choice_Staticness; + + procedure Check_Kind_For_Procedure_Call (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Procedure_Call_Statement => + null; + when others => + Failed ("Procedure_Call", Target); + end case; + end Check_Kind_For_Procedure_Call; + + function Get_Procedure_Call (Stmt : Iir) return Iir is + begin + Check_Kind_For_Procedure_Call (Stmt); + return Get_Field1 (Stmt); + end Get_Procedure_Call; + + procedure Set_Procedure_Call (Stmt : Iir; Call : Iir) is + begin + Check_Kind_For_Procedure_Call (Stmt); + Set_Field1 (Stmt, Call); + end Set_Procedure_Call; + + procedure Check_Kind_For_Implementation (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Procedure_Call + | Iir_Kind_Identity_Operator + | Iir_Kind_Negation_Operator + | Iir_Kind_Absolute_Operator + | Iir_Kind_Not_Operator + | Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator + | Iir_Kind_Function_Call => + null; + when others => + Failed ("Implementation", Target); + end case; + end Check_Kind_For_Implementation; + + function Get_Implementation (Target : Iir) return Iir is + begin + Check_Kind_For_Implementation (Target); + return Get_Field3 (Target); + end Get_Implementation; + + procedure Set_Implementation (Target : Iir; Decl : Iir) is + begin + Check_Kind_For_Implementation (Target); + Set_Field3 (Target, Decl); + end Set_Implementation; + + procedure Check_Kind_For_Parameter_Association_Chain (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Procedure_Call + | Iir_Kind_Function_Call => + null; + when others => + Failed ("Parameter_Association_Chain", Target); + end case; + end Check_Kind_For_Parameter_Association_Chain; + + function Get_Parameter_Association_Chain (Target : Iir) return Iir is + begin + Check_Kind_For_Parameter_Association_Chain (Target); + return Get_Field2 (Target); + end Get_Parameter_Association_Chain; + + procedure Set_Parameter_Association_Chain (Target : Iir; Chain : Iir) is + begin + Check_Kind_For_Parameter_Association_Chain (Target); + Set_Field2 (Target, Chain); + end Set_Parameter_Association_Chain; + + procedure Check_Kind_For_Method_Object (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Procedure_Call + | Iir_Kind_Function_Call => + null; + when others => + Failed ("Method_Object", Target); + end case; + end Check_Kind_For_Method_Object; + + function Get_Method_Object (Target : Iir) return Iir is + begin + Check_Kind_For_Method_Object (Target); + return Get_Field4 (Target); + end Get_Method_Object; + + procedure Set_Method_Object (Target : Iir; Object : Iir) is + begin + Check_Kind_For_Method_Object (Target); + Set_Field4 (Target, Object); + end Set_Method_Object; + + procedure Check_Kind_For_Type_Mark (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_File_Type_Definition + | Iir_Kind_Unconstrained_Array_Subtype_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Subtype_Definition + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion => + null; + when others => + Failed ("Type_Mark", Target); + end case; + end Check_Kind_For_Type_Mark; + + function Get_Type_Mark (Target : Iir) return Iir is + begin + Check_Kind_For_Type_Mark (Target); + return Get_Field2 (Target); + end Get_Type_Mark; + + procedure Set_Type_Mark (Target : Iir; Mark : Iir) is + begin + Check_Kind_For_Type_Mark (Target); + Set_Field2 (Target, Mark); + end Set_Type_Mark; + + procedure Check_Kind_For_Lexical_Layout (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => + null; + when others => + Failed ("Lexical_Layout", Target); + end case; + end Check_Kind_For_Lexical_Layout; + + function Get_Lexical_Layout (Decl : Iir) return Iir_Lexical_Layout_Type is + begin + Check_Kind_For_Lexical_Layout (Decl); + return Iir_Lexical_Layout_Type'Val (Get_Odigit1 (Decl)); + end Get_Lexical_Layout; + + procedure Set_Lexical_Layout (Decl : Iir; Lay : Iir_Lexical_Layout_Type) is + begin + Check_Kind_For_Lexical_Layout (Decl); + Set_Odigit1 (Decl, Iir_Lexical_Layout_Type'Pos (Lay)); + end Set_Lexical_Layout; + + procedure Check_Kind_For_Incomplete_Type_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Incomplete_Type_Definition => + null; + when others => + Failed ("Incomplete_Type_List", Target); + end case; + end Check_Kind_For_Incomplete_Type_List; + + function Get_Incomplete_Type_List (Target : Iir) return Iir_List is + begin + Check_Kind_For_Incomplete_Type_List (Target); + return Iir_To_Iir_List (Get_Field2 (Target)); + end Get_Incomplete_Type_List; + + procedure Set_Incomplete_Type_List (Target : Iir; List : Iir_List) is + begin + Check_Kind_For_Incomplete_Type_List (Target); + Set_Field2 (Target, Iir_List_To_Iir (List)); + end Set_Incomplete_Type_List; + + procedure Check_Kind_For_Has_Disconnect_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Signal_Declaration + | Iir_Kind_Signal_Interface_Declaration => + null; + when others => + Failed ("Has_Disconnect_Flag", Target); + end case; + end Check_Kind_For_Has_Disconnect_Flag; + + function Get_Has_Disconnect_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Has_Disconnect_Flag (Target); + return Get_Flag1 (Target); + end Get_Has_Disconnect_Flag; + + procedure Set_Has_Disconnect_Flag (Target : Iir; Val : Boolean) is + begin + Check_Kind_For_Has_Disconnect_Flag (Target); + Set_Flag1 (Target, Val); + end Set_Has_Disconnect_Flag; + + procedure Check_Kind_For_Has_Active_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute => + null; + when others => + Failed ("Has_Active_Flag", Target); + end case; + end Check_Kind_For_Has_Active_Flag; + + function Get_Has_Active_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Has_Active_Flag (Target); + return Get_Flag2 (Target); + end Get_Has_Active_Flag; + + procedure Set_Has_Active_Flag (Target : Iir; Val : Boolean) is + begin + Check_Kind_For_Has_Active_Flag (Target); + Set_Flag2 (Target, Val); + end Set_Has_Active_Flag; + + procedure Check_Kind_For_Is_Within_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_For_Loop_Statement => + null; + when others => + Failed ("Is_Within_Flag", Target); + end case; + end Check_Kind_For_Is_Within_Flag; + + function Get_Is_Within_Flag (Target : Iir) return Boolean is + begin + Check_Kind_For_Is_Within_Flag (Target); + return Get_Flag5 (Target); + end Get_Is_Within_Flag; + + procedure Set_Is_Within_Flag (Target : Iir; Val : Boolean) is + begin + Check_Kind_For_Is_Within_Flag (Target); + Set_Flag5 (Target, Val); + end Set_Is_Within_Flag; + + procedure Check_Kind_For_Type_Marks_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Signature => + null; + when others => + Failed ("Type_Marks_List", Target); + end case; + end Check_Kind_For_Type_Marks_List; + + function Get_Type_Marks_List (Target : Iir) return Iir_List is + begin + Check_Kind_For_Type_Marks_List (Target); + return Iir_To_Iir_List (Get_Field2 (Target)); + end Get_Type_Marks_List; + + procedure Set_Type_Marks_List (Target : Iir; List : Iir_List) is + begin + Check_Kind_For_Type_Marks_List (Target); + Set_Field2 (Target, Iir_List_To_Iir (List)); + end Set_Type_Marks_List; + + procedure Check_Kind_For_Signature (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Attribute_Name => + null; + when others => + Failed ("Signature", Target); + end case; + end Check_Kind_For_Signature; + + function Get_Signature (Target : Iir) return Iir is + begin + Check_Kind_For_Signature (Target); + return Get_Field5 (Target); + end Get_Signature; + + procedure Set_Signature (Target : Iir; Value : Iir) is + begin + Check_Kind_For_Signature (Target); + Set_Field5 (Target, Value); + end Set_Signature; + + procedure Check_Kind_For_Overload_List (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Overload_List => + null; + when others => + Failed ("Overload_List", Target); + end case; + end Check_Kind_For_Overload_List; + + function Get_Overload_List (Target : Iir) return Iir_List is + begin + Check_Kind_For_Overload_List (Target); + return Iir_To_Iir_List (Get_Field1 (Target)); + end Get_Overload_List; + + procedure Set_Overload_List (Target : Iir; List : Iir_List) is + begin + Check_Kind_For_Overload_List (Target); + Set_Field1 (Target, Iir_List_To_Iir (List)); + end Set_Overload_List; + + procedure Check_Kind_For_Simple_Name_Identifier (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Simple_Name_Attribute => + null; + when others => + Failed ("Simple_Name_Identifier", Target); + end case; + end Check_Kind_For_Simple_Name_Identifier; + + function Get_Simple_Name_Identifier (Target : Iir) return Name_Id is + begin + Check_Kind_For_Simple_Name_Identifier (Target); + return Iir_To_Name_Id (Get_Field2 (Target)); + end Get_Simple_Name_Identifier; + + procedure Set_Simple_Name_Identifier (Target : Iir; Ident : Name_Id) is + begin + Check_Kind_For_Simple_Name_Identifier (Target); + Set_Field2 (Target, Name_Id_To_Iir (Ident)); + end Set_Simple_Name_Identifier; + + procedure Check_Kind_For_Protected_Type_Body (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Protected_Type_Declaration => + null; + when others => + Failed ("Protected_Type_Body", Target); + end case; + end Check_Kind_For_Protected_Type_Body; + + function Get_Protected_Type_Body (Target : Iir) return Iir is + begin + Check_Kind_For_Protected_Type_Body (Target); + return Get_Field2 (Target); + end Get_Protected_Type_Body; + + procedure Set_Protected_Type_Body (Target : Iir; Bod : Iir) is + begin + Check_Kind_For_Protected_Type_Body (Target); + Set_Field2 (Target, Bod); + end Set_Protected_Type_Body; + + procedure Check_Kind_For_Protected_Type_Declaration (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Protected_Type_Body => + null; + when others => + Failed ("Protected_Type_Declaration", Target); + end case; + end Check_Kind_For_Protected_Type_Declaration; + + function Get_Protected_Type_Declaration (Target : Iir) return Iir is + begin + Check_Kind_For_Protected_Type_Declaration (Target); + return Get_Field4 (Target); + end Get_Protected_Type_Declaration; + + procedure Set_Protected_Type_Declaration (Target : Iir; Decl : Iir) is + begin + Check_Kind_For_Protected_Type_Declaration (Target); + Set_Field4 (Target, Decl); + end Set_Protected_Type_Declaration; + + procedure Check_Kind_For_End_Location (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Design_Unit => + null; + when others => + Failed ("End_Location", Target); + end case; + end Check_Kind_For_End_Location; + + function Get_End_Location (Target : Iir) return Location_Type is + begin + Check_Kind_For_End_Location (Target); + return Iir_To_Location_Type (Get_Field6 (Target)); + end Get_End_Location; + + procedure Set_End_Location (Target : Iir; Loc : Location_Type) is + begin + Check_Kind_For_End_Location (Target); + Set_Field6 (Target, Location_Type_To_Iir (Loc)); + end Set_End_Location; + + procedure Check_Kind_For_String_Id (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_String_Literal + | Iir_Kind_Bit_String_Literal => + null; + when others => + Failed ("String_Id", Target); + end case; + end Check_Kind_For_String_Id; + + function Get_String_Id (Lit : Iir) return String_Id is + begin + Check_Kind_For_String_Id (Lit); + return Iir_To_String_Id (Get_Field3 (Lit)); + end Get_String_Id; + + procedure Set_String_Id (Lit : Iir; Id : String_Id) is + begin + Check_Kind_For_String_Id (Lit); + Set_Field3 (Lit, String_Id_To_Iir (Id)); + end Set_String_Id; + + procedure Check_Kind_For_String_Length (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_String_Literal + | Iir_Kind_Bit_String_Literal => + null; + when others => + Failed ("String_Length", Target); + end case; + end Check_Kind_For_String_Length; + + function Get_String_Length (Lit : Iir) return Int32 is + begin + Check_Kind_For_String_Length (Lit); + return Iir_To_Int32 (Get_Field0 (Lit)); + end Get_String_Length; + + procedure Set_String_Length (Lit : Iir; Len : Int32) is + begin + Check_Kind_For_String_Length (Lit); + Set_Field0 (Lit, Int32_To_Iir (Len)); + end Set_String_Length; + + procedure Check_Kind_For_Use_Flag (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => + null; + when others => + Failed ("Use_Flag", Target); + end case; + end Check_Kind_For_Use_Flag; + + function Get_Use_Flag (Decl : Iir) return Boolean is + begin + Check_Kind_For_Use_Flag (Decl); + return Get_Flag6 (Decl); + end Get_Use_Flag; + + procedure Set_Use_Flag (Decl : Iir; Val : Boolean) is + begin + Check_Kind_For_Use_Flag (Decl); + Set_Flag6 (Decl, Val); + end Set_Use_Flag; + +end Iirs; diff --git a/iirs.adb.in b/iirs.adb.in new file mode 100644 index 000000000..3af6920a4 --- /dev/null +++ b/iirs.adb.in @@ -0,0 +1,316 @@ +-- Tree node definitions. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Unchecked_Deallocation; +with Ada.Unchecked_Conversion; +with Ada.Text_IO; +with Errorout; use Errorout; +with Nodes; use Nodes; +with Lists; use Lists; + +package body Iirs is + function Is_Null (Node : Iir) return Boolean is + begin + return Node = Null_Iir; + end Is_Null; + + function Is_Null_List (Node : Iir_List) return Boolean is + begin + return Node = Null_Iir_List; + end Is_Null_List; + + --------------------------------------------------- + -- General subprograms that operate on every iir -- + --------------------------------------------------- + + -- This is the procedure to call when an internal consistancy test has + -- failed. + -- The main idea is the consistancy test *MUST* have no side effect, + -- except calling this procedure. To speed up, this procedure could + -- be a no-op. + procedure Failed (Func: String := ""; Node : Iir := Null_Iir) + is + begin + if Func /= "" then + Error_Kind (Func, Node); + end if; + raise Internal_Error; + end Failed; + + function Get_Format (Kind : Iir_Kind) return Format_Type; + + -- Statistics. + procedure Disp_Stats + is + use Ada.Text_IO; + type Num_Array is array (Iir_Kind) of Natural; + Num : Num_Array := (others => 0); + type Format_Array is array (Format_Type) of Natural; + Formats : Format_Array := (others => 0); + Kind : Iir_Kind; + I : Iir; + Last_I : Iir; + Format : Format_Type; + begin + I := Error_Node + 1; + Last_I := Get_Last_Node; + while I < Last_I loop + Kind := Get_Kind (I); + Num (Kind) := Num (Kind) + 1; + Format := Get_Format (Kind); + Formats (Format) := Formats (Format) + 1; + case Format is + when Format_Medium => + I := I + 2; + when Format_Short + | Format_Fp + | Format_Int => + I := I + 1; + end case; + end loop; + + Put_Line ("Stats per iir_kind:"); + for J in Iir_Kind loop + if Num (J) /= 0 then + Put_Line (' ' & Iir_Kind'Image (J) & ':' + & Natural'Image (Num (J))); + end if; + end loop; + Put_Line ("Stats per formats:"); + for J in Format_Type loop + Put_Line (' ' & Format_Type'Image (J) & ':' + & Natural'Image (Formats (J))); + end loop; + end Disp_Stats; + + function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions) + return Boolean is + begin + case Func is + when Iir_Predefined_Bit_And + | Iir_Predefined_Bit_Or + | Iir_Predefined_Bit_Nand + | Iir_Predefined_Bit_Nor + | Iir_Predefined_Boolean_And + | Iir_Predefined_Boolean_Or + | Iir_Predefined_Boolean_Nand + | Iir_Predefined_Boolean_Nor => + return True; + when others => + return False; + end case; + end Iir_Predefined_Shortcut_P; + + function Create_Proxy (Proxy: Iir) return Iir_Proxy is + Res : Iir_Proxy; + begin + Res := Create_Iir (Iir_Kind_Proxy); + Set_Proxy (Res, Proxy); + return Res; + end Create_Proxy; + + -- + + function Create_Iir_Error return Iir + is + Res : Iir; + begin + Res := Create_Node (Format_Short); + Set_Nkind (Res, Iir_Kind'Pos (Iir_Kind_Error)); + Set_Base_Type (Res, Res); + return Res; + end Create_Iir_Error; + + procedure Location_Copy (Target: Iir; Src: Iir) is + begin + Set_Location (Target, Get_Location (Src)); + end Location_Copy; + + -- Get kind + function Get_Kind (An_Iir: Iir) return Iir_Kind + is + -- Speed up: avoid to check that nkind is in the bounds of Iir_Kind. + pragma Suppress (Range_Check); + begin + return Iir_Kind'Val (Get_Nkind (An_Iir)); + end Get_Kind; + +-- function Clone_Iir (Src : Iir; New_Kind : Iir_Kind) return Iir +-- is +-- Res : Iir; +-- begin +-- Res := new Iir_Node (New_Kind); +-- Res.Flag1 := Src.Flag1; +-- Res.Flag2 := Src.Flag2; +-- Res.Flag3 := Src.Flag3; +-- Res.Flag4 := Src.Flag4; +-- Res.Flag5 := Src.Flag5; +-- Res.Flag6 := Src.Flag6; +-- Res.Flag7 := Src.Flag7; +-- Res.Flag8 := Src.Flag8; +-- Res.State1 := Src.State1; +-- Res.State2 := Src.State2; +-- Res.State3 := Src.State3; +-- Res.Staticness1 := Src.Staticness1; +-- Res.Staticness2 := Src.Staticness2; +-- Res.Odigit1 := Src.Odigit1; +-- Res.Odigit2 := Src.Odigit2; +-- Res.Location := Src.Location; +-- Res.Back_End_Info := Src.Back_End_Info; +-- Res.Identifier := Src.Identifier; +-- Res.Field1 := Src.Field1; +-- Res.Field2 := Src.Field2; +-- Res.Field3 := Src.Field3; +-- Res.Field4 := Src.Field4; +-- Res.Field5 := Src.Field5; +-- Res.Nbr2 := Src.Nbr2; +-- Res.Nbr3 := Src.Nbr3; + +-- Src.Identifier := Null_Identifier; +-- Src.Field1 := null; +-- Src.Field2 := null; +-- Src.Field3 := null; +-- Src.Field4 := null; +-- Src.Field5 := null; +-- return Res; +-- end Clone_Iir; + + + ----------------- + -- design file -- + ----------------- + + -- Iir_Design_File + +-- type Int_Access_Type is new Integer; +-- for Int_Access_Type'Size use System.Word_Size; --Iir_Identifier_Acc'Size; + + -- Safe conversions. +-- function Iir_To_Int_Access_Type is +-- new Ada.Unchecked_Conversion (Source => Iir, +-- Target => Int_Access_Type); +-- function Int_Access_Type_To_Iir is +-- new Ada.Unchecked_Conversion (Source => Int_Access_Type, +-- Target => Iir); + +-- function To_Iir (V : Integer) return Iir is +-- begin +-- return Int_Access_Type_To_Iir (Int_Access_Type (V)); +-- end To_Iir; + +-- function To_Integer (N : Iir) return Integer is +-- begin +-- return Integer (Iir_To_Int_Access_Type (N)); +-- end To_Integer; + + procedure Set_Pos_Line_Off (Design_Unit: Iir_Design_Unit; + Pos : Source_Ptr; Line, Off: Natural) is + begin + Set_Field1 (Design_Unit, Node_Type (Pos)); + Set_Field11 (Design_Unit, Node_Type (Off)); + Set_Field12 (Design_Unit, Node_Type (Line)); + end Set_Pos_Line_Off; + + procedure Get_Pos_Line_Off (Design_Unit: Iir_Design_Unit; + Pos : out Source_Ptr; Line, Off: out Natural) is + begin + Pos := Source_Ptr (Get_Field1 (Design_Unit)); + Off := Natural (Get_Field11 (Design_Unit)); + Line := Natural (Get_Field12 (Design_Unit)); + end Get_Pos_Line_Off; + + ----------- + -- Lists -- + ----------- + -- Layout of lists: + -- A list is stored into an IIR. + -- There are two bounds for a list: + -- the current number of elements + -- the maximum number of elements. + -- Using a maximum number of element bound (which can be increased) avoid + -- to reallocating memory at each insertion. + + function Time_Stamp_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => Time_Stamp_Id, Target => Iir); + + function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => Time_Stamp_Id); + + function Iir_To_Iir_List is new Ada.Unchecked_Conversion + (Source => Iir, Target => Iir_List); + function Iir_List_To_Iir is new Ada.Unchecked_Conversion + (Source => Iir_List, Target => Iir); + + function Iir_To_Token_Type (N : Iir) return Token_Type is + begin + return Token_Type'Val (N); + end Iir_To_Token_Type; + + function Token_Type_To_Iir (T : Token_Type) return Iir is + begin + return Token_Type'Pos (T); + end Token_Type_To_Iir; + + function Iir_To_Iir_Index32 (N : Iir) return Iir_Index32 is + begin + return Iir_Index32 (N); + end Iir_To_Iir_Index32; + + function Iir_Index32_To_Iir (V : Iir_Index32) return Iir is + begin + return Iir_Index32'Pos (V); + end Iir_Index32_To_Iir; + + function Iir_To_Name_Id (N : Iir) return Name_Id is + begin + return Iir'Pos (N); + end Iir_To_Name_Id; + pragma Inline (Iir_To_Name_Id); + + function Name_Id_To_Iir (V : Name_Id) return Iir is + begin + return Name_Id'Pos (V); + end Name_Id_To_Iir; + + function Iir_To_Iir_Int32 is new Ada.Unchecked_Conversion + (Source => Iir, Target => Iir_Int32); + + function Iir_Int32_To_Iir is new Ada.Unchecked_Conversion + (Source => Iir_Int32, Target => Iir); + + function Iir_To_Location_Type (N : Iir) return Location_Type is + begin + return Location_Type (N); + end Iir_To_Location_Type; + + function Location_Type_To_Iir (L : Location_Type) return Iir is + begin + return Iir (L); + end Location_Type_To_Iir; + + function Iir_To_String_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => String_Id); + function String_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => String_Id, Target => Iir); + + function Iir_To_Int32 is new Ada.Unchecked_Conversion + (Source => Iir, Target => Int32); + function Int32_To_Iir is new Ada.Unchecked_Conversion + (Source => Int32, Target => Iir); + + -- Subprograms +end Iirs; diff --git a/iirs.ads b/iirs.ads new file mode 100644 index 000000000..cdf471324 --- /dev/null +++ b/iirs.ads @@ -0,0 +1,4920 @@ +-- Tree node definitions. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Unchecked_Deallocation; +with Types; use Types; +with Tokens; use Tokens; +with Nodes; +with Lists; + +package Iirs is + -- This package defines the semantic tree and functions to handle it. + -- The tree is roughly based on IIR (Internal Intermediate Representation), + -- [AIRE/CE Advanced Intermediate Representation with Extensibility, + -- Common Environment. http://www.vhdl.org/aire/index.html ] + -- but oriented object features are not used, and sometimes, functions + -- or fields have changed. + + -- Note: this tree is also used during syntaxic analysis, but with + -- a little bit different meanings for the fields. + -- The parser (parse package) build the tree. + -- The semantic pass (sem, sem_expr, sem_name) transforms it into a + -- semantic tree. + + -- Documentation: + -- Only the semantic aspect is to be fully documented. + -- The syntaxic aspect is only used between parse and sem. + + -- Each node of the tree is a record of type iir. The record has only + -- one discriminent, which contains the kind of the node. There is + -- currenlty no variant (but this can change, this is not public). + + -- The root of a semantic tree is a library_declaration. + -- All the library_declarations are kept in a private list, held by + -- package libraries. + -- Exemple of a tree: + -- library_declaration + -- +-- design_file + -- +-- design_unit + -- | +-- entity_declaration + -- +-- design_unit + -- +-- architecture_declaration + -- ... + + -- Since the tree can represent all the libraries and their contents, it + -- is not always loaded into memory. + -- When a library is loaded, only library_declaration, design_file, + -- design_unit and library_unit nodes are created. When a design_unit is + -- really loaded, the design_unit node is not replaced but modified (ie, + -- access to this node are still valid). + + -- To add a new kind of node: + -- the name should be of the form iir_kind_NAME + -- add iir_kind_NAME in the definition of type iir_kind_type + -- add a declaration of access type of name iir_kind_NAME_acc + -- document the node below: grammar, methods. + -- for each methods, add the name if the case statement in the body + -- (this enables the methods) + -- add an entry in create_iir and free_iir + -- add an entry in disp_tree (debugging) + + ------------------------------------------------- + -- General methods (can be used on all nodes): -- + ------------------------------------------------- + + -- Create a node of kind KIND. + -- function Create_Iir (Kind: Iir_Kind) return Iir; + -- + -- Deallocate a node. Deallocate fields that where allocated by create_iir. + -- procedure Free_Iir (Target: in out Iir); + -- + -- Get the kind of the iir. + -- See below for the (public) list of kinds. + -- function Get_Kind (An_Iir: Iir) return Iir_Kind; + + -- Get the location of the node: ie the current position in the source + -- file when the node was created. This is a little bit fuzzy. + -- + -- procedure Set_Location (Target: in out Iir; Location: Location_Type); + -- function Get_Location (Target: in out Iir) return Location_Type; + -- + -- function Get_Line_Number (Target: Iir) return Natural; + -- function Get_Column_Number (Target: Iir) return natural; + -- function Get_File_Name (Target: in Iir) return name_id; + -- + -- Copy a location from a node to another one. + -- procedure Location_Copy (Target: in out Iir; Src: in Iir); + + -- Get or Set info for a back-end. + -- function Get_Back_End_Info (Target: in Iir) return System.Address; + -- procedure Set_Back_End_Info (Target: in out Iir; Addr: System.Address); + + + -- The next line marks the start of the node description. + -- Start of Iir_Kind. + + ------------------------------------------------- + -- A set of methods are associed with a kind. -- + ------------------------------------------------- + + -- Iir_Kind_Design_File (Medium) + -- LRM93 11 + -- DESIGN_FILE ::= DESIGN_UNIT { DESIGN_UNIT} + -- + -- The library containing this design file. + -- Get/Set_Library (Field0) + -- Get/Set_Parent (Alias Field0) + -- + -- Get/Set_File_Dependence_List (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Analysis_Time_Stamp (Field3) + -- + -- Get/Set_File_Time_Stamp (Field4) + -- + -- Get the chain of unit contained in the file. This is a simply linked + -- chain, but the tail is kept to speed-up appending operation. + -- Get/Set_First_Design_Unit (Field5) + -- + -- Get/Set_Last_Design_Unit (Field6) + -- + -- Identifier for the design file file name and dirname. + -- Get/Set_Design_File_Filename (Field12) + -- Get/Set_Design_File_Directory (Field11) + -- + -- Flag used during elaboration. Set when the file was already seen. + -- Get/Set_Elab_Flag (Flag3) + + -- Iir_Kind_Design_Unit (Medium) + -- LRM93 11 + -- DESIGN_UNIT ::= CONTEXT_CLAUSE LIBRARY_UNIT + -- + -- The design_file containing this design unit. + -- Get/Set_Design_File (Field0) + -- Get/Set_Parent (Alias Field0) + -- + -- Get the chain of context clause. + -- Get_Context_Items (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set the library unit, which can be an entity, an architecture, + -- a package, a package body or a configuration. + -- Get/Set_Library_Unit (Field5) + -- + -- Get/Set_End_Location (Field6) + -- + -- Collision chain for units. + -- Get/Set_Hash_Chain (Field7) + -- + -- Get the list of design units that must be analysed before this unit. + -- See LRM93 11.4 for the rules defining the order of analysis. + -- Get/Set_Dependence_List (Field8) + -- + -- FIXME: this field can be put in the library_unit, since it is only used + -- when the units have been analyzed. + -- Get/Set_Analysis_Checks_List (Field9) + -- + -- This is a symbolic date, only used as a order of analysis of design + -- units. + -- Get/Set_Date (Field10) + -- + -- Set the line and the offset in the line, only for the library manager. + -- This is valid until the file is really loaded in memory. On loading, + -- location will contain all this informations. + -- Get/Set_Pos_Line_Off (Field1,Field11,Field12) + -- + -- Get/Set the date state, which indicates whether this design unit is in + -- memory or not. + -- Get/Set_Date_State (State1) + -- + -- Flag used during elaboration. Set when the file was already seen. + -- Get/Set_Elab_Flag (Flag3) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Library_Clause (Short) + -- Note: a library_clause node is created for every logical_name. + -- As a consequence, the scope of the library starts after the logical_name + -- and not after the library_clause. However, since an identifier + -- can only be used as a logical_name, and since the second occurence has + -- no effect, this is correct. + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Library_Declaration (Field1) + -- + -- Get/Set_Chain (Field2) + + -------------- + -- Literals -- + -------------- + + -- Iir_Kind_Character_Literal (Short) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Type (Field1) + + -- Iir_Kind_String_Literal (Short) + -- Iir_Kind_Bit_String_Literal (Medium) + -- + -- Type of the literal. Note: for a (bit_)string_literal, the type must be + -- computed during semantization. Roughly speaking, this is possible since + -- integer type range constraint are locally static. + -- Get/Set_Type (Field1) + -- + -- Used for computed literals. Literal_Origin contains the expression whose + -- value was computed during analysis and replaces the expression. + -- Get/Set_Literal_Origin (Field2) + -- + -- Get/Set_String_Id (Field3) + -- + -- Get/Set_String_Length (Field0) + -- + -- For bit string only: + -- Enumeration literal which correspond to '0' and '1'. + -- This cannot be defined only in the enumeration type definition, due to + -- possible aliases. + -- Only for Iir_Kind_Bit_String_Literal: + -- Get/Set_Bit_String_0 (Field4) + -- Only for Iir_Kind_Bit_String_Literal: + -- Get/Set_Bit_String_1 (Field5) + -- + -- Only for Iir_Kind_Bit_String_Literal: + -- Get/Set_Bit_String_Base (Field11) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Integer_Literal (Int) + -- Get/Set_Type (Field1) + -- + -- Get/Set the value of the integer. + -- Get/Set_Value (Int64) + -- + -- Get/Set_Literal_Origin (Field2) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Floating_Point_Literal (Fp) + -- Get/Set_Type (Field1) + -- + -- Get/Set the value of the literal. + -- Get/Set_Fp_Value (Fp64) + -- + -- Get/Set_Literal_Origin (Field2) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Null_Literal (Short) + -- The null literal, which can be a disconnection or a null access. + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Physical_Int_Literal (Int) + -- Iir_Kind_Physical_Fp_Literal (Fp) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Literal_Origin (Field2) + -- + -- Get/Set the physical unit of the literal. + -- Get/Set_Unit_Name (Field3) + -- + -- Must be set to locally except for time literal, which is globally. + -- Get/Set_Expr_Staticness (State1) + -- + -- Only for Iir_Kind_Physical_Int_Literal: + -- The multiplicand. + -- Get/Set_Value (Int64) + -- + -- Only for Iir_Kind_Physical_Fp_Literal: + -- The multiplicand. + -- Get/Set_Fp_Value (Fp64) + + -- Iir_Kind_Simple_Aggregate (Short) + -- This node can only be generated by evaluation: it is an unidimentional + -- positional aggregate. + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Literal_Origin (Field2) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- List of elements + -- Get/Set_Simple_Aggregate_List (Field3) + + ------------ + -- Tuples -- + ------------ + + -- Iir_Kind_Association_Element_By_Expression (Short) + -- Iir_Kind_Association_Element_Open (Short) + -- Iir_Kind_Association_Element_By_Individual (Short) + -- These are used for association element of an association list with + -- an interface (ie subprogram call, port map, generic map). + -- + -- Get/Set_Formal (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Only for Iir_Kind_Association_Element_By_Expression: + -- Get/Set_Actual (Field3) + -- + -- Only for Iir_Kind_Association_Element_By_Individual: + -- Get/Set_Actual_Type (Field3) + -- + -- Only for Iir_Kind_Association_Element_By_Individual: + -- Get/Set_Individual_Association_Chain (Field4) + -- + -- Only for Iir_Kind_Association_Element_By_Expression: + -- Get/Set_In_Conversion (Field4) + -- + -- Only for Iir_Kind_Association_Element_By_Expression: + -- Get/Set_Out_Conversion (Field5) + -- + -- Get/Set the whole association flag (true if the formal is associated in + -- whole, see LRM 4.3.2.2) + -- Get/Set_Whole_Association_Flag (Flag1) + -- + -- Get/Set_Collapse_Signal_Flag (Flag2) + -- + -- Only for Iir_Kind_Association_Element_Open: + -- Get/Set_Artificial_Flag (Flag3) + + -- Iir_Kind_Proxy (Short) + -- A proxy is used to avoid duplication of a node. + -- Ex: instead of copying a default value of an insterface in the subprogram + -- call, a proxy is used. The default value can't be so easily aliased + -- due to annotation. + -- + -- Create a proxy for PROXY. + -- function Create_Proxy (Proxy: Iir) return Iir_Proxy; + -- + -- Get/Set the value of the proxy. + -- Get/Set_Proxy (Field1) + + -- Iir_Kind_Waveform_Element (Short) + -- + -- Get/Set_We_Value (Field1) + -- + -- Get/Set_Time (Field3) + -- + -- Get/Set_Chain (Field2) + + -- Iir_Kind_Conditional_Waveform (Short) + -- + -- Get/Set_Condition (Field1) + -- + -- Get/Set_Waveform_Chain (Field5) + -- + -- Get/Set_Chain (Field2) + + -- Iir_Kind_Choice_By_Others (Short) + -- Iir_Kind_Choice_By_None (Short) + -- Iir_Kind_Choice_By_Range (Short) + -- Iir_Kind_Choice_By_Name (Short) + -- Iir_Kind_Choice_By_Expression (Short) + -- (Iir_Kinds_Choice) + -- + -- Get/Set_Parent (Field0) + -- + -- These are elements of an choice chain, which is used for + -- case_statement, concurrent_select_signal_assignment, aggregates. + -- + -- Get/Set what is associated with the choice. This can be: + -- * a waveform_chain for a concurrent_select_signal_assignment, + -- * an expression for an aggregate, + -- * a sequential statement list for a case_statement. + -- For a list of choices, only the first one is associated, the following + -- associations have the same_alternative_flag set. + -- Get/Set_Associated (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Only for Iir_Kind_Choice_By_Name: + -- Get/Set the name. + -- Get/Set_Name (Field4) + -- + -- Only for Iir_Kind_Choice_By_Expression: + -- Get/Set_Expression (Field5) + -- + -- Only for Iir_Kind_Choice_By_Range: + -- Get/Set the range. + -- Get/Set_Expression (Field5) + -- + -- Get/Set_Same_Alternative_Flag (Flag1) + -- + -- Only for Iir_Kind_Choice_By_Range: + -- Only for Iir_Kind_Choice_By_Expression: + -- Get/Set_Choice_Staticness (State2) + + -- Iir_Kind_Entity_Aspect_Entity (Short) + -- + -- Parse: a name + -- Sem: a design unit + -- Get/Set_Entity (Field4) + -- + -- parse: a simple name. + -- sem: an architecture declaration or NULL_IIR. + -- Get/Set_Architecture (Field2) + + -- Iir_Kind_Entity_Aspect_Open (Short) + + -- Iir_Kind_Entity_Aspect_Configuration (Short) + -- + -- Parse: a name + -- Sem: a design unit + -- Get/Set_Configuration (Field1) + + -- Iir_Kind_Block_Configuration (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Declaration_Chain (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Configuration_Item_Chain (Field3) + -- + -- Note: for default block configurations of iterative generate statement, + -- the block specification is a selected_name, whose identifier is others. + -- Get/Set_Block_Specification (Field5) + -- + -- Single linked list of block configuration that apply to the same + -- for scheme generate block. + -- Get/Set_Prev_Block_Configuration (Field4) + + -- Iir_Kind_Binding_Indication (Medium) + -- + -- Get/Set_Default_Entity_Aspect (Field1) + -- + -- The entity aspect. + -- It is a iir_kind_entity_aspect_entity, iir_kind_entity_aspect_open or + -- iir_kind_entity_aspect_configuration. This may be transformed into a + -- declaration by semantic. + -- Get/Set_Entity_Aspect (Field3) + -- + -- Get/Set_Default_Generic_Map_Aspect_Chain (Field6) + -- + -- Get/Set_Default_Port_Map_Aspect_Chain (Field7) + -- + -- Get/Set_Generic_Map_Aspect_Chain (Field8) + -- + -- Get/Set_Port_Map_Aspect_Chain (Field9) + + -- Iir_Kind_Component_Configuration (Short) + -- Iir_Kind_Configuration_Specification (Short) + -- + -- The declaration containing this type declaration. + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Component_Name (Field4) + -- + -- Must be one of designator_list, designator_by_others or + -- designator_by_all. + -- Get/Set_Instantiation_List (Field1) + -- + -- Only for Iir_Kind_Component_Configuration: + -- Get/Set_Block_Configuration (Field5) + -- + -- Get/Set_Binding_Indication (Field3) + -- + -- Get/Set_Chain (Field2) + + -- Iir_Kind_Disconnection_Specification (Short) + -- + -- The declaration containing this type declaration. + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Signal_List (Field4) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Expression (Field5) + -- + -- Get/Set_Chain (Field2) + + -- Iir_Kind_Block_Header (Medium) + -- + -- Get/Set_Generic_Chain (Field6) + -- + -- Get/Set_Port_Chain (Field7) + -- + -- Get/Set_Generic_Map_Aspect_Chain (Field8) + -- + -- Get/Set_Port_Map_Aspect_Chain (Field9) + + -- Iir_Kind_Entity_Class (Short) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Entity_Class (Field3) + + -- Iir_Kind_Attribute_Specification (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Entity_Name_List (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Entity_Class (Field3) + -- + -- Get/Set_Attribute_Value_Spec_Chain (Field4) + -- + -- Get/Set_Expression (Field5) + -- + -- Get/Set_Attribute_Designator (Field6) + -- + -- Get/Set_Attribute_Specification_Chain (Field7) + + -- Iir_Kind_Attribute_Value (Short) + -- An attribute value is the element of the chain of attribute of an entity, + -- marking the entity as decorated by the attribute. + -- This node is built only by sem. + -- In fact, the node is member of the chain of attribute of an entity, and + -- of the chain of entity of the attribute specification. + -- This makes elaboration (and more precisely, expression evaluation) + -- easier. + -- + -- Get/Set_Spec_Chain (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Designated_Entity (Field3) + -- + -- Get/Set_Attribute_Specification (Field4) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Selected_Element (Short) + -- A record element selection. + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Selected_Element (Field2) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Implicit_Dereference (Short) + -- Iir_Kind_Dereference (Short) + -- An implicit access dereference. + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Signature (Short) + -- + -- Get/Set_Return_Type (Field1) + -- + -- Get/Set_Type_Marks_List (Field2) + -- + -- Used only for attribute specification. + -- Get/Set_Name (Field4) + + -- Iir_Kind_Overload_List (Short) + -- + -- Get/Set_Overload_List (Field1) + + ------------------ + -- Declarations -- + ------------------ + + -- Iir_Kind_Entity_Declaration (Medium) + -- + -- Get/Set_Parent (Field0) + -- Get/Set_Design_Unit (Alias Field0) + -- + -- Get_Declaration_Chain (Field1) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Concurrent_Statement_Chain (Field5) + -- + -- Get/Set_Generic_Chain (Field6) + -- + -- Get/Set_Port_Chain (Field7) + -- + -- Get/Set_Is_Within_Flag (Flag5) + + -- Iir_Kind_Architecture_Declaration (Medium) + -- + -- Get/Set_Parent (Field0) + -- Get/Set_Design_Unit (Alias Field0) + -- + -- Get_Declaration_Chain (Field1) + -- + -- Get/Set_Identifier (Field3) + -- + -- Set the entity of an architecture. + -- Before the semantic pass, it can be a name. + -- Get/Set_Entity (Field4) + -- + -- Get/Set_Concurrent_Statement_Chain (Field5) + -- + -- The default configuration created by canon. This is a design unit. + -- Get/Set_Default_Configuration_Declaration (Field6) + -- + -- Get/Set_Foreign_Flag (Flag3) + -- + -- Get/Set_Is_Within_Flag (Flag5) + + -- Iir_Kind_Configuration_Declaration (Short) + -- + -- Get/Set_Parent (Field0) + -- Get/Set_Design_Unit (Alias Field0) + -- + -- Get_Declaration_Chain (Field1) + -- + -- Get/Set_Identifier (Field3) + -- + -- Set the entity of a configuration (a design_unit) + -- Before the semantic pass, it can be an identifier. + -- Get/Set_Entity (Field4) + -- + -- Get/Set_Block_Configuration (Field5) + + -- Iir_Kind_Package_Declaration (Short) + -- + -- Get/Set_Parent (Field0) + -- Get/Set_Design_Unit (Alias Field0) + -- + -- Get_Declaration_Chain (Field1) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Package_Body (Field4) + -- + -- Get/Set_Need_Body (Flag1) + + -- Iir_Kind_Package_Body (Short) + -- Note: a body is not a declaration, that's the reason why there is no + -- _declaration suffix in the name. + -- + -- Get/Set_Parent (Field0) + -- Get/Set_Design_Unit (Alias Field0) + -- + -- Get_Declaration_Chain (Field1) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Package (Field4) + + -- Iir_Kind_Library_Declaration (Medium) + -- + -- Design files in the library. + -- Get/Set_Design_File_Chain (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- This node is used to contain all a library. Only internaly used. + -- Name (identifier) of the library. + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Date (Field10) + -- + -- Get/Set_Library_Directory (Field11) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Component_Declaration (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Generic_Chain (Field6) + -- + -- Get/Set_Port_Chain (Field7) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + + -- Iir_Kind_Object_Alias_Declaration (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Name (Field4) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + + -- Iir_Kind_Non_Object_Alias_Declaration (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Name (Field4) + -- + -- Get/Set_Signature (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + + -- Iir_Kind_Anonymous_Type_Declaration (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Used for informative purpose only. + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Subtype_Definition (Field4) + + -- Iir_Kind_Type_Declaration (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Definition of the type. + -- Note: the type definition can be a real type (unconstrained array, + -- enumeration, file, record, access) or a subtype (integer, floating + -- point). + -- The parser set this field to null_iir for an incomplete type declaration. + -- This field is set to an incomplete_type_definition node when first + -- semantized. + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + + -- Iir_Kind_Subtype_Declaration (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + + -- Iir_Kind_Signal_Interface_Declaration (Medium) + -- Iir_Kind_Constant_Interface_Declaration (Medium) + -- Iir_Kind_Variable_Interface_Declaration (Medium) + -- Iir_Kind_File_Interface_Declaration (Medium) + -- + -- Note: If type is an iir_kind_proxy node, then type *and* default value + -- (if any) must be extracted from proxy. + -- + -- Get/Set the parent of an interface declaration. + -- The parent is an entity declaration, a subprogram specification, a + -- component declaration, a loop statement, a block declaration or ?? + -- Useful to distinguish a port and an interface. + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Must always be null_iir for iir_kind_file_interface_declaration. + -- Get/Set_Default_Value (Field6) + -- + -- Get/Set_Lexical_Layout (Odigit1) + -- + -- Get/Set_Mode (Odigit2) + -- + -- Only for Iir_Kind_Signal_Interface_Declaration: + -- Get/Set_Has_Disconnect_Flag (Flag1) + -- + -- Only for Iir_Kind_Signal_Interface_Declaration: + -- Get/Set_Has_Active_Flag (Flag2) + -- + -- Only for Iir_Kind_Signal_Interface_Declaration: + -- Get/Set_Open_Flag (Flag3) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + -- + -- Only for Iir_Kind_Signal_Interface_Declaration: + -- Get/Set_Signal_Kind (State4) + + -- Iir_Kind_Function_Declaration (Medium) + -- Iir_Kind_Procedure_Declaration (Medium) + -- + -- Subprogram declaration. + -- + -- The declaration containing this type declaration. + -- Get/Set_Parent (Field0) + -- + -- Only for Iir_Kind_Function_Declaration: + -- Get/Set_Return_Type (Field1) + -- + -- Only for Iir_Kind_Function_Declaration: + -- Get/Set_Type (Alias Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get_Interface_Declaration_Chain (Field5) + -- + -- Get/Set_Subprogram_Body (Field6) + -- + -- Get/Set_Callees_List (Field7) + -- + -- FIXME: to be removed. + -- Get/Set_Driver_List (Field8) + -- + -- Get/Set_Overload_Number (Field9) + -- + -- Get/Set_Subprogram_Depth (Field10) + -- + -- Get/Set_Subprogram_Hash (Field11) + -- + -- Get/Set_Extra_Info (Field12) + -- + -- Get/Set_Seen_Flag (Flag1) + -- + -- Only for Iir_Kind_Function_Declaration: + -- Get/Set_Pure_Flag (Flag2) + -- + -- Only for Iir_Kind_Procedure_Declaration: + -- Get/Set_Passive_Flag (Flag2) + -- + -- Get/Set_Foreign_Flag (Flag3) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Is_Within_Flag (Flag5) + -- + -- Get/Set_Use_Flag (Flag6) + -- + -- Only for Iir_Kind_Procedure_Declaration: + -- Get/Set_Purity_State (State3) + -- + -- Get/Set_Wait_State (State1) + + -- Iir_Kind_Function_Body (Short) + -- Iir_Kind_Procedure_Body (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- The parse stage always puts a declaration before a body. + -- Sem will remove the declaration if there is a forward declaration. + -- + -- Get_Declaration_Chain (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Impure_Depth (Field3) + -- + -- Get/Set_Subprogram_Specification (Field4) + -- + -- Get/Set_Sequential_Statement_Chain (Field5) + + -- Iir_Kind_Implicit_Procedure_Declaration (Medium) + -- Iir_Kind_Implicit_Function_Declaration (Medium) + -- + -- This node contains a subprogram_declaration that was implicitly defined + -- just after a type declaration. + -- This declaration is inserted by sem. + -- + -- Get/Set_Parent (Field0) + -- + -- Only for Iir_Kind_Implicit_Function_Declaration: + -- Get/Set_Return_Type (Field1) + -- + -- Only for Iir_Kind_Implicit_Function_Declaration: + -- Get/Set_Type (Alias Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get_Interface_Declaration_Chain (Field5) + -- + -- Get/Set_Implicit_Definition (Field6) + -- + -- Get/Set_Callees_List (Field7) + -- + -- Get/Set_Type_Reference (Field8) + -- + -- Get/Set_Overload_Number (Field9) + -- + -- Get/Set_Subprogram_Hash (Field11) + -- + -- Get/Set_Extra_Info (Field12) + -- + -- Get/Set_Wait_State (State1) + -- + -- Get/Set_Seen_Flag (Flag1) + -- + -- Only for Iir_Kind_Implicit_Function_Declaration: + -- Get/Set_Pure_Flag (Flag2) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Is_Within_Flag (Flag5) + -- + -- Get/Set_Use_Flag (Flag6) + + -- Iir_Kind_Signal_Declaration (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Default_Value (Field6) + -- + -- For a non-resolved signal: null_iir if the signal has no driver, or + -- a process/concurrent_statement for which the signal should have a + -- driver. This is used to catch at analyse time unresolved signals with + -- several drivers. + -- Get/Set_Signal_Driver (Field7) + -- + -- Get/Set_Has_Disconnect_Flag (Flag1) + -- + -- Get/Set_Has_Active_Flag (Flag2) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + -- + -- Get/Set_Signal_Kind (State4) + + -- Iir_Kind_Guard_Signal_Declaration (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Guard_Expression (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Guard_Sensitivity_List (Field6) + -- + -- Get/Set_Block_Statement (Field7) + -- + -- Get/Set_Has_Active_Flag (Flag2) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + -- + -- Get/Set_Signal_Kind (State4) + + -- Iir_Kind_Constant_Declaration (Medium) + -- Iir_Kind_Iterator_Declaration (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Only for Iir_Kind_Constant_Declaration: + -- Default value of a deferred constant points to the full constant + -- declaration. + -- Get/Set_Default_Value (Field6) + -- + -- Only for Iir_Kind_Constant_Declaration: + -- Summary: + -- | constant C1 : integer; -- Deferred declaration (in a package) + -- | constant C2 : integer := 4; -- Declaration + -- | constant C1 : integer := 3; -- Full declaration (in a body) + -- | NAME Deferred_declaration Deferred_declaration_flag + -- | C1 Null_iir or C1' (*) True + -- | C2 Null_Iir False + -- | C1' C1 False + -- |(*): Deferred_declaration is Null_Iir as long as the full declaration + -- | has not been analyzed. + -- Get/Set_Deferred_Declaration (Field7) + -- + -- Only for Iir_Kind_Constant_Declaration: + -- Get/Set_Deferred_Declaration_Flag (Flag1) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Variable_Declaration (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Default_Value (Field6) + -- + -- True if the variable is a shared variable. + -- Get/Set_Shared_Flag (Flag2) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_File_Declaration (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_File_Logical_Name (Field6) + -- + -- This is not used in vhdl 87. + -- Get/Set_File_Open_Kind (Field7) + -- + -- This is used only in vhdl 87. + -- Get/Set_Mode (Odigit2) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Element_Declaration (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Return the position of the element in the record, starting from 0 for the + -- first record element, increasing by one for each successive element. + -- Get/Set_Element_Position (Field4) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Attribute_Declaration (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + + -- Iir_Kind_Group_Template_Declaration (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- List of entity class entry. + -- To handle `<>', the last element of the list can be an entity_class of + -- kind tok_box. + -- Get/Set_Entity_Class_Entry_Chain (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + + -- Iir_Kind_Group_Declaration (Short) + -- + -- The declaration containing this type declaration. + -- Get/Set_Parent (Field0) + -- + -- List of constituent. + -- Get/Set_Group_Constituent_List (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Group_Template_Name (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Use_Flag (Flag6) + + -- Iir_Kind_Use_Clause (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Selected_Name (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Use_Clause_Chain (Field3) + + + ---------------------- + -- type definitions -- + ---------------------- + + -- For Iir_Kinds_Type_And_Subtype_Definition: + -- + -- Type_Declarator: + -- Points to the type declaration or subtype declaration that has created + -- this definition. For some types, such as integer and floating point + -- types, both type and subtype points to the declaration. + -- However, there are cases where a type definition doesn't point to + -- a declarator: anonymous subtype created by index contraints, or + -- anonymous subtype created by an object declaration. + -- Note: a type definition cannot be anoynymous. + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set the base type. + -- For a subtype, it returns the type. + -- For a type, it must return the type itself. + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set the staticness of a type, according to LRM93 7.4.1. + -- Note: These types definition are always locally static: + -- enumeration, integer, floating. + -- However, their subtype are not necessary locally static. + -- Get/Set_Type_Staticness (State1) + -- + -- Get/Set the resolved flag of a subtype, according to LRM93 2.4 + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set the signal_type flag of a type definition. + -- It is true when the type can be used for a signal. + -- Get/Set_Signal_Type_Flag (Flag2) + + -- Iir_Kind_Enumeration_Type_Definition (Short) + -- + -- Get the range of the type (This is just an ascending range from the + -- first literal to the last declared literal). + -- Get/Set_Range_Constraint (Field1) + -- + -- Return the list of literals. This list is created when the node is + -- created. + -- Get/Set_Enumeration_Literal_List (Field2) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + -- + -- Get/Set_Type_Staticness (State1) + + -- Iir_Kind_Enumeration_Literal (Medium) + -- + -- Nota: two literals of the same type are equal iff their value is the + -- same; in other words, there may be severals literals with the same value. + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- Get/Set_Return_Type (Alias Field1) + -- + -- Get/Set_Literal_Origin (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Base_Name (Field5) + -- + -- The declaration of the literal. If LITERAL_ORIGIN is not set, then this + -- is the node itself, else this is the literal defined. + -- Get/Set_Enumeration_Decl (Field6) + -- + -- The value of an enumeration literal is the position. + -- Get/Set_Enum_Pos (Field10) + -- + -- Get/Set_Subprogram_Hash (Field11) + -- + -- Get/Set_Seen_Flag (Flag1) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Physical_Type_Definition (Short) + -- + -- Get/Set_Unit_Chain (Field1) + -- Get_Primary_Unit (Alias Field1) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + -- + -- Get/Set_Type_Staticness (State1) + + -- Iir_Kind_Unit_Declaration (Medium) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Physical_Literal (Field6) + -- + -- Get/Set_Physical_Unit_Value (Field7) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Integer_Type_Definition (Short) + -- Iir_Kind_Floating_Type_Definition (Short) + -- + -- Get/Set the declarator that has created this integer type. + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Type staticness is always locally. + -- Get/Set_Type_Staticness (State1) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + + -- Iir_Kind_Array_Type_Definition (Medium) + -- This defines an unconstrained array type. + -- + -- Get/Set_Element_Subtype (Field1) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Index_Subtype_List (Field6) + -- + -- Get/Set_Type_Staticness (State1) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + + -- Iir_Kind_Record_Type_Definition (Short) + -- + -- Get/Set_Number_Element_Declaration (Field1) + -- + -- Get/Set_Element_Declaration_Chain (Field2) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Type_Staticness (State1) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + + -- Iir_Kind_Access_Type_Definition (Short) + -- + -- Get/Set_Designated_Type (Field2) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- FIXME: Only for access_subtype. + -- FIXME: Get/Set_Resolution_Function (Field5) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + -- + -- Get/Set_Type_Staticness (State1) + + -- Iir_Kind_File_Type_Definition (Short) + -- + -- True if this is the std.textio.text file type, which may require special + -- handling. + -- Get/Set_Text_File_Flag (Flag3) + -- + -- Get/Set_Type_Mark (Field2) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + -- + -- Get/Set_Type_Staticness (State1) + + -- Iir_Kind_Incomplete_Type_Definition (Short) + -- Type definition for an incomplete type. This is created during the + -- semantisation of the incomplete type declaration. + -- + -- Get/Set_Incomplete_Type_List (Field2) + -- + -- Set to the incomplete type declaration when semantized, and set to the + -- complete type declaration when the latter one is semantized. + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Type_Staticness (State1) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + + -- Iir_Kind_Protected_Type_Declaration (Short) + -- + -- Get/Set_Declaration_Chain (Field1) + -- + -- Get/Set_Protected_Type_Body (Field2) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Type_Staticness (State1) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + + -- Iir_Kind_Protected_Type_Body (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Declaration_Chain (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Protected_Type_Declaration (Field4) + + ------------------------- + -- subtype definitions -- + ------------------------- + + -- Iir_Kind_Enumeration_Subtype_Definition (Short) + -- Iir_Kind_Integer_Subtype_Definition (Short) + -- Iir_Kind_Floating_Subtype_Definition (Short) + -- Iir_Kind_Physical_Subtype_Definition (Short) + -- + -- Get/Set_Range_Constraint (Field1) + -- + -- Get/Set_Type_Mark (Field2) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Resolution_Function (Field5) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + -- + -- Get/Set_Type_Staticness (State1) + + -- Iir_Kind_Access_Subtype_Definition (Short) + -- + -- Get/Set_Type_Staticness (State1) + -- + -- Get/Set_Type_Mark (Field2) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Note: no resolution function for access subtype. + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + + -- Iir_Kind_Record_Subtype_Definition (Short) + -- + -- Get/Set_Type_Mark (Field2) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Resolution_Function (Field5) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + -- + -- Get/Set_Type_Staticness (State1) + + -- Iir_Kind_Array_Subtype_Definition (Medium) + -- Iir_Kind_Unconstrained_Array_Subtype_Definition (Medium) + -- + -- Iir_Kind_Array_Subtype_definition defines a constrained array + -- subtype, which *must* be a subtype of an iir_array_type_definition. + -- + -- Iir_Kind_Unconstrained_Array_Subtype_Definition defines a + -- unconstrained array subtype, which *must* be a subtype of an + -- iir_array_type_definition. The only way to create such a + -- subtype is via a subtype declaration, without adding + -- constraints. + -- + -- Get/Set_Element_Subtype (Field1) + -- + -- Get/Set_Type_Mark (Field2) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Resolution_Function (Field5) + -- + -- Get/Set_Index_Subtype_List (Field6) + -- + -- Get/Set_Type_Staticness (State1) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + + -- Iir_Kind_Range_Expression (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Left_Limit (Field2) + -- + -- Get/Set_Right_Limit (Field3) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Direction (State2) + + -- Iir_Kind_Subtype_Definition (Short) + -- Such a node is only created by parse and transformed into the correct + -- kind (enumeration_subtype, integer_subtype...) by sem. + -- + -- Get/Set_Range_Constraint (Field1) + -- + -- Get/Set_Type_Mark (Field2) + -- + -- Get/Set_Resolution_Function (Field5) + + --------------------------- + -- concurrent statements -- + --------------------------- + + -- Iir_Kind_Concurrent_Conditional_Signal_Assignment (Medium) + -- Iir_Kind_Concurrent_Selected_Signal_Assignment (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Target (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Only for Iir_Kind_Concurrent_Selected_Signal_Assignment: + -- Get/Set_Expression (Field5) + -- + -- Get/Set_Reject_Time_Expression (Field6) + -- + -- Only for Iir_Kind_Concurrent_Conditional_Signal_Assignment: + -- Get/Set_Conditional_Waveform_Chain (Field7) + -- + -- Only for Iir_Kind_Concurrent_Selected_Signal_Assignment: + -- Get/Set_Selected_Waveform_Chain (Field7) + -- + -- If the assignment is guarded, then get_guard must return the + -- declaration of the signal guard, otherwise, null_iir. + -- If the guard signal decl is not known, as a kludge and only to mark this + -- assignment guarded, the guard can be this assignment. + -- Get/Set_Guard (Field8) + -- + -- Get/Set_Delay_Mechanism (Field12) + -- + -- Get/Set_Postponed_Flag (Flag3) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- True if the target of the assignment is guarded + -- Get_Guarded_Target_State (State4) + + -- Iir_Kind_Sensitized_Process_Statement (Medium) + -- Iir_Kind_Process_Statement (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get_Declaration_Chain (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Sequential_Statement_Chain (Field5) + -- + -- Only for Iir_Kind_Sensitized_Process_Statement: + -- Get_Sensitivity_List (Field6) + -- + -- Get/Set_Callees_List (Field7) + -- + -- Get/Set_Driver_List (Field8) + -- + -- Get/Set_Extra_Info (Field12) + -- + -- Get/Set_Wait_State (State1) + -- + -- Get/Set_Seen_Flag (Flag1) + -- + -- Get/Set_Passive_Flag (Flag2) + -- + -- Get/Set_Postponed_Flag (Flag3) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Is_Within_Flag (Flag5) + + -- Iir_Kind_Concurrent_Assertion_Statement (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Assertion_Condition (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Severity_Expression (Field5) + -- + -- Get/Set_Report_Expression (Field6) + -- + -- Get/Set_Postponed_Flag (Flag3) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Component_Instantiation_Statement (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Unit instantiated. + -- Parse: a name, a entity_aspect_entity or a entity_aspect_configuration + -- Sem: the component declaration or the design unit. + -- Get/Set_Instantiated_Unit (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Default_Binding_Indication (Field5) + -- + -- Get/Set_Generic_Map_Aspect_Chain (Field8) + -- + -- Get/Set_Port_Map_Aspect_Chain (Field9) + -- + -- Configuration: + -- In case of a configuration specification, the node is put into + -- default configuration. In the absence of a specification, the + -- default entity aspect, if any; if none, this field is null_iir. + -- Get/Set_Configuration_Specification (Field7) + -- + -- During Sem and elaboration, the configuration field can be filled by + -- a component configuration declaration. + -- + -- Configuration for this component. + -- FIXME: must be get/set_binding_indication. + -- Get/Set_Component_Configuration (Field6) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Block_Statement (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get_Declaration_Chain (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Concurrent_Statement_Chain (Field5) + -- + -- Get/Set_Block_Block_Configuration (Field6) + -- + -- Get/Set_Block_Header (Field7) + -- + -- get/set_guard_decl is used for semantic analysis, in order to add + -- a signal declaration. + -- Get/Set_Guard_Decl (Field8) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Is_Within_Flag (Flag5) + + -- Iir_Kind_Generate_Statement (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get_Declaration_Chain (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Concurrent_Statement_Chain (Field5) + -- + -- The generation scheme. + -- A (boolean) expression for a conditionnal elaboration (if). + -- A (iterator) declaration for an iterative elaboration (for). + -- Get/Set_Generation_Scheme (Field6) + -- + -- The block configuration for this statement. + -- Get/Set_Generate_Block_Configuration (Field7) + -- + -- Get/Set_Visible_Flag (Flag4) + + --------------------------- + -- sequential statements -- + --------------------------- + + -- Iir_Kind_If_Statement (Medium) + -- Iir_Kind_Elsif (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- May be NULL only for an iir_kind_elsif node, and then means the else + -- clause. + -- Get/Set_Condition (Field1) + -- + -- Only for Iir_Kind_If_Statement: + -- Get/Set_Chain (Field2) + -- + -- Only for Iir_Kind_If_Statement: + -- Get/Set_Label (Field3) + -- + -- Only for Iir_Kind_If_Statement: + -- Get/Set_Identifier (Alias Field3) + -- + -- Only for Iir_Kind_If_Statement: + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Sequential_Statement_Chain (Field5) + -- + -- Must be an Iir_kind_elsif node, or NULL for no more elsif clauses. + -- Get/Set_Else_Clause (Field6) + -- + -- Only for Iir_Kind_If_Statement: + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_For_Loop_Statement (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Iterator_Scheme (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Sequential_Statement_Chain (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Is_Within_Flag (Flag5) + + -- Iir_Kind_While_Loop_Statement (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Condition (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Sequential_Statement_Chain (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Exit_Statement (Short) + -- Iir_Kind_Next_Statement (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Condition (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Label identifier after parse. + -- Get/Set_Loop (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Signal_Assignment_Statement (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Target (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- The waveform. + -- If the waveform_chain is null_iir, then the signal assignment is a + -- disconnection statement, ie TARGET <= null_iir after disconection_time, + -- where disconnection_time is specified by a disconnection specification. + -- Get/Set_Waveform_Chain (Field5) + -- + -- Get/Set_Reject_Time_Expression (Field6) + -- + -- Get/Set_Delay_Mechanism (Field12) + -- + -- Get/Set_Visible_Flag (Flag4) + -- + -- True if the target of the assignment is guarded + -- Get_Guarded_Target_State (State4) + + -- Iir_Kind_Variable_Assignment_Statement (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Target (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Expression (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Assertion_Statement (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Assertion_Condition (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Severity_Expression (Field5) + -- + -- Get/Set_Report_Expression (Field6) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Report_Statement (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Severity_Expression (Field5) + -- + -- Get/Set_Report_Expression (Field6) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Wait_Statement (Medium) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Timeout_Clause (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Condition_Clause (Field5) + -- + -- Get/Set_Sensitivity_List (Field6) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Return_Statement (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Type of the return value of the function. This is a copy of return_type. + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Expression (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Case_Statement (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Case_Statement_Alternative_Chain (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Expression (Field5) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Procedure_Call_Statement (Short) + -- Iir_Kind_Concurrent_Procedure_Call_Statement (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Procedure_Call (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Only for Iir_Kind_Concurrent_Procedure_Call_Statement: + -- Get/Set_Postponed_Flag (Flag3) + -- + -- Get/Set_Visible_Flag (Flag4) + + -- Iir_Kind_Procedure_Call (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Parameter_Association_Chain (Field2) + -- + -- Get/Set_Implementation (Field3) + -- + -- Get/Set_Method_Object (Field4) + + -- Iir_Kind_Null_Statement (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Label (Field3) + -- Get/Set_Identifier (Alias Field3) + -- + -- Get/Set_Attribute_Value_Chain (Field4) + -- + -- Get/Set_Visible_Flag (Flag4) + + --------------- + -- operators -- + --------------- + + -- Iir_Kinds_Monadic_Operator (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Operand (Field2) + -- + -- Function declaration corresponding to the function to call. + -- Get/Set_Implementation (Field3) + -- + -- Expr_staticness is defined by §7.4 + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kinds_Dyadic_Operator (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Left and Right operands. + -- Get/Set_Left (Field2) + -- + -- Function declaration corresponding to the function to call. + -- Get/Set_Implementation (Field3) + -- + -- Get/Set_Right (Field4) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Function_Call (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Parameter_Association_Chain (Field2) + -- + -- Function declaration corresponding to the function to call. + -- Get/Set_Implementation (Field3) + -- + -- Get/Set_Method_Object (Field4) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Aggregate (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Aggregate_Info (Field2) + -- + -- Get/Set_Association_Choices_Chain (Field4) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Value_Staticness (State2) + + -- Iir_Kind_Aggregate_Info (Short) + -- + -- Get info for the next dimension. NULL_IIR terminated. + -- Get/Set_Sub_Aggregate_Info (Field1) + -- + -- For array aggregate only: + -- If TRUE, the aggregate bounds are not locally static. + -- This flag is only valid when the array aggregate is constrained, ie + -- has no 'others' choice. + -- Get/Set_Aggr_Dynamic_Flag (Flag3) + -- + -- If TRUE, the aggregate is named, else it is positionnal. + -- Get/Set_Aggr_Named_Flag (Flag4) + -- + -- The following three fields are used to check bounds of an array + -- aggregate. + -- For named aggregate, low and high bounds are computed, for positionnal + -- aggregate, the (minimum) number of elements is computed. + -- Note there may be elements beyond the bounds, due to other choice. + -- These fields may apply for the aggregate or for the aggregate and its + -- brothers if the node is for a sub-aggregate. + -- + -- The low and high index choice, if any. + -- Get/Set_Aggr_Low_Limit (Field2) + -- + -- Get/Set_Aggr_High_Limit (Field3) + -- + -- The maximum number of elements, if any. + -- Get/Set_Aggr_Max_Length (Field4) + -- + -- True if the choice list has an 'others' choice. + -- Get/Set_Aggr_Others_Flag (Flag2) + + -- Iir_Kind_Qualified_Expression (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Type_Mark (Field2) + -- + -- Get/Set_Expression (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Type_Conversion (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Type_Mark (Field2) + -- + -- Get/Set_Expression (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Allocator_By_Expression (Short) + -- Iir_Kind_Allocator_By_Subtype (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Contains the expression for a by expression allocator or the + -- subtype indication for a by subtype allocator. + -- Get/Set_Expression (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + + ----------- + -- names -- + ----------- + + -- Iir_Kind_Simple_Name (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Named_Entity (Field4) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Selected_Name (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Suffix_Identifier (Field2) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Named_Entity (Field4) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Selected_By_All_Name (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Named_Entity (Field4) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Operator_Symbol (Short) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Named_Entity (Field4) + + -- Iir_Kind_Indexed_Name (Short) + -- Select the element designed with the INDEX_LIST from array PREFIX. + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Index_List (Field2) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Slice_Name (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Suffix (Field2) + -- + -- Get/Set_Base_Name (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Parenthesis_Name (Short) + -- Created by the parser, and mutated into the correct iir node: it can be + -- either a function call, an indexed array, a type conversion or a slice + -- name. + -- + -- Always returns null_iir. + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Named_Entity (Field4) + -- + -- Get/Set_Association_Chain (Field2) + + ---------------- + -- attributes -- + ---------------- + + -- Iir_Kind_Attribute_Name (Short) + -- + -- Get/Set_Attribute_Identifier (Field2) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Named_Entity (Field4) + -- + -- Get/Set_Signature (Field5) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Base_Attribute (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + + -- Iir_Kind_Left_Type_Attribute (Short) + -- Iir_Kind_Right_Type_Attribute (Short) + -- Iir_Kind_High_Type_Attribute (Short) + -- Iir_Kind_Low_Type_Attribute (Short) + -- Iir_Kind_Ascending_Type_Attribute (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Range_Array_Attribute (Short) + -- Iir_Kind_Reverse_Range_Array_Attribute (Short) + -- Iir_Kind_Left_Array_Attribute (Short) + -- Iir_Kind_Right_Array_Attribute (Short) + -- Iir_Kind_High_Array_Attribute (Short) + -- Iir_Kind_Low_Array_Attribute (Short) + -- Iir_Kind_Ascending_Array_Attribute (Short) + -- Iir_Kind_Length_Array_Attribute (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Parameter (Field4) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Stable_Attribute (Short) + -- Iir_Kind_Delayed_Attribute (Short) + -- Iir_Kind_Quiet_Attribute (Short) + -- Iir_Kind_Transaction_Attribute (Short) + -- (Iir_Kinds_Signal_Attribute) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Prefix (Field3) + -- + -- Not used by Iir_Kind_Transaction_Attribute + -- Get/Set_Parameter (Field4) + -- + -- Get/Set_Has_Active_Flag (Flag2) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + -- + -- Get/Set_Base_Name (Field5) + + -- Iir_Kind_Event_Attribute (Short) + -- Iir_Kind_Last_Event_Attribute (Short) + -- Iir_Kind_Last_Value_Attribute (Short) + -- Iir_Kind_Active_Attribute (Short) + -- Iir_Kind_Last_Active_Attribute (Short) + -- Iir_Kind_Driving_Attribute (Short) + -- Iir_Kind_Driving_Value_Attribute (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Pos_Attribute (Short) + -- Iir_Kind_Val_Attribute (Short) + -- Iir_Kind_Succ_Attribute (Short) + -- Iir_Kind_Pred_Attribute (Short) + -- Iir_Kind_Leftof_Attribute (Short) + -- Iir_Kind_Rightof_Attribute (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Parameter (Field4) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Image_Attribute (Short) + -- Iir_Kind_Value_Attribute (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Get/Set_Parameter (Field4) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Simple_Name_Attribute (Short) + -- Iir_Kind_Instance_Name_Attribute (Short) + -- Iir_Kind_Path_Name_Attribute (Short) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Prefix (Field3) + -- + -- Only for Iir_Kind_Simple_Name_Attribute: + -- Get/Set_Simple_Name_Identifier (Field2) + -- + -- Get/Set_Expr_Staticness (State1) + + -- Iir_Kind_Behavior_Attribute (Short) + -- Iir_Kind_Structure_Attribute (Short) + -- FIXME: to describe (Short) + + -- Iir_Kind_Error (Short) + -- Can be used instead of an expression or a type. + -- Get/Set_Type (Field1) + -- + -- Get/Set_Error_Origin (Field2) + -- + -- Get/Set_Type_Declarator (Field3) + -- + -- Get/Set_Base_Type (Field4) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Type_Staticness (Alias State1) + -- + -- Get/Set_Resolved_Flag (Flag1) + -- + -- Get/Set_Signal_Type_Flag (Flag2) + + + -- End of Iir_Kind. + + + type Iir_Kind is + ( + -- Erroneous IIR. + Iir_Kind_Error, + + Iir_Kind_Design_File, + Iir_Kind_Design_Unit, + Iir_Kind_Library_Clause, + Iir_Kind_Use_Clause, + + -- Literals. + Iir_Kind_Character_Literal, + Iir_Kind_Integer_Literal, + Iir_Kind_Floating_Point_Literal, + Iir_Kind_Null_Literal, + Iir_Kind_String_Literal, + Iir_Kind_Physical_Int_Literal, + Iir_Kind_Physical_Fp_Literal, + Iir_Kind_Bit_String_Literal, + Iir_Kind_Simple_Aggregate, + + -- Tuple, + Iir_Kind_Proxy, + Iir_Kind_Waveform_Element, + Iir_Kind_Conditional_Waveform, + Iir_Kind_Association_Element_By_Expression, + Iir_Kind_Association_Element_By_Individual, + Iir_Kind_Association_Element_Open, + Iir_Kind_Choice_By_Others, + Iir_Kind_Choice_By_Expression, + Iir_Kind_Choice_By_Range, + Iir_Kind_Choice_By_None, + Iir_Kind_Choice_By_Name, + Iir_Kind_Entity_Aspect_Entity, + Iir_Kind_Entity_Aspect_Configuration, + Iir_Kind_Entity_Aspect_Open, + Iir_Kind_Block_Configuration, + Iir_Kind_Block_Header, + Iir_Kind_Component_Configuration, + Iir_Kind_Binding_Indication, + Iir_Kind_Entity_Class, + Iir_Kind_Attribute_Value, + Iir_Kind_Signature, + Iir_Kind_Aggregate_Info, + Iir_Kind_Procedure_Call, + Iir_Kind_Operator_Symbol, + + Iir_Kind_Attribute_Specification, + Iir_Kind_Disconnection_Specification, + Iir_Kind_Configuration_Specification, + + -- Type definitions. + -- iir_kinds_type_and_subtype_definition + -- kinds: disc: discrete, st: subtype. + Iir_Kind_Access_Type_Definition, + Iir_Kind_Incomplete_Type_Definition, + Iir_Kind_File_Type_Definition, + Iir_Kind_Protected_Type_Declaration, + Iir_Kind_Record_Type_Definition, -- composite + Iir_Kind_Array_Type_Definition, -- composite, array + Iir_Kind_Unconstrained_Array_Subtype_Definition, -- composite, array, st + Iir_Kind_Array_Subtype_Definition, -- composite, array, st + Iir_Kind_Record_Subtype_Definition, -- composite, st + Iir_Kind_Access_Subtype_Definition, -- st + Iir_Kind_Physical_Subtype_Definition, -- scalar, st + Iir_Kind_Floating_Subtype_Definition, -- scalar, st + Iir_Kind_Integer_Subtype_Definition, -- scalar, disc, st + Iir_Kind_Enumeration_Subtype_Definition, -- scalar, disc, st + Iir_Kind_Integer_Type_Definition, -- scalar, disc + Iir_Kind_Enumeration_Type_Definition, -- scalar, disc + Iir_Kind_Floating_Type_Definition, -- scalar + Iir_Kind_Physical_Type_Definition, -- scalar + Iir_Kind_Range_Expression, + Iir_Kind_Protected_Type_Body, + Iir_Kind_Subtype_Definition, -- temporary (must not appear after sem). + + -- Lists. + Iir_Kind_Overload_List, -- used internally by sem_expr. + + -- Declarations. + -- iir_kinds_nonoverloadable_declaration + Iir_Kind_Type_Declaration, + Iir_Kind_Anonymous_Type_Declaration, + Iir_Kind_Subtype_Declaration, + Iir_Kind_Configuration_Declaration, + Iir_Kind_Entity_Declaration, + Iir_Kind_Package_Declaration, + Iir_Kind_Package_Body, + Iir_Kind_Architecture_Declaration, + Iir_Kind_Unit_Declaration, + Iir_Kind_Library_Declaration, + Iir_Kind_Component_Declaration, + Iir_Kind_Attribute_Declaration, + Iir_Kind_Group_Template_Declaration, + Iir_Kind_Group_Declaration, + Iir_Kind_Element_Declaration, + Iir_Kind_Non_Object_Alias_Declaration, + + Iir_Kind_Function_Body, + Iir_Kind_Function_Declaration, + Iir_Kind_Implicit_Function_Declaration, + Iir_Kind_Implicit_Procedure_Declaration, + Iir_Kind_Procedure_Declaration, + Iir_Kind_Procedure_Body, + Iir_Kind_Enumeration_Literal, + + Iir_Kind_Object_Alias_Declaration, -- object + Iir_Kind_File_Declaration, -- object + Iir_Kind_Guard_Signal_Declaration, -- object + Iir_Kind_Signal_Declaration, -- object + Iir_Kind_Variable_Declaration, -- object + Iir_Kind_Constant_Declaration, -- object + Iir_Kind_Iterator_Declaration, -- object + Iir_Kind_Constant_Interface_Declaration, -- object, interface + Iir_Kind_Variable_Interface_Declaration, -- object, interface + Iir_Kind_Signal_Interface_Declaration, -- object, interface + Iir_Kind_File_Interface_Declaration, -- object, interface + + -- Expressions. + Iir_Kind_Identity_Operator, + Iir_Kind_Negation_Operator, + Iir_Kind_Absolute_Operator, + Iir_Kind_Not_Operator, + Iir_Kind_And_Operator, + Iir_Kind_Or_Operator, + Iir_Kind_Nand_Operator, + Iir_Kind_Nor_Operator, + Iir_Kind_Xor_Operator, + Iir_Kind_Xnor_Operator, + Iir_Kind_Equality_Operator, + Iir_Kind_Inequality_Operator, + Iir_Kind_Less_Than_Operator, + Iir_Kind_Less_Than_Or_Equal_Operator, + Iir_Kind_Greater_Than_Operator, + Iir_Kind_Greater_Than_Or_Equal_Operator, + Iir_Kind_Sll_Operator, + Iir_Kind_Sla_Operator, + Iir_Kind_Srl_Operator, + Iir_Kind_Sra_Operator, + Iir_Kind_Rol_Operator, + Iir_Kind_Ror_Operator, + Iir_Kind_Addition_Operator, + Iir_Kind_Substraction_Operator, + Iir_Kind_Concatenation_Operator, + Iir_Kind_Multiplication_Operator, + Iir_Kind_Division_Operator, + Iir_Kind_Modulus_Operator, + Iir_Kind_Remainder_Operator, + Iir_Kind_Exponentiation_Operator, + Iir_Kind_Function_Call, + Iir_Kind_Aggregate, + Iir_Kind_Qualified_Expression, + Iir_Kind_Type_Conversion, + Iir_Kind_Allocator_By_Expression, + Iir_Kind_Allocator_By_Subtype, + Iir_Kind_Selected_Element, + Iir_Kind_Dereference, + Iir_Kind_Implicit_Dereference, + + -- Concurrent statements. + Iir_Kind_Sensitized_Process_Statement, + Iir_Kind_Process_Statement, + Iir_Kind_Concurrent_Conditional_Signal_Assignment, + Iir_Kind_Concurrent_Selected_Signal_Assignment, + Iir_Kind_Concurrent_Assertion_Statement, + Iir_Kind_Concurrent_Procedure_Call_Statement, + Iir_Kind_Block_Statement, + Iir_Kind_Generate_Statement, + Iir_Kind_Component_Instantiation_Statement, + + -- Iir_Kind_Sequential_Statement + Iir_Kind_Signal_Assignment_Statement, + Iir_Kind_Null_Statement, + Iir_Kind_Assertion_Statement, + Iir_Kind_Report_Statement, + Iir_Kind_Wait_Statement, + Iir_Kind_Variable_Assignment_Statement, + Iir_Kind_Return_Statement, + Iir_Kind_For_Loop_Statement, + Iir_Kind_While_Loop_Statement, + Iir_Kind_Next_Statement, + Iir_Kind_Exit_Statement, + Iir_Kind_Case_Statement, + Iir_Kind_Procedure_Call_Statement, + Iir_Kind_If_Statement, + Iir_Kind_Elsif, + + -- Names + Iir_Kind_Simple_Name, + Iir_Kind_Slice_Name, + Iir_Kind_Indexed_Name, + Iir_Kind_Selected_Name, + Iir_Kind_Selected_By_All_Name, + Iir_Kind_Parenthesis_Name, + + -- Attributes + Iir_Kind_Base_Attribute, + Iir_Kind_Left_Type_Attribute, -- type_attribute + Iir_Kind_Right_Type_Attribute, -- type_attribute + Iir_Kind_High_Type_Attribute, -- type_attribute + Iir_Kind_Low_Type_Attribute, -- type_attribute + Iir_Kind_Ascending_Type_Attribute, -- type_attribute + Iir_Kind_Image_Attribute, + Iir_Kind_Value_Attribute, + Iir_Kind_Pos_Attribute, -- scalar_type_attribute + Iir_Kind_Val_Attribute, -- scalar_type_attribute + Iir_Kind_Succ_Attribute, -- scalar_type_attribute + Iir_Kind_Pred_Attribute, -- scalar_type_attribute + Iir_Kind_Leftof_Attribute, -- scalar_type_attribute + Iir_Kind_Rightof_Attribute, -- scalar_type_attribute + Iir_Kind_Left_Array_Attribute, -- array_attribute + Iir_Kind_Right_Array_Attribute, -- array_attribute + Iir_Kind_High_Array_Attribute, -- array_attribute + Iir_Kind_Low_Array_Attribute, -- array_attribute + Iir_Kind_Range_Array_Attribute, -- array_attribute + Iir_Kind_Reverse_Range_Array_Attribute, -- array_attribute + Iir_Kind_Length_Array_Attribute, -- array_attribute + Iir_Kind_Ascending_Array_Attribute, -- array_attribute + Iir_Kind_Delayed_Attribute, -- signal_attribute + Iir_Kind_Stable_Attribute, -- signal_attribute + Iir_Kind_Quiet_Attribute, -- signal_attribute + Iir_Kind_Transaction_Attribute, -- signal_attribute + Iir_Kind_Event_Attribute, -- signal_value_attribute + Iir_Kind_Active_Attribute, -- signal_value_attribute + Iir_Kind_Last_Event_Attribute, -- signal_value_attribute + Iir_Kind_Last_Active_Attribute, -- signal_value_attribute + Iir_Kind_Last_Value_Attribute, -- signal_value_attribute + Iir_Kind_Driving_Attribute, -- signal_value_attribute + Iir_Kind_Driving_Value_Attribute, -- signal_value_attribute + Iir_Kind_Behavior_Attribute, + Iir_Kind_Structure_Attribute, + Iir_Kind_Simple_Name_Attribute, + Iir_Kind_Instance_Name_Attribute, + Iir_Kind_Path_Name_Attribute, + + Iir_Kind_Attribute_Name + ); + + type Iir_Signal_Kind is + ( + Iir_No_Signal_Kind, + Iir_Register_Kind, + Iir_Bus_Kind + ); + + -- If the order of elements in IIR_MODE is modified, also modify the + -- order in GRT (types and rtis). + type Iir_Mode is + ( + Iir_Unknown_Mode, + Iir_Linkage_Mode, + Iir_Buffer_Mode, + Iir_Out_Mode, + Iir_Inout_Mode, + Iir_In_Mode + ); + + subtype Iir_In_Modes is Iir_Mode range Iir_Inout_Mode .. Iir_In_Mode; + subtype Iir_Out_Modes is Iir_Mode range Iir_Out_Mode .. Iir_Inout_Mode; + + type Iir_Delay_Mechanism is (Iir_Inertial_Delay, Iir_Transport_Delay); + + type Iir_Direction is (Iir_To, Iir_Downto); + + -- Iir_Lexical_Layout_type describe the lexical token used to describe + -- an interface declaration. This has no semantics meaning, but it is + -- necessary to keep how lexically an interface was declared due to + -- LRM93 2.7 (conformance rules). + -- To keep this simple, the layout is stored as a bit-string. + -- Fields are: + -- Has_type: set if the interface is the last of a list. + -- has_mode: set if mode is explicit + -- has_class: set if class (constant, signal, variable or file) is explicit + -- + -- Exemple: + -- procedure P (A,B: integer; + -- C: in constant bit; + -- D: inout bit; + -- E: variable bit; + -- F, G: in bit; + -- H, I: constant bit; + -- J, K: in constant bit); + -- A: + -- B: has_type + -- C, K: has_mode, has_class, has_type + -- D: has_mode, has_type + -- E, I: has_class, has_type + -- F: has_mode + -- G: has_mode, has_type + -- H: has_class + -- J: has_mode, has_class + type Iir_Lexical_Layout_Type is mod 2 ** 3; + Iir_Lexical_Has_Mode : constant Iir_Lexical_Layout_Type := 2 ** 0; + Iir_Lexical_Has_Class : constant Iir_Lexical_Layout_Type := 2 ** 1; + Iir_Lexical_Has_Type : constant Iir_Lexical_Layout_Type := 2 ** 2; + + -- List of predefined operators and functions. + type Iir_Predefined_Functions is + ( + Iir_Predefined_Error, + + -- Predefined operators for BOOLEAN type. + Iir_Predefined_Boolean_And, + Iir_Predefined_Boolean_Or, + Iir_Predefined_Boolean_Nand, + Iir_Predefined_Boolean_Nor, + Iir_Predefined_Boolean_Xor, + Iir_Predefined_Boolean_Xnor, + Iir_Predefined_Boolean_Not, + + -- Predefined operators for any enumeration type. + Iir_Predefined_Enum_Equality, + Iir_Predefined_Enum_Inequality, + Iir_Predefined_Enum_Less, + Iir_Predefined_Enum_Less_Equal, + Iir_Predefined_Enum_Greater, + Iir_Predefined_Enum_Greater_Equal, + + -- Predefined operators for BIT type. + Iir_Predefined_Bit_And, + Iir_Predefined_Bit_Or, + Iir_Predefined_Bit_Nand, + Iir_Predefined_Bit_Nor, + Iir_Predefined_Bit_Xor, + Iir_Predefined_Bit_Xnor, + Iir_Predefined_Bit_Not, + + -- Predefined operators for any integer type. + Iir_Predefined_Integer_Equality, + Iir_Predefined_Integer_Inequality, + Iir_Predefined_Integer_Less, + Iir_Predefined_Integer_Less_Equal, + Iir_Predefined_Integer_Greater, + Iir_Predefined_Integer_Greater_Equal, + + Iir_Predefined_Integer_Identity, + Iir_Predefined_Integer_Negation, + Iir_Predefined_Integer_Absolute, + + Iir_Predefined_Integer_Plus, + Iir_Predefined_Integer_Minus, + Iir_Predefined_Integer_Mul, + Iir_Predefined_Integer_Div, + Iir_Predefined_Integer_Mod, + Iir_Predefined_Integer_Rem, + + Iir_Predefined_Integer_Exp, + + -- Predefined operators for any floating type. + Iir_Predefined_Floating_Equality, + Iir_Predefined_Floating_Inequality, + Iir_Predefined_Floating_Less, + Iir_Predefined_Floating_Less_Equal, + Iir_Predefined_Floating_Greater, + Iir_Predefined_Floating_Greater_Equal, + + Iir_Predefined_Floating_Identity, + Iir_Predefined_Floating_Negation, + Iir_Predefined_Floating_Absolute, + + Iir_Predefined_Floating_Plus, + Iir_Predefined_Floating_Minus, + Iir_Predefined_Floating_Mul, + Iir_Predefined_Floating_Div, + + Iir_Predefined_Floating_Exp, + + -- Predefined operator for universal types. + Iir_Predefined_Universal_R_I_Mul, + Iir_Predefined_Universal_I_R_Mul, + Iir_Predefined_Universal_R_I_Div, + + -- Predefined operators for physical types. + Iir_Predefined_Physical_Equality, + Iir_Predefined_Physical_Inequality, + Iir_Predefined_Physical_Less, + Iir_Predefined_Physical_Less_Equal, + Iir_Predefined_Physical_Greater, + Iir_Predefined_Physical_Greater_Equal, + + Iir_Predefined_Physical_Identity, + Iir_Predefined_Physical_Negation, + Iir_Predefined_Physical_Absolute, + + Iir_Predefined_Physical_Plus, + Iir_Predefined_Physical_Minus, + + Iir_Predefined_Physical_Integer_Mul, + Iir_Predefined_Physical_Real_Mul, + Iir_Predefined_Integer_Physical_Mul, + Iir_Predefined_Real_Physical_Mul, + Iir_Predefined_Physical_Integer_Div, + Iir_Predefined_Physical_Real_Div, + Iir_Predefined_Physical_Physical_Div, + + -- Predefined operators for access. + Iir_Predefined_Access_Equality, + Iir_Predefined_Access_Inequality, + + -- Predefined operators for record. + Iir_Predefined_Record_Equality, + Iir_Predefined_Record_Inequality, + + -- Predefined operators for array. + Iir_Predefined_Array_Equality, + Iir_Predefined_Array_Inequality, + Iir_Predefined_Array_Less, + Iir_Predefined_Array_Less_Equal, + Iir_Predefined_Array_Greater, + Iir_Predefined_Array_Greater_Equal, + + Iir_Predefined_Array_Array_Concat, + Iir_Predefined_Array_Element_Concat, + Iir_Predefined_Element_Array_Concat, + Iir_Predefined_Element_Element_Concat, + + -- Predefined shift operators. + Iir_Predefined_Array_Sll, + Iir_Predefined_Array_Srl, + Iir_Predefined_Array_Sla, + Iir_Predefined_Array_Sra, + Iir_Predefined_Array_Rol, + Iir_Predefined_Array_Ror, + + -- Predefined operators for one dimensional array + Iir_Predefined_Bit_Array_And, + Iir_Predefined_Bit_Array_Or, + Iir_Predefined_Bit_Array_Nand, + Iir_Predefined_Bit_Array_Nor, + Iir_Predefined_Bit_Array_Xor, + Iir_Predefined_Bit_Array_Xnor, + Iir_Predefined_Bit_Array_Not, + + Iir_Predefined_Boolean_Array_And, + Iir_Predefined_Boolean_Array_Or, + Iir_Predefined_Boolean_Array_Nand, + Iir_Predefined_Boolean_Array_Nor, + Iir_Predefined_Boolean_Array_Xor, + Iir_Predefined_Boolean_Array_Xnor, + Iir_Predefined_Boolean_Array_Not, + + -- Predefined attribute functions. + Iir_Predefined_Attribute_Image, + Iir_Predefined_Attribute_Value, + Iir_Predefined_Attribute_Pos, + Iir_Predefined_Attribute_Val, + Iir_Predefined_Attribute_Succ, + Iir_Predefined_Attribute_Pred, + Iir_Predefined_Attribute_Leftof, + Iir_Predefined_Attribute_Rightof, + Iir_Predefined_Attribute_Left, + Iir_Predefined_Attribute_Right, + Iir_Predefined_Attribute_Low, + Iir_Predefined_Attribute_Event, + Iir_Predefined_Attribute_Active, + Iir_Predefined_Attribute_Last_Event, + Iir_Predefined_Attribute_Last_Active, + Iir_Predefined_Attribute_Last_Value, + Iir_Predefined_Attribute_Driving, + Iir_Predefined_Attribute_Driving_Value, + + -- Access procedure + Iir_Predefined_Deallocate, + + -- file function / procedures. + Iir_Predefined_File_Open, + Iir_Predefined_File_Open_Status, + Iir_Predefined_File_Close, + Iir_Predefined_Read, + Iir_Predefined_Read_Length, + Iir_Predefined_Write, + Iir_Predefined_Endfile, + + -- Predefined function. + Iir_Predefined_Now_Function + ); + + -- Return TRUE iff FUNC is a short-cut predefined function. + function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions) + return Boolean; + + subtype Iir_Predefined_Pure_Functions is Iir_Predefined_Functions range + Iir_Predefined_Boolean_And .. Iir_Predefined_Attribute_Driving_Value; + + subtype Iir_Predefined_Dyadic_Bit_Array_Functions + is Iir_Predefined_Functions range + Iir_Predefined_Bit_Array_And .. + --Iir_Predefined_Bit_Array_Or + --Iir_Predefined_Bit_Array_Nand + --Iir_Predefined_Bit_Array_Nor + --Iir_Predefined_Bit_Array_Xor + Iir_Predefined_Bit_Array_Xnor; + + subtype Iir_Predefined_Shift_Functions is Iir_Predefined_Functions range + Iir_Predefined_Array_Sll .. + --Iir_Predefined_Array_Srl + --Iir_Predefined_Array_Sla + --Iir_Predefined_Array_Sra + --Iir_Predefined_Array_Rol + Iir_Predefined_Array_Ror; + + subtype Iir_Predefined_Concat_Functions is Iir_Predefined_Functions range + Iir_Predefined_Array_Array_Concat .. + --Iir_Predefined_Array_Element_Concat + --Iir_Predefined_Element_Array_Concat + Iir_Predefined_Element_Element_Concat; + + -- Staticness as defined by LRM93 §6.1 and §7.4 + type Iir_Staticness is (Unknown, None, Globally, Locally); + + -- Staticness as defined by LRM93 §6.1 and §7.4 + function Min (L,R: Iir_Staticness) return Iir_Staticness renames + Iir_Staticness'Min; + + -- Purity state of a procedure. + -- PURE means the procedure is pure. + -- IMPURE means the procedure is impure: it references a file object or + -- a signal or a variable declared outside a subprogram, or it calls an + -- impure subprogram. + -- MAYBE_IMPURE means the procedure references a signal or a variable + -- declared in a subprogram. The relative position of a parent has to + -- be considered. The list of callees must not be checked. + -- UNKNOWN is like MAYBE_IMPURE, but the subprogram has a list of callees + -- whose purity is not yet known. As a consequence, a direct or + -- indirect call to such a procedure cannot be proved to be allowed + -- in a pure function. + -- Note: UNKNOWN is the default state. At any impure call, the state is + -- set to IMPURE. Only at the end of body analysis and only if the + -- callee list is empty, the state can be set either to MAYBE_IMPURE or + -- PURE. + type Iir_Pure_State is (Unknown, Pure, Maybe_Impure, Impure); + + --------------- + -- subranges -- + --------------- + -- These subtypes are used for ranges, for `case' statments or for the `in' + -- operator. + + -- In order to be correctly parsed by check_iir, the declaration must + -- follow these rules: + -- * the first line must be "subtype Iir_Kinds_NAME is Iir_Kind_range" + -- * the second line must be the lowest bound of the range, followed by ".. + -- * comments line + -- * the last line must be the highest bound of the range, followed by ";" + +-- subtype Iir_Kinds_List is Iir_Kind range +-- Iir_Kind_List .. +-- Iir_Kind_Callees_List; + + subtype Iir_Kinds_Library_Unit_Declaration is Iir_Kind range + Iir_Kind_Configuration_Declaration .. + --Iir_Kind_Entity_Declaration + --Iir_Kind_Package_Declaration + --Iir_Kind_Package_Body + Iir_Kind_Architecture_Declaration; + + -- Note: does not include iir_kind_enumeration_literal since it is + -- considered as a declaration. + subtype Iir_Kinds_Literal is Iir_Kind range + Iir_Kind_Character_Literal .. + --Iir_Kind_Integer_Literal + --Iir_Kind_Floating_Point_Literal + --Iir_Kind_Null_Literal + --Iir_Kind_String_Literal + --Iir_Kind_Physical_Int_Literal + --Iir_Kind_Physical_Fp_Literal + Iir_Kind_Bit_String_Literal; + + subtype Iir_Kinds_Array_Type_Definition is Iir_Kind range + Iir_Kind_Array_Type_Definition .. + --Iir_Kind_Unconstrained_Array_Subtype_Definition + Iir_Kind_Array_Subtype_Definition; + + subtype Iir_Kinds_Type_And_Subtype_Definition is Iir_Kind range + Iir_Kind_Access_Type_Definition .. + --Iir_Kind_Incomplete_Type_Definition + --Iir_Kind_File_Type_Definition + --Iir_Kind_Protected_Type_Declaration + --Iir_Kind_Record_Type_Definition + --Iir_Kind_Array_Type_Definition + --Iir_Kind_Unconstrained_Array_Subtype_Definition + --Iir_Kind_Array_Subtype_Definition + --Iir_Kind_Record_Subtype_Definition + --Iir_Kind_Access_Subtype_Definition + --Iir_Kind_Physical_Subtype_Definition + --Iir_Kind_Floating_Subtype_Definition + --Iir_Kind_Integer_Subtype_Definition + --Iir_Kind_Enumeration_Subtype_Definition + --Iir_Kind_Integer_Type_Definition + --Iir_Kind_Enumeration_Type_Definition + --Iir_Kind_Floating_Type_Definition + Iir_Kind_Physical_Type_Definition; + + subtype Iir_Kinds_Subtype_Definition is Iir_Kind range + Iir_Kind_Unconstrained_Array_Subtype_Definition .. + --Iir_Kind_Array_Subtype_Definition + --Iir_Kind_Record_Subtype_Definition + --Iir_Kind_Access_Subtype_Definition + --Iir_Kind_Physical_Subtype_Definition + --Iir_Kind_Floating_Subtype_Definition + --Iir_Kind_Integer_Subtype_Definition + Iir_Kind_Enumeration_Subtype_Definition; + + subtype Iir_Kinds_Scalar_Type_Definition is Iir_Kind range + Iir_Kind_Physical_Subtype_Definition .. + --Iir_Kind_Floating_Subtype_Definition + --Iir_Kind_Integer_Subtype_Definition + --Iir_Kind_Enumeration_Subtype_Definition + --Iir_Kind_Integer_Type_Definition + --Iir_Kind_Enumeration_Type_Definition + --Iir_Kind_Floating_Type_Definition + Iir_Kind_Physical_Type_Definition; + + subtype Iir_Kinds_Discrete_Type_Definition is Iir_Kind range + Iir_Kind_Integer_Subtype_Definition .. + --Iir_Kind_Enumeration_Subtype_Definition + --Iir_Kind_Integer_Type_Definition + Iir_Kind_Enumeration_Type_Definition; + + subtype Iir_Kinds_Composite_Type_Definition is Iir_Kind range + Iir_Kind_Record_Type_Definition .. + --Iir_Kind_Array_Type_Definition + --Iir_Kind_Unconstrained_Array_Subtype_Definition + --Iir_Kind_Array_Subtype_Definition + Iir_Kind_Record_Subtype_Definition; + + subtype Iir_Kinds_Unconstrained_Array_Type_Definition is Iir_Kind range + Iir_Kind_Array_Type_Definition .. + Iir_Kind_Unconstrained_Array_Subtype_Definition; + + subtype Iir_Kinds_Array_Subtype_Definition is Iir_Kind range + Iir_Kind_Unconstrained_Array_Subtype_Definition .. + Iir_Kind_Array_Subtype_Definition; + + subtype Iir_Kinds_Type_Declaration is Iir_Kind range + Iir_Kind_Type_Declaration .. + --Iir_Kind_Anonymous_Type_Declaration + Iir_Kind_Subtype_Declaration; + + subtype Iir_Kinds_Nonoverloadable_Declaration is Iir_Kind range + Iir_Kind_Type_Declaration .. + Iir_Kind_Element_Declaration; + + subtype Iir_Kinds_Monadic_Operator is Iir_Kind range + Iir_Kind_Identity_Operator .. + --Iir_Kind_Negation_Operator + --Iir_Kind_Absolute_Operator + Iir_Kind_Not_Operator; + + subtype Iir_Kinds_Dyadic_Operator is Iir_Kind range + Iir_Kind_And_Operator .. + --Iir_Kind_Or_Operator + --Iir_Kind_Nand_Operator + --Iir_Kind_Nor_Operator + --Iir_Kind_Xor_Operator + --Iir_Kind_Xnor_Operator + --Iir_Kind_Equality_Operator + --Iir_Kind_Inequality_Operator + --Iir_Kind_Less_Than_Operator + --Iir_Kind_Less_Than_Or_Equal_Operator + --Iir_Kind_Greater_Than_Operator + --Iir_Kind_Greater_Than_Or_Equal_Operator + --Iir_Kind_Sll_Operator + --Iir_Kind_Sla_Operator + --Iir_Kind_Srl_Operator + --Iir_Kind_Sra_Operator + --Iir_Kind_Rol_Operator + --Iir_Kind_Ror_Operator + --Iir_Kind_Addition_Operator + --Iir_Kind_Substraction_Operator + --Iir_Kind_Concatenation_Operator + --Iir_Kind_Multiplication_Operator + --Iir_Kind_Division_Operator + --Iir_Kind_Modulus_Operator + --Iir_Kind_Remainder_Operator + Iir_Kind_Exponentiation_Operator; + + subtype Iir_Kinds_Function_Declaration is Iir_Kind range + Iir_Kind_Function_Declaration .. + Iir_Kind_Implicit_Function_Declaration; + + subtype Iir_Kinds_Procedure_Declaration is Iir_Kind range + Iir_Kind_Implicit_Procedure_Declaration .. + Iir_Kind_Procedure_Declaration; + + subtype Iir_Kinds_Subprogram_Declaration is Iir_Kind range + Iir_Kind_Function_Declaration .. + --Iir_Kind_Implicit_Function_Declaration + --Iir_Kind_Implicit_Procedure_Declaration + Iir_Kind_Procedure_Declaration; + + subtype Iir_Kinds_Process_Statement is Iir_Kind range + Iir_Kind_Sensitized_Process_Statement .. + Iir_Kind_Process_Statement; + + subtype Iir_Kinds_Interface_Declaration is Iir_Kind range + Iir_Kind_Constant_Interface_Declaration .. + --Iir_Kind_Variable_Interface_Declaration + --Iir_Kind_Signal_Interface_Declaration + Iir_Kind_File_Interface_Declaration; + + subtype Iir_Kinds_Object_Declaration is Iir_Kind range + Iir_Kind_Object_Alias_Declaration .. + --Iir_Kind_File_Declaration + --Iir_Kind_Guard_Signal_Declaration + --Iir_Kind_Signal_Declaration + --Iir_Kind_Variable_Declaration + --Iir_Kind_Constant_Declaration + --Iir_Kind_Iterator_Declaration + --Iir_Kind_Constant_Interface_Declaration + --Iir_Kind_Variable_Interface_Declaration + --Iir_Kind_Signal_Interface_Declaration + Iir_Kind_File_Interface_Declaration; + + subtype Iir_Kinds_Non_Alias_Object_Declaration is Iir_Kind range + Iir_Kind_File_Declaration .. + --Iir_Kind_Guard_Signal_Declaration + --Iir_Kind_Signal_Declaration + --Iir_Kind_Variable_Declaration + --Iir_Kind_Constant_Declaration + --Iir_Kind_Iterator_Declaration + --Iir_Kind_Constant_Interface_Declaration + --Iir_Kind_Variable_Interface_Declaration + --Iir_Kind_Signal_Interface_Declaration + Iir_Kind_File_Interface_Declaration; + + subtype Iir_Kinds_Association_Element is Iir_Kind range + Iir_Kind_Association_Element_By_Expression .. + --Iir_Kind_Association_Element_By_Individual + Iir_Kind_Association_Element_Open; + + subtype Iir_Kinds_Choice is Iir_Kind range + Iir_Kind_Choice_By_Others .. + --Iir_Kind_Choice_By_Expression + --Iir_Kind_Choice_By_Range + --Iir_Kind_Choice_By_None + Iir_Kind_Choice_By_Name; + + subtype Iir_Kinds_Name is Iir_Kind range + Iir_Kind_Simple_Name .. + --Iir_Kind_Slice_Name + --Iir_Kind_Indexed_Name + --Iir_Kind_Selected_Name + --Iir_Kind_Selected_By_All_Name + Iir_Kind_Parenthesis_Name; + + subtype Iir_Kinds_Dereference is Iir_Kind range + Iir_Kind_Dereference .. + Iir_Kind_Implicit_Dereference; + + -- Any attribute that is an expression. + subtype Iir_Kinds_Expression_Attribute is Iir_Kind range + Iir_Kind_Left_Type_Attribute .. + --Iir_Kind_Right_Type_Attribute + --Iir_Kind_High_Type_Attribute + --Iir_Kind_Low_Type_Attribute + --Iir_Kind_Ascending_Type_Attribute + --Iir_Kind_Image_Attribute + --Iir_Kind_Value_Attribute + --Iir_Kind_Pos_Attribute + --Iir_Kind_Val_Attribute + --Iir_Kind_Succ_Attribute + --Iir_Kind_Pred_Attribute + --Iir_Kind_Leftof_Attribute + --Iir_Kind_Rightof_Attribute + --Iir_Kind_Left_Array_Attribute + --Iir_Kind_Right_Array_Attribute + --Iir_Kind_High_Array_Attribute + --Iir_Kind_Low_Array_Attribute + --Iir_Kind_Range_Array_Attribute + --Iir_Kind_Reverse_Range_Array_Attribute + --Iir_Kind_Length_Array_Attribute + --Iir_Kind_Ascending_Array_Attribute + --Iir_Kind_Delayed_Attribute + --Iir_Kind_Stable_Attribute + --Iir_Kind_Quiet_Attribute + --Iir_Kind_Transaction_Attribute + --Iir_Kind_Event_Attribute + --Iir_Kind_Active_Attribute + --Iir_Kind_Last_Event_Attribute + --Iir_Kind_Last_Active_Attribute + --Iir_Kind_Last_Value_Attribute + --Iir_Kind_Driving_Attribute + --Iir_Kind_Driving_Value_Attribute + --Iir_Kind_Behavior_Attribute + --Iir_Kind_Structure_Attribute + --Iir_Kind_Simple_Name_Attribute + --Iir_Kind_Instance_Name_Attribute + Iir_Kind_Path_Name_Attribute; + + subtype Iir_Kinds_Attribute is Iir_Kind range + Iir_Kind_Base_Attribute .. + Iir_Kind_Path_Name_Attribute; + + subtype Iir_Kinds_Type_Attribute is Iir_Kind range + Iir_Kind_Left_Type_Attribute .. + --Iir_Kind_Right_Type_Attribute + --Iir_Kind_High_Type_Attribute + --Iir_Kind_Low_Type_Attribute + Iir_Kind_Ascending_Type_Attribute; + + subtype Iir_Kinds_Scalar_Type_Attribute is Iir_Kind range + Iir_Kind_Pos_Attribute .. + --Iir_Kind_Val_Attribute + --Iir_Kind_Succ_Attribute + --Iir_Kind_Pred_Attribute + --Iir_Kind_Leftof_Attribute + Iir_Kind_Rightof_Attribute; + + subtype Iir_Kinds_Array_Attribute is Iir_Kind range + Iir_Kind_Left_Array_Attribute .. + --Iir_Kind_Right_Array_Attribute + --Iir_Kind_High_Array_Attribute + --Iir_Kind_Low_Array_Attribute + --Iir_Kind_Range_Array_Attribute + --Iir_Kind_Reverse_Range_Array_Attribute + --Iir_Kind_Length_Array_Attribute + Iir_Kind_Ascending_Array_Attribute; + + subtype Iir_Kinds_Signal_Attribute is Iir_Kind range + Iir_Kind_Delayed_Attribute .. + --Iir_Kind_Stable_Attribute + --Iir_Kind_Quiet_Attribute + Iir_Kind_Transaction_Attribute; + + subtype Iir_Kinds_Signal_Value_Attribute is Iir_Kind range + Iir_Kind_Event_Attribute .. + --Iir_Kind_Active_Attribute + --Iir_Kind_Last_Event_Attribute + --Iir_Kind_Last_Active_Attribute + --Iir_Kind_Last_Value_Attribute + --Iir_Kind_Driving_Attribute + Iir_Kind_Driving_Value_Attribute; + + subtype Iir_Kinds_Name_Attribute is Iir_Kind range + Iir_Kind_Simple_Name_Attribute .. + --Iir_Kind_Instance_Name_Attribute + Iir_Kind_Path_Name_Attribute; + + subtype Iir_Kinds_Concurrent_Statement is Iir_Kind range + Iir_Kind_Sensitized_Process_Statement .. + --Iir_Kind_Process_Statement + --Iir_Kind_Concurrent_Conditional_Signal_Assignment + --Iir_Kind_Concurrent_Selected_Signal_Assignment + --Iir_Kind_Concurrent_Assertion_Statement + --Iir_Kind_Concurrent_Procedure_Call_Statement + --Iir_Kind_Block_Statement + --Iir_Kind_Generate_Statement + Iir_Kind_Component_Instantiation_Statement; + + subtype Iir_Kinds_Concurrent_Signal_Assignment is Iir_Kind range + Iir_Kind_Concurrent_Conditional_Signal_Assignment .. + Iir_Kind_Concurrent_Selected_Signal_Assignment; + + subtype Iir_Kinds_Sequential_Statement is Iir_Kind range + Iir_Kind_Signal_Assignment_Statement .. + --Iir_Kind_Null_Statement + --Iir_Kind_Assertion_Statement + --Iir_Kind_Report_Statement + --Iir_Kind_Wait_Statement + --Iir_Kind_Variable_Assignment_Statement + --Iir_Kind_Return_Statement + --Iir_Kind_For_Loop_Statement + --Iir_Kind_While_Loop_Statement + --Iir_Kind_Next_Statement + --Iir_Kind_Exit_Statement + --Iir_Kind_Case_Statement + --Iir_Kind_Procedure_Call_Statement + Iir_Kind_If_Statement; + + subtype Iir_Kinds_Allocator is Iir_Kind range + Iir_Kind_Allocator_By_Expression .. + Iir_Kind_Allocator_By_Subtype; + + subtype Iir_Kinds_Clause is Iir_Kind range + Iir_Kind_Library_Clause .. + Iir_Kind_Use_Clause; + + subtype Iir_Kinds_Specification is Iir_Kind range + Iir_Kind_Attribute_Specification .. + --Iir_Kind_Disconnection_Specification + Iir_Kind_Configuration_Specification; + + subtype Iir_Kinds_Declaration is Iir_Kind range + Iir_Kind_Type_Declaration .. + --Iir_Kind_Anonymous_Type_Declaration + --Iir_Kind_Subtype_Declaration + --Iir_Kind_Configuration_Declaration + --Iir_Kind_Entity_Declaration + --Iir_Kind_Package_Declaration + --Iir_Kind_Package_Body + --Iir_Kind_Architecture_Declaration + --Iir_Kind_Unit_Declaration + --Iir_Kind_Library_Declaration + --Iir_Kind_Component_Declaration + --Iir_Kind_Attribute_Declaration + --Iir_Kind_Group_Template_Declaration + --Iir_Kind_Group_Declaration + --Iir_Kind_Element_Declaration + --Iir_Kind_Non_Object_Alias_Declaration + --Iir_Kind_Function_Body + --Iir_Kind_Function_Declaration + --Iir_Kind_Implicit_Function_Declaration + --Iir_Kind_Implicit_Procedure_Declaration + --Iir_Kind_Procedure_Declaration + --Iir_Kind_Procedure_Body + --Iir_Kind_Enumeration_Literal + --Iir_Kind_Object_Alias_Declaration + --Iir_Kind_File_Declaration + --Iir_Kind_Guard_Signal_Declaration + --Iir_Kind_Signal_Declaration + --Iir_Kind_Variable_Declaration + --Iir_Kind_Constant_Declaration + --Iir_Kind_Iterator_Declaration + --Iir_Kind_Constant_Interface_Declaration + --Iir_Kind_Variable_Interface_Declaration + --Iir_Kind_Signal_Interface_Declaration + Iir_Kind_File_Interface_Declaration; + + ------------------------------------- + -- Types and subtypes declarations -- + ------------------------------------- + + -- Level 1 base class. + subtype Iir is Nodes.Node_Type; + subtype Iir_List is Lists.List_Type; + Null_Iir_List : constant Iir_List := Lists.Null_List; + Iir_List_All : constant Iir_List := Lists.List_All; + Iir_List_Others : constant Iir_List := Lists.List_Others; + subtype Iir_Lists_All_Others is Iir_List + range Iir_List_Others .. Iir_List_All; + + Null_Iir : constant Iir := Nodes.Null_Node; + + function Is_Null (Node : Iir) return Boolean; + pragma Inline (Is_Null); + + function Is_Null_List (Node : Iir_List) return Boolean; + pragma Inline (Is_Null_List); + + function "=" (L, R : Iir) return Boolean renames Nodes."="; + + function Get_Last_Node return Iir renames Nodes.Get_Last_Node; + + function Create_Iir_List return Iir_List + renames Lists.Create_List; + function Get_Nth_Element (L : Iir_List; N : Natural) return Iir + renames Lists.Get_Nth_Element; + procedure Replace_Nth_Element (L : Iir_List; N : Natural; El : Iir) + renames Lists.Replace_Nth_Element; + procedure Append_Element (L : Iir_List; E : Iir) + renames Lists.Append_Element; + procedure Add_Element (L : Iir_List; E : Iir) + renames Lists.Add_Element; + procedure Destroy_Iir_List (L : in out Iir_List) + renames Lists.Destroy_List; + function Get_Nbr_Elements (L : Iir_List) return Natural + renames Lists.Get_Nbr_Elements; + procedure Set_Nbr_Elements (L : Iir_List; Nbr : Natural) + renames Lists.Set_Nbr_Elements; + function Get_First_Element (L : Iir_List) return Iir + renames Lists.Get_First_Element; + function Get_Last_Element (L : Iir_List) return Iir + renames Lists.Get_Last_Element; + function "=" (L, R : Iir_List) return Boolean renames Lists."="; + + -- This is used only for lists. + type Iir_Array is array (Natural range <>) of Iir; + type Iir_Array_Acc is access Iir_Array; + procedure Free is new Ada.Unchecked_Deallocation + (Object => Iir_Array, Name => Iir_Array_Acc); + + -- Date State. + -- This indicates the origin of the data information. + -- This also indicates the state of the unit (loaded or not). + type Date_State_Type is + ( + -- The unit is not yet in the library. + Date_Extern, + + -- The unit is not loaded (still on the disk). + -- All the informations come from the library file. + Date_Disk, + + -- The unit has been parsed, but not analyzed. + -- Only the date information come from the library. + Date_Parse, + + -- The unit has been analyzed. + Date_Analyze + ); + + -- A date is used for analysis order. All design units from a library + -- are ordered according to the date. + type Date_Type is new Nat32; + -- The unit is obseleted (ie replaced) by a more recently analyzed design + -- unit.another design unit. + -- If another design unit depends (directly or not) on an obseleted design + -- unit, it is also obselete, and cannot be defined. + Date_Obsolete : constant Date_Type := 0; + -- The unit was not analyzed. + Date_Not_Analyzed : constant Date_Type := 1; + -- The unit has been analyzed but it has bad dependences. + Date_Bad_Analyze : constant Date_Type := 2; + -- The unit has been parsed but not analyzed. + Date_Parsed : constant Date_Type := 4; + -- The unit is being analyzed. + Date_Analyzing : constant Date_Type := 5; + -- This unit has just been analyzed and should be marked at the last + -- analyzed unit. + Date_Analyzed : constant Date_Type := 6; + -- Used only for default configuration. + -- Such units are always up-to-date. + Date_Uptodate : constant Date_Type := 7; + subtype Date_Valid is Date_Type range 10 .. Date_Type'Last; + + -- Predefined depth values. + -- Depth of a subprogram not declared in another subprogram. + Iir_Depth_Top : constant Iir_Int32 := 0; + -- Purity depth of a pure subprogram. + Iir_Depth_Pure : constant Iir_Int32 := Iir_Int32'Last; + -- Purity depth of an impure subprogram. + Iir_Depth_Impure : constant Iir_Int32 := -1; + + type Base_Type is (Base_2, Base_8, Base_16); + + -- design file + subtype Iir_Design_File is Iir; + + subtype Iir_Design_Unit is Iir; + + subtype Iir_Library_Clause is Iir; + + -- Literals. + --subtype Iir_Text_Literal is Iir; + + subtype Iir_Character_Literal is Iir; + + subtype Iir_Integer_Literal is Iir; + + subtype Iir_Floating_Point_Literal is Iir; + + subtype Iir_String_Literal is Iir; + + subtype Iir_Bit_String_Literal is Iir; + + subtype Iir_Null_Literal is Iir; + + subtype Iir_Physical_Int_Literal is Iir; + + subtype Iir_Physical_Fp_Literal is Iir; + + subtype Iir_Enumeration_Literal is Iir; + + subtype Iir_Simple_Aggregate is Iir; + + subtype Iir_Enumeration_Type_Definition is Iir; + + subtype Iir_Enumeration_Subtype_Definition is Iir; + + subtype Iir_Range_Expression is Iir; + + subtype Iir_Integer_Subtype_Definition is Iir; + + subtype Iir_Integer_Type_Definition is Iir; + + subtype Iir_Floating_Subtype_Definition is Iir; + + subtype Iir_Floating_Type_Definition is Iir; + + subtype Iir_Array_Type_Definition is Iir; + + subtype Iir_Record_Type_Definition is Iir; + + subtype Iir_Protected_Type_Declaration is Iir; + + subtype Iir_Protected_Type_Body is Iir; + + subtype Iir_Subtype_Definition is Iir; + + subtype Iir_Array_Subtype_Definition is Iir; + + subtype Iir_Unconstrained_Array_Subtype_Definition is Iir; + + subtype Iir_Physical_Type_Definition is Iir; + + subtype Iir_Physical_Subtype_Definition is Iir; + + subtype Iir_Access_Type_Definition is Iir; + + subtype Iir_Access_Subtype_Definition is Iir; + + subtype Iir_File_Type_Definition is Iir; + + -- Tuples. + subtype Iir_Proxy is Iir; + + subtype Iir_Waveform_Element is Iir; + + subtype Iir_Conditional_Waveform is Iir; + + subtype Iir_Association_Element_By_Expression is Iir; + + subtype Iir_Association_Element_By_Individual is Iir; + + subtype Iir_Association_Element_Open is Iir; + + subtype Iir_Signature is Iir; + + subtype Iir_Unit_Declaration is Iir; + + subtype Iir_Entity_Aspect_Entity is Iir; + + subtype Iir_Entity_Aspect_Configuration is Iir; + + subtype Iir_Entity_Aspect_Open is Iir; + + subtype Iir_Block_Configuration is Iir; + + subtype Iir_Block_Header is Iir; + + subtype Iir_Component_Configuration is Iir; + + subtype Iir_Binding_Indication is Iir; + + subtype Iir_Entity_Class is Iir; + + subtype Iir_Attribute_Specification is Iir; + + subtype Iir_Attribute_Value is Iir; + + subtype Iir_Selected_Element is Iir; + + subtype Iir_Implicit_Dereference is Iir; + + subtype Iir_Aggregate_Info is Iir; + + subtype Iir_Procedure_Call is Iir; + + subtype Iir_Disconnection_Specification is Iir; + + -- Lists. + + subtype Iir_Index_List is Iir_List; + + subtype Iir_Design_Unit_List is Iir_List; + + subtype Iir_Enumeration_Literal_List is Iir_List; + + subtype Iir_Designator_List is Iir_List; + + subtype Iir_Driver_List is Iir_List; + + subtype Iir_Attribute_Value_Chain is Iir_List; + + subtype Iir_Overload_List is Iir; + + subtype Iir_Group_Constituent_List is Iir_List; + + subtype Iir_Callees_List is Iir_List; + + -- Declaration and children. + subtype Iir_Entity_Declaration is Iir; + + subtype Iir_Signal_Interface_Declaration is Iir; + + subtype Iir_Architecture_Declaration is Iir; + + subtype Iir_Configuration_Declaration is Iir; + + subtype Iir_Type_Declaration is Iir; + + subtype Iir_Anonymous_Type_Declaration is Iir; + + subtype Iir_Subtype_Declaration is Iir; + + subtype Iir_Package_Declaration is Iir; + subtype Iir_Package_Body is Iir; + + subtype Iir_Library_Declaration is Iir; + + subtype Iir_Function_Declaration is Iir; + + subtype Iir_Function_Body is Iir; + + subtype Iir_Procedure_Declaration is Iir; + + subtype Iir_Procedure_Body is Iir; + + subtype Iir_Implicit_Function_Declaration is Iir; + + subtype Iir_Implicit_Procedure_Declaration is Iir; + + subtype Iir_Use_Clause is Iir; + + subtype Iir_Constant_Declaration is Iir; + + subtype Iir_Iterator_Declaration is Iir; + + subtype Iir_Constant_Interface_Declaration is Iir; + + subtype Iir_Variable_Interface_Declaration is Iir; + + subtype Iir_File_Interface_Declaration is Iir; + + subtype Iir_Guard_Signal_Declaration is Iir; + + subtype Iir_Signal_Declaration is Iir; + + subtype Iir_Variable_Declaration is Iir; + + subtype Iir_Component_Declaration is Iir; + + subtype Iir_Element_Declaration is Iir; + + subtype Iir_Object_Alias_Declaration is Iir; + + subtype Iir_Non_Object_Alias_Declaration is Iir; + + subtype Iir_Interface_Declaration is Iir; + + subtype Iir_Configuration_Specification is Iir; + + subtype Iir_File_Declaration is Iir; + + subtype Iir_Attribute_Declaration is Iir; + + subtype Iir_Group_Template_Declaration is Iir; + + subtype Iir_Group_Declaration is Iir; + + -- concurrent_statement and children. + subtype Iir_Concurrent_Statement is Iir; + + subtype Iir_Concurrent_Conditional_Signal_Assignment is Iir; + + subtype Iir_Sensitized_Process_Statement is Iir; + + subtype Iir_Process_Statement is Iir; + + subtype Iir_Component_Instantiation_Statement is Iir; + + subtype Iir_Block_Statement is Iir; + + subtype Iir_Generate_Statement is Iir; + + -- sequential statements. + subtype Iir_If_Statement is Iir; + + subtype Iir_Elsif is Iir; + + subtype Iir_For_Loop_Statement is Iir; + + subtype Iir_While_Loop_Statement is Iir; + + subtype Iir_Exit_Statement is Iir; + subtype Iir_Next_Statement is Iir; + + subtype Iir_Variable_Assignment_Statement is Iir; + + subtype Iir_Signal_Assignment_Statement is Iir; + + subtype Iir_Assertion_Statement is Iir; + + subtype Iir_Report_Statement is Iir; + + subtype Iir_Wait_Statement is Iir; + + subtype Iir_Return_Statement is Iir; + + subtype Iir_Case_Statement is Iir; + + subtype Iir_Procedure_Call_Statement is Iir; + + -- expression and children. + subtype Iir_Expression is Iir; + + subtype Iir_Function_Call is Iir; + + subtype Iir_Aggregate is Iir; + + subtype Iir_Qualified_Expression is Iir; + + subtype Iir_Type_Conversion is Iir; + + subtype Iir_Allocator_By_Expression is Iir; + + subtype Iir_Allocator_By_Subtype is Iir; + + -- names. + subtype Iir_Simple_Name is Iir; + + subtype Iir_Slice_Name is Iir; + + subtype Iir_Selected_Name is Iir; + + subtype Iir_Selected_By_All_Name is Iir; + + subtype Iir_Indexed_Name is Iir; + + subtype Iir_Parenthesis_Name is Iir; + + -- attributes. + subtype Iir_Attribute_Name is Iir; + + -- General methods. + + -- Get the kind of the iir. + function Get_Kind (An_Iir: Iir) return Iir_Kind; + pragma Inline (Get_Kind); + + -- Create a new IIR of kind NEW_KIND, and copy fields from SRC to this + -- iir. Src fields are cleaned. + --function Clone_Iir (Src: Iir; New_Kind : Iir_Kind) return Iir; + + procedure Set_Location (Target: Iir; Location: Location_Type) + renames Nodes.Set_Location; + function Get_Location (Target: Iir) return Location_Type + renames Nodes.Get_Location; + + procedure Location_Copy (Target: Iir; Src: Iir); + + function Create_Iir (Kind: Iir_Kind) return Iir; + function Create_Iir_Error return Iir; + procedure Free_Iir (Target: Iir) renames Nodes.Free_Node; + + -- Disp statistics about node usage. + procedure Disp_Stats; + + -- Design units contained in a design file. + -- Field: Field5 + function Get_First_Design_Unit (Design : Iir) return Iir; + procedure Set_First_Design_Unit (Design : Iir; Chain : Iir); + + -- Field: Field6 + function Get_Last_Design_Unit (Design : Iir) return Iir; + procedure Set_Last_Design_Unit (Design : Iir; Chain : Iir); + + -- Library declaration of a library clause. + -- Field: Field1 + function Get_Library_Declaration (Design : Iir) return Iir; + procedure Set_Library_Declaration (Design : Iir; Library : Iir); + + -- File time stamp is the system time of the file last modification. + -- Field: Field4 (uc) + function Get_File_Time_Stamp (Design : Iir) return Time_Stamp_Id; + procedure Set_File_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id); + + -- Time stamp of the last analysis system time. + -- Field: Field3 (uc) + function Get_Analysis_Time_Stamp (Design : Iir) return Time_Stamp_Id; + procedure Set_Analysis_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id); + + -- The library which FILE belongs to. + -- Field: Field0 + function Get_Library (File : Iir_Design_File) return Iir; + procedure Set_Library (File : Iir_Design_File; Lib : Iir); + + -- List of files which this design file depends on. + -- Field: Field1 (uc) + function Get_File_Dependence_List (File : Iir_Design_File) return Iir_List; + procedure Set_File_Dependence_List (File : Iir_Design_File; Lst : Iir_List); + + -- Identifier for the design file file name. + -- Field: Field12 (pos) + function Get_Design_File_Filename (File : Iir_Design_File) return Name_Id; + procedure Set_Design_File_Filename (File : Iir_Design_File; Name : Name_Id); + + -- Directory of a design file. + -- Field: Field11 (pos) + function Get_Design_File_Directory (File : Iir_Design_File) return Name_Id; + procedure Set_Design_File_Directory (File : Iir_Design_File; Dir : Name_Id); + + -- The parent of a design unit is a design file. + -- Field: Field0 + function Get_Design_File (Unit : Iir_Design_Unit) return Iir_Design_File; + procedure Set_Design_File (Unit : Iir_Design_Unit; File : Iir_Design_File); + + -- Design files of a library. + -- Field: Field1 + function Get_Design_File_Chain (Library : Iir) return Iir_Design_File; + procedure Set_Design_File_Chain (Library : Iir; Chain : Iir_Design_File); + + -- System directory where the library is stored. + -- Field: Field11 (pos) + function Get_Library_Directory (Library : Iir) return Name_Id; + procedure Set_Library_Directory (Library : Iir; Dir : Name_Id); + + -- Symbolic date, used to order design units in a library. + -- Field: Field10 (pos) + function Get_Date (Target : Iir) return Date_Type; + procedure Set_Date (Target : Iir; Date : Date_Type); + + -- Chain of context clauses. + -- Field: Field1 + function Get_Context_Items (Design_Unit : Iir) return Iir; + procedure Set_Context_Items (Design_Unit : Iir; Items_Chain : Iir); + + -- List of design units on which the design unit depends. + -- Field: Field8 (uc) + function Get_Dependence_List (Unit : Iir) return Iir_List; + procedure Set_Dependence_List (Unit : Iir; List : Iir_List); + + -- List of functions or sensitized processes whose analysis checks are not + -- complete. + -- These elements have direct or indirect calls to procedure whose body is + -- not yet analyzed. Therefore, purity or wait checks are not complete. + -- Field: Field9 (uc) + function Get_Analysis_Checks_List (Unit : Iir) return Iir_List; + procedure Set_Analysis_Checks_List (Unit : Iir; List : Iir_List); + + -- Wether the unit is on disk, parsed or analyzed. + -- Field: State1 (pos) + function Get_Date_State (Unit : Iir_Design_Unit) return Date_State_Type; + procedure Set_Date_State (Unit : Iir_Design_Unit; State : Date_State_Type); + + -- If TRUE, the target of the signal assignment is guarded. + -- If FALSE, the target is not guarded. + -- This is determined during sem by examining the declaration(s) of the + -- target (there may be severals declarations in the case of a aggregate + -- target). + -- If UNKNOWN, this is not determined at compile time but at run-time. + -- This is the case for formal signal interfaces of subprograms. + -- Field: State4 (pos) + function Get_Guarded_Target_State (Stmt : Iir) return Tri_State_Type; + procedure Set_Guarded_Target_State (Stmt : Iir; State : Tri_State_Type); + + -- Library unit of a design unit. + -- Field: Field5 + function Get_Library_Unit (Design_Unit : Iir_Design_Unit) return Iir; + procedure Set_Library_Unit (Design_Unit : Iir_Design_Unit; Lib_Unit : Iir); + pragma Inline (Get_Library_Unit); + + -- Every design unit is put in an hash table to find quickly found by its + -- name. This field is a single chain for collisions. + -- Field: Field7 + function Get_Hash_Chain (Design_Unit : Iir_Design_Unit) return Iir; + procedure Set_Hash_Chain (Design_Unit : Iir_Design_Unit; Chain : Iir); + + -- Set the line and the offset in the line, only for the library manager. + -- This is valid until the file is really loaded in memory. On loading, + -- location will contain all this informations. + -- Field: Field1 + -- Field: Field6 + -- Field: Field7 + procedure Set_Pos_Line_Off (Design_Unit: Iir_Design_Unit; + Pos : Source_Ptr; Line, Off: Natural); + procedure Get_Pos_Line_Off (Design_Unit: Iir_Design_Unit; + Pos : out Source_Ptr; Line, Off: out Natural); + + + -- literals. + + -- Value of an integer/physical literal. + -- Field: Int64 + function Get_Value (Lit : Iir) return Iir_Int64; + procedure Set_Value (Lit : Iir; Val : Iir_Int64); + + -- Position (same as lit_type'pos) of an enumeration literal. + -- Field: Field10 (pos) + function Get_Enum_Pos (Lit : Iir) return Iir_Int32; + procedure Set_Enum_Pos (Lit : Iir; Val : Iir_Int32); + + -- Field: Field6 + function Get_Physical_Literal (Unit : Iir) return Iir; + procedure Set_Physical_Literal (Unit : Iir; Lit : Iir); + + -- Value of a physical unit declaration. + -- Field: Field7 + function Get_Physical_Unit_Value (Unit : Iir) return Iir; + procedure Set_Physical_Unit_Value (Unit : Iir; Lit : Iir); + + -- Value of a floating point literal. + -- Field: Fp64 + function Get_Fp_Value (Lit : Iir) return Iir_Fp64; + procedure Set_Fp_Value (Lit : Iir; Val : Iir_Fp64); + + -- Declaration of the literal. + -- This is used to retrieve the genuine enumeration literal for literals + -- created from static expression. + -- Field: Field6 + function Get_Enumeration_Decl (Target : Iir) return Iir; + procedure Set_Enumeration_Decl (Target : Iir; Lit : Iir); + + -- List of elements of a simple aggregate. + -- Field: Field3 (uc) + function Get_Simple_Aggregate_List (Target : Iir) return Iir_List; + procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List); + + -- The logarithm of the base (1, 3 or 4) of a bit string. + -- Field: Field11 (pos) + function Get_Bit_String_Base (Lit : Iir) return Base_Type; + procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type); + + -- The enumeration literal which defines the '0' and '1' value. + -- Field: Field4 + function Get_Bit_String_0 (Lit : Iir) return Iir_Enumeration_Literal; + procedure Set_Bit_String_0 (Lit : Iir; El : Iir_Enumeration_Literal); + + -- Field: Field5 + function Get_Bit_String_1 (Lit : Iir) return Iir_Enumeration_Literal; + procedure Set_Bit_String_1 (Lit : Iir; El : Iir_Enumeration_Literal); + + -- The origin of a literal can be null_iir for a literal generated by the + -- parser, or a node which was statically evaluated to this literal. + -- Such nodes are created by eval_expr. + -- Field: Field2 + function Get_Literal_Origin (Lit : Iir) return Iir; + procedure Set_Literal_Origin (Lit : Iir; Orig : Iir); + + -- tuples. + + function Create_Proxy (Proxy: Iir) return Iir_Proxy; + + -- Field: Field1 + function Get_Proxy (Target : Iir_Proxy) return Iir; + procedure Set_Proxy (Target : Iir_Proxy; Proxy : Iir); + + -- Field: Field3 (uc) + function Get_Entity_Class (Target : Iir) return Token_Type; + procedure Set_Entity_Class (Target : Iir; Kind : Token_Type); + + -- Field: Field1 (uc) + function Get_Entity_Name_List (Target : Iir) return Iir_List; + procedure Set_Entity_Name_List (Target : Iir; Names : Iir_List); + + -- Field: Field6 + function Get_Attribute_Designator (Target : Iir) return Iir; + procedure Set_Attribute_Designator (Target : Iir; Designator : Iir); + + -- Chain of attribute specifications. This is used only during sem, to + -- check that no named entity of a given class appear after an attr. spec. + -- with the entity name list OTHERS or ALL. + -- Field: Field7 + function Get_Attribute_Specification_Chain (Target : Iir) return Iir; + procedure Set_Attribute_Specification_Chain (Target : Iir; Chain : Iir); + + -- Field: Field4 + function Get_Attribute_Specification (Val : Iir) return Iir; + procedure Set_Attribute_Specification (Val : Iir; Attr : Iir); + + -- Field: Field4 (uc) + function Get_Signal_List (Target : Iir) return Iir_List; + procedure Set_Signal_List (Target : Iir; List : Iir_List); + + -- Field: Field3 + function Get_Designated_Entity (Val : Iir_Attribute_Value) return Iir; + procedure Set_Designated_Entity (Val : Iir_Attribute_Value; Entity : Iir); + + -- Field: Field1 + function Get_Formal (Target : Iir) return Iir; + procedure Set_Formal (Target : Iir; Formal : Iir); + + -- Field: Field3 + function Get_Actual (Target : Iir) return Iir; + procedure Set_Actual (Target : Iir; Actual : Iir); + + -- Field: Field4 + function Get_In_Conversion (Target : Iir) return Iir; + procedure Set_In_Conversion (Target : Iir; Conv : Iir); + + -- Field: Field5 + function Get_Out_Conversion (Target : Iir) return Iir; + procedure Set_Out_Conversion (Target : Iir; Conv : Iir); + + -- This flag is set when the formal is associated in whole (ie, not + -- individually). + -- Field: Flag1 + function Get_Whole_Association_Flag (Target : Iir) return Boolean; + procedure Set_Whole_Association_Flag (Target : Iir; Flag : Boolean); + + -- This flag is set when the formal signal can be the actual signal. In + -- this case, the formal signal is not created, and the actual is shared. + -- This is the signal collapsing optimisation. + -- Field: Flag2 + function Get_Collapse_Signal_Flag (Target : Iir) return Boolean; + procedure Set_Collapse_Signal_Flag (Target : Iir; Flag : Boolean); + + -- Set when the node was artificially created, eg by canon. + -- Currently used only by association_element_open. + -- Field: Flag3 + function Get_Artificial_Flag (Target : Iir) return Boolean; + procedure Set_Artificial_Flag (Target : Iir; Flag : Boolean); + + -- This flag is set for a very short time during the check that no in + -- port is unconnected. + -- Field: Flag3 + function Get_Open_Flag (Target : Iir) return Boolean; + procedure Set_Open_Flag (Target : Iir; Flag : Boolean); + + -- Field: Field1 + function Get_We_Value (We : Iir_Waveform_Element) return Iir; + procedure Set_We_Value (We : Iir_Waveform_Element; An_Iir : Iir); + + -- Field: Field3 + function Get_Time (We : Iir_Waveform_Element) return Iir; + procedure Set_Time (We : Iir_Waveform_Element; An_Iir : Iir); + + -- Node associated with a choice. + -- Field: Field1 + function Get_Associated (Target : Iir) return Iir; + procedure Set_Associated (Target : Iir; Associated : Iir); + + -- Set when a choice belongs to the same alternative as the previous one. + -- Field: Flag1 + function Get_Same_Alternative_Flag (Target : Iir) return Boolean; + procedure Set_Same_Alternative_Flag (Target : Iir; Val : Boolean); + + -- Field: Field2 + function Get_Architecture (Target : Iir_Entity_Aspect_Entity) return Iir; + procedure Set_Architecture (Target : Iir_Entity_Aspect_Entity; Arch : Iir); + + -- Field: Field5 + function Get_Block_Specification (Target : Iir) return Iir; + procedure Set_Block_Specification (Target : Iir; Block : Iir); + + -- Return the link of the previous block_configuration of a + -- block_configuration. + -- This single linked list is used to list all the block_configuration that + -- configuration the same block (which can only be an iterative generate + -- statement). + -- All elements of this list must belong to the same block configuration. + -- The order is not important. + -- Field: Field4 + function Get_Prev_Block_Configuration (Target : Iir) return Iir; + procedure Set_Prev_Block_Configuration (Target : Iir; Block : Iir); + + -- Field: Field3 + function Get_Configuration_Item_Chain (Target : Iir) return Iir; + procedure Set_Configuration_Item_Chain (Target : Iir; Chain : Iir); + + -- Chain of attribute values for a named entity. + -- To be used with Get/Set_Chain. + -- There is no order, therefore, a new attribute value may be always + -- prepended. + -- Field: Field4 + function Get_Attribute_Value_Chain (Target : Iir) return Iir; + procedure Set_Attribute_Value_Chain (Target : Iir; Chain : Iir); + + -- Next attribute value in the attribute specification chain (of attribute + -- value). + -- Field: Field0 + function Get_Spec_Chain (Target : Iir) return Iir; + procedure Set_Spec_Chain (Target : Iir; Chain : Iir); + + -- Chain of attribute values for attribute specification. + -- To be used with Get/Set_Spec_Chain. + -- Field: Field4 + function Get_Attribute_Value_Spec_Chain (Target : Iir) return Iir; + procedure Set_Attribute_Value_Spec_Chain (Target : Iir; Chain : Iir); + + -- Field: Field4 + function Get_Entity (Decl : Iir) return Iir; + procedure Set_Entity (Decl : Iir; Entity : Iir); + + -- The package declaration corresponding to the body. + -- Field: Field4 + function Get_Package (Package_Body : Iir) return Iir_Package_Declaration; + procedure Set_Package (Package_Body : Iir; Decl : Iir_Package_Declaration); + + -- The package body corresponding to the package declaration. + -- Field: Field4 + function Get_Package_Body (Pkg : Iir) return Iir_Package_Body; + procedure Set_Package_Body (Pkg : Iir; Decl : Iir_Package_Body); + + -- If true, the package need a body. + -- Field: Flag1 + function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean; + procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean); + + -- Field: Field5 + function Get_Block_Configuration (Target : Iir) return Iir; + procedure Set_Block_Configuration (Target : Iir; Block : Iir); + + -- Field: Field5 + function Get_Concurrent_Statement_Chain (Target : Iir) return Iir; + procedure Set_Concurrent_Statement_Chain (Target : Iir; First : Iir); + + -- Field: Field2 + function Get_Chain (Target : Iir) return Iir; + procedure Set_Chain (Target : Iir; Chain : Iir); + pragma Inline (Get_Chain); + + -- Field: Field7 + function Get_Port_Chain (Target : Iir) return Iir; + procedure Set_Port_Chain (Target : Iir; Chain : Iir); + + -- Field: Field6 + function Get_Generic_Chain (Target : Iir) return Iir; + procedure Set_Generic_Chain (Target : Iir; Generics : Iir); + + -- Field: Field1 + function Get_Type (Target : Iir) return Iir; + procedure Set_Type (Target : Iir; Atype : Iir); + pragma Inline (Get_Type); + + -- The subtype definition associated with the type declaration (if any). + -- Field: Field4 + function Get_Subtype_Definition (Target : Iir) return Iir; + procedure Set_Subtype_Definition (Target : Iir; Def : Iir); + + -- Mode of interfaces or file (v87). + -- Field: Odigit2 (pos) + function Get_Mode (Target : Iir) return Iir_Mode; + procedure Set_Mode (Target : Iir; Mode : Iir_Mode); + + -- Field: State4 (pos) + function Get_Signal_Kind (Target : Iir) return Iir_Signal_Kind; + procedure Set_Signal_Kind (Target : Iir; Signal_Kind : Iir_Signal_Kind); + + -- The base name of a name is the node at the origin of the name. + -- The base name is a declaration (signal, object, constant or interface), + -- a selected_by_all name, an implicit_dereference name. + -- Field: Field5 + function Get_Base_Name (Target : Iir) return Iir; + procedure Set_Base_Name (Target : Iir; Name : Iir); + pragma Inline (Get_Base_Name); + + -- Field: Field5 + function Get_Interface_Declaration_Chain (Target : Iir) return Iir; + procedure Set_Interface_Declaration_Chain (Target : Iir; Chain : Iir); + pragma Inline (Get_Interface_Declaration_Chain); + + -- Field: Field4 + function Get_Subprogram_Specification (Target : Iir) return Iir; + procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir); + + -- Field: Field5 + function Get_Sequential_Statement_Chain (Target : Iir) return Iir; + procedure Set_Sequential_Statement_Chain (Target : Iir; Chain : Iir); + + -- Field: Field6 + function Get_Subprogram_Body (Target : Iir) return Iir; + procedure Set_Subprogram_Body (Target : Iir; A_Body : Iir); + + -- Several subprograms in a declarative region may have the same + -- identifier. If the overload number is not 0, it is the rank of the + -- subprogram. If the overload number is 0, then the identifier is not + -- overloaded in the declarative region. + -- Field: Field9 (pos) + function Get_Overload_Number (Target : Iir) return Iir_Int32; + procedure Set_Overload_Number (Target : Iir; Val : Iir_Int32); + + -- Depth of a subprogram. + -- For a subprogram declared immediatly within an entity, architecture, + -- package, process, block, generate, the depth is 0. + -- For a subprogram declared immediatly within a subprogram of level N, + -- the depth is N + 1. + -- Depth is used with depth of impure objects to check purity rules. + -- Field: Field10 (pos) + function Get_Subprogram_Depth (Target : Iir) return Iir_Int32; + procedure Set_Subprogram_Depth (Target : Iir; Depth : Iir_Int32); + + -- Hash of a subprogram profile. + -- This is used to speed up subprogram profile comparaison, which is very + -- often used by overload. + -- Field: Field11 (pos) + function Get_Subprogram_Hash (Target : Iir) return Iir_Int32; + procedure Set_Subprogram_Hash (Target : Iir; Val : Iir_Int32); + pragma Inline (Get_Subprogram_Hash); + + -- Index for extra infos. + -- Subprograms and processes need a lot of field in their nodes. + -- Unfortunatly, the size of the nodes is limited and these infos are + -- only used for optimization. + -- This is an index into a separate table. + -- Field: Field12 (pos) + function Get_Extra_Info (Target : Iir) return Iir_Int32; + procedure Set_Extra_Info (Target : Iir; Info : Iir_Int32); + + -- Depth of the deepest impure object. + -- Field: Field3 (uc) + function Get_Impure_Depth (Target : Iir) return Iir_Int32; + procedure Set_Impure_Depth (Target : Iir; Depth : Iir_Int32); + + -- Field: Field1 + function Get_Return_Type (Target : Iir) return Iir; + procedure Set_Return_Type (Target : Iir; Decl : Iir); + pragma Inline (Get_Return_Type); + + -- Code of an implicit subprogram definition. + -- Field: Field6 (pos) + function Get_Implicit_Definition (D : Iir) return Iir_Predefined_Functions; + procedure Set_Implicit_Definition (D : Iir; Def : Iir_Predefined_Functions); + + -- For an implicit subprogram, the type_reference is the type declaration + -- for which the implicit subprogram was defined. + -- Field: Field8 + function Get_Type_Reference (Target : Iir) return Iir; + procedure Set_Type_Reference (Target : Iir; Decl : Iir); + + -- Get the default value of an object declaration. + -- Null_iir if no default value. + -- Field: Field6 + function Get_Default_Value (Target : Iir) return Iir; + procedure Set_Default_Value (Target : Iir; Value : Iir); + + -- The deferred_declaration field points to the deferred constant + -- declaration for a full constant declaration, or is null_iir for a + -- usual or deferred constant declaration. + -- Set only during sem. + -- Field: Field7 + function Get_Deferred_Declaration (Target : Iir) return Iir; + procedure Set_Deferred_Declaration (Target : Iir; Decl : Iir); + + -- The deferred_declaration_flag must be set if the constant declaration is + -- a deferred_constant declaration. + -- Set only during sem. + -- Field: Flag1 + function Get_Deferred_Declaration_Flag (Target : Iir) return Boolean; + procedure Set_Deferred_Declaration_Flag (Target : Iir; Flag : Boolean); + + -- If true, the variable is declared shared. + -- Field: Flag2 + function Get_Shared_Flag (Target : Iir) return Boolean; + procedure Set_Shared_Flag (Target : Iir; Shared : Boolean); + + -- Get the design unit in which the target is declared. + -- For a library unit, this is to get the design unit node. + -- Field: Field0 + function Get_Design_Unit (Target : Iir) return Iir_Design_Unit; + procedure Set_Design_Unit (Target : Iir; Unit : Iir_Design_Unit); + + -- Field: Field7 + function Get_Block_Statement (Target : Iir) return Iir_Block_Statement; + procedure Set_Block_Statement (Target : Iir; Block : Iir_Block_Statement); + + -- For a non-resolved signal: null_iir if the signal has no driver, or + -- a process/concurrent_statement for which the signal should have a + -- driver. This is used to catch at analyse time unresolved signals with + -- several drivers. + -- Field: Field7 + function Get_Signal_Driver (Target : Iir_Signal_Declaration) return Iir; + procedure Set_Signal_Driver (Target : Iir_Signal_Declaration; Driver : Iir); + + -- Field: Field1 + function Get_Declaration_Chain (Target : Iir) return Iir; + procedure Set_Declaration_Chain (Target : Iir; Decls : Iir); + + -- Field: Field6 + function Get_File_Logical_Name (Target : Iir_File_Declaration) return Iir; + procedure Set_File_Logical_Name (Target : Iir_File_Declaration; Name : Iir); + + -- Field: Field7 + function Get_File_Open_Kind (Target : Iir_File_Declaration) return Iir; + procedure Set_File_Open_Kind (Target : Iir_File_Declaration; Kind : Iir); + + -- Field: Field4 (pos) + function Get_Element_Position (Target : Iir) return Iir_Index32; + procedure Set_Element_Position (Target : Iir; Pos : Iir_Index32); + + -- Field: Field2 + function Get_Selected_Element (Target : Iir) return Iir; + procedure Set_Selected_Element (Target : Iir; El : Iir); + + -- Field: Field2 (uc) + function Get_Suffix_Identifier (Target : Iir) return Name_Id; + procedure Set_Suffix_Identifier (Target : Iir; Ident : Name_Id); + + -- Field: Field2 (uc) + function Get_Attribute_Identifier (Target : Iir) return Name_Id; + procedure Set_Attribute_Identifier (Target : Iir; Ident : Name_Id); + + -- Selected names of an use_clause are chained. + -- Field: Field3 + function Get_Use_Clause_Chain (Target : Iir) return Iir; + procedure Set_Use_Clause_Chain (Target : Iir; Chain : Iir); + + -- Selected name of an use_clause. + -- Field: Field1 + function Get_Selected_Name (Target : Iir_Use_Clause) return Iir; + procedure Set_Selected_Name (Target : Iir_Use_Clause; Name : Iir); + + -- The type declarator which declares the type definition TARGET. + -- Field: Field3 + function Get_Type_Declarator (Target : Iir) return Iir; + procedure Set_Type_Declarator (Target : Iir; Decl : Iir); + + -- Field: Field2 (uc) + function Get_Enumeration_Literal_List (Target : Iir) return Iir_List; + procedure Set_Enumeration_Literal_List (Target : Iir; List : Iir_List); + + -- Field: Field1 + function Get_Entity_Class_Entry_Chain (Target : Iir) return Iir; + procedure Set_Entity_Class_Entry_Chain (Target : Iir; Chain : Iir); + + -- Field: Field1 (uc) + function Get_Group_Constituent_List (Group : Iir) return Iir_List; + procedure Set_Group_Constituent_List (Group : Iir; List : Iir_List); + + -- Chain of physical type units. + -- The first unit is the primary unit. If you really need the primary + -- unit (and not the chain), you'd better to use Get_Primary_Unit. + -- Field: Field1 + function Get_Unit_Chain (Target : Iir) return Iir; + procedure Set_Unit_Chain (Target : Iir; Chain : Iir); + + -- Alias of Get_Unit_Chain. + -- Return the primary unit of a physical type. + -- Field: Field1 + function Get_Primary_Unit (Target : Iir) return Iir; + + -- Get/Set the identifier of a declaration. + -- Can also be used instead of get/set_label. + -- Field: Field3 (uc) + function Get_Identifier (Target : Iir) return Name_Id; + procedure Set_Identifier (Target : Iir; Identifier : Name_Id); + pragma Inline (Get_Identifier); + + -- Field: Field3 (uc) + function Get_Label (Target : Iir) return Name_Id; + procedure Set_Label (Target : Iir; Label : Name_Id); + + -- Get/Set the visible flag of a declaration. + -- The visible flag is true to make invalid the use of the identifier + -- during its declaration. It is set to false when the identifier is added + -- to the name table, and set to true when the declaration is finished. + -- Field: Flag4 + function Get_Visible_Flag (Target : Iir) return Boolean; + procedure Set_Visible_Flag (Target : Iir; Flag : Boolean); + + -- Field: Field1 + function Get_Range_Constraint (Target : Iir) return Iir; + procedure Set_Range_Constraint (Target : Iir; Constraint : Iir); + + -- Field: State2 (pos) + function Get_Direction (Decl : Iir) return Iir_Direction; + procedure Set_Direction (Decl : Iir; Dir : Iir_Direction); + + -- Field: Field2 + function Get_Left_Limit (Decl : Iir_Range_Expression) return Iir; + procedure Set_Left_Limit (Decl : Iir_Range_Expression; Limit : Iir); + + -- Field: Field3 + function Get_Right_Limit (Decl : Iir_Range_Expression) return Iir; + procedure Set_Right_Limit (Decl : Iir_Range_Expression; Limit : Iir); + + -- Field: Field4 + function Get_Base_Type (Decl : Iir) return Iir; + procedure Set_Base_Type (Decl : Iir; Base_Type : Iir); + pragma Inline (Get_Base_Type); + + -- Field: Field5 + function Get_Resolution_Function (Decl : Iir) return Iir; + procedure Set_Resolution_Function (Decl : Iir; Func : Iir); + + -- Field: Flag3 + function Get_Text_File_Flag (Target : Iir) return Boolean; + procedure Set_Text_File_Flag (Target : Iir; Flag : Boolean); + + -- Field: State1 (pos) + function Get_Type_Staticness (Target : Iir) return Iir_Staticness; + procedure Set_Type_Staticness (Target : Iir; Static : Iir_Staticness); + + -- Field: Field6 (uc) + function Get_Index_Subtype_List (Decl : Iir) return Iir_List; + procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List); + + -- Field: Field2 (uc) + function Get_Index_List (Decl : Iir) return Iir_List; + procedure Set_Index_List (Decl : Iir; List : Iir_List); + + -- Field: Field1 + function Get_Element_Subtype (Decl : Iir) return Iir; + procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir); + + -- Chains of elements of a record. + -- Field: Field2 + function Get_Element_Declaration_Chain (Decl : Iir) return Iir; + procedure Set_Element_Declaration_Chain (Decl : Iir; Chain : Iir); + + -- Number of elements in the record. + -- Field: Field1 (uc) + function Get_Number_Element_Declaration (Decl : Iir) return Iir_Index32; + procedure Set_Number_Element_Declaration (Decl : Iir; Val : Iir_Index32); + + -- Field: Field2 + function Get_Designated_Type (Target : Iir) return Iir; + procedure Set_Designated_Type (Target : Iir; Dtype : Iir); + + -- Field: Field1 + function Get_Target (Target : Iir) return Iir; + procedure Set_Target (Target : Iir; Atarget : Iir); + + -- Field: Field5 + function Get_Waveform_Chain (Target : Iir) return Iir_Waveform_Element; + procedure Set_Waveform_Chain (Target : Iir; Chain : Iir_Waveform_Element); + + -- Field: Field8 + function Get_Guard (Target : Iir) return Iir; + procedure Set_Guard (Target : Iir; Guard : Iir); + + -- Field: Field12 (pos) + function Get_Delay_Mechanism (Target : Iir) return Iir_Delay_Mechanism; + procedure Set_Delay_Mechanism (Target : Iir; Kind : Iir_Delay_Mechanism); + + -- Field: Field6 + function Get_Reject_Time_Expression (Target : Iir) return Iir; + procedure Set_Reject_Time_Expression (Target : Iir; Expr : Iir); + + -- Field: Field6 (uc) + function Get_Sensitivity_List (Wait : Iir) return Iir_List; + procedure Set_Sensitivity_List (Wait : Iir; List : Iir_List); + + -- Field: Field5 + function Get_Condition_Clause (Wait : Iir_Wait_Statement) return Iir; + procedure Set_Condition_Clause (Wait : Iir_Wait_Statement; Cond : Iir); + + -- Field: Field1 + function Get_Timeout_Clause (Wait : Iir_Wait_Statement) return Iir; + procedure Set_Timeout_Clause (Wait : Iir_Wait_Statement; Timeout : Iir); + + -- If set, the concurrent statement is postponed. + -- Field: Flag3 + function Get_Postponed_Flag (Target : Iir) return Boolean; + procedure Set_Postponed_Flag (Target : Iir; Value : Boolean); + + -- Returns a list of signal or ports which are assigned in the current + -- subprogram or process. + -- Can return null_iir if there is no such assignment. + -- Field: Field8 (uc) + function Get_Driver_List (Stmt : Iir) return Iir_List; + procedure Set_Driver_List (Stmt : Iir; List : Iir_List); + + -- Returns the list of subprogram called in this subprogram or process. + -- Note: implicit function (such as implicit operators) are omitted + -- from this list, since the purpose of this list is to correctly set + -- flags for side effects (purity_state, wait_state). + -- Can return null_iir if there is no subprogram called. + -- Field: Field7 (uc) + function Get_Callees_List (Proc : Iir) return Iir_List; + procedure Set_Callees_List (Proc : Iir; List : Iir_List); + + -- Get/Set the passive flag of a process. + -- TRUE if the process must be passive. + -- FALSE if the process may be not passive. + -- For a procedure declaration, set if it is passive. + -- Field: Flag2 + function Get_Passive_Flag (Proc : Iir) return Boolean; + procedure Set_Passive_Flag (Proc : Iir; Flag : Boolean); + + -- Get/Set the wait state of the current subprogram or process. + -- TRUE if it contains a wait statement, either directly or + -- indirectly. + -- FALSE if it doesn't contain a wait statement. + -- UNKNOWN if the wait status is not yet known. + -- Field: State1 (pos) + function Get_Wait_State (Proc : Iir) return Tri_State_Type; + procedure Set_Wait_State (Proc : Iir; State : Tri_State_Type); + + -- Get/Set the seen flag. + -- Used when the graph of callees is walked, to avoid infinite loops, since + -- the graph is not a DAG (there may be cycles). + -- Field: Flag1 + function Get_Seen_Flag (Proc : Iir) return Boolean; + procedure Set_Seen_Flag (Proc : Iir; Flag : Boolean); + + -- Get/Set the pure flag of a function. + -- TRUE if the function is declared pure. + -- FALSE if the function is declared impure. + -- Field: Flag2 + function Get_Pure_Flag (Func : Iir) return Boolean; + procedure Set_Pure_Flag (Func : Iir; Flag : Boolean); + + -- Get/Set the foreign flag of a declaration. + -- TRUE if the declaration was decored with the std.foreign attribute. + -- Field: Flag3 + function Get_Foreign_Flag (Decl : Iir) return Boolean; + procedure Set_Foreign_Flag (Decl : Iir; Flag : Boolean); + + -- Get/Set the resolved flag of a subtype definition. + -- A subtype definition may be resolved either because a + -- resolution_function_name is present in the subtype_indication, or + -- because all elements type are resolved. + -- Field: Flag1 + function Get_Resolved_Flag (Atype : Iir) return Boolean; + procedure Set_Resolved_Flag (Atype : Iir; Flag : Boolean); + + -- Get/Set the signal_type flag of a type/subtype definition. + -- This flags indicates whether the type can be used as a signal type. + -- Access types, file types and composite types whose a sub-element is + -- an access type cannot be used as a signal type. + -- Field: Flag2 + function Get_Signal_Type_Flag (Atype : Iir) return Boolean; + procedure Set_Signal_Type_Flag (Atype : Iir; Flag : Boolean); + + -- Get/Set the purity status of a subprogram. + -- Field: State3 (pos) + function Get_Purity_State (Proc : Iir) return Iir_Pure_State; + procedure Set_Purity_State (Proc : Iir; State : Iir_Pure_State); + + -- Set during binding when DESIGN is added in a list of file to bind. + -- Field: Flag3 + function Get_Elab_Flag (Design : Iir) return Boolean; + procedure Set_Elab_Flag (Design : Iir; Flag : Boolean); + + -- Condition of an assertion. + -- Field: Field1 + function Get_Assertion_Condition (Target : Iir) return Iir; + procedure Set_Assertion_Condition (Target : Iir; Cond : Iir); + + -- Report expression of an assertion or report statement. + -- Field: Field6 + function Get_Report_Expression (Target : Iir) return Iir; + procedure Set_Report_Expression (Target : Iir; Expr : Iir); + + -- Severity expression of an assertion or report statement. + -- Field: Field5 + function Get_Severity_Expression (Target : Iir) return Iir; + procedure Set_Severity_Expression (Target : Iir; Expr : Iir); + + -- Instantiated unit of a component instantiation statement. + -- Field: Field1 + function Get_Instantiated_Unit (Target : Iir) return Iir; + procedure Set_Instantiated_Unit (Target : Iir; Unit : Iir); + + -- Generic map aspect list. + -- Field: Field8 + function Get_Generic_Map_Aspect_Chain (Target : Iir) return Iir; + procedure Set_Generic_Map_Aspect_Chain (Target : Iir; Generics : Iir); + + -- Port map aspect list. + -- Field: Field9 + function Get_Port_Map_Aspect_Chain (Target : Iir) return Iir; + procedure Set_Port_Map_Aspect_Chain (Target : Iir; Port : Iir); + + -- Configuration of an entity_aspect_configuration. + -- Field: Field1 + function Get_Configuration (Target : Iir) return Iir; + procedure Set_Configuration (Target : Iir; Conf : Iir); + + -- Component configuration for a component_instantiation_statement. + -- Field: Field6 + function Get_Component_Configuration (Target : Iir) return Iir; + procedure Set_Component_Configuration (Target : Iir; Conf : Iir); + + -- Configuration specification for a component_instantiation_statement. + -- Field: Field7 + function Get_Configuration_Specification (Target : Iir) return Iir; + procedure Set_Configuration_Specification (Target : Iir; Conf : Iir); + + -- Set/Get the default binding indication of a configuration specification + -- or a component configuration. + -- Field: Field5 + function Get_Default_Binding_Indication (Target : Iir) return Iir; + procedure Set_Default_Binding_Indication (Target : Iir; Conf : Iir); + + -- Set/Get the default configuration of an architecture. + -- Field: Field6 + function Get_Default_Configuration_Declaration (Target : Iir) return Iir; + procedure Set_Default_Configuration_Declaration (Target : Iir; Conf : Iir); + + -- Expression for an various nodes. + -- Field: Field5 + function Get_Expression (Target : Iir) return Iir; + procedure Set_Expression (Target : Iir; Expr : Iir); + + -- Field: Field7 + function Get_Selected_Waveform_Chain (Target : Iir) return Iir; + procedure Set_Selected_Waveform_Chain (Target : Iir; Chain : Iir); + + -- Field: Field7 + function Get_Conditional_Waveform_Chain (Target : Iir) return Iir; + procedure Set_Conditional_Waveform_Chain (Target : Iir; Chain : Iir); + + -- Expression defining the value of the implicit guard signal. + -- Field: Field2 + function Get_Guard_Expression (Target : Iir) return Iir; + procedure Set_Guard_Expression (Target : Iir; Expr : Iir); + + -- The declaration (if any) of the implicit guard signal of a block + -- statement. + -- Field: Field8 + function Get_Guard_Decl (Target : Iir_Block_Statement) return Iir; + procedure Set_Guard_Decl (Target : Iir_Block_Statement; Decl : Iir); + + -- Sensitivity list for the implicit guard signal. + -- Field: Field6 (uc) + function Get_Guard_Sensitivity_List (Guard : Iir) return Iir_List; + procedure Set_Guard_Sensitivity_List (Guard : Iir; List : Iir_List); + + -- Block_Configuration that applies to this block statement. + -- Field: Field6 + function Get_Block_Block_Configuration (Block : Iir) return Iir; + procedure Set_Block_Block_Configuration (Block : Iir; Conf : Iir); + + -- Field: Field7 + function Get_Block_Header (Target : Iir) return Iir; + procedure Set_Block_Header (Target : Iir; Header : Iir); + + -- Get/Set the block_configuration (there may be several + -- block_configuration through the use of prev_configuration singly linked + -- list) that apply to this generate statement. + -- Field: Field7 + function Get_Generate_Block_Configuration (Target : Iir) return Iir; + procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir); + + -- Field: Field6 + function Get_Generation_Scheme (Target : Iir) return Iir; + procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir); + + -- Condition of a conditionam_waveform, if_statement, elsif, + -- while_loop_statement, next_statement or exit_statement. + -- Field: Field1 + function Get_Condition (Target : Iir) return Iir; + procedure Set_Condition (Target : Iir; Condition : Iir); + + -- Field: Field6 + function Get_Else_Clause (Target : Iir) return Iir_Elsif; + procedure Set_Else_Clause (Target : Iir; Clause : Iir_Elsif); + + -- Iterator of a for_loop_statement. + -- Field: Field1 + function Get_Iterator_Scheme (Target : Iir) return Iir; + procedure Set_Iterator_Scheme (Target : Iir; Iterator : Iir); + + -- Get/Set the statement in which TARGET appears. This is used to check + -- if next/exit is in a loop. + -- Field: Field0 + function Get_Parent (Target : Iir) return Iir; + procedure Set_Parent (Target : Iir; Parent : Iir); + + -- Loop label for an exit_statement or next_statement. + -- Field: Field5 + function Get_Loop (Target : Iir) return Iir; + procedure Set_Loop (Target : Iir; Stmt : Iir); + + -- Component name for a component_configuration or + -- a configuration_specification. + -- Field: Field4 + function Get_Component_Name (Target : Iir) return Iir; + procedure Set_Component_Name (Target : Iir; Name : Iir); + + -- Field: Field1 (uc) + function Get_Instantiation_List (Target : Iir) return Iir_List; + procedure Set_Instantiation_List (Target : Iir; List : Iir_List); + + -- Field: Field3 + function Get_Entity_Aspect (Target : Iir_Binding_Indication) return Iir; + procedure Set_Entity_Aspect (Target : Iir_Binding_Indication; Entity : Iir); + + -- Field: Field1 + function Get_Default_Entity_Aspect (Target : Iir) return Iir; + procedure Set_Default_Entity_Aspect (Target : Iir; Aspect : Iir); + + -- Field: Field6 + function Get_Default_Generic_Map_Aspect_Chain (Target : Iir) return Iir; + procedure Set_Default_Generic_Map_Aspect_Chain (Target : Iir; Chain : Iir); + + -- Field: Field7 + function Get_Default_Port_Map_Aspect_Chain (Target : Iir) return Iir; + procedure Set_Default_Port_Map_Aspect_Chain (Target : Iir; Chain : Iir); + + -- Field: Field3 + function Get_Binding_Indication (Target : Iir) return Iir; + procedure Set_Binding_Indication (Target : Iir; Binding : Iir); + + -- The named entity designated by a name. + -- Field: Field4 + function Get_Named_Entity (Target : Iir) return Iir; + procedure Set_Named_Entity (Target : Iir; Val : Iir); + + -- Expression staticness, defined by rules of LRM 7.4 + -- Field: State1 (pos) + function Get_Expr_Staticness (Target : Iir) return Iir_Staticness; + procedure Set_Expr_Staticness (Target : Iir; Static : Iir_Staticness); + + -- Node which couldn't be correctly analyzed. + -- Field: Field2 + function Get_Error_Origin (Target : Iir) return Iir; + procedure Set_Error_Origin (Target : Iir; Origin : Iir); + + -- Operand of a monadic operator. + -- Field: Field2 + function Get_Operand (Target : Iir) return Iir; + procedure Set_Operand (Target : Iir; An_Iir : Iir); + + -- Left operand of a dyadic operator. + -- Field: Field2 + function Get_Left (Target : Iir) return Iir; + procedure Set_Left (Target : Iir; An_Iir : Iir); + + -- Right operand of a dyadic operator. + -- Field: Field4 + function Get_Right (Target : Iir) return Iir; + procedure Set_Right (Target : Iir; An_Iir : Iir); + + -- Field: Field3 + function Get_Unit_Name (Target : Iir) return Iir; + procedure Set_Unit_Name (Target : Iir; Name : Iir); + + -- Field: Field4 + function Get_Name (Target : Iir) return Iir; + procedure Set_Name (Target : Iir; Name : Iir); + + -- Field: Field5 + function Get_Group_Template_Name (Target : Iir) return Iir; + procedure Set_Group_Template_Name (Target : Iir; Name : Iir); + + -- Staticness of a name, according to rules of LRM 6.1 + -- Field: State2 (pos) + function Get_Name_Staticness (Target : Iir) return Iir_Staticness; + procedure Set_Name_Staticness (Target : Iir; Static : Iir_Staticness); + + -- Prefix of a name. + -- Field: Field3 + function Get_Prefix (Target : Iir) return Iir; + procedure Set_Prefix (Target : Iir; Prefix : Iir); + + -- Suffix of a slice or attribute. + -- Field: Field2 + function Get_Suffix (Target : Iir) return Iir; + procedure Set_Suffix (Target : Iir; Suffix : Iir); + + -- Parameter of an attribute. + -- Field: Field4 + function Get_Parameter (Target : Iir) return Iir; + procedure Set_Parameter (Target : Iir; Param : Iir); + + -- Type of the actual for an association by individual. + -- Unless the formal is an unconstrained array type, this is the same as + -- the formal type. + -- Field: Field3 + function Get_Actual_Type (Target : Iir) return Iir; + procedure Set_Actual_Type (Target : Iir; Atype : Iir); + + -- List of individual associations for association_element_by_individual. + -- Associations for parenthesis_name. + -- Field: Field2 + function Get_Association_Chain (Target : Iir) return Iir; + procedure Set_Association_Chain (Target : Iir; Chain : Iir); + + -- List of individual associations for association_element_by_individual. + -- Field: Field4 + function Get_Individual_Association_Chain (Target : Iir) return Iir; + procedure Set_Individual_Association_Chain (Target : Iir; Chain : Iir); + + -- Get/Set info for the aggregate. + -- There is one aggregate_info for for each dimension. + -- Field: Field2 + function Get_Aggregate_Info (Target : Iir) return Iir_Aggregate_Info; + procedure Set_Aggregate_Info (Target : Iir; Info : Iir_Aggregate_Info); + + -- Get/Set the info node for the next dimension. + -- Field: Field1 + function Get_Sub_Aggregate_Info (Target : Iir) return Iir_Aggregate_Info; + procedure Set_Sub_Aggregate_Info (Target : Iir; Info : Iir_Aggregate_Info); + + -- TRUE when the length of the aggregate is not locally static. + -- Field: Flag3 + function Get_Aggr_Dynamic_Flag (Target : Iir) return Boolean; + procedure Set_Aggr_Dynamic_Flag (Target : Iir; Val : Boolean); + + -- Get/Set the maximum number of elements for the lowest dimension of + -- the aggregate or for the current dimension of a sub-aggregate. + -- The real number of elements may be greater than this number if there + -- is an 'other' choice. + -- Field: Field4 (uc) + function Get_Aggr_Max_Length (Info : Iir_Aggregate_Info) return Iir_Int32; + procedure Set_Aggr_Max_Length (Info : Iir_Aggregate_Info; Nbr : Iir_Int32); + + -- Highest index choice, if any. + -- Field: Field2 + function Get_Aggr_Low_Limit (Target : Iir_Aggregate_Info) return Iir; + procedure Set_Aggr_Low_Limit (Target : Iir_Aggregate_Info; Limit : Iir); + + -- Highest index choice, if any. + -- Field: Field3 + function Get_Aggr_High_Limit (Target : Iir_Aggregate_Info) return Iir; + procedure Set_Aggr_High_Limit (Target : Iir_Aggregate_Info; Limit : Iir); + + -- True if the aggregate has an 'others' choice. + -- Field: Flag2 + function Get_Aggr_Others_Flag (Target : Iir_Aggregate_Info) return Boolean; + procedure Set_Aggr_Others_Flag (Target : Iir_Aggregate_Info; Val : Boolean); + + -- True if the aggregate have named associations. + -- Field: Flag4 + function Get_Aggr_Named_Flag (Target : Iir_Aggregate_Info) return Boolean; + procedure Set_Aggr_Named_Flag (Target : Iir_Aggregate_Info; Val : Boolean); + + -- Staticness of the expressions in an aggregate. + -- We can't use expr_staticness for this purpose, since the staticness + -- of an aggregate is at most globally. + -- Field: State2 (pos) + function Get_Value_Staticness (Target : Iir) return Iir_Staticness; + procedure Set_Value_Staticness (Target : Iir; Staticness : Iir_Staticness); + + -- Chain of choices. + -- Field: Field4 + function Get_Association_Choices_Chain (Target : Iir) return Iir; + procedure Set_Association_Choices_Chain (Target : Iir; Chain : Iir); + + -- Chain of choices. + -- Field: Field1 + function Get_Case_Statement_Alternative_Chain (Target : Iir) return Iir; + procedure Set_Case_Statement_Alternative_Chain (Target : Iir; Chain : Iir); + + -- Staticness of the choice. + -- Field: State2 (pos) + function Get_Choice_Staticness (Target : Iir) return Iir_Staticness; + procedure Set_Choice_Staticness (Target : Iir; Staticness : Iir_Staticness); + + -- Field: Field1 + function Get_Procedure_Call (Stmt : Iir) return Iir; + procedure Set_Procedure_Call (Stmt : Iir; Call : Iir); + + -- Subprogram to be called by a procedure, function call or operator. + -- Field: Field3 + function Get_Implementation (Target : Iir) return Iir; + procedure Set_Implementation (Target : Iir; Decl : Iir); + + -- Paramater associations for procedure and function call. + -- Field: Field2 + function Get_Parameter_Association_Chain (Target : Iir) return Iir; + procedure Set_Parameter_Association_Chain (Target : Iir; Chain : Iir); + + -- Object of a method call. NULL_IIR if the subprogram is not a method. + -- Field: Field4 + function Get_Method_Object (Target : Iir) return Iir; + procedure Set_Method_Object (Target : Iir; Object : Iir); + + -- The type_mark that appeared in the subtype indication. + -- May be null_iir if there is no type mark (as in an iterator). + -- May differ from base_type, if the type_mark is a subtype_name. + -- Field: Field2 + function Get_Type_Mark (Target : Iir) return Iir; + procedure Set_Type_Mark (Target : Iir; Mark : Iir); + + -- Get/set the lexical layout of an interface. + -- Field: Odigit1 (pos) + function Get_Lexical_Layout (Decl : Iir) return Iir_Lexical_Layout_Type; + procedure Set_Lexical_Layout (Decl : Iir; Lay : Iir_Lexical_Layout_Type); + + -- List of use (designated type of access types) of an incomplete type + -- definition. The purpose is to complete the uses with the full type + -- definition. + -- Field: Field2 (uc) + function Get_Incomplete_Type_List (Target : Iir) return Iir_List; + procedure Set_Incomplete_Type_List (Target : Iir; List : Iir_List); + + -- This flag is set on a signal_declaration, when a disconnection + -- specification applies to the signal (or a subelement of it). + -- This is used to check 'others' and 'all' designators. + -- Field: Flag1 + function Get_Has_Disconnect_Flag (Target : Iir) return Boolean; + procedure Set_Has_Disconnect_Flag (Target : Iir; Val : Boolean); + + -- This flag is set on a signal when its activity is read by the user. + -- Some signals handling can be optimized when this flag is set. + -- Field: Flag2 + function Get_Has_Active_Flag (Target : Iir) return Boolean; + procedure Set_Has_Active_Flag (Target : Iir; Val : Boolean); + + -- This flag is set is code being analyzed is textually within TARGET. + -- This is used for selected by name rule. + -- Field: Flag5 + function Get_Is_Within_Flag (Target : Iir) return Boolean; + procedure Set_Is_Within_Flag (Target : Iir; Val : Boolean); + + -- List of type_mark for an Iir_Kind_Signature + -- Field: Field2 (uc) + function Get_Type_Marks_List (Target : Iir) return Iir_List; + procedure Set_Type_Marks_List (Target : Iir; List : Iir_List); + + -- Field: Field5 + function Get_Signature (Target : Iir) return Iir; + procedure Set_Signature (Target : Iir; Value : Iir); + + -- Field: Field1 (uc) + function Get_Overload_List (Target : Iir) return Iir_List; + procedure Set_Overload_List (Target : Iir; List : Iir_List); + + -- Identifier of the simple_name attribute. + -- Field: Field2 (uc) + function Get_Simple_Name_Identifier (Target : Iir) return Name_Id; + procedure Set_Simple_Name_Identifier (Target : Iir; Ident : Name_Id); + + -- Body of a protected type declaration. + -- Field: Field2 + function Get_Protected_Type_Body (Target : Iir) return Iir; + procedure Set_Protected_Type_Body (Target : Iir; Bod : Iir); + + -- Corresponsing protected type declaration of a protected type body. + -- Field: Field4 + function Get_Protected_Type_Declaration (Target : Iir) return Iir; + procedure Set_Protected_Type_Declaration (Target : Iir; Decl : Iir); + + -- Location of the 'end' token. + -- Field: Field6 (uc) + function Get_End_Location (Target : Iir) return Location_Type; + procedure Set_End_Location (Target : Iir; Loc : Location_Type); + + -- For a string literal: the string identifier. + -- Field: Field3 (uc) + function Get_String_Id (Lit : Iir) return String_Id; + procedure Set_String_Id (Lit : Iir; Id : String_Id); + + -- For a string literal: the string length. + -- Field: Field0 (uc) + function Get_String_Length (Lit : Iir) return Int32; + procedure Set_String_Length (Lit : Iir; Len : Int32); + + -- For a declaration: true if the declaration is used somewhere. + -- Field: Flag6 + function Get_Use_Flag (Decl : Iir) return Boolean; + procedure Set_Use_Flag (Decl : Iir; Val : Boolean); +end Iirs; diff --git a/iirs_utils.adb b/iirs_utils.adb new file mode 100644 index 000000000..b5b63d2d9 --- /dev/null +++ b/iirs_utils.adb @@ -0,0 +1,813 @@ +-- Common operations on nodes. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Scan; use Scan; +with Tokens; use Tokens; +with Errorout; use Errorout; +with Name_Table; +with Str_Table; +with Std_Names; use Std_Names; +with Flags; + +package body Iirs_Utils is + -- Transform the current token into an iir literal. + -- The current token must be either a character or an identifier. + function Current_Text return Iir is + Res: Iir; + begin + case Current_Token is + when Tok_Identifier => + Res := Create_Iir (Iir_Kind_Simple_Name); + when Tok_Character => + Res := Create_Iir (Iir_Kind_Character_Literal); + when others => + raise Internal_Error; + end case; + Set_Identifier (Res, Current_Identifier); + Invalidate_Current_Identifier; + Invalidate_Current_Token; + Set_Location (Res, Get_Token_Location); + return Res; + end Current_Text; + + function Get_Operator_Name (Op : Iir) return Name_Id is + begin + case Get_Kind (Op) is + when Iir_Kind_And_Operator => + return Name_And; + when Iir_Kind_Or_Operator => + return Name_Or; + when Iir_Kind_Nand_Operator => + return Name_Nand; + when Iir_Kind_Nor_Operator => + return Name_Nor; + when Iir_Kind_Xor_Operator => + return Name_Xor; + when Iir_Kind_Xnor_Operator => + return Name_Xnor; + when Iir_Kind_Equality_Operator => + return Name_Op_Equality; + when Iir_Kind_Inequality_Operator => + return Name_Op_Inequality; + when Iir_Kind_Less_Than_Operator => + return Name_Op_Less; + when Iir_Kind_Less_Than_Or_Equal_Operator => + return Name_Op_Less_Equal; + when Iir_Kind_Greater_Than_Operator => + return Name_Op_Greater; + when Iir_Kind_Greater_Than_Or_Equal_Operator => + return Name_Op_Greater_Equal; + when Iir_Kind_Sll_Operator => + return Name_Sll; + when Iir_Kind_Sla_Operator => + return Name_Sla; + when Iir_Kind_Srl_Operator => + return Name_Srl; + when Iir_Kind_Sra_Operator => + return Name_Sra; + when Iir_Kind_Rol_Operator => + return Name_Rol; + when Iir_Kind_Ror_Operator => + return Name_Ror; + when Iir_Kind_Addition_Operator => + return Name_Op_Plus; + when Iir_Kind_Substraction_Operator => + return Name_Op_Minus; + when Iir_Kind_Concatenation_Operator => + return Name_Op_Concatenation; + when Iir_Kind_Multiplication_Operator => + return Name_Op_Mul; + when Iir_Kind_Division_Operator => + return Name_Op_Div; + when Iir_Kind_Modulus_Operator => + return Name_Mod; + when Iir_Kind_Remainder_Operator => + return Name_Rem; + when Iir_Kind_Exponentiation_Operator => + return Name_Op_Exp; + when Iir_Kind_Not_Operator => + return Name_Not; + when Iir_Kind_Negation_Operator => + return Name_Op_Minus; + when Iir_Kind_Identity_Operator => + return Name_Op_Plus; + when Iir_Kind_Absolute_Operator => + return Name_Abs; + when others => + raise Internal_Error; + end case; + end Get_Operator_Name; + + function Get_Longuest_Static_Prefix (Expr: Iir) return Iir is + Adecl: Iir; + begin + Adecl := Expr; + loop + case Get_Kind (Adecl) is + when Iir_Kind_Variable_Declaration + | Iir_Kind_Variable_Interface_Declaration => + return Adecl; + when Iir_Kind_Constant_Declaration + | Iir_Kind_Constant_Interface_Declaration => + return Adecl; + when Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Interface_Declaration => + return Adecl; + when Iir_Kind_Object_Alias_Declaration => + -- LRM 4.3.3.1 Object Aliases + -- 2. The name must be a static name [...] + return Adecl; + when Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Element => + if Get_Name_Staticness (Adecl) >= Globally then + return Adecl; + else + Adecl := Get_Prefix (Adecl); + end if; + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + Adecl := Get_Named_Entity (Adecl); + when Iir_Kind_Type_Conversion => + return Null_Iir; + when others => + Error_Kind ("get_longuest_static_prefix", Adecl); + end case; + end loop; + end Get_Longuest_Static_Prefix; + + function Get_Object_Prefix (Decl: Iir) return Iir is + Adecl: Iir; + begin + Adecl := Decl; + loop + case Get_Kind (Adecl) is + when Iir_Kind_Variable_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Iterator_Declaration => + return Adecl; + when Iir_Kind_Object_Alias_Declaration => + Adecl := Get_Name (Adecl); + when Iir_Kind_Indexed_Name + | Iir_Kind_Slice_Name + | Iir_Kind_Selected_Element + | Iir_Kind_Selected_By_All_Name => + Adecl := Get_Prefix (Adecl); + when Iir_Kinds_Literal + | Iir_Kind_Enumeration_Literal + | Iir_Kinds_Monadic_Operator + | Iir_Kinds_Dyadic_Operator + | Iir_Kind_Function_Call + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype + | Iir_Kinds_Attribute + | Iir_Kind_Attribute_Value + | Iir_Kind_Aggregate + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Unit_Declaration => + return Adecl; + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + Adecl := Get_Named_Entity (Adecl); + when others => + Error_Kind ("get_object_prefix", Adecl); + end case; + end loop; + end Get_Object_Prefix; + + function Find_Name_In_List (List: Iir_List; Lit: Name_Id) return Iir is + El: Iir; + Ident: Name_Id; + begin + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Ident := Get_Identifier (El); + if Ident = Lit then + return El; + end if; + end loop; + return Null_Iir; + end Find_Name_In_List; + + function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir + is + El: Iir := Chain; + begin + while El /= Null_Iir loop + if Get_Identifier (El) = Lit then + return El; + end if; + El := Get_Chain (El); + end loop; + return Null_Iir; + end Find_Name_In_Chain; + + function Is_In_Chain (Chain : Iir; El : Iir) return Boolean + is + Chain_El : Iir; + begin + Chain_El := Chain; + while Chain_El /= Null_Iir loop + if Chain_El = El then + return True; + end if; + Chain_El := Get_Chain (Chain_El); + end loop; + return False; + end Is_In_Chain; + + procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir) is + begin + if Unit = Target then + return; + end if; + Add_Element (Get_Dependence_List (Target), Unit); + end Add_Dependence; + + procedure Clear_Instantiation_Configuration_Vhdl87 + (Parent : Iir; In_Generate : Boolean; Full : Boolean) + is + El : Iir; + Prev : Iir; + begin + El := Get_Concurrent_Statement_Chain (Parent); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Component_Instantiation_Statement => + if In_Generate and not Full then + Prev := Get_Component_Configuration (El); + if Prev /= Null_Iir then + case Get_Kind (Prev) is + when Iir_Kind_Configuration_Specification => + -- Keep it. + null; + when Iir_Kind_Component_Configuration => + Set_Component_Configuration (El, Null_Iir); + when others => + Error_Kind + ("clear_instantiation_configuration_vhdl87", + Prev); + end case; + end if; + else + Set_Component_Configuration (El, Null_Iir); + end if; + when Iir_Kind_Generate_Statement => + Set_Generate_Block_Configuration (El, Null_Iir); + -- Clear inside a generate statement. + Clear_Instantiation_Configuration_Vhdl87 (El, True, Full); + when Iir_Kind_Block_Statement => + Set_Block_Block_Configuration (El, Null_Iir); + when others => + null; + end case; + El := Get_Chain (El); + end loop; + end Clear_Instantiation_Configuration_Vhdl87; + + procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean) + is + El : Iir; + begin + if False and then Flags.Vhdl_Std = Vhdl_87 then + Clear_Instantiation_Configuration_Vhdl87 + (Parent, Get_Kind (Parent) = Iir_Kind_Generate_Statement, Full); + else + El := Get_Concurrent_Statement_Chain (Parent); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Component_Instantiation_Statement => + Set_Component_Configuration (El, Null_Iir); + when Iir_Kind_Generate_Statement => + Set_Generate_Block_Configuration (El, Null_Iir); + when Iir_Kind_Block_Statement => + Set_Block_Block_Configuration (El, Null_Iir); + when others => + null; + end case; + El := Get_Chain (El); + end loop; + end if; + end Clear_Instantiation_Configuration; + + function Get_String_Fat_Acc (Str : Iir) return String_Fat_Acc is + begin + return Str_Table.Get_String_Fat_Acc (Get_String_Id (Str)); + end Get_String_Fat_Acc; + + function Get_String_Length (Str : Iir) return Natural is + begin + return Natural (Nat32'(Get_String_Length (Str))); + end Get_String_Length; + + -- Get identifier of NODE as a string. + function Image_Identifier (Node : Iir) return String is + begin + return Name_Table.Image (Iirs.Get_Identifier (Node)); + end Image_Identifier; + + function Image_String_Lit (Str : Iir) return String + is + Ptr : String_Fat_Acc; + Len : Natural; + begin + Ptr := Get_String_Fat_Acc (Str); + Len := Get_String_Length (Str); + return Ptr (1 .. Len); + end Image_String_Lit; + + procedure Create_Range_Constraint_For_Enumeration_Type + (Def : Iir_Enumeration_Type_Definition) + is + Range_Expr : Iir_Range_Expression; + Literal_List: Iir_List; + begin + Literal_List := Get_Enumeration_Literal_List (Def); + + -- Create a constraint. + Range_Expr := Create_Iir (Iir_Kind_Range_Expression); + Location_Copy (Range_Expr, Def); + Set_Type (Range_Expr, Def); + Set_Direction (Range_Expr, Iir_To); + Set_Left_Limit (Range_Expr, Get_First_Element (Literal_List)); + Set_Right_Limit (Range_Expr, Get_Last_Element (Literal_List)); + Set_Expr_Staticness (Range_Expr, Locally); + Set_Range_Constraint (Def, Range_Expr); + end Create_Range_Constraint_For_Enumeration_Type; + + procedure Free_Old_Iir (Node: in Iir) + is + N : Iir; + begin + N := Node; + Free_Iir (N); + end Free_Old_Iir; + + procedure Free_Name (Node : Iir) + is + N : Iir; + N1 : Iir; + begin + if Node = Null_Iir then + return; + end if; + N := Node; + case Get_Kind (N) is + when Iir_Kind_Simple_Name + | Iir_Kind_Character_Literal + | Iir_Kind_String_Literal + | Iir_Kind_Subtype_Definition => + Free_Iir (N); + when Iir_Kind_Selected_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Selected_By_All_Name => + N1 := Get_Prefix (N); + Free_Iir (N); + Free_Name (N1); + when Iir_Kind_Library_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Design_Unit + | Iir_Kinds_Concurrent_Statement + | Iir_Kinds_Sequential_Statement => + return; + when others => + Error_Kind ("free_name", Node); + --Free_Iir (N); + end case; + end Free_Name; + + procedure Free_Recursive_List (List : Iir_List) + is + El : Iir; + begin + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Free_Recursive (El); + end loop; + end Free_Recursive_List; + + procedure Free_Recursive (Node : Iir; Free_List : Boolean := False) + is + N : Iir; + begin + if Node = Null_Iir then + return; + end if; + N := Node; + case Get_Kind (N) is + when Iir_Kind_Library_Declaration => + return; + when Iir_Kind_Simple_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Character_Literal => + null; + when Iir_Kind_Enumeration_Literal => + return; + when Iir_Kind_Selected_Name => + Free_Recursive (Get_Prefix (N)); + when Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration => + Free_Recursive (Get_Type (N)); + Free_Recursive (Get_Default_Value (N)); + when Iir_Kind_Range_Expression => + Free_Recursive (Get_Left_Limit (N)); + Free_Recursive (Get_Right_Limit (N)); + when Iir_Kind_Subtype_Definition => + Free_Recursive (Get_Base_Type (N)); + when Iir_Kind_Integer_Literal => + null; + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Entity_Declaration + | Iir_Kind_Configuration_Declaration => + null; + when Iir_Kind_File_Type_Definition + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition => + return; + when Iir_Kind_Architecture_Declaration => + Free_Recursive (Get_Entity (N)); + when Iir_Kind_Proxy => + null; + when Iir_Kind_Overload_List => + Free_Recursive_List (Get_Overload_List (N)); + if not Free_List then + return; + end if; + when Iir_Kind_Array_Subtype_Definition => + Free_Recursive_List (Get_Index_List (N)); + Free_Recursive (Get_Base_Type (N)); + when Iir_Kind_Entity_Aspect_Entity => + Free_Recursive (Get_Entity (N)); + Free_Recursive (Get_Architecture (N)); + when others => + Error_Kind ("free_recursive", Node); + end case; + Free_Iir (N); + end Free_Recursive; + + function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) + return String + is + begin + return Iir_Predefined_Functions'Image (Func); + end Get_Predefined_Function_Name; + + procedure Clear_Seen_Flag (Top : Iir) + is + Callees_List : Iir_Callees_List; + El: Iir; + begin + if Get_Seen_Flag (Top) then + Set_Seen_Flag (Top, False); + Callees_List := Get_Callees_List (Top); + if Callees_List /= Null_Iir_List then + for I in Natural loop + El := Get_Nth_Element (Callees_List, I); + exit when El = Null_Iir; + if Get_Seen_Flag (El) = False then + Clear_Seen_Flag (El); + end if; + end loop; + end if; + end if; + end Clear_Seen_Flag; + + function Is_Anonymous_Type_Definition (Def : Iir) return Boolean is + begin + return Get_Type_Declarator (Def) = Null_Iir; + end Is_Anonymous_Type_Definition; + + function Is_Unconstrained_Type_Definition (Def : Iir) return Boolean is + begin + return Get_Kind (Def) in Iir_Kinds_Unconstrained_Array_Type_Definition; + end Is_Unconstrained_Type_Definition; + + function Is_Same_Profile (L, R: Iir) return Boolean + is + L1, R1 : Iir; + L_Kind, R_Kind : Iir_Kind; + El_L, El_R : Iir; + begin + L_Kind := Get_Kind (L); + if L_Kind = Iir_Kind_Non_Object_Alias_Declaration then + L1 := Get_Name (L); + L_Kind := Get_Kind (L1); + else + L1 := L; + end if; + R_Kind := Get_Kind (R); + if R_Kind = Iir_Kind_Non_Object_Alias_Declaration then + R1 := Get_Name (R); + R_Kind := Get_Kind (R1); + else + R1 := R; + end if; + + -- Check L and R are both of the same 'kind'. + -- Also the return profile for functions. + if L_Kind in Iir_Kinds_Function_Declaration + and then R_Kind in Iir_Kinds_Function_Declaration + then + if Get_Base_Type (Get_Return_Type (L1)) /= + Get_Base_Type (Get_Return_Type (R1)) + then + return False; + end if; + elsif L_Kind in Iir_Kinds_Procedure_Declaration + and then R_Kind in Iir_Kinds_Procedure_Declaration + then + null; + elsif L_Kind = Iir_Kind_Enumeration_Literal + and then R_Kind = Iir_Kind_Enumeration_Literal + then + return Get_Type (L1) = Get_Type (R1); + else + -- Kind mismatch. + return False; + end if; + + -- Check parameters profile. + El_L := Get_Interface_Declaration_Chain (L1); + El_R := Get_Interface_Declaration_Chain (R1); + loop + exit when El_L = Null_Iir and El_R = Null_Iir; + if El_L = Null_Iir or El_R = Null_Iir then + return False; + end if; + if Get_Base_Type (Get_Type (El_L)) /= Get_Base_Type (Get_Type (El_R)) + then + return False; + end if; + El_L := Get_Chain (El_L); + El_R := Get_Chain (El_R); + end loop; + + return True; + end Is_Same_Profile; + + -- From a block_specification, returns the block. + function Get_Block_From_Block_Specification (Block_Spec : Iir) + return Iir + is + Res : Iir; + begin + case Get_Kind (Block_Spec) is + when Iir_Kind_Design_Unit => + Res := Get_Library_Unit (Block_Spec); + if Get_Kind (Res) /= Iir_Kind_Architecture_Declaration then + raise Internal_Error; + end if; + return Res; + when Iir_Kind_Block_Statement + | Iir_Kind_Architecture_Declaration + | Iir_Kind_Generate_Statement => + return Block_Spec; + when Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Slice_Name => + return Get_Prefix (Block_Spec); + when others => + Error_Kind ("get_block_from_block_specification", Block_Spec); + return Null_Iir; + end case; + end Get_Block_From_Block_Specification; + + function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir is + begin + if Get_Kind (Sub_Type) /= Iir_Kind_Array_Subtype_Definition then + Error_Kind ("get_string_type_bound_type", Sub_Type); + end if; + return Get_First_Element (Get_Index_Subtype_List (Sub_Type)); + end Get_String_Type_Bound_Type; + + procedure Get_Low_High_Limit (Arange : Iir_Range_Expression; + Low, High : out Iir) + is + begin + case Get_Direction (Arange) is + when Iir_To => + Low := Get_Left_Limit (Arange); + High := Get_Right_Limit (Arange); + when Iir_Downto => + High := Get_Left_Limit (Arange); + Low := Get_Right_Limit (Arange); + end case; + end Get_Low_High_Limit; + + function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir is + begin + case Get_Direction (Arange) is + when Iir_To => + return Get_Left_Limit (Arange); + when Iir_Downto => + return Get_Right_Limit (Arange); + end case; + end Get_Low_Limit; + + function Get_High_Limit (Arange : Iir_Range_Expression) return Iir is + begin + case Get_Direction (Arange) is + when Iir_To => + return Get_Right_Limit (Arange); + when Iir_Downto => + return Get_Left_Limit (Arange); + end case; + end Get_High_Limit; + + function Is_Unidim_Array_Type (A_Type : Iir) return Boolean + is + Base_Type : Iir := Get_Base_Type (A_Type); + begin + if Get_Kind (Base_Type) = Iir_Kind_Array_Type_Definition + and then Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)) = 1 + then + return True; + else + return False; + end if; + end Is_Unidim_Array_Type; + + function Is_Range_Attribute_Name (Expr : Iir) return Boolean + is + Attr : Iir; + Id : Name_Id; + begin + if Get_Kind (Expr) = Iir_Kind_Parenthesis_Name then + Attr := Get_Prefix (Expr); + else + Attr := Expr; + end if; + if Get_Kind (Attr) /= Iir_Kind_Attribute_Name then + return False; + end if; + Id := Get_Attribute_Identifier (Attr); + return Id = Name_Range or Id = Name_Reverse_Range; + end Is_Range_Attribute_Name; + + function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type) + return Iir_Array_Subtype_Definition + is + Res : Iir_Array_Subtype_Definition; + Base_Type : Iir; + begin + Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); + Set_Location (Res, Loc); + Base_Type := Get_Base_Type (Arr_Type); + Set_Base_Type (Res, Base_Type); + Set_Element_Subtype (Res, Get_Element_Subtype (Base_Type)); + if Get_Kind (Arr_Type) /= Iir_Kind_Array_Type_Definition then + Set_Resolution_Function (Res, Get_Resolution_Function (Arr_Type)); + end if; + Set_Resolved_Flag (Res, Get_Resolved_Flag (Arr_Type)); + Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Arr_Type)); + Set_Type_Staticness (Res, Get_Type_Staticness (Base_Type)); + Set_Index_Subtype_List (Res, Create_Iir_List); + return Res; + end Create_Array_Subtype; + + function Is_Subprogram_Method (Spec : Iir) return Boolean is + begin + case Get_Kind (Get_Parent (Spec)) is + when Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Protected_Type_Body => + return True; + when others => + return False; + end case; + end Is_Subprogram_Method; + + function Get_Method_Type (Spec : Iir) return Iir + is + Parent : Iir; + begin + Parent := Get_Parent (Spec); + case Get_Kind (Parent) is + when Iir_Kind_Protected_Type_Declaration => + return Parent; + when Iir_Kind_Protected_Type_Body => + return Get_Protected_Type_Declaration (Parent); + when others => + return Null_Iir; + end case; + end Get_Method_Type; + + function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Error); + Set_Expr_Staticness (Res, Locally); + Set_Type (Res, Atype); + Set_Error_Origin (Res, Orig); + Location_Copy (Res, Orig); + return Res; + end Create_Error_Expr; + + function Create_Error_Type (Orig : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Error); + --Set_Expr_Staticness (Res, Locally); + Set_Base_Type (Res, Res); + Set_Error_Origin (Res, Orig); + Location_Copy (Res, Orig); + Set_Type_Declarator (Res, Null_Iir); + Set_Resolved_Flag (Res, True); + Set_Signal_Type_Flag (Res, True); + return Res; + end Create_Error_Type; + + function Get_Associated_Formal (Assoc : Iir) return Iir + is + Formal : Iir; + begin + Formal := Get_Formal (Assoc); + case Get_Kind (Formal) is + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + Formal := Get_Named_Entity (Formal); + when others => + null; + end case; + return Get_Base_Name (Formal); + end Get_Associated_Formal; + + -- Extract the entity from ASPECT. + -- Note: if ASPECT is a component declaration, returns ASPECT. + function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir + is + Inst : Iir; + begin + case Get_Kind (Aspect) is + when Iir_Kind_Component_Declaration => + return Aspect; + when Iir_Kind_Entity_Aspect_Entity => + return Get_Library_Unit (Get_Entity (Aspect)); + when Iir_Kind_Entity_Aspect_Configuration => + Inst := Get_Library_Unit (Get_Configuration (Aspect)); + return Get_Library_Unit (Get_Entity (Inst)); + when Iir_Kind_Entity_Aspect_Open => + return Null_Iir; + when others => + Error_Kind ("get_entity_from_entity_aspect", Aspect); + end case; + end Get_Entity_From_Entity_Aspect; + + function Get_Physical_Literal_Value (Lit : Iir) return Iir_Int64 + is + begin + case Get_Kind (Lit) is + when Iir_Kind_Physical_Int_Literal => + return Get_Value (Lit) + * Get_Value (Get_Physical_Unit_Value (Get_Unit_Name (Lit))); + when Iir_Kind_Unit_Declaration => + return Get_Value (Get_Physical_Unit_Value (Lit)); + when Iir_Kind_Physical_Fp_Literal => + return Iir_Int64 + (Get_Fp_Value (Lit) + * Iir_Fp64 (Get_Value (Get_Physical_Unit_Value + (Get_Unit_Name (Lit))))); + when others => + Error_Kind ("get_physical_literal_value", Lit); + end case; + end Get_Physical_Literal_Value; + +end Iirs_Utils; diff --git a/iirs_utils.ads b/iirs_utils.ads new file mode 100644 index 000000000..f567d10b8 --- /dev/null +++ b/iirs_utils.ads @@ -0,0 +1,156 @@ +-- Common operations on nodes. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Iirs; use Iirs; + +package Iirs_Utils is + -- Transform the current token into an iir literal. + -- The current token must be either a character, a string or an identifier. + function Current_Text return Iir; + + -- Get identifier of NODE as a string. + function Image_Identifier (Node : Iir) return String; + function Image_String_Lit (Str : Iir) return String; + + -- Easier function for string literals. + function Get_String_Fat_Acc (Str : Iir) return String_Fat_Acc; + function Get_String_Length (Str : Iir) return Natural; + pragma Inline (Get_String_Fat_Acc); + pragma Inline (Get_String_Length); + + -- Find LIT in the list of identifiers or characters LIST. + -- Return the literal (whose name is LIT) or null_iir if not found. + function Find_Name_In_Chain (Chain: Iir; Lit: Name_Id) return Iir; + function Find_Name_In_List (List : Iir_List; Lit: Name_Id) return Iir; + + -- Return TRUE if EL in an element of chain CHAIN. + function Is_In_Chain (Chain : Iir; El : Iir) return Boolean; + + -- Convert an operator node to a name. + function Get_Operator_Name (Op : Iir) return Name_Id; + + -- Get the longuest static prefix of EXPR. + -- See LRM §8.1 + function Get_Longuest_Static_Prefix (Expr: Iir) return Iir; + + -- Get the prefix of DECL, ie: + -- {signal, variable, constant}{interface_declaration, declaration}, or + -- DECL itself, if it is not an object. + function Get_Object_Prefix (Decl: Iir) return Iir; + + -- Make TARGETS depends on UNIT. + -- UNIT must be either a design unit or a entity_aspect_entity. + procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir); + + -- Clear configuration field of all component instantiation of + -- the concurrent statements of PARENT. + procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean); + + -- Free Node and its prefixes, if any. + procedure Free_Name (Node : Iir); + + -- Free NODE and its sub-nodes. + procedure Free_Recursive (Node : Iir; Free_List : Boolean := False); + + -- Free NODE. + procedure Free_Old_Iir (Node: in Iir); + + -- Name of FUNC. + function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) + return String; + + -- Create the range_constraint node for an enumeration type. + procedure Create_Range_Constraint_For_Enumeration_Type + (Def : Iir_Enumeration_Type_Definition); + + -- Clear flag of TOP and all of its callees. + procedure Clear_Seen_Flag (Top : Iir); + + -- Return TRUE iff DEF is an anonymous type (or subtype) definition. + -- Note: DEF is required to be a type (or subtype) definition. + -- Note: type (and not subtype) are never anonymous. + function Is_Anonymous_Type_Definition (Def : Iir) return Boolean; + pragma Inline (Is_Anonymous_Type_Definition); + + -- Return TRUE iff DEF is an unconstrained type (or subtype) definition. + function Is_Unconstrained_Type_Definition (Def : Iir) return Boolean; + + -- Return true iff L and R have the same profile. + -- L and R must be subprograms specification (or spec_body). + function Is_Same_Profile (L, R: Iir) return Boolean; + + -- From a block_specification, returns the block. + -- Roughly speaking, this get prefix of indexed and sliced name. + function Get_Block_From_Block_Specification (Block_Spec : Iir) + return Iir; + + -- Return the bound type of a string type, ie the type of the (first) + -- dimension of a one-dimensional array type. + function Get_String_Type_Bound_Type (Sub_Type : Iir) return Iir; + + -- Return left or right limit according to the direction. + procedure Get_Low_High_Limit (Arange : Iir_Range_Expression; + Low, High : out Iir); + function Get_Low_Limit (Arange : Iir_Range_Expression) return Iir; + function Get_High_Limit (Arange : Iir_Range_Expression) return Iir; + + -- Return TRUE iff type/subtype definition A_TYPE is an undim array. + function Is_Unidim_Array_Type (A_Type : Iir) return Boolean; + + -- Return TRUE iff unsemantized EXPR is a range attribute. + function Is_Range_Attribute_Name (Expr : Iir) return Boolean; + + -- Create an array subtype from array_type or unconstrained_array_subtype + -- ARR_TYPE. + -- All fields of the returned node are filled, except the index_list. + -- The type_staticness is set with the type staticness of the element + -- subtype and therefore must be updated. + -- The type_declarator field is set to null_iir. + function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type) + return Iir_Array_Subtype_Definition; + + -- Return TRUE iff SPEC is declared inside a protected type or a protected + -- body. + function Is_Subprogram_Method (Spec : Iir) return Boolean; + + -- Return the protected type for method SPEC. + function Get_Method_Type (Spec : Iir) return Iir; + + -- Create an error node for node ORIG, and set its type to ATYPE. + -- Set its staticness to locally. + function Create_Error_Expr (Orig : Iir; Atype : Iir) return Iir; + + -- Create an error node for node ORIG, which is supposed to be a type. + function Create_Error_Type (Orig : Iir) return Iir; + + -- Get the base name of the formal of an association. + function Get_Associated_Formal (Assoc : Iir) return Iir; + + -- Extract the entity from ASPECT. + -- Note: if ASPECT is a component declaration, returns ASPECT. + -- if ASPECT is open, return Null_Iir; + function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir; + + + -- Get the value of any physical literals. + -- A physical literal can be either an int_literal, and fp_literal or + -- a unit_declaration. + -- See also Evaluation.Get_Physical_Value. + function Get_Physical_Literal_Value (Lit : Iir) return Iir_Int64; +end Iirs_Utils; + diff --git a/libraries.adb b/libraries.adb new file mode 100644 index 000000000..5eee733f7 --- /dev/null +++ b/libraries.adb @@ -0,0 +1,1634 @@ +-- VHDL libraries handling. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Text_IO; use Ada.Text_IO; +with GNAT.Table; +with GNAT.OS_Lib; +with Errorout; use Errorout; +with Scan; +with Iirs_Utils; +with Parse; +with Back_End; +with Name_Table; use Name_Table; +with Str_Table; +with Sem_Scopes; +with Tokens; +with Files_Map; +with Flags; +with Std_Names; +with Std_Package; + +package body Libraries is + -- Chain of known libraries. This is also the top node of all iir node. + Libraries_Chain : Iir_Library_Declaration := Null_Iir; + Libraries_Chain_Last : Iir_Library_Declaration := Null_Iir; + + -- A location for any implicit declarations (such as library WORK). + Implicit_Location: Location_Type; + + -- Table of library pathes. + package Pathes is new GNAT.Table + (Table_Index_Type => Integer, + Table_Component_Type => Name_Id, + Table_Low_Bound => 1, + Table_Initial => 4, + Table_Increment => 100); + + -- Initialize pathes table. + -- Set the local path. + Name_Nil : Name_Id; + procedure Init_Pathes + is + begin + Name_Nil := Get_Identifier (""); + Pathes.Append (Name_Nil); + Local_Directory := Name_Nil; + Work_Directory := Name_Nil; + end Init_Pathes; + + function Path_To_Id (Path : String) return Name_Id is + begin + if Path (Path'Last) /= GNAT.OS_Lib.Directory_Separator then + return Get_Identifier (Path & GNAT.OS_Lib.Directory_Separator); + else + return Get_Identifier (Path); + end if; + end Path_To_Id; + + procedure Add_Library_Path (Path : String) + is + begin + if Path'Length = 0 then + return; + end if; + Pathes.Increment_Last; + Pathes.Table (Pathes.Last) := Path_To_Id (Path); + end Add_Library_Path; + + function Get_Nbr_Pathes return Natural is + begin + return Pathes.Last; + end Get_Nbr_Pathes; + + function Get_Path (N : Natural) return Name_Id is + begin + if N > Pathes.Last or N < Pathes.First then + raise Constraint_Error; + end if; + return Pathes.Table (N); + end Get_Path; + + -- Set PATH as the path of the work library. + procedure Set_Work_Library_Path (Path : String) is + begin + Work_Directory := Path_To_Id (Path); + if not GNAT.OS_Lib.Is_Directory (Get_Address (Work_Directory)) then + -- This is a warning, since 'clean' action should not fail in + -- this cases. + Warning_Msg + ("directory '" & Path & "' set by --workdir= does not exist"); + -- raise Option_Error; + end if; + end Set_Work_Library_Path; + + -- Open LIBRARY map file, return TRUE if successful. + function Set_Library_File_Name (Dir : Name_Id; + Library: Iir_Library_Declaration) + return Boolean + is + File_Name : String := Back_End.Library_To_File_Name (Library); + Fe : Source_File_Entry; + begin + Fe := Files_Map.Load_Source_File (Dir, Get_Identifier (File_Name)); + if Fe = No_Source_File_Entry then + return False; + end if; + Scan.Set_File (Fe); + return True; + end Set_Library_File_Name; + + -- Every design unit is put in this hash table to be quickly found by + -- its (primary) identifier. + Unit_Hash_Length : constant Name_Id := 127; + subtype Hash_Id is Name_Id range 0 .. Unit_Hash_Length - 1; + Unit_Hash_Table : array (Hash_Id) of Iir := (others => Null_Iir); + + -- Get the hash value for DESIGN_UNIT. + -- Architectures use the entity name. + function Get_Hash_Id_For_Unit (Design_Unit : Iir_Design_Unit) + return Hash_Id + is + Lib_Unit : Iir; + Id : Name_Id; + begin + Lib_Unit := Get_Library_Unit (Design_Unit); + case Get_Kind (Lib_Unit) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Body => + Id := Get_Identifier (Lib_Unit); + when Iir_Kind_Architecture_Declaration => + -- Architectures are put with the entity identifier. + Id := Get_Identifier (Get_Entity (Lib_Unit)); + when others => + Error_Kind ("get_id_for_unit_hash", Lib_Unit); + end case; + return Id mod Unit_Hash_Length; + end Get_Hash_Id_For_Unit; + + -- Put DESIGN_UNIT into the unit hash table. + procedure Add_Unit_Hash (Design_Unit : Iir) + is + Id : Hash_Id; + begin + Id := Get_Hash_Id_For_Unit (Design_Unit); + Set_Hash_Chain (Design_Unit, Unit_Hash_Table (Id)); + Unit_Hash_Table (Id) := Design_Unit; + end Add_Unit_Hash; + + -- Remove DESIGN_UNIT from the unit hash table. + procedure Remove_Unit_Hash (Design_Unit : Iir) + is + Id : Hash_Id; + Unit, Prev, Next : Iir_Design_Unit; + begin + Id := Get_Hash_Id_For_Unit (Design_Unit); + Unit := Unit_Hash_Table (Id); + Prev := Null_Iir; + while Unit /= Null_Iir loop + Next := Get_Hash_Chain (Unit); + if Unit = Design_Unit then + if Prev = Null_Iir then + Unit_Hash_Table (Id) := Next; + else + Set_Hash_Chain (Prev, Next); + end if; + return; + end if; + Prev := Unit; + Unit := Next; + end loop; + -- Not found. + raise Internal_Error; + end Remove_Unit_Hash; + + procedure Purge_Design_File (Design_File : Iir_Design_File) + is + Prev, File, Next : Iir_Design_File; + Unit : Iir_Design_Unit; + + File_Name : Name_Id; + Dir_Name : Name_Id; + begin + File_Name := Get_Design_File_Filename (Design_File); + Dir_Name := Get_Design_File_Directory (Design_File); + + File := Get_Design_File_Chain (Work_Library); + Prev := Null_Iir; + while File /= Null_Iir loop + Next := Get_Chain (File); + if Get_Design_File_Filename (File) = File_Name + and then Get_Design_File_Directory (File) = Dir_Name + then + -- Remove from library. + if Prev = Null_Iir then + Set_Design_File_Chain (Work_Library, Next); + else + Set_Chain (Prev, Next); + end if; + + -- Remove all units from unit hash table. + Unit := Get_First_Design_Unit (File); + while Unit /= Null_Iir loop + Remove_Unit_Hash (Unit); + Unit := Get_Chain (Unit); + end loop; + + return; + end if; + Prev := File; + File := Next; + end loop; + end Purge_Design_File; + + -- Load the contents of a library from a map file. + -- The format of this file, used by save_library and load_library is + -- as follow: + -- + -- file_format ::= header { design_file_format } + -- header ::= v 3 + -- design_file_format ::= + -- filename_format { design_unit_format } + -- filename_format ::= + -- FILE directory "FILENAME" file_time_stamp analyze_time_stamp: + -- design_unit_format ::= entity_format + -- | architecture_format + -- | package_format + -- | package_body_format + -- | configuration_format + -- position_format ::= LINE(POS) + OFF on DATE + -- entity_format ::= + -- ENTITY identifier AT position_format ; + -- architecture_format ::= + -- ARCHITECTURE identifier of name AT position_format ; + -- package_format ::= + -- PACKAGE identifier AT position_format [BODY] ; + -- package_body_format ::= + -- PACKAGE BODY identifier AT position_format ; + -- configuration_format ::= + -- CONFIGURATION identifier AT position_format ; + -- + -- The position_format meaning is: + -- LINE is the line number (first line is number 1), + -- POS is the offset of this line number, as a source_ptr value, + -- OFF is the offset in the line, starting with 0. + -- DATE is the symbolic date of analysis (order). + -- + -- Return TRUE if the library was found. + function Load_Library (Library: Iir_Library_Declaration) + return Boolean + is + use Scan; + use Tokens; + use Iirs_Utils; + + File : Source_File_Entry; + + procedure Bad_Library_Format is + begin + Error_Msg (Image (Files_Map.Get_File_Name (File)) & + ": bad library format"); + end Bad_Library_Format; + + procedure Scan_Expect (Tok: Token_Type) is + begin + Scan.Scan; + if Current_Token /= Tok then + Bad_Library_Format; + raise Compilation_Error; + end if; + end Scan_Expect; + + function Current_Time_Stamp return Time_Stamp_Id is + begin + if Current_String_Length /= Time_Stamp_String'Length then + Bad_Library_Format; + raise Compilation_Error; + end if; + return Time_Stamp_Id (Current_String_Id); + end Current_Time_Stamp; + + function String_To_Name_Id return Name_Id + is + Len : Natural; + Ptr : String_Fat_Acc; + begin + Len := Natural (Current_String_Length); + Ptr := Str_Table.Get_String_Fat_Acc (Current_String_Id); + for I in 1 .. Len loop + Name_Table.Name_Buffer (I) := Ptr (I); + end loop; + Name_Table.Name_Length := Len; + -- FIXME: should remove last string. + return Get_Identifier; + end String_To_Name_Id; + + Design_Unit, Last_Design_Unit : Iir_Design_Unit; + Lib_Ident : Name_Id; + + function Scan_Unit_List return Iir_List is + begin + if Current_Token = Tok_Left_Paren then + Scan_Expect (Tok_Identifier); + loop + Scan_Expect (Tok_Dot); + Scan_Expect (Tok_Identifier); + Scan.Scan; + if Current_Token = Tok_Left_Paren then + -- This is an architecture. + Scan_Expect (Tok_Identifier); + Scan_Expect (Tok_Right_Paren); + Scan.Scan; + end if; + exit when Current_Token /= Tok_Comma; + Scan.Scan; + end loop; + Scan.Scan; + end if; + return Null_Iir_List; + end Scan_Unit_List; + + Design_File: Iir_Design_File; + Library_Unit: Iir; + Line, Col: Natural; + File_Dir : Name_Id; + Pos: Source_Ptr; + Date: Date_Type; + Max_Date: Date_Type := Date_Valid'First; + Dir : Name_Id; + begin + Lib_Ident := Get_Identifier (Library); + + if False then + Ada.Text_IO.Put_Line ("Load library " & Image (Lib_Ident)); + end if; + + -- Check the library was not already loaded. + if Get_Design_File_Chain (Library) /= Null_Iir then + raise Internal_Error; + end if; + + -- Try to open the library file map. + Dir := Get_Library_Directory (Library); + if Dir = Null_Identifier then + -- Search in the library path. + declare + File_Name : String := Back_End.Library_To_File_Name (Library); + L : Natural; + begin + for I in Pathes.First .. Pathes.Last loop + Image (Pathes.Table (I)); + L := Name_Length + File_Name'Length; + Name_Buffer (Name_Length + 1 .. L) := File_Name; + Name_Buffer (L + 1) := Character'Val (0); + if GNAT.OS_Lib.Is_Regular_File (Name_Buffer'Address) then + Dir := Pathes.Table (I); + Set_Library_Directory (Library, Dir); + exit; + end if; + end loop; + end; + end if; + if Dir = Null_Identifier + or else not Set_Library_File_Name (Dir, Library) + then + -- Not found. + Set_Date (Library, Date_Valid'First); + return False; + end if; + File := Get_Current_Source_File; + + -- Parse header. + Scan.Scan; + if Current_Token /= Tok_Identifier + or else Name_Length /= 1 or else Name_Buffer (1) /= 'v' + then + Bad_Library_Format; + raise Compilation_Error; + end if; + Scan_Expect (Tok_Integer); + if Current_Iir_Int64 not in 1 .. 3 then + Bad_Library_Format; + raise Compilation_Error; + end if; + Scan.Scan; + + Last_Design_Unit := Null_Iir; + while Current_Token /= Tok_Eof loop + if Current_Token = Tok_File then + -- This is a new design file. + Design_File := Create_Iir (Iir_Kind_Design_File); + + Scan.Scan; + if Current_Token = Tok_Dot then + -- The filename is local, use the directory of the library. + if Dir = Name_Nil then + File_Dir := Files_Map.Get_Home_Directory; + else + File_Dir := Dir; + end if; + elsif Current_Token = Tok_Slash then + -- The filename is an absolute file. + File_Dir := Null_Identifier; + elsif Current_Token = Tok_String then + -- Be compatible with version 1: an empty directory for + -- an absolute filename. + if Current_String_Length = 0 then + File_Dir := Null_Identifier; + else + File_Dir := String_To_Name_Id; + end if; + else + Bad_Library_Format; + raise Compilation_Error; + end if; + + Set_Design_File_Directory (Design_File, File_Dir); + + Scan_Expect (Tok_String); + Set_Design_File_Filename (Design_File, String_To_Name_Id); + + -- FIXME: check the file name is uniq. + + Set_Parent (Design_File, Library); + + -- Prepend. + Set_Chain (Design_File, Get_Design_File_Chain (Library)); + Set_Design_File_Chain (Library, Design_File); + + Scan_Expect (Tok_String); + Set_File_Time_Stamp (Design_File, Current_Time_Stamp); + + Scan_Expect (Tok_String); + Set_Analysis_Time_Stamp (Design_File, Current_Time_Stamp); + + Scan_Expect (Tok_Colon); + Scan.Scan; + Last_Design_Unit := Null_Iir; + else + -- This is a new design unit. + Design_Unit := Create_Iir (Iir_Kind_Design_Unit); + Set_Design_File (Design_Unit, Design_File); + case Current_Token is + when Tok_Entity => + Library_Unit := Create_Iir (Iir_Kind_Entity_Declaration); + Scan.Scan; + when Tok_Architecture => + Library_Unit := + Create_Iir (Iir_Kind_Architecture_Declaration); + Scan.Scan; + when Tok_Configuration => + Library_Unit := + Create_Iir (Iir_Kind_Configuration_Declaration); + Scan.Scan; + when Tok_Package => + Scan.Scan; + if Current_Token = Tok_Body then + Library_Unit := Create_Iir (Iir_Kind_Package_Body); + Scan.Scan; + else + Library_Unit := Create_Iir (Iir_Kind_Package_Declaration); + end if; + when Tok_With => + if Library_Unit = Null_Iir + or else + Get_Kind (Library_Unit) + /= Iir_Kind_Architecture_Declaration + then + Put_Line ("load_library: invalid use of 'with'"); + raise Internal_Error; + end if; + Scan_Expect (Tok_Configuration); + Scan_Expect (Tok_Colon); + Scan.Scan; + Set_Dependence_List (Design_Unit, Scan_Unit_List); + goto Next_Line; + when others => + Put_Line + ("load_library: line must start with " & + "'architecture', 'entity', 'package' or 'configuration'"); + raise Internal_Error; + end case; + + if Current_Token /= Tok_Identifier then + raise Internal_Error; + end if; + Set_Identifier (Library_Unit, Current_Identifier); + Set_Identifier (Design_Unit, Current_Identifier); + Set_Visible_Flag (Design_Unit, True); + + if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Declaration then + Scan_Expect (Tok_Of); + Scan_Expect (Tok_Identifier); + Set_Entity (Library_Unit, Current_Text); + end if; + + -- Scan position. + Scan_Expect (Tok_Identifier); -- at + Scan_Expect (Tok_Integer); + Line := Natural (Current_Iir_Int64); + Scan_Expect (Tok_Left_Paren); + Scan_Expect (Tok_Integer); + Pos := Source_Ptr (Current_Iir_Int64); + Scan_Expect (Tok_Right_Paren); + Scan_Expect (Tok_Plus); + Scan_Expect (Tok_Integer); + Col := Natural (Current_Iir_Int64); + Scan_Expect (Tok_On); + Scan_Expect (Tok_Integer); + Date := Date_Type (Current_Iir_Int64); + + Scan.Scan; + if Get_Kind (Library_Unit) = Iir_Kind_Package_Declaration + and then Current_Token = Tok_Body + then + Set_Need_Body (Library_Unit, True); + Scan.Scan; + end if; + if Current_Token /= Tok_Semi_Colon then + raise Internal_Error; + end if; + Scan.Scan; + + if False then + Put_Line ("line:" & Natural'Image (Line) + & ", pos:" & Source_Ptr'Image (Pos)); + end if; + + -- Scan dependence list. + Set_Dependence_List (Design_Unit, Scan_Unit_List); + + -- Keep the position of the design unit. + --Set_Location (Design_Unit, Location_Type (File)); + --Set_Location (Library_Unit, Location_Type (File)); + Set_Pos_Line_Off (Design_Unit, Pos, Line, Col); + Set_Date (Design_Unit, Date); + if Date > Max_Date then + Max_Date := Date; + end if; + Set_Date_State (Design_Unit, Date_Disk); + Set_Library_Unit (Design_Unit, Library_Unit); + Set_Design_Unit (Library_Unit, Design_Unit); + + -- Add in the unit hash table. + Add_Unit_Hash (Design_Unit); + + if Last_Design_Unit = Null_Iir then + Set_First_Design_Unit (Design_File, Design_Unit); + else + Set_Chain (Last_Design_Unit, Design_Unit); + end if; + Last_Design_Unit := Design_Unit; + Set_Last_Design_Unit (Design_File, Design_Unit); + end if; + << Next_Line >> null; + end loop; + Set_Date (Library, Max_Date); + Close_File; + return True; + end Load_Library; + + procedure Create_Virtual_Locations + is + use Files_Map; + use Name_Table; + Implicit_Source_File : Source_File_Entry; + Command_Source_File : Source_File_Entry; + begin + Implicit_Source_File := Create_Virtual_Source_File + (Get_Identifier ("*implicit*")); + Command_Source_File := Create_Virtual_Source_File + (Get_Identifier ("*command line*")); + Command_Line_Location := Source_File_To_Location (Command_Source_File); + Implicit_Location := Source_File_To_Location (Implicit_Source_File); + end Create_Virtual_Locations; + + -- Note: the scanner shouldn't be in use, since this procedure uses it. + procedure Load_Std_Library (Build_Standard : Boolean := True) + is + use Std_Package; + Dir : Name_Id; + begin + if Libraries_Chain /= Null_Iir then + -- This procedure must not be called twice. + raise Internal_Error; + end if; + + Flags.Create_Flag_String; + Create_Virtual_Locations; + + Std_Package.Create_First_Nodes; + + -- Create the library. + Std_Library := Create_Iir (Iir_Kind_Library_Declaration); + Set_Identifier (Std_Library, Std_Names.Name_Std); + Set_Location (Std_Library, Implicit_Location); + Libraries_Chain := Std_Library; + Libraries_Chain_Last := Std_Library; + + if Build_Standard then + Create_Std_Standard_Package (Std_Library); + Add_Unit_Hash (Std_Standard_Unit); + end if; + + if Flags.Bootstrap + and then Work_Library_Name = Std_Names.Name_Std + then + Dir := Work_Directory; + else + Dir := Null_Identifier; + end if; + Set_Library_Directory (Std_Library, Dir); + if Load_Library (Std_Library) = False + and then not Flags.Bootstrap + then + Error_Msg_Option ("cannot find ""std"" library"); + end if; + + if Build_Standard then + -- Add the standard_file into the library. + -- This is done after Load_Library, because it checks there is no + -- previous files in the library. + Set_Parent (Std_Standard_File, Std_Library); + Set_Chain (Std_Standard_File, Get_Design_File_Chain (Std_Library)); + Set_Design_File_Chain (Std_Library, Std_Standard_File); + end if; + + Set_Visible_Flag (Std_Library, True); + end Load_Std_Library; + + procedure Load_Work_Library (Empty : Boolean := False) + is + use Std_Names; + begin + if Work_Library_Name = Name_Std then + if not Flags.Bootstrap then + Error_Msg_Option ("the WORK library cannot be STD"); + return; + end if; + Work_Library := Std_Library; + else + Work_Library := Create_Iir (Iir_Kind_Library_Declaration); + Set_Location (Work_Library, Implicit_Location); + --Set_Visible_Flag (Work_Library, True); + Set_Library_Directory (Work_Library, Work_Directory); + + Set_Identifier (Work_Library, Work_Library_Name); + + if not Empty then + if Load_Library (Work_Library) = False then + null; + end if; + end if; + + -- Add it to the list of libraries. + Set_Chain (Libraries_Chain_Last, Work_Library); + Libraries_Chain_Last := Work_Library; + end if; + Set_Visible_Flag (Work_Library, True); + end Load_Work_Library; + +-- procedure Unload_Library (Library : Iir_Library_Declaration) +-- is +-- File : Iir_Design_File; +-- Unit : Iir_Design_Unit; +-- begin +-- loop +-- File := Get_Design_File_Chain (Library); +-- exit when File = Null_Iir; +-- Set_Design_File_Chain (Library, Get_Chain (File)); + +-- loop +-- Unit := Get_Design_Unit_Chain (File); +-- exit when Unit = Null_Iir; +-- Set_Design_Unit_Chain (File, Get_Chain (Unit)); + +-- -- Units should not be loaded. +-- if Get_Loaded_Flag (Unit) then +-- raise Internal_Error; +-- end if; + +-- -- Free dependences list. +-- end loop; +-- end loop; +-- end Unload_Library; + +-- procedure Unload_All_Libraries +-- is +-- Library : Iir_Library_Declaration; +-- begin +-- if Get_Identifier (Std_Library) /= Name_Std then +-- raise Internal_Error; +-- end if; +-- if Std_Library /= Libraries_Chain then +-- raise Internal_Error; +-- end if; +-- loop +-- Library := Get_Chain (Libraries_Chain); +-- exit when Library = Null_Iir; +-- Set_Chain (Libraries_Chain, Get_Chain (Libraries_Chain)); +-- Unload_Library (Library); +-- end loop; +-- end Unload_All_Libraries; + + -- Get or create a library from an identifier. + function Get_Library (Ident: Name_Id; Loc : Location_Type) + return Iir_Library_Declaration + is + Library: Iir_Library_Declaration; + begin + -- library work is a little bit special. + if Ident = Std_Names.Name_Work or else Ident = Work_Library_Name then + if Work_Library = Null_Iir then + -- load_work_library must have been called before. + raise Internal_Error; + end if; + return Work_Library; + end if; + + -- Check if the library has already been loaded. + Library := Iirs_Utils.Find_Name_In_Chain (Libraries_Chain, Ident); + if Library /= Null_Iir then + return Library; + end if; + + -- This is a new library. + if Ident = Std_Names.Name_Std then + -- Load_std_library must have been called before. + raise Internal_Error; + end if; + + Library := Create_Iir (Iir_Kind_Library_Declaration); + Set_Location (Library, Scan.Get_Token_Location); + Set_Library_Directory (Library, Null_Identifier); + Set_Identifier (Library, Ident); + if Load_Library (Library) = False then + Error_Msg_Sem ("cannot find resource library """ + & Name_Table.Image (Ident) & """", Loc); + end if; + Set_Visible_Flag (Library, True); + + Set_Chain (Libraries_Chain_Last, Library); + Libraries_Chain_Last := Library; + + return Library; + end Get_Library; + + -- Return TRUE if LIBRARY_UNIT and UNIT have identifiers for the same + -- design unit identifier. + -- eg: 'entity A' and 'package A' returns TRUE. + function Is_Same_Library_Unit (Library_Unit, Unit: Iir) return Boolean + is + Entity_Name1, Entity_Name2: Name_Id; + Library_Unit_Kind, Unit_Kind : Iir_Kind; + begin + if Get_Identifier (Unit) /= Get_Identifier (Library_Unit) then + return False; + end if; + + Library_Unit_Kind := Get_Kind (Library_Unit); + Unit_Kind := Get_Kind (Unit); + + -- Package and package body are never the same library unit. + if Library_Unit_Kind = Iir_Kind_Package_Declaration + and then Unit_Kind = Iir_Kind_Package_Body + then + return False; + end if; + if Unit_Kind = Iir_Kind_Package_Declaration + and then Library_Unit_Kind = Iir_Kind_Package_Body + then + return False; + end if; + + -- Two architecture declarations are identical only if they also have + -- the same entity name. + if Unit_Kind = Iir_Kind_Architecture_Declaration + and then Library_Unit_Kind = Iir_Kind_Architecture_Declaration + then + Entity_Name1 := Get_Identifier (Get_Entity (Unit)); + Entity_Name2 := Get_Identifier (Get_Entity (Library_Unit)); + if Entity_Name1 /= Entity_Name2 then + return False; + end if; + end if; + + -- An architecture declaration never conflits with a library unit that + -- is not an architecture declaration. + if (Unit_Kind = Iir_Kind_Architecture_Declaration + and then Library_Unit_Kind /= Iir_Kind_Architecture_Declaration) + or else + (Unit_Kind /= Iir_Kind_Architecture_Declaration + and then Library_Unit_Kind = Iir_Kind_Architecture_Declaration) + then + return False; + end if; + + return True; + end Is_Same_Library_Unit; + + procedure Free_Dependence_List (Design : Iir_Design_Unit) + is + List : Iir_List; + El : Iir; + begin + List := Get_Dependence_List (Design); + if List /= Null_Iir_List then + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Iirs_Utils.Free_Recursive (El); + end loop; + Destroy_Iir_List (List); + end if; + end Free_Dependence_List; + + procedure Free_Design_Unit (Design_Unit : Iir_Design_Unit) + is + Lib : Iir; + Unit : Iir_Design_Unit; + Dep_List : Iir_List; + begin + Dep_List := Get_Dependence_List (Design_Unit); + Destroy_Iir_List (Dep_List); + Lib := Get_Library_Unit (Design_Unit); + if Lib /= Null_Iir + and then Get_Kind (Lib) = Iir_Kind_Architecture_Declaration + then + Unit := Get_Default_Configuration_Declaration (Lib); + if Unit /= Null_Iir then + Free_Design_Unit (Unit); + end if; + end if; + Iirs_Utils.Free_Old_Iir (Lib); + end Free_Design_Unit; + + procedure Remove_Unit_From_File + (Unit_Ref : Iir_Design_Unit; File : Iir_Design_File) + is + Prev : Iir_Design_Unit; + Unit, Next : Iir_Design_Unit; + begin + Prev := Null_Iir; + Unit := Get_First_Design_Unit (File); + while Unit /= Null_Iir loop + Next := Get_Chain (Unit); + if Unit = Unit_Ref then + if Prev = Null_Iir then + Set_First_Design_Unit (File, Next); + else + Set_Chain (Prev, Next); + end if; + if Next = Null_Iir then + Set_Last_Design_Unit (File, Prev); + end if; + return; + end if; + Prev := Unit; + Unit := Next; + end loop; + -- Not found. + raise Internal_Error; + end Remove_Unit_From_File; + + -- Last design_file used. Kept to speed-up operations. + Last_Design_File : Iir_Design_File := Null_Iir; + + -- Add or replace a design unit in the working library. + procedure Add_Design_Unit_Into_Library (Unit : Iir_Design_Unit) + is + Design_File: Iir_Design_File; + Design_Unit, Prev_Design_Unit : Iir_Design_Unit; + Last_Unit : Iir_Design_Unit; + Library_Unit: Iir; + New_Library_Unit: Iir; + Unit_Id : Name_Id; + Date: Date_Type; + New_Lib_Time_Stamp : Time_Stamp_Id; + Id : Hash_Id; + + -- File name and dir name of DECL. + File_Name : Name_Id; + Dir_Name : Name_Id; + begin + pragma Assert (Get_Chain (Unit) = Null_Iir); + + if Get_Date_State (Unit) /= Date_Extern then + raise Internal_Error; + end if; + + -- Mark this design unit as being loaded. + New_Library_Unit := Get_Library_Unit (Unit); + Unit_Id := Get_Identifier (New_Library_Unit); + + -- Set the date of the design unit as the most recently analyzed + -- design unit. + case Get_Date (Unit) is + when Date_Parsed => + Set_Date_State (Unit, Date_Parse); + when Date_Analyzed => + Date := Get_Date (Work_Library) + 1; + Set_Date (Unit, Date); + Set_Date (Work_Library, Date); + Set_Date_State (Unit, Date_Analyze); + when Date_Valid => + raise Internal_Error; + when others => + raise Internal_Error; + end case; + + -- Set file time stamp. + declare + File : Source_File_Entry; + Pos : Source_Ptr; + begin + Files_Map.Location_To_File_Pos (Get_Location (New_Library_Unit), + File, Pos); + New_Lib_Time_Stamp := Files_Map.Get_File_Time_Stamp (File); + File_Name := Files_Map.Get_File_Name (File); + Image (File_Name); + if Files_Map.Is_Absolute_Pathname (Name_Buffer (1 .. Name_Length)) + then + Dir_Name := Null_Identifier; + else + Dir_Name := Files_Map.Get_Home_Directory; + end if; + end; + + -- Try to find a design unit with the same name in the work library. + Id := Get_Hash_Id_For_Unit (Unit); + Design_Unit := Unit_Hash_Table (Id); + Prev_Design_Unit := Null_Iir; + while Design_Unit /= Null_Iir loop + Design_File := Get_Design_File (Design_Unit); + Library_Unit := Get_Library_Unit (Design_Unit); + if Get_Identifier (Design_Unit) = Unit_Id + and then Get_Library (Design_File) = Work_Library + and then Is_Same_Library_Unit (New_Library_Unit, Library_Unit) + then + -- LIBRARY_UNIT and UNIT designate the same design unit. + -- Remove the old one. + Set_Date (Design_Unit, Date_Obsolete); + declare + Next_Design : Iir; + begin + -- Remove DESIGN_UNIT from the unit_hash. + Next_Design := Get_Hash_Chain (Design_Unit); + if Prev_Design_Unit = Null_Iir then + Unit_Hash_Table (Id) := Next_Design; + else + Set_Hash_Chain (Prev_Design_Unit, Next_Design); + end if; + + -- Remove DESIGN_UNIT from the design_file. + Remove_Unit_From_File (Design_Unit, Design_File); + end; + + -- UNIT *must* replace library_unit if they don't belong + -- to the same file. + if Get_Design_File_Filename (Design_File) = File_Name + and then Get_Design_File_Directory (Design_File) = Dir_Name + then + -- In the same file. + if Get_Date_State (Design_Unit) = Date_Analyze then + -- Warns only if we are not re-analyzing the file. + if Flags.Warn_Library then + Warning_Msg_Sem + ("redefinition of a library unit in " + & "same design file:", Unit); + Warning_Msg_Sem + (Disp_Node (Library_Unit) & " defined at " + & Disp_Location (Library_Unit) & " is now " + & Disp_Node (New_Library_Unit), Unit); + end if; + else + -- Free the stub. + Free_Design_Unit (Design_Unit); + end if; + + -- Note: the current design unit should not be freed if + -- in use; unfortunatly, this is not obvious to check. + else + if Flags.Warn_Library then + if Get_Kind (Library_Unit) /= Get_Kind (New_Library_Unit) + then + Warning_Msg ("changing definition of a library unit:"); + Warning_Msg (Disp_Node (Library_Unit) & " is now " + & Disp_Node (New_Library_Unit)); + end if; + Warning_Msg + ("library unit '" + & Iirs_Utils.Image_Identifier (Library_Unit) + & "' was also defined in file '" + & Image (Get_Design_File_Filename (Design_File)) + & '''); + end if; + end if; + exit; + end if; + Prev_Design_Unit := Design_Unit; + Design_Unit := Get_Hash_Chain (Design_Unit); + end loop; + + -- Try to find the design file in the library. + -- First try the last one found. + if Last_Design_File /= Null_Iir + and then Get_Library (Last_Design_File) = Work_Library + and then Get_Design_File_Filename (Last_Design_File) = File_Name + and then Get_Design_File_Directory (Last_Design_File) = Dir_Name + then + Design_File := Last_Design_File; + else + -- Search. + Design_File := Get_Design_File_Chain (Work_Library); + while Design_File /= Null_Iir loop + if Get_Design_File_Filename (Design_File) = File_Name + and then Get_Design_File_Directory (Design_File) = Dir_Name + then + exit; + end if; + Design_File := Get_Chain (Design_File); + end loop; + end if; + + if Design_File /= Null_Iir + and then not Files_Map.Is_Eq (New_Lib_Time_Stamp, + Get_File_Time_Stamp (Design_File)) + then + -- FIXME: this test is not enough: what about reanalyzing + -- unmodified files (this works only because the order is not + -- changed). + -- Design file is updated. + -- Outdate all other units, overwrite the design_file. + Set_File_Time_Stamp (Design_File, New_Lib_Time_Stamp); + Design_Unit := Get_First_Design_Unit (Design_File); + while Design_Unit /= Null_Iir loop + if Design_Unit /= Unit then + -- Mark other design unit as obsolete. + Set_Date (Design_Unit, Date_Obsolete); + Remove_Unit_Hash (Design_Unit); + else + raise Internal_Error; + end if; + Design_Unit := Get_Chain (Design_Unit); + end loop; + Set_First_Design_Unit (Design_File, Null_Iir); + Set_Last_Design_Unit (Design_File, Null_Iir); + end if; + + if Design_File = Null_Iir then + -- This is the first apparition of the design file. + Design_File := Create_Iir (Iir_Kind_Design_File); + Location_Copy (Design_File, Unit); + + Set_Design_File_Filename (Design_File, File_Name); + Set_Design_File_Directory (Design_File, Dir_Name); + + Set_File_Time_Stamp (Design_File, New_Lib_Time_Stamp); + Set_Parent (Design_File, Work_Library); + Set_Chain (Design_File, Get_Design_File_Chain (Work_Library)); + Set_Design_File_Chain (Work_Library, Design_File); + end if; + + -- Add DECL to DESIGN_FILE. + Last_Unit := Get_Last_Design_Unit (Design_File); + if Last_Unit = Null_Iir then + if Get_First_Design_Unit (Design_File) /= Null_Iir then + raise Internal_Error; + end if; + Set_First_Design_Unit (Design_File, Unit); + else + if Get_First_Design_Unit (Design_File) = Null_Iir then + raise Internal_Error; + end if; + Set_Chain (Last_Unit, Unit); + end if; + Set_Last_Design_Unit (Design_File, Unit); + Set_Design_File (Unit, Design_File); + + -- Add DECL in unit hash table. + Set_Hash_Chain (Unit, Unit_Hash_Table (Id)); + Unit_Hash_Table (Id) := Unit; + + -- Update the analyzed time stamp. + Set_Analysis_Time_Stamp (Design_File, Files_Map.Get_Os_Time_Stamp); + end Add_Design_Unit_Into_Library; + + procedure Add_Design_File_Into_Library (File : in out Iir_Design_File) + is + Unit : Iir_Design_Unit; + Next_Unit : Iir_Design_Unit; + First_Unit : Iir_Design_Unit; + begin + Unit := Get_First_Design_Unit (File); + First_Unit := Unit; + Set_First_Design_Unit (File, Null_Iir); + Set_Last_Design_Unit (File, Null_Iir); + while Unit /= Null_Iir loop + Next_Unit := Get_Chain (Unit); + Set_Chain (Unit, Null_Iir); + Libraries.Add_Design_Unit_Into_Library (Unit); + Unit := Next_Unit; + end loop; + if First_Unit /= Null_Iir then + File := Get_Design_File (Unit); + end if; + end Add_Design_File_Into_Library; + + -- Save the file map of library LIBRARY. + procedure Save_Library (Library: Iir_Library_Declaration) is + File: File_Type; + + Design_File: Iir_Design_File; + Design_Unit: Iir_Design_Unit; + Library_Unit: Iir; + Dir : Name_Id; + + Off, Line: Natural; + Pos: Source_Ptr; + Source_File : Source_File_Entry; + begin + -- FIXME: directory + declare + use Files_Map; + File_Name: String := Image (Work_Directory) + & Back_End.Library_To_File_Name (Library); + begin + Create (File, Out_File, File_Name); + exception + when Use_Error => + Open (File, Out_File, File_Name); + when Name_Error => + Error_Msg ("cannot create library file """ & File_Name & """"); + raise Option_Error; + end; + + -- Header: version. + Put_Line (File, "v 3"); + + Design_File := Get_Design_File_Chain (Library); + while Design_File /= Null_Iir loop + if Design_File = Std_Package.Std_Standard_File then + goto Continue; + end if; + Design_Unit := Get_First_Design_Unit (Design_File); + + if Design_Unit /= Null_Iir then + Put (File, "file "); + Dir := Get_Design_File_Directory (Design_File); + if Dir = Null_Identifier then + -- Absolute filenames. + Put (File, "/"); + elsif Work_Directory = Name_Nil + and then Dir = Files_Map.Get_Home_Directory + then + -- If the library is in the current directory, do not write + -- it. This allows to move the library file. + Put (File, "."); + else + Image (Dir); + Put (File, """"); + Put (File, Name_Buffer (1 .. Name_Length)); + Put (File, """"); + end if; + Put (File, " """); + Image (Get_Design_File_Filename (Design_File)); + Put (File, Name_Buffer (1 .. Name_Length)); + Put (File, """ """); + Put (File, Files_Map.Get_Time_Stamp_String + (Get_File_Time_Stamp (Design_File))); + Put (File, """ """); + Put (File, Files_Map.Get_Time_Stamp_String + (Get_Analysis_Time_Stamp (Design_File))); + Put_Line (File, """:"); + end if; + + while Design_Unit /= Null_Iir loop + Library_Unit := Get_Library_Unit (Design_Unit); + + Put (File, " "); + case Get_Kind (Library_Unit) is + when Iir_Kind_Entity_Declaration => + Put (File, "entity "); + Put (File, Iirs_Utils.Image_Identifier (Library_Unit)); + when Iir_Kind_Architecture_Declaration => + Put (File, "architecture "); + Put (File, Iirs_Utils.Image_Identifier (Library_Unit)); + Put (File, " of "); + Put (File, Iirs_Utils.Image_Identifier + (Get_Entity (Library_Unit))); + when Iir_Kind_Package_Declaration => + Put (File, "package "); + Put (File, Iirs_Utils.Image_Identifier (Library_Unit)); + when Iir_Kind_Package_Body => + Put (File, "package body "); + Put (File, Iirs_Utils.Image_Identifier (Library_Unit)); + when Iir_Kind_Configuration_Declaration => + Put (File, "configuration "); + Put (File, Iirs_Utils.Image_Identifier (Library_Unit)); + when others => + Error_Kind ("save_library", Library_Unit); + end case; + + if Get_Date_State (Design_Unit) = Date_Disk then + Get_Pos_Line_Off (Design_Unit, Pos, Line, Off); + else + Files_Map.Location_To_Coord (Get_Location (Design_Unit), + Source_File, Pos, Line, Off); + end if; + + Put (File, " at"); + Put (File, Natural'Image (Line)); + Put (File, "("); + Put (File, Source_Ptr'Image (Pos)); + Put (File, ") +"); + Put (File, Natural'Image (Off)); + Put (File, " on"); + case Get_Date (Design_Unit) is + when Date_Valid + | Date_Analyzed + | Date_Parsed => + Put (File, Date_Type'Image (Get_Date (Design_Unit))); + when others => + Put_Line (Date_Type'Image (Get_Date (Design_Unit))); + raise Internal_Error; + end case; + if Get_Kind (Library_Unit) = Iir_Kind_Package_Declaration + and then Get_Need_Body (Library_Unit) + then + Put (File, " body"); + end if; + Put_Line (File, ";"); + + Design_Unit := Get_Chain (Design_Unit); + end loop; + << Continue >> null; + Design_File := Get_Chain (Design_File); + end loop; + + Close (File); + end Save_Library; + + -- Save the map of the work library. + procedure Save_Work_Library is + begin + Save_Library (Work_Library); + end Save_Work_Library; + + -- Return the name of the latest architecture analysed for an entity. + function Get_Latest_Architecture (Entity: Iir_Entity_Declaration) + return Iir_Architecture_Declaration + is + Entity_Id : Name_Id; + Lib : Iir_Library_Declaration; + Design_File: Iir_Design_File; + Design_Unit: Iir_Design_Unit; + Library_Unit: Iir; + Res: Iir_Design_Unit; + begin + -- FIXME: use hash + Entity_Id := Get_Identifier (Entity); + Lib := Get_Library (Get_Design_File (Get_Design_Unit (Entity))); + Design_File := Get_Design_File_Chain (Lib); + Res := Null_Iir; + while Design_File /= Null_Iir loop + Design_Unit := Get_First_Design_Unit (Design_File); + while Design_Unit /= Null_Iir loop + Library_Unit := Get_Library_Unit (Design_Unit); + + if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Declaration + and then Get_Identifier (Get_Entity (Library_Unit)) = Entity_Id + then + if Res = Null_Iir then + Res := Design_Unit; + elsif Get_Date (Design_Unit) > Get_Date (Res) then + Res := Design_Unit; + end if; + end if; + Design_Unit := Get_Chain (Design_Unit); + end loop; + Design_File := Get_Chain (Design_File); + end loop; + if Res = Null_Iir then + return Null_Iir; + else + return Get_Library_Unit (Res); + end if; + end Get_Latest_Architecture; + + function Load_File (File : Source_File_Entry) return Iir_Design_File + is + Res : Iir_Design_File; + begin + Scan.Set_File (File); + Res := Parse.Parse_Design_File; + Scan.Close_File; + if Res /= Null_Iir then + Set_Parent (Res, Work_Library); + Set_Design_File_Filename (Res, Files_Map.Get_File_Name (File)); + end if; + return Res; + end Load_File; + + -- parse a file. + -- Return a design_file without putting it into the library + -- (because it was not semantized). + function Load_File (File_Name: Name_Id) return Iir_Design_File + is + Fe : Source_File_Entry; + begin + Fe := Files_Map.Load_Source_File (Local_Directory, File_Name); + if Fe = No_Source_File_Entry then + Error_Msg_Option ("cannot open " & Image (File_Name)); + return Null_Iir; + end if; + return Load_File (Fe); + end Load_File; + + function Find_Design_Unit (Unit : Iir) return Iir_Design_Unit is + begin + case Get_Kind (Unit) is + when Iir_Kind_Design_Unit => + return Unit; + when Iir_Kind_Selected_Name => + declare + Lib : Iir_Library_Declaration; + begin + Lib := Get_Library (Get_Identifier (Get_Prefix (Unit)), + Get_Location (Unit)); + return Find_Primary_Unit (Lib, Get_Suffix_Identifier (Unit)); + end; + when Iir_Kind_Entity_Aspect_Entity => + declare + Prim : Iir_Design_Unit; + begin + Prim := Find_Design_Unit (Get_Entity (Unit)); + if Prim = Null_Iir then + return Null_Iir; + end if; + return Find_Secondary_Unit + (Prim, Get_Identifier (Get_Architecture (Unit))); + end; + when others => + Error_Kind ("find_design_unit", Unit); + end case; + end Find_Design_Unit; + + function Is_Obsolete (Design_Unit : Iir_Design_Unit; Loc : Iir) + return Boolean + is + procedure Error_Obsolete (Msg : String) is + begin + if not Flags.Flag_Elaborate_With_Outdated then + Error_Msg_Sem (Msg, Loc); + end if; + end Error_Obsolete; + + List : Iir_List; + El : Iir; + Unit : Iir_Design_Unit; + U_Ts : Time_Stamp_Id; + Du_Ts : Time_Stamp_Id; + begin + if Get_Date (Design_Unit) = Date_Obsolete then + Error_Obsolete (Disp_Node (Design_Unit) & " is obsolete"); + return True; + end if; + List := Get_Dependence_List (Design_Unit); + if List = Null_Iir_List then + return False; + end if; + Du_Ts := Get_Analysis_Time_Stamp (Get_Design_File (Design_Unit)); + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Unit := Find_Design_Unit (El); + if Unit /= Null_Iir then + U_Ts := Get_Analysis_Time_Stamp (Get_Design_File (Unit)); + if Files_Map.Is_Gt (U_Ts, Du_Ts) then + Error_Obsolete + (Disp_Node (Design_Unit) & " is obsoleted by " & + Disp_Node (Unit)); + return True; + elsif Is_Obsolete (Unit, Loc) then + Error_Obsolete + (Disp_Node (Design_Unit) & " depends on obsolete unit"); + return True; + end if; + end if; + end loop; + return False; + end Is_Obsolete; + + procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) + is + use Scan; + Line, Off: Natural; + Pos: Source_Ptr; + Res: Iir; + Library : Iir_Library_Declaration; + Design_File : Iir_Design_File; + Fe : Source_File_Entry; + begin + if Get_Date_State (Design_Unit) /= Date_Disk then + raise Internal_Error; + end if; + + -- Load and parse the unit. + Design_File := Get_Design_File (Design_Unit); + Library := Get_Library (Design_File); + Fe := Files_Map.Load_Source_File + (Get_Design_File_Directory (Design_File), + Get_Design_File_Filename (Design_File)); + if Fe = No_Source_File_Entry then + Error_Msg + ("cannot load " & Disp_Node (Get_Library_Unit (Design_Unit))); + raise Compilation_Error; + end if; + Set_File (Fe); + + if not Files_Map.Is_Eq + (Files_Map.Get_File_Time_Stamp (Get_Current_Source_File), + Get_File_Time_Stamp (Design_File)) + then + Error_Msg_Sem + ("file " & Image (Get_Design_File_Filename (Design_File)) + & " has changed and must be reanalysed", Loc); + raise Compilation_Error; + elsif Get_Date (Design_Unit) = Date_Obsolete then + Error_Msg_Sem + (''' & Disp_Node (Get_Library_Unit (Design_Unit)) + & "' is not anymore in the file", + Design_Unit); + raise Compilation_Error; + end if; + Get_Pos_Line_Off (Design_Unit, Pos, Line, Off); + Files_Map.File_Add_Line_Number (Get_Current_Source_File, Line, Pos); + Set_Current_Position (Pos + Source_Ptr (Off)); + Res := Parse.Parse_Design_Unit; + Close_File; + if Res = Null_Iir then + raise Compilation_Error; + end if; + Set_Date_State (Design_Unit, Date_Parse); + -- FIXME: check the library unit read is the one expected. + -- Copy node. + Iirs_Utils.Free_Recursive (Get_Library_Unit (Design_Unit)); + Set_Library_Unit (Design_Unit, Get_Library_Unit (Res)); + Set_Design_Unit (Get_Library_Unit (Res), Design_Unit); + Set_Parent (Get_Library_Unit (Res), Design_Unit); + Set_Context_Items (Design_Unit, Get_Context_Items (Res)); + Location_Copy (Design_Unit, Res); + Free_Dependence_List (Design_Unit); + Set_Dependence_List (Design_Unit, Get_Dependence_List (Res)); + Set_Dependence_List (Res, Null_Iir_List); + Free_Iir (Res); + end Load_Parse_Design_Unit; + + -- Load, parse, semantize, back-end a design_unit if necessary. + procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) is + begin + if Get_Date_State (Design_Unit) = Date_Disk then + Load_Parse_Design_Unit (Design_Unit, Loc); + end if; + + if Get_Date_State (Design_Unit) = Date_Parse then + -- Analyze the design unit. + + if Get_Date (Design_Unit) = Date_Analyzed then + -- Work-around for an internal check in sem. + -- FIXME: to be removed ? + Set_Date (Design_Unit, Date_Parsed); + end if; + + -- Avoid infinite recursion, if the unit is self-referenced. + Set_Date_State (Design_Unit, Date_Analyze); + + Sem_Scopes.Push_Interpretations; + Back_End.Finish_Compilation (Design_Unit); + Sem_Scopes.Pop_Interpretations; + + end if; + + case Get_Date (Design_Unit) is + when Date_Parsed => + raise Internal_Error; + when Date_Analyzing => + -- Self-referenced unit. + return; + when Date_Analyzed => + -- FIXME: Accept it silently ? + -- Note: this is used when Flag_Elaborate_With_Outdated is set. + -- This is also used by anonymous configuration declaration. + null; + when Date_Uptodate => + return; + when Date_Valid => + null; + when Date_Obsolete => + if not Flags.Flag_Elaborate_With_Outdated then + Error_Msg_Sem (Disp_Node (Design_Unit) & " is obsolete", Loc); + return; + end if; + when others => + raise Internal_Error; + end case; + + if not Flags.Flag_Elaborate_With_Outdated + and then Is_Obsolete (Design_Unit, Loc) + then + Set_Date (Design_Unit, Date_Obsolete); + end if; + end Load_Design_Unit; + + -- Return the declaration of primary unit NAME of LIBRARY. + function Find_Primary_Unit + (Library: Iir_Library_Declaration; Name: Name_Id) + return Iir_Design_Unit + is + Unit : Iir_Design_Unit; + begin + Unit := Unit_Hash_Table (Name mod Unit_Hash_Length); + while Unit /= Null_Iir loop + if Get_Identifier (Unit) = Name + and then Get_Library (Get_Design_File (Unit)) = Library + then + case Get_Kind (Get_Library_Unit (Unit)) is + when Iir_Kind_Package_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Configuration_Declaration => + -- Only return a primary unit. + return Unit; + when others => + null; + end case; + end if; + Unit := Get_Hash_Chain (Unit); + end loop; + + -- The primary unit is not in the library, return null. + return Null_Iir; + end Find_Primary_Unit; + + function Load_Primary_Unit + (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir) + return Iir_Design_Unit + is + Design_Unit: Iir_Design_Unit; + begin + Design_Unit := Find_Primary_Unit (Library, Name); + if Design_Unit /= Null_Iir then + Load_Design_Unit (Design_Unit, Loc); + end if; + return Design_Unit; + end Load_Primary_Unit; + + -- Return the declaration of secondary unit NAME for PRIMARY, or null if + -- not found. + function Find_Secondary_Unit (Primary: Iir_Design_Unit; Name: Name_Id) + return Iir_Design_Unit + is + Design_Unit: Iir_Design_Unit; + Library_Unit: Iir; + Primary_Ident: Name_Id; + Ident: Name_Id; + Lib_Prim : Iir; + begin + Lib_Prim := Get_Library (Get_Design_File (Primary)); + Primary_Ident := Get_Identifier (Get_Library_Unit (Primary)); + Design_Unit := Unit_Hash_Table (Primary_Ident mod Unit_Hash_Length); + while Design_Unit /= Null_Iir loop + Library_Unit := Get_Library_Unit (Design_Unit); + + -- The secondary is always in the same library as the primary. + if Get_Library (Get_Design_File (Design_Unit)) = Lib_Prim then + -- Set design_unit to null iff this is not the correct + -- design unit. + case Get_Kind (Library_Unit) is + when Iir_Kind_Architecture_Declaration => + -- The entity field can be either an identifier (if the + -- library unit was not loaded) or an access to the entity + -- unit. + Ident := Get_Identifier (Get_Entity (Library_Unit)); + if Ident = Primary_Ident + and then Get_Identifier (Library_Unit) = Name + then + return Design_Unit; + end if; + when Iir_Kind_Package_Body => + if Name = Null_Identifier + and then Get_Identifier (Library_Unit) = Primary_Ident + then + return Design_Unit; + end if; + when others => + null; + end case; + end if; + Design_Unit := Get_Hash_Chain (Design_Unit); + end loop; + + -- The architecture or the body is not in the library, return null. + return Null_Iir; + end Find_Secondary_Unit; + + -- Load an secondary unit and analyse it. + function Load_Secondary_Unit + (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir) + return Iir_Design_Unit + is + Design_Unit: Iir_Design_Unit; + begin + Design_Unit := Find_Secondary_Unit (Primary, Name); + if Design_Unit /= Null_Iir then + Load_Design_Unit (Design_Unit, Loc); + end if; + return Design_Unit; + end Load_Secondary_Unit; + +end Libraries; diff --git a/libraries.ads b/libraries.ads new file mode 100644 index 000000000..cb988d655 --- /dev/null +++ b/libraries.ads @@ -0,0 +1,167 @@ +-- VHDL libraries handling. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Iirs; use Iirs; +with Std_Names; + +package Libraries is + -- This package defines the library manager. + -- The purpose of the library manager is to associate library logical names + -- with host-dependent library. + -- + -- In this implementation a host-dependent library is a file, whose name + -- is logical name of the library with the extension '.cf'. This file + -- contains the name and the position (filename, line, column and offset) + -- of all library unit of the library. + -- + -- The working library WORK can be aliased with a ressource library, + -- they share the same host-dependenet library whose name is the name + -- of the ressource library. This is done by load_work_library. + + -- Location for a command line. + Command_Line_Location : Location_Type; + + -- Library declaration for the std library. + -- This is also the first library of the libraries chain. + Std_Library : Iir_Library_Declaration := Null_Iir; + + -- Library declaration for the work library. + -- Note: the identifier of the work_library is work_library_name, which + -- may be different from 'WORK'. + Work_Library: Iir_Library_Declaration; + + -- Name of the WORK library. + Work_Library_Name : Name_Id := Std_Names.Name_Work; + + -- Directory of the work library. + -- Set by default by INIT_PATHES to the local directory. + Work_Directory : Name_Id; + + -- Local (current) directory. + Local_Directory : Name_Id; + + -- Initialize library pathes table. + -- Set the local path. + procedure Init_Pathes; + + -- Add PATH in the search path. + procedure Add_Library_Path (Path : String); + + -- Get the number of path in the search pathes. + function Get_Nbr_Pathes return Natural; + + -- Get path N. + function Get_Path (N : Natural) return Name_Id; + + -- Set PATH as the path of the work library. + procedure Set_Work_Library_Path (Path : String); + + -- Set the name of the work library, load the work library. + -- Note: the scanner shouldn't be in use, since this function uses it. + -- If EMPTY is set, the work library is just created and not loaded. + procedure Load_Work_Library (Empty : Boolean := False); + + -- Initialize the library manager and load the STD library. + -- If BUILD_STANDARD is false, the std.standard library is not created. + procedure Load_Std_Library (Build_Standard : Boolean := True); + + -- Save the work library as a host-dependent library. + procedure Save_Work_Library; + + -- Start the analyse a file (ie load and parse it). + -- The file is read from the current directory (unless FILE_NAME is an + -- absolute path). + -- Emit an error if the file cannot be opened. + -- Return NULL_IIR in case of parse error. + function Load_File (File_Name: Name_Id) return Iir_Design_File; + function Load_File (File : Source_File_Entry) return Iir_Design_File; + + -- Load, parse, semantize, back-end a design_unit if necessary. + -- Check Design_Unit is not obsolete. + -- LOC is the location where the design unit was needed, in case of error. + procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir); + + -- Load and parse DESIGN_UNIT. + -- Contrary to Load_Design_Unit, the design_unit is not analyzed. + -- Also, the design_unit must not have been already loaded. + -- Used almost only by Load_Design_Unit. + procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir); + + -- Remove the same file as DESIGN_FILE from work library and all of its + -- units. + procedure Purge_Design_File (Design_File : Iir_Design_File); + + -- Just return the design_unit for NAME, or NULL if not found. + function Find_Primary_Unit + (Library: Iir_Library_Declaration; Name: Name_Id) + return Iir_Design_Unit; + + -- Load an already analyzed primary unit NAME from library LIBRARY + -- and compile it. + -- Return NULL_IIR if not found (ie, NAME does not correspond to a + -- library unit identifier). + function Load_Primary_Unit + (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir) + return Iir_Design_Unit; + + -- Find the secondary unit of PRIMARY. + -- If PRIMARY is a package declaration, returns the package body, + -- If PRIMARY is an entity declaration, returns the architecture NAME. + -- Return NULL_IIR if not found. + function Find_Secondary_Unit (Primary: Iir_Design_Unit; Name: Name_Id) + return Iir_Design_Unit; + + -- Load an secondary unit of primary unit PRIMARY and analyse it. + -- NAME must be set only for an architecture. + function Load_Secondary_Unit + (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir) + return Iir_Design_Unit; + + -- Get or create a library from an identifier. + -- LOC is used only to report errors. + function Get_Library (Ident : Name_Id; Loc : Location_Type) + return Iir_Library_Declaration; + + -- Add or replace an design unit in the work library. + -- DECL must not have a chain (because it may be modified). + -- + -- If the design_file of UNIT is not already in the library, a new one + -- is created. + -- + -- Units are always appended to the design_file. Therefore, the order is + -- kept. + procedure Add_Design_Unit_Into_Library (Unit : in Iir_Design_Unit); + + -- Put all design_units of FILE into the work library, by calling + -- Add_Design_Unit_Into_Library. + -- FILE is updated since it may changed (FILE is never put in the library, + -- a new one is created). + procedure Add_Design_File_Into_Library (File : in out Iir_Design_File); + + -- Return the latest architecture analysed for entity ENTITY. + function Get_Latest_Architecture (Entity: Iir_Entity_Declaration) + return Iir_Architecture_Declaration; + + -- Return the design unit (stubed if not loaded) from UNIT. + -- UNIT may be either a design unit, in this case UNIT is returned, + -- or a selected name, in this case the prefix is a library name and + -- the suffix a primary design unit name, + -- or an entity_aspect_entity to designate an architectrure. + -- Return null_iir if the design unit is not found. + function Find_Design_Unit (Unit : Iir) return Iir_Design_Unit; +end Libraries; diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc new file mode 100644 index 000000000..e1557c603 --- /dev/null +++ b/libraries/Makefile.inc @@ -0,0 +1,169 @@ +# -*- Makefile -*- for the VHDL libraries. +# Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +# Software Foundation, 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# Variable to be defined: +# LIB93_DIR +# LIB87_DIR +# REL_DIR +# LIBSRC_DIR +# ANALYZE +# LN +# CP +# +# Note: the source files are analyzed in the LIBxx_DIR. So LIBSRC_DIR must be +# relative to the target directory. + +STD_SRCS := std/textio.vhdl std/textio_body.vhdl +IEEE_SRCS := ieee/std_logic_1164.vhdl ieee/std_logic_1164_body.vhdl \ + ieee/numeric_bit.vhdl ieee/numeric_bit-body.vhdl \ + ieee/numeric_std.vhdl ieee/numeric_std-body.vhdl +MATH_SRCS := ieee/math_real.vhdl ieee/math_real-body.vhdl \ + ieee/math_complex.vhdl ieee/math_complex-body.vhdl +VITAL95_BSRCS := vital95/vital_timing.vhdl vital95/vital_timing_body.vhdl \ + vital95/vital_primitives.vhdl vital95/vital_primitives_body.vhdl +VITAL2000_BSRCS := vital2000/timing_p.vhdl vital2000/timing_b.vhdl \ + vital2000/prmtvs_p.vhdl vital2000/prmtvs_b.vhdl \ + vital2000/memory_p.vhdl vital2000/memory_b.vhdl +SYNOPSYS_BSRCS := synopsys/std_logic_arith.vhdl \ + synopsys/std_logic_textio.vhdl synopsys/std_logic_unsigned.vhdl \ + synopsys/std_logic_signed.vhdl \ + synopsys/std_logic_misc.vhdl synopsys/std_logic_misc-body.vhdl +MENTOR_BSRCS := mentor/std_logic_arith.vhdl mentor/std_logic_arith_body.vhdl + +STD87_BSRCS := $(STD_SRCS:.vhdl=.v87) +STD93_BSRCS := $(STD_SRCS:.vhdl=.v93) +IEEE87_BSRCS := $(IEEE_SRCS:.vhdl=.v87) +IEEE93_BSRCS := $(IEEE_SRCS:.vhdl=.v93) $(MATH_SRCS) +SYNOPSYS87_BSRCS := $(SYNOPSYS_BSRCS) +SYNOPSYS93_BSRCS := $(SYNOPSYS_BSRCS) +MENTOR93_BSRCS := $(MENTOR_BSRCS) + +.PREFIXES: .vhdl .v93 .v87 + +%.v93: %.vhdl + sed -e '/--V87/s/^/ --/' < $< > $@ + +%.v87: %.vhdl + sed -e '/--V93/s/^/ --/' -e '/--START-V93/,/--END-V93/s/^/--/' \ + < $< > $@ + +STD93_DIR:=$(LIB93_DIR)/std +IEEE93_DIR:=$(LIB93_DIR)/ieee +SYN93_DIR:=$(LIB93_DIR)/synopsys +MENTOR93_DIR:=$(LIB93_DIR)/mentor + +STD87_DIR:=$(LIB87_DIR)/std +IEEE87_DIR:=$(LIB87_DIR)/ieee +SYN87_DIR:=$(LIB87_DIR)/synopsys + +ANALYZE93:=$(ANALYZE) --std=93 +ANALYZE87:=$(ANALYZE) --std=87 + +STD87_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD87_BSRCS)) +STD93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD93_BSRCS)) +IEEE93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE93_BSRCS)) +IEEE87_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE87_BSRCS)) +SYNOPSYS_SRCS=$(addprefix $(LIBSRC_DIR)/,$(SYNOPSYS_BSRCS)) +MENTOR93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(MENTOR93_BSRCS)) +VITAL95_SRCS=$(addprefix $(LIBSRC_DIR)/,$(VITAL95_BSRCS)) +VITAL2000_SRCS=$(addprefix $(LIBSRC_DIR)/,$(VITAL2000_BSRCS)) + +std.v93: $(LIB93_DIR) $(STD93_SRCS) force + $(RM) -rf $(STD93_DIR) + mkdir $(STD93_DIR) + prev=`pwd`; cd $(STD93_DIR); \ + for i in $(STD93_SRCS); do \ + echo $$i; \ + $(ANALYZE93) --bootstrap --work=std $(REL_DIR)/$$i || exit 1; \ + done; \ + cd $$prev + +ANALYZE_IEEE93=$(ANALYZE93) -P../std --work=ieee + +ieee.v93: $(LIB93_DIR) $(IEEE93_SRCS) force + $(RM) -rf $(IEEE93_DIR) + mkdir $(IEEE93_DIR) + prev=`pwd`; cd $(IEEE93_DIR); \ + for i in $(IEEE93_BSRCS) $(VITAL2000_BSRCS); do \ + cmd="$(ANALYZE_IEEE93) $(REL_DIR)/$(LIBSRC_DIR)/$$i"; \ + echo $$cmd; eval $$cmd || exit 1; \ + done; \ + cd $$prev + +synopsys.v93: $(LIB93_DIR) $(SYNOPSYS_SRCS) force + $(RM) -rf $(SYN93_DIR) + mkdir $(SYN93_DIR) + prev=`pwd`; cd $(SYN93_DIR); \ + $(CP) ../ieee/ieee-obj93.cf .; \ + for i in $(IEEE_SRCS) $(VITAL2000_SRCS); do \ + b=`basename $$i .vhdl`; $(LN) ../ieee/$$b.o $$b.o || exit 1; \ + done; \ + for i in $(SYNOPSYS93_BSRCS); do \ + cmd="$(ANALYZE_IEEE93) $(REL_DIR)/$(LIBSRC_DIR)/$$i"; \ + echo $$cmd; eval $$cmd || exit 1; \ + done; \ + cd $$prev + +mentor.v93: $(LIB93_DIR) $(MENTOR93_SRCS) force + $(RM) -rf $(MENTOR93_DIR) + mkdir $(MENTOR93_DIR) + prev=`pwd`; cd $(MENTOR93_DIR); \ + $(CP) ../ieee/ieee-obj93.cf . ;\ + for i in $(IEEE_SRCS) $(VITAL2000_SRCS); do \ + b=`basename $$i .vhdl`; $(LN) ../ieee/$$b.o $$b.o || exit 1; \ + done ; \ + for i in $(MENTOR93_BSRCS); do \ + cmd="$(ANALYZE_IEEE93) $(REL_DIR)/$(LIBSRC_DIR)/$$i";\ + echo $$cmd; eval $$cmd || exit 1; \ + done + +std.v87: $(LIB87_DIR) $(STD87_SRCS) force + $(RM) -rf $(STD87_DIR) + mkdir $(STD87_DIR) + prev=`pwd`; cd $(STD87_DIR); \ + for i in $(STD87_SRCS); do \ + echo $$i; \ + $(ANALYZE87) --bootstrap --work=std $(REL_DIR)/$$i || exit 1; \ + done; \ + cd $$prev + +ANALYZE_IEEE87=$(ANALYZE87) -P../std --work=ieee + +ieee.v87: $(LIB87_DIR) $(IEEE87_SRCS) force + $(RM) -rf $(IEEE87_DIR) + mkdir $(IEEE87_DIR) + prev=`pwd`; cd $(IEEE87_DIR); \ + for i in $(IEEE87_BSRCS) $(VITAL95_BSRCS); do \ + cmd="$(ANALYZE_IEEE87) $(REL_DIR)/$(LIBSRC_DIR)/$$i";\ + echo $$cmd; eval $$cmd || exit 1; \ + done; \ + cd $$prev + +synopsys.v87: $(LIB87_DIR) $(SYNOPSYS_SRCS) force + $(RM) -rf $(SYN87_DIR) + mkdir $(SYN87_DIR) + prev=`pwd`; cd $(SYN87_DIR); \ + $(CP) ../ieee/ieee-obj87.cf . ; \ + for i in $(IEEE_SRCS) $(VITAL95_SRCS); do \ + b=`basename $$i .vhdl`; $(LN) ../ieee/$$b.o $$b.o || exit 1; \ + done; \ + for i in $(SYNOPSYS87_BSRCS); do \ + cmd="$(ANALYZE_IEEE87) $(REL_DIR)/$(LIBSRC_DIR)/$$i";\ + echo $$cmd; eval $$cmd || exit 1; \ + done; \ + cd $$prev diff --git a/libraries/README b/libraries/README new file mode 100644 index 000000000..d569a25a1 --- /dev/null +++ b/libraries/README @@ -0,0 +1,27 @@ +VHDL libraries. +--------------- + +* Filename convention: + +For a package XXXX, the file containing the declaration must be named XXXX.vhdl +and the file containing the body must be named XXXX-body.vhdl + +Note: this is not completly followed! + + +* Using Vhdl-87 or Vhdl-93: + +Lines that must be compiled only for vhdl-87 must have a --V87 comment at the +end, lines for vhdl-93 must a a --V93 comment. +Example: + procedure readline (variable f: in text; l: out line) --V87 + procedure readline (file f: text; l: out line) --V93 +For group of lines that must be compiled only for vhdl-93 (such as xnor +functions), use this: + --START-V93 + ...[lines to compile only with vhdl-93]... + --END-V93 +Makefile rules create .v87 and .v93 files from .vhdl files, and compile them +with the correct version. + +# Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold diff --git a/libraries/ieee/math_complex-body.vhdl b/libraries/ieee/math_complex-body.vhdl new file mode 100644 index 000000000..9b8b75ad4 --- /dev/null +++ b/libraries/ieee/math_complex-body.vhdl @@ -0,0 +1,394 @@ +--------------------------------------------------------------- +-- +-- This source file may be used and distributed without restriction. +-- No declarations or definitions shall be included in this package. +-- This package cannot be sold or distributed for profit. +-- +-- **************************************************************** +-- * * +-- * W A R N I N G * +-- * * +-- * This DRAFT version IS NOT endorsed or approved by IEEE * +-- * * +-- **************************************************************** +-- +-- Title: PACKAGE BODY MATH_COMPLEX +-- +-- Purpose: VHDL declarations for mathematical package MATH_COMPLEX +-- which contains common complex constants and basic complex +-- functions and operations. +-- +-- Author: IEEE VHDL Math Package Study Group +-- +-- Notes: +-- The package body uses package IEEE.MATH_REAL +-- +-- The package body shall be considered the formal definition of +-- the semantics of this package. Tool developers may choose to implement +-- the package body in the most efficient manner available to them. +-- +-- Source code for this package body comes from the following +-- following sources: +-- IEEE VHDL Math Package Study Group participants, +-- U. of Mississippi, Mentor Graphics, Synopsys, +-- Viewlogic/Vantage, Communications of the ACM (June 1988, Vol +-- 31, Number 6, pp. 747, Pierre L'Ecuyer, Efficient and Portable +-- Random Number Generators, Handbook of Mathematical Functions +-- by Milton Abramowitz and Irene A. Stegun (Dover). +-- +-- History: +-- Version 0.1 Jose A. Torres 4/23/93 First draft +-- Version 0.2 Jose A. Torres 5/28/93 Fixed potentially illegal code +-- +------------------------------------------------------------- +Library IEEE; + +Use IEEE.MATH_REAL.all; -- real trascendental operations + +Package body MATH_COMPLEX is + + function CABS(Z: in complex ) return real is + -- returns absolute value (magnitude) of Z + variable ztemp : complex_polar; + begin + ztemp := COMPLEX_TO_POLAR(Z); + return ztemp.mag; + end CABS; + + function CARG(Z: in complex ) return real is + -- returns argument (angle) in radians of a complex number + variable ztemp : complex_polar; + begin + ztemp := COMPLEX_TO_POLAR(Z); + return ztemp.arg; + end CARG; + + function CMPLX(X: in real; Y: in real := 0.0 ) return complex is + -- returns complex number X + iY + begin + return COMPLEX'(X, Y); + end CMPLX; + + function "-" (Z: in complex ) return complex is + -- unary minus; returns -x -jy for z= x + jy + begin + return COMPLEX'(-z.Re, -z.Im); + end "-"; + + function "-" (Z: in complex_polar ) return complex_polar is + -- unary minus; returns (z.mag, z.arg + MATH_PI) + begin + return COMPLEX_POLAR'(z.mag, z.arg + MATH_PI); + end "-"; + + function CONJ (Z: in complex) return complex is + -- returns complex conjugate (x-jy for z = x+ jy) + begin + return COMPLEX'(z.Re, -z.Im); + end CONJ; + + function CONJ (Z: in complex_polar) return complex_polar is + -- returns complex conjugate (z.mag, -z.arg) + begin + return COMPLEX_POLAR'(z.mag, -z.arg); + end CONJ; + + function CSQRT(Z: in complex ) return complex_vector is + -- returns square root of Z; 2 values + variable ztemp : complex_polar; + variable zout : complex_vector (0 to 1); + variable temp : real; + begin + ztemp := COMPLEX_TO_POLAR(Z); + temp := SQRT(ztemp.mag); + zout(0).re := temp*COS(ztemp.arg/2.0); + zout(0).im := temp*SIN(ztemp.arg/2.0); + + zout(1).re := temp*COS(ztemp.arg/2.0 + MATH_PI); + zout(1).im := temp*SIN(ztemp.arg/2.0 + MATH_PI); + + return zout; + end CSQRT; + + function CEXP(Z: in complex ) return complex is + -- returns e**Z + begin + return COMPLEX'(EXP(Z.re)*COS(Z.im), EXP(Z.re)*SIN(Z.im)); + end CEXP; + + function COMPLEX_TO_POLAR(Z: in complex ) return complex_polar is + -- converts complex to complex_polar + begin + return COMPLEX_POLAR'(sqrt(z.re**2 + z.im**2),atan2(z.re,z.im)); + end COMPLEX_TO_POLAR; + + function POLAR_TO_COMPLEX(Z: in complex_polar ) return complex is + -- converts complex_polar to complex + begin + return COMPLEX'( z.mag*cos(z.arg), z.mag*sin(z.arg) ); + end POLAR_TO_COMPLEX; + + + -- + -- arithmetic operators + -- + + function "+" ( L: in complex; R: in complex ) return complex is + begin + return COMPLEX'(L.Re + R.Re, L.Im + R.Im); + end "+"; + + function "+" (L: in complex_polar; R: in complex_polar) return complex is + variable zL, zR : complex; + begin + zL := POLAR_TO_COMPLEX( L ); + zR := POLAR_TO_COMPLEX( R ); + return COMPLEX'(zL.Re + zR.Re, zL.Im + zR.Im); + end "+"; + + function "+" ( L: in complex_polar; R: in complex ) return complex is + variable zL : complex; + begin + zL := POLAR_TO_COMPLEX( L ); + return COMPLEX'(zL.Re + R.Re, zL.Im + R.Im); + end "+"; + + function "+" ( L: in complex; R: in complex_polar) return complex is + variable zR : complex; + begin + zR := POLAR_TO_COMPLEX( R ); + return COMPLEX'(L.Re + zR.Re, L.Im + zR.Im); + end "+"; + + function "+" ( L: in real; R: in complex ) return complex is + begin + return COMPLEX'(L + R.Re, R.Im); + end "+"; + + function "+" ( L: in complex; R: in real ) return complex is + begin + return COMPLEX'(L.Re + R, L.Im); + end "+"; + + function "+" ( L: in real; R: in complex_polar) return complex is + variable zR : complex; + begin + zR := POLAR_TO_COMPLEX( R ); + return COMPLEX'(L + zR.Re, zR.Im); + end "+"; + + function "+" ( L: in complex_polar; R: in real) return complex is + variable zL : complex; + begin + zL := POLAR_TO_COMPLEX( L ); + return COMPLEX'(zL.Re + R, zL.Im); + end "+"; + + function "-" ( L: in complex; R: in complex ) return complex is + begin + return COMPLEX'(L.Re - R.Re, L.Im - R.Im); + end "-"; + + function "-" ( L: in complex_polar; R: in complex_polar) return complex is + variable zL, zR : complex; + begin + zL := POLAR_TO_COMPLEX( L ); + zR := POLAR_TO_COMPLEX( R ); + return COMPLEX'(zL.Re - zR.Re, zL.Im - zR.Im); + end "-"; + + function "-" ( L: in complex_polar; R: in complex ) return complex is + variable zL : complex; + begin + zL := POLAR_TO_COMPLEX( L ); + return COMPLEX'(zL.Re - R.Re, zL.Im - R.Im); + end "-"; + + function "-" ( L: in complex; R: in complex_polar) return complex is + variable zR : complex; + begin + zR := POLAR_TO_COMPLEX( R ); + return COMPLEX'(L.Re - zR.Re, L.Im - zR.Im); + end "-"; + + function "-" ( L: in real; R: in complex ) return complex is + begin + return COMPLEX'(L - R.Re, -1.0 * R.Im); + end "-"; + + function "-" ( L: in complex; R: in real ) return complex is + begin + return COMPLEX'(L.Re - R, L.Im); + end "-"; + + function "-" ( L: in real; R: in complex_polar) return complex is + variable zR : complex; + begin + zR := POLAR_TO_COMPLEX( R ); + return COMPLEX'(L - zR.Re, -1.0*zR.Im); + end "-"; + + function "-" ( L: in complex_polar; R: in real) return complex is + variable zL : complex; + begin + zL := POLAR_TO_COMPLEX( L ); + return COMPLEX'(zL.Re - R, zL.Im); + end "-"; + + function "*" ( L: in complex; R: in complex ) return complex is + begin + return COMPLEX'(L.Re * R.Re - L.Im * R.Im, L.Re * R.Im + L.Im * R.Re); + end "*"; + + function "*" ( L: in complex_polar; R: in complex_polar) return complex is + variable zout : complex_polar; + begin + zout.mag := L.mag * R.mag; + zout.arg := L.arg + R.arg; + return POLAR_TO_COMPLEX(zout); + end "*"; + + function "*" ( L: in complex_polar; R: in complex ) return complex is + variable zL : complex; + begin + zL := POLAR_TO_COMPLEX( L ); + return COMPLEX'(zL.Re*R.Re - zL.Im * R.Im, zL.Re * R.Im + zL.Im*R.Re); + end "*"; + + function "*" ( L: in complex; R: in complex_polar) return complex is + variable zR : complex; + begin + zR := POLAR_TO_COMPLEX( R ); + return COMPLEX'(L.Re*zR.Re - L.Im * zR.Im, L.Re * zR.Im + L.Im*zR.Re); + end "*"; + + function "*" ( L: in real; R: in complex ) return complex is + begin + return COMPLEX'(L * R.Re, L * R.Im); + end "*"; + + function "*" ( L: in complex; R: in real ) return complex is + begin + return COMPLEX'(L.Re * R, L.Im * R); + end "*"; + + function "*" ( L: in real; R: in complex_polar) return complex is + variable zR : complex; + begin + zR := POLAR_TO_COMPLEX( R ); + return COMPLEX'(L * zR.Re, L * zR.Im); + end "*"; + + function "*" ( L: in complex_polar; R: in real) return complex is + variable zL : complex; + begin + zL := POLAR_TO_COMPLEX( L ); + return COMPLEX'(zL.Re * R, zL.Im * R); + end "*"; + + function "/" ( L: in complex; R: in complex ) return complex is + variable magrsq : REAL := R.Re ** 2 + R.Im ** 2; + begin + if (magrsq = 0.0) then + assert FALSE report "Attempt to divide by (0,0)" + severity ERROR; + return COMPLEX'(REAL'RIGHT, REAL'RIGHT); + else + return COMPLEX'( (L.Re * R.Re + L.Im * R.Im) / magrsq, + (L.Im * R.Re - L.Re * R.Im) / magrsq); + end if; + end "/"; + + function "/" ( L: in complex_polar; R: in complex_polar) return complex is + variable zout : complex_polar; + begin + if (R.mag = 0.0) then + assert FALSE report "Attempt to divide by (0,0)" + severity ERROR; + return COMPLEX'(REAL'RIGHT, REAL'RIGHT); + else + zout.mag := L.mag/R.mag; + zout.arg := L.arg - R.arg; + return POLAR_TO_COMPLEX(zout); + end if; + end "/"; + + function "/" ( L: in complex_polar; R: in complex ) return complex is + variable zL : complex; + variable temp : REAL := R.Re ** 2 + R.Im ** 2; + begin + if (temp = 0.0) then + assert FALSE report "Attempt to divide by (0.0,0.0)" + severity ERROR; + return COMPLEX'(REAL'RIGHT, REAL'RIGHT); + else + zL := POLAR_TO_COMPLEX( L ); + return COMPLEX'( (zL.Re * R.Re + zL.Im * R.Im) / temp, + (zL.Im * R.Re - zL.Re * R.Im) / temp); + end if; + end "/"; + + function "/" ( L: in complex; R: in complex_polar) return complex is + variable zR : complex := POLAR_TO_COMPLEX( R ); + variable temp : REAL := zR.Re ** 2 + zR.Im ** 2; + begin + if (R.mag = 0.0) or (temp = 0.0) then + assert FALSE report "Attempt to divide by (0.0,0.0)" + severity ERROR; + return COMPLEX'(REAL'RIGHT, REAL'RIGHT); + else + return COMPLEX'( (L.Re * zR.Re + L.Im * zR.Im) / temp, + (L.Im * zR.Re - L.Re * zR.Im) / temp); + end if; + end "/"; + + function "/" ( L: in real; R: in complex ) return complex is + variable temp : REAL := R.Re ** 2 + R.Im ** 2; + begin + if (temp = 0.0) then + assert FALSE report "Attempt to divide by (0.0,0.0)" + severity ERROR; + return COMPLEX'(REAL'RIGHT, REAL'RIGHT); + else + temp := L / temp; + return COMPLEX'( temp * R.Re, -temp * R.Im ); + end if; + end "/"; + + function "/" ( L: in complex; R: in real ) return complex is + begin + if (R = 0.0) then + assert FALSE report "Attempt to divide by (0.0,0.0)" + severity ERROR; + return COMPLEX'(REAL'RIGHT, REAL'RIGHT); + else + return COMPLEX'(L.Re / R, L.Im / R); + end if; + end "/"; + + function "/" ( L: in real; R: in complex_polar) return complex is + variable zR : complex := POLAR_TO_COMPLEX( R ); + variable temp : REAL := zR.Re ** 2 + zR.Im ** 2; + begin + if (R.mag = 0.0) or (temp = 0.0) then + assert FALSE report "Attempt to divide by (0.0,0.0)" + severity ERROR; + return COMPLEX'(REAL'RIGHT, REAL'RIGHT); + else + temp := L / temp; + return COMPLEX'( temp * zR.Re, -temp * zR.Im ); + end if; + end "/"; + + function "/" ( L: in complex_polar; R: in real) return complex is + variable zL : complex := POLAR_TO_COMPLEX( L ); + begin + if (R = 0.0) then + assert FALSE report "Attempt to divide by (0.0,0.0)" + severity ERROR; + return COMPLEX'(REAL'RIGHT, REAL'RIGHT); + else + return COMPLEX'(zL.Re / R, zL.Im / R); + end if; + end "/"; +end MATH_COMPLEX; diff --git a/libraries/ieee/math_complex.vhdl b/libraries/ieee/math_complex.vhdl new file mode 100644 index 000000000..2f9376bfb --- /dev/null +++ b/libraries/ieee/math_complex.vhdl @@ -0,0 +1,126 @@ +--------------------------------------------------------------- +-- +-- This source file may be used and distributed without restriction. +-- No declarations or definitions shall be included in this package. +-- This package cannot be sold or distributed for profit. +-- +-- **************************************************************** +-- * * +-- * W A R N I N G * +-- * * +-- * This DRAFT version IS NOT endorsed or approved by IEEE * +-- * * +-- **************************************************************** +-- +-- Title: PACKAGE MATH_COMPLEX +-- +-- Purpose: VHDL declarations for mathematical package MATH_COMPLEX +-- which contains common complex constants and basic complex +-- functions and operations. +-- +-- Author: IEEE VHDL Math Package Study Group +-- +-- Notes: +-- The package body uses package IEEE.MATH_REAL +-- +-- The package body shall be considered the formal definition of +-- the semantics of this package. Tool developers may choose to implement +-- the package body in the most efficient manner available to them. +-- +-- History: +-- Version 0.1 (Strawman) Jose A. Torres 6/22/92 +-- Version 0.2 Jose A. Torres 1/15/93 +-- Version 0.3 Jose A. Torres 4/13/93 +-- Version 0.4 Jose A. Torres 4/19/93 +-- Version 0.5 Jose A. Torres 4/20/93 +-- Version 0.6 Jose A. Torres 4/23/93 Added unary minus +-- and CONJ for polar +-- Version 0.7 Jose A. Torres 5/28/93 Rev up for compatibility +-- with package body. +------------------------------------------------------------- +Library IEEE; + +Package MATH_COMPLEX is + + + type COMPLEX is record RE, IM: real; end record; + type COMPLEX_VECTOR is array (integer range <>) of COMPLEX; + type COMPLEX_POLAR is record MAG: real; ARG: real; end record; + + constant CBASE_1: complex := COMPLEX'(1.0, 0.0); + constant CBASE_j: complex := COMPLEX'(0.0, 1.0); + constant CZERO: complex := COMPLEX'(0.0, 0.0); + + function CABS(Z: in complex ) return real; + -- returns absolute value (magnitude) of Z + + function CARG(Z: in complex ) return real; + -- returns argument (angle) in radians of a complex number + + function CMPLX(X: in real; Y: in real:= 0.0 ) return complex; + -- returns complex number X + iY + + function "-" (Z: in complex ) return complex; + -- unary minus + + function "-" (Z: in complex_polar ) return complex_polar; + -- unary minus + + function CONJ (Z: in complex) return complex; + -- returns complex conjugate + + function CONJ (Z: in complex_polar) return complex_polar; + -- returns complex conjugate + + function CSQRT(Z: in complex ) return complex_vector; + -- returns square root of Z; 2 values + + function CEXP(Z: in complex ) return complex; + -- returns e**Z + + function COMPLEX_TO_POLAR(Z: in complex ) return complex_polar; + -- converts complex to complex_polar + + function POLAR_TO_COMPLEX(Z: in complex_polar ) return complex; + -- converts complex_polar to complex + + + -- arithmetic operators + + function "+" ( L: in complex; R: in complex ) return complex; + function "+" ( L: in complex_polar; R: in complex_polar) return complex; + function "+" ( L: in complex_polar; R: in complex ) return complex; + function "+" ( L: in complex; R: in complex_polar) return complex; + function "+" ( L: in real; R: in complex ) return complex; + function "+" ( L: in complex; R: in real ) return complex; + function "+" ( L: in real; R: in complex_polar) return complex; + function "+" ( L: in complex_polar; R: in real) return complex; + + function "-" ( L: in complex; R: in complex ) return complex; + function "-" ( L: in complex_polar; R: in complex_polar) return complex; + function "-" ( L: in complex_polar; R: in complex ) return complex; + function "-" ( L: in complex; R: in complex_polar) return complex; + function "-" ( L: in real; R: in complex ) return complex; + function "-" ( L: in complex; R: in real ) return complex; + function "-" ( L: in real; R: in complex_polar) return complex; + function "-" ( L: in complex_polar; R: in real) return complex; + + function "*" ( L: in complex; R: in complex ) return complex; + function "*" ( L: in complex_polar; R: in complex_polar) return complex; + function "*" ( L: in complex_polar; R: in complex ) return complex; + function "*" ( L: in complex; R: in complex_polar) return complex; + function "*" ( L: in real; R: in complex ) return complex; + function "*" ( L: in complex; R: in real ) return complex; + function "*" ( L: in real; R: in complex_polar) return complex; + function "*" ( L: in complex_polar; R: in real) return complex; + + + function "/" ( L: in complex; R: in complex ) return complex; + function "/" ( L: in complex_polar; R: in complex_polar) return complex; + function "/" ( L: in complex_polar; R: in complex ) return complex; + function "/" ( L: in complex; R: in complex_polar) return complex; + function "/" ( L: in real; R: in complex ) return complex; + function "/" ( L: in complex; R: in real ) return complex; + function "/" ( L: in real; R: in complex_polar) return complex; + function "/" ( L: in complex_polar; R: in real) return complex; +end MATH_COMPLEX; diff --git a/libraries/ieee/math_real-body.vhdl b/libraries/ieee/math_real-body.vhdl new file mode 100644 index 000000000..1473f6787 --- /dev/null +++ b/libraries/ieee/math_real-body.vhdl @@ -0,0 +1,410 @@ +--------------------------------------------------------------- +-- +-- This source file may be used and distributed without restriction. +-- No declarations or definitions shall be added to this package. +-- This package cannot be sold or distributed for profit. +-- +-- **************************************************************** +-- * * +-- * W A R N I N G * +-- * * +-- * This DRAFT version IS NOT endorsed or approved by IEEE * +-- * * +-- **************************************************************** +-- +-- Title: PACKAGE BODY MATH_REAL +-- +-- Library: This package shall be compiled into a library +-- symbolically named IEEE. +-- +-- Purpose: VHDL declarations for mathematical package MATH_REAL +-- which contains common real constants, common real +-- functions, and real trascendental functions. +-- +-- Author: IEEE VHDL Math Package Study Group +-- +-- Notes: +-- The package body shall be considered the formal definition of +-- the semantics of this package. Tool developers may choose to implement +-- the package body in the most efficient manner available to them. +-- +-- Source code and algorithms for this package body comes from the +-- following sources: +-- IEEE VHDL Math Package Study Group participants, +-- U. of Mississippi, Mentor Graphics, Synopsys, +-- Viewlogic/Vantage, Communications of the ACM (June 1988, Vol +-- 31, Number 6, pp. 747, Pierre L'Ecuyer, Efficient and Portable +-- Random Number Generators), Handbook of Mathematical Functions +-- by Milton Abramowitz and Irene A. Stegun (Dover). +-- +-- History: +-- Version 0.1 Jose A. Torres 4/23/93 First draft +-- Version 0.2 Jose A. Torres 5/28/93 Fixed potentially illegal code +-- +-- GHDL history +-- 2005-04-07 Initial version. +------------------------------------------------------------- +Library IEEE; + +Package body MATH_REAL is + -- + -- non-trascendental functions + -- + function SIGN (X: real ) return real is + -- returns 1.0 if X > 0.0; 0.0 if X == 0.0; -1.0 if X < 0.0 + begin + assert false severity failure; + end SIGN; + + function CEIL (X : real ) return real is + begin + assert false severity failure; + end CEIL; + + function FLOOR (X : real ) return real is + begin + assert false severity failure; + end FLOOR; + + function ROUND (X : real ) return real is + begin + assert false severity failure; + end ROUND; + + function FMAX (X, Y : real ) return real is + begin + assert false severity failure; + end FMAX; + + function FMIN (X, Y : real ) return real is + begin + assert false severity failure; + end FMIN; + + -- + -- Pseudo-random number generators + -- + + procedure UNIFORM(variable Seed1,Seed2:inout integer;variable X:out real) is + -- returns a pseudo-random number with uniform distribution in the + -- interval (0.0, 1.0). + -- Before the first call to UNIFORM, the seed values (Seed1, Seed2) must + -- be initialized to values in the range [1, 2147483562] and + -- [1, 2147483398] respectively. The seed values are modified after + -- each call to UNIFORM. + -- This random number generator is portable for 32-bit computers, and + -- it has period ~2.30584*(10**18) for each set of seed values. + -- + -- For VHDL-1992, the seeds will be global variables, functions to + -- initialize their values (INIT_SEED) will be provided, and the UNIFORM + -- procedure call will be modified accordingly. + + variable z, k: integer; + begin + k := Seed1/53668; + Seed1 := 40014 * (Seed1 - k * 53668) - k * 12211; + + if Seed1 < 0 then + Seed1 := Seed1 + 2147483563; + end if; + + + k := Seed2/52774; + Seed2 := 40692 * (Seed2 - k * 52774) - k * 3791; + + if Seed2 < 0 then + Seed2 := Seed2 + 2147483399; + end if; + + z := Seed1 - Seed2; + if z < 1 then + z := z + 2147483562; + end if; + + X := REAL(Z)*4.656613e-10; + end UNIFORM; + + + function SRAND (seed: in integer ) return integer is + begin + assert false severity failure; + end SRAND; + + function RAND return integer is + begin + assert false severity failure; + end RAND; + + function GET_RAND_MAX return integer is + -- The value this function returns should be the same as + -- RAND_MAX in /usr/include/stdlib.h + begin + assert false + report "Be sure to update GET_RAND_MAX in mathpack.vhd" + severity note; + return 2147483647; -- i386 linux + end GET_RAND_MAX; + + -- + -- trascendental and trigonometric functions + -- + function c_sqrt (x : real ) return real; + attribute foreign of c_sqrt : function is "VHPIDIRECT sqrt"; + + function c_sqrt (x : real ) return real is + begin + assert false severity failure; + end c_sqrt; + + function SQRT (X : real ) return real is + begin + -- check validity of argument + if ( X < 0.0 ) then + assert false report "X < 0 in SQRT(X)" + severity ERROR; + return (0.0); + end if; + return c_sqrt(X); + end SQRT; + + function CBRT (X : real ) return real is + begin + assert false severity failure; + end CBRT; + + function "**" (X : integer; Y : real) return real is + -- returns Y power of X ==> X**Y; + -- error if X = 0 and Y <= 0.0 + -- error if X < 0 and Y does not have an integer value + begin + -- check validity of argument + if ( X = 0 ) and ( Y <= 0.0 ) then + assert false report "X = 0 and Y <= 0.0 in X**Y" + severity ERROR; + return (0.0); + end if; + + if ( X < 0 ) and ( Y /= REAL(INTEGER(Y)) ) then + assert false + report "X < 0 and Y \= integer in X**Y" + severity ERROR; + return (0.0); + end if; + + -- compute the result + return EXP (Y * LOG (REAL(X))); + end "**"; + + function "**" (X : real; Y : real) return real is + -- returns Y power of X ==> X**Y; + -- error if X = 0.0 and Y <= 0.0 + -- error if X < 0.0 and Y does not have an integer value + begin + -- check validity of argument + if ( X = 0.0 ) and ( Y <= 0.0 ) then + assert false report "X = 0.0 and Y <= 0.0 in X**Y" + severity ERROR; + return (0.0); + end if; + + if ( X < 0.0 ) and ( Y /= REAL(INTEGER(Y)) ) then + assert false report "X < 0.0 and Y \= integer in X**Y" + severity ERROR; + return (0.0); + end if; + + -- compute the result + return EXP (Y * LOG (X)); + end "**"; + + function EXP (X : real ) return real is + begin + assert false severity failure; + end EXP; + + function c_log (x : real ) return real; + attribute foreign of c_log : function is "VHPIDIRECT log"; + + function c_log (x : real ) return real is + begin + assert false severity failure; + end c_log; + + function LOG (X : real ) return real is + -- returns natural logarithm of X; X > 0 + -- + -- This function computes the exponential using the following series: + -- log(x) = 2[ (x-1)/(x+1) + (((x-1)/(x+1))**3)/3.0 + ...] ; x > 0 + -- + begin + -- check validity of argument + if ( x <= 0.0 ) then + assert false report "X <= 0 in LOG(X)" + severity ERROR; + return(REAL'LOW); + end if; + return c_log(x); + end LOG; + + function LOG (BASE: positive; X : real) return real is + -- returns logarithm base BASE of X; X > 0 + begin + -- check validity of argument + if ( BASE <= 0 ) or ( x <= 0.0 ) then + assert false report "BASE <= 0 or X <= 0.0 in LOG(BASE, X)" + severity ERROR; + return(REAL'LOW); + end if; + -- compute the value + return (LOG(X)/LOG(REAL(BASE))); + end LOG; + + function SIN (X : real ) return real is + begin + assert false severity failure; + end SIN; + + + function COS (x : REAL) return REAL is + begin + assert false severity failure; + end COS; + + function TAN (x : REAL) return REAL is + begin + assert false severity failure; + end TAN; + + function c_asin (x : real ) return real; + attribute foreign of c_asin : function is "VHPIDIRECT asin"; + + function c_asin (x : real ) return real is + begin + assert false severity failure; + end c_asin; + + function ASIN (x : real ) return real is + -- returns -PI/2 < asin X < PI/2; | X | <= 1 + begin + if abs x > 1.0 then + assert false + report "Out of range parameter passed to ASIN" + severity ERROR; + return x; + else + return c_asin(x); + end if; + end ASIN; + + function c_acos (x : real ) return real; + attribute foreign of c_acos : function is "VHPIDIRECT acos"; + + function c_acos (x : real ) return real is + begin + assert false severity failure; + end c_acos; + + function ACOS (x : REAL) return REAL is + -- returns 0 < acos X < PI; | X | <= 1 + begin + if abs x > 1.0 then + assert false + report "Out of range parameter passed to ACOS" + severity ERROR; + return x; + else + return c_acos(x); + end if; + end ACOS; + + function ATAN (x : REAL) return REAL is + -- returns -PI/2 < atan X < PI/2 + begin + assert false severity failure; + end ATAN; + + function c_atan2 (x : real; y : real) return real; + attribute foreign of c_atan2 : function is "VHPIDIRECT atan2"; + + function c_atan2 (x : real; y: real) return real is + begin + assert false severity failure; + end c_atan2; + + function ATAN2 (x : REAL; y : REAL) return REAL is + -- returns atan (X/Y); -PI < atan2(X,Y) < PI; Y /= 0.0 + begin + if y = 0.0 and x = 0.0 then + assert false + report "atan2(0.0, 0.0) is undetermined, returned 0,0" + severity NOTE; + return 0.0; + else + return c_atan2(x,y); + end if; + end ATAN2; + + + function SINH (X : real) return real is + -- hyperbolic sine; returns (e**X - e**(-X))/2 + begin + assert false severity failure; + end SINH; + + function COSH (X : real) return real is + -- hyperbolic cosine; returns (e**X + e**(-X))/2 + begin + assert false severity failure; + end COSH; + + function TANH (X : real) return real is + -- hyperbolic tangent; -- returns (e**X - e**(-X))/(e**X + e**(-X)) + begin + assert false severity failure; + end TANH; + + function ASINH (X : real) return real is + -- returns ln( X + sqrt( X**2 + 1)) + begin + assert false severity failure; + end ASINH; + + function c_acosh (x : real ) return real; + attribute foreign of c_acosh : function is "VHPIDIRECT acosh"; + + function c_acosh (x : real ) return real is + begin + assert false severity failure; + end c_acosh; + + function ACOSH (X : real) return real is + -- returns ln( X + sqrt( X**2 - 1)); X >= 1 + begin + if abs x >= 1.0 then + assert false report "Out of range parameter passed to ACOSH" + severity ERROR; + return x; + end if; + return c_acosh(x); + end ACOSH; + + function c_atanh (x : real ) return real; + attribute foreign of c_atanh : function is "VHPIDIRECT atanh"; + + function c_atanh (x : real ) return real is + begin + assert false severity failure; + end c_atanh; + + function ATANH (X : real) return real is + -- returns (ln( (1 + X)/(1 - X)))/2 ; | X | < 1 + begin + if abs x < 1.0 then + assert false report "Out of range parameter passed to ATANH" + severity ERROR; + return x; + end if; + return c_atanh(x); + end ATANH; + +end MATH_REAL; diff --git a/libraries/ieee/math_real.vhdl b/libraries/ieee/math_real.vhdl new file mode 100644 index 000000000..c70d2160b --- /dev/null +++ b/libraries/ieee/math_real.vhdl @@ -0,0 +1,223 @@ +------------------------------------------------------------------------ +-- +-- This source file may be used and distributed without restriction. +-- No declarations or definitions shall be added to this package. +-- This package cannot be sold or distributed for profit. +-- +-- **************************************************************** +-- * * +-- * W A R N I N G * +-- * * +-- * This DRAFT version IS NOT endorsed or approved by IEEE * +-- * * +-- **************************************************************** +-- +-- Title: PACKAGE MATH_REAL +-- +-- Library: This package shall be compiled into a library +-- symbolically named IEEE. +-- +-- Purpose: VHDL declarations for mathematical package MATH_REAL +-- which contains common real constants, common real +-- functions, and real trascendental functions. +-- +-- Author: IEEE VHDL Math Package Study Group +-- +-- Notes: +-- The package body shall be considered the formal definition of +-- the semantics of this package. Tool developers may choose to implement +-- the package body in the most efficient manner available to them. +-- +-- History: +-- Version 0.1 (Strawman) Jose A. Torres 6/22/92 +-- Version 0.2 Jose A. Torres 1/15/93 +-- Version 0.3 Jose A. Torres 4/13/93 +-- Version 0.4 Jose A. Torres 4/19/93 +-- Version 0.5 Jose A. Torres 4/20/93 Added RANDOM() +-- Version 0.6 Jose A. Torres 4/23/93 Renamed RANDOM as +-- UNIFORM. Modified +-- rights banner. +-- Version 0.7 Jose A. Torres 5/28/93 Rev up for compatibility +-- with package body. +-- +-- GHDL history +-- 2005-04-07 Initial version. +-- 2005-09-01 Some PI constants added. +------------------------------------------------------------- +Library IEEE; + +Package MATH_REAL is + + -- + -- commonly used constants + -- + constant MATH_E : real := 2.71828_18284_59045_23536; -- e + constant MATH_1_OVER_E : real := 0.36787_94411_71442_32160; -- 1/e + constant MATH_PI : real := 3.14159_26535_89793_23846; -- pi + constant MATH_2_PI : real := 2.0 * MATH_PI; -- 2 * pi + constant MATH_1_OVER_PI : real := 0.31830_98861_83790_67154; -- 1/pi + constant MATH_PI_OVER_2 : real := 1.57079_63267_94896_61923; -- pi / 2 + constant MATH_PI_OVER_4 : real := 0.78539_81633_97448_30962; -- pi / 4 + constant MATH_LOG_OF_2 : real := 0.69314_71805_59945_30942; + -- natural log of 2 + constant MATH_LOG_OF_10: real := 2.30258_50929_94045_68402; + -- natural log of10 + constant MATH_LOG2_OF_E: real := 1.44269_50408_88963_4074; + -- log base 2 of e + constant MATH_LOG10_OF_E: real := 0.43429_44819_03251_82765; + -- log base 10 of e + constant MATH_SQRT2: real := 1.41421_35623_73095_04880; + -- sqrt of 2 + constant MATH_SQRT1_2: real := 0.70710_67811_86547_52440; + -- sqrt of 1/2 + constant MATH_SQRT_PI: real := 1.77245_38509_05516_02730; + -- sqrt of pi + constant MATH_DEG_TO_RAD: real := 0.01745_32925_19943_29577; + -- conversion factor from degree to radian + constant MATH_RAD_TO_DEG: real := 57.29577_95130_82320_87685; + -- conversion factor from radian to degree + + -- + -- function declarations + -- + function SIGN (X: real ) return real; + -- returns 1.0 if X > 0.0; 0.0 if X == 0.0; -1.0 if X < 0.0 + + function CEIL (X : real ) return real; + attribute foreign of ceil : function is "VHPIDIRECT ceil"; + -- returns smallest integer value (as real) not less than X + + function FLOOR (X : real ) return real; + attribute foreign of floor : function is "VHPIDIRECT floor"; + -- returns largest integer value (as real) not greater than X + + function ROUND (X : real ) return real; + attribute foreign of round : function is "VHPIDIRECT round"; + -- returns integer FLOOR(X + 0.5) if X > 0; + -- return integer CEIL(X - 0.5) if X < 0 + + function FMAX (X, Y : real ) return real; + attribute foreign of fmax : function is "VHPIDIRECT fmax"; + -- returns the algebraically larger of X and Y + + function FMIN (X, Y : real ) return real; + attribute foreign of fmin : function is "VHPIDIRECT fmin"; + -- returns the algebraically smaller of X and Y + + procedure UNIFORM (variable Seed1,Seed2:inout integer; variable X:out real); + -- returns a pseudo-random number with uniform distribution in the + -- interval (0.0, 1.0). + -- Before the first call to UNIFORM, the seed values (Seed1, Seed2) must + -- be initialized to values in the range [1, 2147483562] and + -- [1, 2147483398] respectively. The seed values are modified after + -- each call to UNIFORM. + -- This random number generator is portable for 32-bit computers, and + -- it has period ~2.30584*(10**18) for each set of seed values. + -- + -- For VHDL-1992, the seeds will be global variables, functions to + -- initialize their values (INIT_SEED) will be provided, and the UNIFORM + -- procedure call will be modified accordingly. + + function SRAND (seed: in integer ) return integer; + attribute foreign of srand : function is "VHPIDIRECT srand"; + -- + -- sets value of seed for sequence of + -- pseudo-random numbers. + -- It uses the foreign native C function srand(). + + function RAND return integer; + attribute foreign of rand : function is "VHPIDIRECT rand"; + -- + -- returns an integer pseudo-random number with uniform distribution. + -- It uses the foreign native C function rand(). + -- Seed for the sequence is initialized with the + -- SRAND() function and value of the seed is changed every + -- time SRAND() is called, but it is not visible. + -- The range of generated values is platform dependent. + + function GET_RAND_MAX return integer; + -- + -- returns the upper bound of the range of the + -- pseudo-random numbers generated by RAND(). + -- The support for this function is platform dependent, and + -- it uses foreign native C functions or constants. + -- It may not be available in some platforms. + -- Note: the value of (RAND() / GET_RAND_MAX()) is a + -- pseudo-random number distributed between 0 & 1. + + function SQRT (X : real ) return real; + -- returns square root of X; X >= 0 + + function CBRT (X : real ) return real; + attribute foreign of cbrt : function is "VHPIDIRECT cbrt"; + -- returns cube root of X + + function "**" (X : integer; Y : real) return real; + -- returns Y power of X ==> X**Y; + -- error if X = 0 and Y <= 0.0 + -- error if X < 0 and Y does not have an integer value + + function "**" (X : real; Y : real) return real; + -- returns Y power of X ==> X**Y; + -- error if X = 0.0 and Y <= 0.0 + -- error if X < 0.0 and Y does not have an integer value + + function EXP (X : real ) return real; + attribute foreign of exp : function is "VHPIDIRECT exp"; + -- returns e**X; where e = MATH_E + + function LOG (X : real ) return real; + -- returns natural logarithm of X; X > 0 + + function LOG (BASE: positive; X : real) return real; + -- returns logarithm base BASE of X; X > 0 + + function SIN (X : real ) return real; + attribute foreign of sin : function is "VHPIDIRECT sin"; + -- returns sin X; X in radians + + function COS ( X : real ) return real; + attribute foreign of cos : function is "VHPIDIRECT cos"; + -- returns cos X; X in radians + + function TAN (X : real ) return real; + attribute foreign of tan : function is "VHPIDIRECT tan"; + -- returns tan X; X in radians + -- X /= ((2k+1) * PI/2), where k is an integer + + function ASIN (X : real ) return real; + -- returns -PI/2 < asin X < PI/2; | X | <= 1 + + function ACOS (X : real ) return real; + -- returns 0 < acos X < PI; | X | <= 1 + + function ATAN (X : real) return real; + attribute foreign of atan : function is "VHPIDIRECT atan"; + -- returns -PI/2 < atan X < PI/2 + + function ATAN2 (X : real; Y : real) return real; + -- returns atan (X/Y); -PI < atan2(X,Y) < PI; Y /= 0.0 + + function SINH (X : real) return real; + attribute foreign of sinh : function is "VHPIDIRECT sinh"; + -- hyperbolic sine; returns (e**X - e**(-X))/2 + + function COSH (X : real) return real; + attribute foreign of cosh : function is "VHPIDIRECT cosh"; + -- hyperbolic cosine; returns (e**X + e**(-X))/2 + + function TANH (X : real) return real; + attribute foreign of tanh : function is "VHPIDIRECT tanh"; + -- hyperbolic tangent; -- returns (e**X - e**(-X))/(e**X + e**(-X)) + + function ASINH (X : real) return real; + attribute foreign of asinh : function is "VHPIDIRECT asinh"; + -- returns ln( X + sqrt( X**2 + 1)) + + function ACOSH (X : real) return real; + -- returns ln( X + sqrt( X**2 - 1)); X >= 1 + + function ATANH (X : real) return real; + -- returns (ln( (1 + X)/(1 - X)))/2 ; | X | < 1 + +end MATH_REAL; diff --git a/libraries/ieee/numeric_bit-body.vhdl b/libraries/ieee/numeric_bit-body.vhdl new file mode 100644 index 000000000..895594631 --- /dev/null +++ b/libraries/ieee/numeric_bit-body.vhdl @@ -0,0 +1,1818 @@ +-- ----------------------------------------------------------------------------- +-- +-- Copyright 1995 by IEEE. All rights reserved. +-- +-- This source file is considered by the IEEE to be an essential part of the use +-- of the standard 1076.3 and as such may be distributed without change, except +-- as permitted by the standard. This source file may not be sold or distributed +-- for profit. This package may be modified to include additional data required +-- by tools, but must in no way change the external interfaces or simulation +-- behaviour of the description. It is permissible to add comments and/or +-- attributes to the package declarations, but not to change or delete any +-- original lines of the approved package declaration. The package body may be +-- changed only in accordance with the terms of clauses 7.1 and 7.2 of the +-- standard. +-- +-- Title : Standard VHDL Synthesis Package (1076.3, NUMERIC_BIT) +-- +-- Library : This package shall be compiled into a library symbolically +-- : named IEEE. +-- +-- Developers : IEEE DASC Synthesis Working Group, PAR 1076.3 +-- +-- Purpose : This package defines numeric types and arithmetic functions +-- : for use with synthesis tools. Two numeric types are defined: +-- : -- > UNSIGNED: represents an UNSIGNED number in vector form +-- : -- > SIGNED: represents a SIGNED number in vector form +-- : The base element type is type BIT. +-- : The leftmost bit is treated as the most significant bit. +-- : Signed vectors are represented in two's complement form. +-- : This package contains overloaded arithmetic operators on +-- : the SIGNED and UNSIGNED types. The package also contains +-- : useful type conversions functions, clock detection +-- : functions, and other utility functions. +-- : +-- : If any argument to a function is a null array, a null array is +-- : returned (exceptions, if any, are noted individually). +-- +-- Limitation : +-- +-- Note : No declarations or definitions shall be included in, +-- : or excluded from this package. The "package declaration" +-- : defines the types, subtypes and declarations of +-- : NUMERIC_BIT. The NUMERIC_BIT package body shall be +-- : considered the formal definition of the semantics of +-- : this package. Tool developers may choose to implement +-- : the package body in the most efficient manner available +-- : to them. +-- : +-- ----------------------------------------------------------------------------- +-- Version : 2.4 +-- Date : 12 April 1995 +-- ----------------------------------------------------------------------------- + +--============================================================================== +--======================= Package Body ========================================= +--============================================================================== + +package body NUMERIC_BIT is + + -- null range array constants + + constant NAU: UNSIGNED(0 downto 1) := (others => '0'); + constant NAS: SIGNED(0 downto 1) := (others => '0'); + + -- implementation controls + + constant NO_WARNING: BOOLEAN := FALSE; -- default to emit warnings + + --=========================Local Subprograms ================================= + + function MAX (LEFT, RIGHT: INTEGER) return INTEGER is + begin + if LEFT > RIGHT then return LEFT; + else return RIGHT; + end if; + end MAX; + + function MIN (LEFT, RIGHT: INTEGER) return INTEGER is + begin + if LEFT < RIGHT then return LEFT; + else return RIGHT; + end if; + end MIN; + + function SIGNED_NUM_BITS (ARG: INTEGER) return NATURAL is + variable NBITS: NATURAL; + variable N: NATURAL; + begin + if ARG >= 0 then + N := ARG; + else + N := -(ARG+1); + end if; + NBITS := 1; + while N > 0 loop + NBITS := NBITS+1; + N := N / 2; + end loop; + return NBITS; + end SIGNED_NUM_BITS; + + function UNSIGNED_NUM_BITS (ARG: NATURAL) return NATURAL is + variable NBITS: NATURAL; + variable N: NATURAL; + begin + N := ARG; + NBITS := 1; + while N > 1 loop + NBITS := NBITS+1; + N := N / 2; + end loop; + return NBITS; + end UNSIGNED_NUM_BITS; + + ------------------------------------------------------------------------------ + -- this internal function computes the addition of two UNSIGNED + -- with input carry + -- * the two arguments are of the same length + + function ADD_UNSIGNED (L, R: UNSIGNED; C: BIT) return UNSIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + alias XR: UNSIGNED(L_LEFT downto 0) is R; + variable RESULT: UNSIGNED(L_LEFT downto 0); + variable CBIT: BIT := C; + begin + for I in 0 to L_LEFT loop + RESULT(I) := CBIT xor XL(I) xor XR(I); + CBIT := (CBIT and XL(I)) or (CBIT and XR(I)) or (XL(I) and XR(I)); + end loop; + return RESULT; + end ADD_UNSIGNED; + + -- this internal function computes the addition of two SIGNED + -- with input carry + -- * the two arguments are of the same length + + function ADD_SIGNED (L, R: SIGNED; C: BIT) return SIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + alias XR: SIGNED(L_LEFT downto 0) is R; + variable RESULT: SIGNED(L_LEFT downto 0); + variable CBIT: BIT := C; + begin + for I in 0 to L_LEFT loop + RESULT(I) := CBIT xor XL(I) xor XR(I); + CBIT := (CBIT and XL(I)) or (CBIT and XR(I)) or (XL(I) and XR(I)); + end loop; + return RESULT; + end ADD_SIGNED; + + ------------------------------------------------------------------------------ + + -- this internal procedure computes UNSIGNED division + -- giving the quotient and remainder. + procedure DIVMOD (NUM, XDENOM: UNSIGNED; XQUOT, XREMAIN: out UNSIGNED) is + variable TEMP: UNSIGNED(NUM'LENGTH downto 0); + variable QUOT: UNSIGNED(MAX(NUM'LENGTH, XDENOM'LENGTH)-1 downto 0); + alias DENOM: UNSIGNED(XDENOM'LENGTH-1 downto 0) is XDENOM; + variable TOPBIT: INTEGER; + begin + TEMP := "0"&NUM; + QUOT := (others => '0'); + TOPBIT := -1; + for J in DENOM'RANGE loop + if DENOM(J)='1' then + TOPBIT := J; + exit; + end if; + end loop; + assert TOPBIT >= 0 report "DIV, MOD, or REM by zero" severity ERROR; + + for J in NUM'LENGTH-(TOPBIT+1) downto 0 loop + if TEMP(TOPBIT+J+1 downto J) >= "0"&DENOM(TOPBIT downto 0) then + TEMP(TOPBIT+J+1 downto J) := (TEMP(TOPBIT+J+1 downto J)) + -("0"&DENOM(TOPBIT downto 0)); + QUOT(J) := '1'; + end if; + assert TEMP(TOPBIT+J+1)='0' + report "internal error in the division algorithm" + severity ERROR; + end loop; + XQUOT := RESIZE(QUOT, XQUOT'LENGTH); + XREMAIN := RESIZE(TEMP, XREMAIN'LENGTH); + end DIVMOD; + + -----------------Local Subprograms - shift/rotate ops------------------------- + + function XSLL (ARG: BIT_VECTOR; COUNT: NATURAL) return BIT_VECTOR is + constant ARG_L: INTEGER := ARG'LENGTH-1; + alias XARG: BIT_VECTOR(ARG_L downto 0) is ARG; + variable RESULT: BIT_VECTOR(ARG_L downto 0) := (others => '0'); + begin + if COUNT <= ARG_L then + RESULT(ARG_L downto COUNT) := XARG(ARG_L-COUNT downto 0); + end if; + return RESULT; + end XSLL; + + function XSRL (ARG: BIT_VECTOR; COUNT: NATURAL) return BIT_VECTOR is + constant ARG_L: INTEGER := ARG'LENGTH-1; + alias XARG: BIT_VECTOR(ARG_L downto 0) is ARG; + variable RESULT: BIT_VECTOR(ARG_L downto 0) := (others => '0'); + begin + if COUNT <= ARG_L then + RESULT(ARG_L-COUNT downto 0) := XARG(ARG_L downto COUNT); + end if; + return RESULT; + end XSRL; + + function XSRA (ARG: BIT_VECTOR; COUNT: NATURAL) return BIT_VECTOR is + constant ARG_L: INTEGER := ARG'LENGTH-1; + alias XARG: BIT_VECTOR(ARG_L downto 0) is ARG; + variable RESULT: BIT_VECTOR(ARG_L downto 0); + variable XCOUNT: NATURAL := COUNT; + begin + if ((ARG'LENGTH <= 1) or (XCOUNT = 0)) then return ARG; + else + if (XCOUNT > ARG_L) then XCOUNT := ARG_L; + end if; + RESULT(ARG_L-XCOUNT downto 0) := XARG(ARG_L downto XCOUNT); + RESULT(ARG_L downto (ARG_L - XCOUNT + 1)) := (others => XARG(ARG_L)); + end if; + return RESULT; + end XSRA; + + function XROL (ARG: BIT_VECTOR; COUNT: NATURAL) return BIT_VECTOR is + constant ARG_L: INTEGER := ARG'LENGTH-1; + alias XARG: BIT_VECTOR(ARG_L downto 0) is ARG; + variable RESULT: BIT_VECTOR(ARG_L downto 0) := XARG; + variable COUNTM: INTEGER; + begin + COUNTM := COUNT mod (ARG_L + 1); + if COUNTM /= 0 then + RESULT(ARG_L downto COUNTM) := XARG(ARG_L-COUNTM downto 0); + RESULT(COUNTM-1 downto 0) := XARG(ARG_L downto ARG_L-COUNTM+1); + end if; + return RESULT; + end XROL; + + function XROR (ARG: BIT_VECTOR; COUNT: NATURAL) return BIT_VECTOR is + constant ARG_L: INTEGER := ARG'LENGTH-1; + alias XARG: BIT_VECTOR(ARG_L downto 0) is ARG; + variable RESULT: BIT_VECTOR(ARG_L downto 0) := XARG; + variable COUNTM: INTEGER; + begin + COUNTM := COUNT mod (ARG_L + 1); + if COUNTM /= 0 then + RESULT(ARG_L-COUNTM downto 0) := XARG(ARG_L downto COUNTM); + RESULT(ARG_L downto ARG_L-COUNTM+1) := XARG(COUNTM-1 downto 0); + end if; + return RESULT; + end XROR; + + ---------------- Local Subprograms - Relational Operators -------------------- + + -- General "=" for UNSIGNED vectors, same length + -- + function UNSIGNED_EQUAL (L, R: UNSIGNED) return BOOLEAN is + begin + return BIT_VECTOR(L) = BIT_VECTOR(R); + end UNSIGNED_EQUAL; + + -- + -- General "=" for SIGNED vectors, same length + -- + function SIGNED_EQUAL (L, R: SIGNED) return BOOLEAN is + begin + return BIT_VECTOR(L) = BIT_VECTOR(R); + end SIGNED_EQUAL; + + -- + -- General "<" for UNSIGNED vectors, same length + -- + function UNSIGNED_LESS (L, R: UNSIGNED) return BOOLEAN is + begin + return BIT_VECTOR(L) < BIT_VECTOR(R); + end UNSIGNED_LESS; + + -- + -- General "<" function for SIGNED vectors, same length + -- + function SIGNED_LESS (L, R: SIGNED) return BOOLEAN is + -- Need aliases to assure index direction + variable INTERN_L: SIGNED(0 to L'LENGTH-1); + variable INTERN_R: SIGNED(0 to R'LENGTH-1); + begin + INTERN_L := L; + INTERN_R := R; + INTERN_L(0) := not INTERN_L(0); + INTERN_R(0) := not INTERN_R(0); + return BIT_VECTOR(INTERN_L) < BIT_VECTOR(INTERN_R); + end SIGNED_LESS; + + -- + -- General "<=" function for UNSIGNED vectors, same length + -- + function UNSIGNED_LESS_OR_EQUAL (L, R: UNSIGNED) return BOOLEAN is + begin + return BIT_VECTOR(L) <= BIT_VECTOR(R); + end UNSIGNED_LESS_OR_EQUAL; + + -- + -- General "<=" function for SIGNED vectors, same length + -- + function SIGNED_LESS_OR_EQUAL (L, R: SIGNED) return BOOLEAN is + -- Need aliases to assure index direction + variable INTERN_L: SIGNED(0 to L'LENGTH-1); + variable INTERN_R: SIGNED(0 to R'LENGTH-1); + begin + INTERN_L := L; + INTERN_R := R; + INTERN_L(0) := not INTERN_L(0); + INTERN_R(0) := not INTERN_R(0); + return BIT_VECTOR(INTERN_L) <= BIT_VECTOR(INTERN_R); + end SIGNED_LESS_OR_EQUAL; + + --====================== Exported Functions ================================== + + -- Id: A.1 + function "abs" (ARG: SIGNED) return SIGNED is + constant ARG_LEFT: INTEGER := ARG'LENGTH-1; + variable RESULT: SIGNED(ARG_LEFT downto 0); + begin + if ARG'LENGTH < 1 then return NAS; + end if; + RESULT := ARG; + if RESULT(RESULT'LEFT) = '1' then + RESULT := -RESULT; + end if; + return RESULT; + end "abs"; + + -- Id: A.2 + function "-" (ARG: SIGNED) return SIGNED is + constant ARG_LEFT: INTEGER := ARG'LENGTH-1; + alias XARG: SIGNED(ARG_LEFT downto 0) is ARG; + variable RESULT: SIGNED(ARG_LEFT downto 0); + variable CBIT: BIT := '1'; + begin + if ARG'LENGTH < 1 then return NAS; + end if; + for I in 0 to RESULT'LEFT loop + RESULT(I) := not(XARG(I)) xor CBIT; + CBIT := CBIT and not(XARG(I)); + end loop; + return RESULT; + end "-"; + + --============================================================================ + + -- Id: A.3 + function "+" (L, R: UNSIGNED) return UNSIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + return ADD_UNSIGNED(RESIZE(L, SIZE), RESIZE(R, SIZE), '0'); + end "+"; + + -- Id: A.4 + function "+" (L, R: SIGNED) return SIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS; + end if; + return ADD_SIGNED(RESIZE(L, SIZE), RESIZE(R, SIZE), '0'); + end "+"; + + -- Id: A.5 + function "+" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + begin + return L + TO_UNSIGNED(R, L'LENGTH); + end "+"; + + -- Id: A.6 + function "+" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + begin + return TO_UNSIGNED(L, R'LENGTH) + R; + end "+"; + + -- Id: A.7 + function "+" (L: SIGNED; R: INTEGER) return SIGNED is + begin + return L + TO_SIGNED(R, L'LENGTH); + end "+"; + + -- Id: A.8 + function "+" (L: INTEGER; R: SIGNED) return SIGNED is + begin + return TO_SIGNED(L, R'LENGTH) + R; + end "+"; + + --============================================================================ + + -- Id: A.9 + function "-" (L, R: UNSIGNED) return UNSIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + return ADD_UNSIGNED(RESIZE(L, SIZE), + not(RESIZE(R, SIZE)), + '1'); + end "-"; + + -- Id: A.10 + function "-" (L, R: SIGNED) return SIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS; + end if; + return ADD_SIGNED(RESIZE(L, SIZE), + not(RESIZE(R, SIZE)), + '1'); + end "-"; + + -- Id: A.11 + function "-" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + begin + return L - TO_UNSIGNED(R, L'LENGTH); + end "-"; + + -- Id: A.12 + function "-" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + begin + return TO_UNSIGNED(L, R'LENGTH) - R; + end "-"; + + -- Id: A.13 + function "-" (L: SIGNED; R: INTEGER) return SIGNED is + begin + return L - TO_SIGNED(R, L'LENGTH); + end "-"; + + -- Id: A.14 + function "-" (L: INTEGER; R: SIGNED) return SIGNED is + begin + return TO_SIGNED(L, R'LENGTH) - R; + end "-"; + + --============================================================================ + + -- Id: A.15 + function "*" (L, R: UNSIGNED) return UNSIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + variable RESULT: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0) := (others => '0'); + variable ADVAL: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + ADVAL := RESIZE(XR, RESULT'LENGTH); + for I in 0 to L_LEFT loop + if XL(I)='1' then RESULT := RESULT + ADVAL; + end if; + ADVAL := SHIFT_LEFT(ADVAL, 1); + end loop; + return RESULT; + end "*"; + + -- Id: A.16 + function "*" (L, R: SIGNED) return SIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + variable XL: SIGNED(L_LEFT downto 0); + variable XR: SIGNED(R_LEFT downto 0); + variable RESULT: SIGNED((L_LEFT+R_LEFT+1) downto 0) := (others => '0'); + variable ADVAL: SIGNED((L_LEFT+R_LEFT+1) downto 0); + begin + if ((L_LEFT < 0) or (R_LEFT < 0)) then return NAS; + end if; + XL := L; + XR := R; + ADVAL := RESIZE(XR, RESULT'LENGTH); + for I in 0 to L_LEFT-1 loop + if XL(I)='1' then RESULT := RESULT + ADVAL; + end if; + ADVAL := SHIFT_LEFT(ADVAL, 1); + end loop; + if XL(L_LEFT)='1' then + RESULT := RESULT - ADVAL; + end if; + return RESULT; + end "*"; + + -- Id: A.17 + function "*" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + begin + return L * TO_UNSIGNED(R, L'LENGTH); + end "*"; + + -- Id: A.18 + function "*" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + begin + return TO_UNSIGNED(L, R'LENGTH) * R; + end "*"; + + -- Id: A.19 + function "*" (L: SIGNED; R: INTEGER) return SIGNED is + begin + return L * TO_SIGNED(R, L'LENGTH); + end "*"; + + -- Id: A.20 + function "*" (L: INTEGER; R: SIGNED) return SIGNED is + begin + return TO_SIGNED(L, R'LENGTH) * R; + end "*"; + + --============================================================================ + + -- Id: A.21 + function "/" (L, R: UNSIGNED) return UNSIGNED is + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + DIVMOD(L, R, FQUOT, FREMAIN); + return FQUOT; + end "/"; + + -- Id: A.22 + function "/" (L, R: SIGNED) return SIGNED is + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + variable XNUM: UNSIGNED(L'LENGTH-1 downto 0); + variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0); + variable QNEG: BOOLEAN := FALSE; + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS; + end if; + if L(L'LEFT)='1' then + XNUM := UNSIGNED(-L); + QNEG := TRUE; + else + XNUM := UNSIGNED(L); + end if; + if R(R'LEFT)='1' then + XDENOM := UNSIGNED(-R); + QNEG := not QNEG; + else + XDENOM := UNSIGNED(R); + end if; + DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN); + if QNEG then FQUOT := "0"-FQUOT; + end if; + return SIGNED(FQUOT); + end "/"; + + -- Id: A.23 + function "/" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R)); + variable XR, QUOT: UNSIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAU; + end if; + if (R_LENGTH > L'LENGTH) then + QUOT := (others => '0'); + return RESIZE(QUOT, L'LENGTH); + end if; + XR := TO_UNSIGNED(R, R_LENGTH); + QUOT := RESIZE((L / XR), QUOT'LENGTH); + return RESIZE(QUOT, L'LENGTH); + end "/"; + + -- Id: A.24 + function "/" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH); + variable XL, QUOT: UNSIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAU; + end if; + XL := TO_UNSIGNED(L, L_LENGTH); + QUOT := RESIZE((XL / R), QUOT'LENGTH); + if L_LENGTH > R'LENGTH + and QUOT(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => '0') + then + assert NO_WARNING report "NUMERIC_BIT.""/"": Quotient Truncated" + severity WARNING; + end if; + return RESIZE(QUOT, R'LENGTH); + end "/"; + + -- Id: A.25 + function "/" (L: SIGNED; R: INTEGER) return SIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R)); + variable XR, QUOT: SIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAS; + end if; + if (R_LENGTH > L'LENGTH) then + QUOT := (others => '0'); + return RESIZE(QUOT, L'LENGTH); + end if; + XR := TO_SIGNED(R, R_LENGTH); + QUOT := RESIZE((L / XR), QUOT'LENGTH); + return RESIZE(QUOT, L'LENGTH); + end "/"; + + -- Id: A.26 + function "/" (L: INTEGER; R: SIGNED) return SIGNED is + constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH); + variable XL, QUOT: SIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAS; + end if; + XL := TO_SIGNED(L, L_LENGTH); + QUOT := RESIZE((XL / R), QUOT'LENGTH); + if L_LENGTH > R'LENGTH and QUOT(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => QUOT(R'LENGTH-1)) + then + assert NO_WARNING report "NUMERIC_BIT.""/"": Quotient Truncated" + severity WARNING; + end if; + return RESIZE(QUOT, R'LENGTH); + end "/"; + + --============================================================================ + + -- Id: A.27 + function "rem" (L, R: UNSIGNED) return UNSIGNED is + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + DIVMOD(L, R, FQUOT, FREMAIN); + return FREMAIN; + end "rem"; + + -- Id: A.28 + function "rem" (L, R: SIGNED) return SIGNED is + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + variable XNUM: UNSIGNED(L'LENGTH-1 downto 0); + variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0); + variable RNEG: BOOLEAN := FALSE; + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS; + end if; + if L(L'LEFT)='1' then + XNUM := UNSIGNED(-L); + RNEG := TRUE; + else + XNUM := UNSIGNED(L); + end if; + if R(R'LEFT)='1' then + XDENOM := UNSIGNED(-R); + else + XDENOM := UNSIGNED(R); + end if; + DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN); + if RNEG then + FREMAIN := "0"-FREMAIN; + end if; + return SIGNED(FREMAIN); + end "rem"; + + -- Id: A.29 + function "rem" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R)); + variable XR, XREM: UNSIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAU; + end if; + XR := TO_UNSIGNED(R, R_LENGTH); + XREM := RESIZE((L rem XR), XREM'LENGTH); + if R_LENGTH > L'LENGTH and XREM(R_LENGTH-1 downto L'LENGTH) + /= (R_LENGTH-1 downto L'LENGTH => '0') + then + assert NO_WARNING report "NUMERIC_BIT.""rem"": Remainder Truncated" + severity WARNING; + end if; + return RESIZE(XREM, L'LENGTH); + end "rem"; + + -- Id: A.30 + function "rem" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH); + variable XL, XREM: UNSIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAU; + end if; + XL := TO_UNSIGNED(L, L_LENGTH); + XREM := RESIZE((XL rem R), XREM'LENGTH); + if L_LENGTH > R'LENGTH and XREM(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => '0') + then + assert NO_WARNING report "NUMERIC_BIT.""rem"": Remainder Truncated" + severity WARNING; + end if; + return RESIZE(XREM, R'LENGTH); + end "rem"; + + -- Id: A.31 + function "rem" (L: SIGNED; R: INTEGER) return SIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R)); + variable XR, XREM: SIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAS; + end if; + XR := TO_SIGNED(R, R_LENGTH); + XREM := RESIZE((L rem XR), XREM'LENGTH); + if R_LENGTH > L'LENGTH and XREM(R_LENGTH-1 downto L'LENGTH) + /= (R_LENGTH-1 downto L'LENGTH => XREM(L'LENGTH-1)) + then + assert NO_WARNING report "NUMERIC_BIT.""rem"": Remainder Truncated" + severity WARNING; + end if; + return RESIZE(XREM, L'LENGTH); + end "rem"; + + -- Id: A.32 + function "rem" (L: INTEGER; R: SIGNED) return SIGNED is + constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH); + variable XL, XREM: SIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAS; + end if; + XL := TO_SIGNED(L, L_LENGTH); + XREM := RESIZE((XL rem R), XREM'LENGTH); + if L_LENGTH > R'LENGTH and XREM(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => XREM(R'LENGTH-1)) + then + assert NO_WARNING report "NUMERIC_BIT.""rem"": Remainder Truncated" + severity WARNING; + end if; + return RESIZE(XREM, R'LENGTH); + end "rem"; + + --============================================================================ + + -- Id: A.33 + function "mod" (L, R: UNSIGNED) return UNSIGNED is + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + DIVMOD(L, R, FQUOT, FREMAIN); + return FREMAIN; + end "mod"; + + -- Id: A.34 + function "mod" (L, R: SIGNED) return SIGNED is + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + variable XNUM: UNSIGNED(L'LENGTH-1 downto 0); + variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0); + variable RNEG: BOOLEAN := FALSE; + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS; + end if; + if L(L'LEFT)='1' then + XNUM := UNSIGNED(-L); + else + XNUM := UNSIGNED(L); + end if; + if R(R'LEFT)='1' then + XDENOM := UNSIGNED(-R); + RNEG := TRUE; + else + XDENOM := UNSIGNED(R); + end if; + DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN); + if RNEG and L(L'LEFT)='1' then + FREMAIN := "0"-FREMAIN; + elsif RNEG and FREMAIN/="0" then + FREMAIN := FREMAIN-XDENOM; + elsif L(L'LEFT)='1' and FREMAIN/="0" then + FREMAIN := XDENOM-FREMAIN; + end if; + return SIGNED(FREMAIN); + end "mod"; + + -- Id: A.35 + function "mod" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R)); + variable XR, XREM: UNSIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAU; + end if; + XR := TO_UNSIGNED(R, R_LENGTH); + XREM := RESIZE((L mod XR), XREM'LENGTH); + if R_LENGTH > L'LENGTH and XREM(R_LENGTH-1 downto L'LENGTH) + /= (R_LENGTH-1 downto L'LENGTH => '0') + then + assert NO_WARNING report "NUMERIC_BIT.""mod"": modulus Truncated" + severity WARNING; + end if; + return RESIZE(XREM, L'LENGTH); + end "mod"; + + -- Id: A.36 + function "mod" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH); + variable XL, XREM: UNSIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAU; + end if; + XL := TO_UNSIGNED(L, L_LENGTH); + XREM := RESIZE((XL mod R), XREM'LENGTH); + if L_LENGTH > R'LENGTH and XREM(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => '0') + then + assert NO_WARNING report "NUMERIC_BIT.""mod"": modulus Truncated" + severity WARNING; + end if; + return RESIZE(XREM, R'LENGTH); + end "mod"; + + -- Id: A.37 + function "mod" (L: SIGNED; R: INTEGER) return SIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R)); + variable XR, XREM: SIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAS; + end if; + XR := TO_SIGNED(R, R_LENGTH); + XREM := RESIZE((L mod XR), XREM'LENGTH); + if R_LENGTH > L'LENGTH and XREM(R_LENGTH-1 downto L'LENGTH) + /= (R_LENGTH-1 downto L'LENGTH => XREM(L'LENGTH-1)) + then + assert NO_WARNING report "NUMERIC_BIT.""mod"": modulus Truncated" + severity WARNING; + end if; + return RESIZE(XREM, L'LENGTH); + end "mod"; + + -- Id: A.38 + function "mod" (L: INTEGER; R: SIGNED) return SIGNED is + constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH); + variable XL, XREM: SIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAS; + end if; + XL := TO_SIGNED(L, L_LENGTH); + XREM := RESIZE((XL mod R), XREM'LENGTH); + if L_LENGTH > R'LENGTH and XREM(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => XREM(R'LENGTH-1)) + then + assert NO_WARNING report "NUMERIC_BIT.""mod"": modulus Truncated" + severity WARNING; + end if; + return RESIZE(XREM, R'LENGTH); + end "mod"; + + --============================================================================ + + -- Id: C.1 + function ">" (L, R: UNSIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return not UNSIGNED_LESS_OR_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE)); + end ">"; + + -- Id: C.2 + function ">" (L, R: SIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return not SIGNED_LESS_OR_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE)); + end ">"; + + -- Id: C.3 + function ">" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return TRUE; + end if; + return not UNSIGNED_LESS_OR_EQUAL(TO_UNSIGNED(L, R'LENGTH), R); + end ">"; + + -- Id: C.4 + function ">" (L: INTEGER; R: SIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return L > 0; + end if; + return not SIGNED_LESS_OR_EQUAL(TO_SIGNED(L, R'LENGTH), R); + end ">"; + + -- Id: C.5 + function ">" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return FALSE; + end if; + return not UNSIGNED_LESS_OR_EQUAL(L, TO_UNSIGNED(R, L'LENGTH)); + end ">"; + + -- Id: C.6 + function ">" (L: SIGNED; R: INTEGER) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R; + end if; + return not SIGNED_LESS_OR_EQUAL(L, TO_SIGNED(R, L'LENGTH)); + end ">"; + + --============================================================================ + + -- Id: C.7 + function "<" (L, R: UNSIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return UNSIGNED_LESS(RESIZE(L, SIZE), RESIZE(R, SIZE)); + end "<"; + + -- Id: C.8 + function "<" (L, R: SIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return SIGNED_LESS(RESIZE(L, SIZE), RESIZE(R, SIZE)); + end "<"; + + -- Id: C.9 + function "<" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L < 0; + end if; + return UNSIGNED_LESS(TO_UNSIGNED(L, R'LENGTH), R); + end "<"; + + -- Id: C.10 + function "<" (L: INTEGER; R: SIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return L < 0; + end if; + return SIGNED_LESS(TO_SIGNED(L, R'LENGTH), R); + end "<"; + + -- Id: C.11 + function "<" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R; + end if; + return UNSIGNED_LESS(L, TO_UNSIGNED(R, L'LENGTH)); + end "<"; + + -- Id: C.12 + function "<" (L: SIGNED; R: INTEGER) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R; + end if; + return SIGNED_LESS(L, TO_SIGNED(R, L'LENGTH)); + end "<"; + + --============================================================================ + + -- Id: C.13 + function "<=" (L, R: UNSIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return UNSIGNED_LESS_OR_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE)); + end "<="; + + -- Id: C.14 + function "<=" (L, R: SIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return SIGNED_LESS_OR_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE)); + end "<="; + + -- Id: C.15 + function "<=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L < 0; + end if; + return UNSIGNED_LESS_OR_EQUAL(TO_UNSIGNED(L, R'LENGTH), R); + end "<="; + + -- Id: C.16 + function "<=" (L: INTEGER; R: SIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return L < 0; + end if; + return SIGNED_LESS_OR_EQUAL(TO_SIGNED(L, R'LENGTH), R); + end "<="; + + -- Id: C.17 + function "<=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R; + end if; + return UNSIGNED_LESS_OR_EQUAL(L, TO_UNSIGNED(R, L'LENGTH)); + end "<="; + + -- Id: C.18 + function "<=" (L: SIGNED; R: INTEGER) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R; + end if; + return SIGNED_LESS_OR_EQUAL(L, TO_SIGNED(R, L'LENGTH)); + end "<="; + + --============================================================================ + + -- Id: C.19 + function ">=" (L, R: UNSIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return not UNSIGNED_LESS(RESIZE(L, SIZE), RESIZE(R, SIZE)); + end ">="; + + -- Id: C.20 + function ">=" (L, R: SIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return not SIGNED_LESS(RESIZE(L, SIZE), RESIZE(R, SIZE)); + end ">="; + + -- Id: C.21 + function ">=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L > 0; + end if; + return not UNSIGNED_LESS(TO_UNSIGNED(L, R'LENGTH), R); + end ">="; + + -- Id: C.22 + function ">=" (L: INTEGER; R: SIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return L > 0; + end if; + return not SIGNED_LESS(TO_SIGNED(L, R'LENGTH), R); + end ">="; + + -- Id: C.23 + function ">=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R; + end if; + return not UNSIGNED_LESS(L, TO_UNSIGNED(R, L'LENGTH)); + end ">="; + + -- Id: C.24 + function ">=" (L: SIGNED; R: INTEGER) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R; + end if; + return not SIGNED_LESS(L, TO_SIGNED(R, L'LENGTH)); + end ">="; + + --============================================================================ + + -- Id: C.25 + function "=" (L, R: UNSIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return UNSIGNED_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE)); + end "="; + + -- Id: C.26 + function "=" (L, R: SIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return SIGNED_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE)); + end "="; + + -- Id: C.27 + function "=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return FALSE; + end if; + return UNSIGNED_EQUAL(TO_UNSIGNED(L, R'LENGTH), R); + end "="; + + -- Id: C.28 + function "=" (L: INTEGER; R: SIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return FALSE; + end if; + return SIGNED_EQUAL(TO_SIGNED(L, R'LENGTH), R); + end "="; + + -- Id: C.29 + function "=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return FALSE; + end if; + return UNSIGNED_EQUAL(L, TO_UNSIGNED(R, L'LENGTH)); + end "="; + + -- Id: C.30 + function "=" (L: SIGNED; R: INTEGER) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return FALSE; + end if; + return SIGNED_EQUAL(L, TO_SIGNED(R, L'LENGTH)); + end "="; + + --============================================================================ + + -- Id: C.31 + function "/=" (L, R: UNSIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + return not(UNSIGNED_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE))); + end "/="; + + -- Id: C.32 + function "/=" (L, R: SIGNED) return BOOLEAN is + variable SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_BIT.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + return not(SIGNED_EQUAL(RESIZE(L, SIZE), RESIZE(R, SIZE))); + end "/="; + + -- Id: C.33 + function "/=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return TRUE; + end if; + return not(UNSIGNED_EQUAL(TO_UNSIGNED(L, R'LENGTH), R)); + end "/="; + + -- Id: C.34 + function "/=" (L: INTEGER; R: SIGNED) return BOOLEAN is + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return TRUE; + end if; + return not(SIGNED_EQUAL(TO_SIGNED(L, R'LENGTH), R)); + end "/="; + + -- Id: C.35 + function "/=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return TRUE; + end if; + return not(UNSIGNED_EQUAL(L, TO_UNSIGNED(R, L'LENGTH))); + end "/="; + + -- Id: C.36 + function "/=" (L: SIGNED; R: INTEGER) return BOOLEAN is + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return TRUE; + end if; + return not(SIGNED_EQUAL(L, TO_SIGNED(R, L'LENGTH))); + end "/="; + + --============================================================================ + + -- Id: S.1 + function SHIFT_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is + begin + if (ARG'LENGTH < 1) then return NAU; + end if; + return UNSIGNED(XSLL(BIT_VECTOR(ARG), COUNT)); + end SHIFT_LEFT; + + -- Id: S.2 + function SHIFT_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is + begin + if (ARG'LENGTH < 1) then return NAU; + end if; + return UNSIGNED(XSRL(BIT_VECTOR(ARG), COUNT)); + end SHIFT_RIGHT; + + -- Id: S.3 + function SHIFT_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is + begin + if (ARG'LENGTH < 1) then return NAS; + end if; + return SIGNED(XSLL(BIT_VECTOR(ARG), COUNT)); + end SHIFT_LEFT; + + -- Id: S.4 + function SHIFT_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is + begin + if (ARG'LENGTH < 1) then return NAS; + end if; + return SIGNED(XSRA(BIT_VECTOR(ARG), COUNT)); + end SHIFT_RIGHT; + + --============================================================================ + + -- Id: S.5 + function ROTATE_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is + begin + if (ARG'LENGTH < 1) then return NAU; + end if; + return UNSIGNED(XROL(BIT_VECTOR(ARG), COUNT)); + end ROTATE_LEFT; + + -- Id: S.6 + function ROTATE_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is + begin + if (ARG'LENGTH < 1) then return NAU; + end if; + return UNSIGNED(XROR(BIT_VECTOR(ARG), COUNT)); + end ROTATE_RIGHT; + + -- Id: S.7 + function ROTATE_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is + begin + if (ARG'LENGTH < 1) then return NAS; + end if; + return SIGNED(XROL(BIT_VECTOR(ARG), COUNT)); + end ROTATE_LEFT; + + -- Id: S.8 + function ROTATE_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is + begin + if (ARG'LENGTH < 1) then return NAS; + end if; + return SIGNED(XROR(BIT_VECTOR(ARG), COUNT)); + end ROTATE_RIGHT; + + --============================================================================ + +--START-V93 + ------------------------------------------------------------------------------ + -- Note : Function S.9 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.9 + function "sll" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is + begin + if (COUNT >= 0) then + return SHIFT_LEFT(ARG, COUNT); + else + return SHIFT_RIGHT(ARG, -COUNT); + end if; + end "sll"; + + ------------------------------------------------------------------------------ + -- Note : Function S.10 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.10 + function "sll" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is + begin + if (COUNT >= 0) then + return SHIFT_LEFT(ARG, COUNT); + else + return SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), -COUNT)); + end if; + end "sll"; + + ------------------------------------------------------------------------------ + -- Note : Function S.11 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.11 + function "srl" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is + begin + if (COUNT >= 0) then + return SHIFT_RIGHT(ARG, COUNT); + else + return SHIFT_LEFT(ARG, -COUNT); + end if; + end "srl"; + + ------------------------------------------------------------------------------ + -- Note : Function S.12 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.12 + function "srl" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is + begin + if (COUNT >= 0) then + return SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), COUNT)); + else + return SHIFT_LEFT(ARG, -COUNT); + end if; + end "srl"; + + ------------------------------------------------------------------------------ + -- Note : Function S.13 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.13 + function "rol" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is + begin + if (COUNT >= 0) then + return ROTATE_LEFT(ARG, COUNT); + else + return ROTATE_RIGHT(ARG, -COUNT); + end if; + end "rol"; + + ------------------------------------------------------------------------------ + -- Note : Function S.14 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.14 + function "rol" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is + begin + if (COUNT >= 0) then + return ROTATE_LEFT(ARG, COUNT); + else + return ROTATE_RIGHT(ARG, -COUNT); + end if; + end "rol"; + + ------------------------------------------------------------------------------ + -- Note : Function S.15 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.15 + function "ror" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is + begin + if (COUNT >= 0) then + return ROTATE_RIGHT(ARG, COUNT); + else + return ROTATE_LEFT(ARG, -COUNT); + end if; + end "ror"; + + ------------------------------------------------------------------------------ + -- Note : Function S.16 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.16 + function "ror" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is + begin + if (COUNT >= 0) then + return ROTATE_RIGHT(ARG, COUNT); + else + return ROTATE_LEFT(ARG, -COUNT); + end if; + end "ror"; + +--END-V93 + --============================================================================ + + -- Id: D.1 + function TO_INTEGER (ARG: UNSIGNED) return NATURAL is + constant ARG_LEFT: INTEGER := ARG'LENGTH-1; + alias XARG: UNSIGNED(ARG_LEFT downto 0) is ARG; + variable RESULT: NATURAL := 0; + begin + if (ARG'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.TO_INTEGER: null detected, returning 0" + severity WARNING; + return 0; + end if; + for I in XARG'RANGE loop + RESULT := RESULT+RESULT; + if XARG(I) = '1' then + RESULT := RESULT + 1; + end if; + end loop; + return RESULT; + end TO_INTEGER; + + -- Id: D.2 + function TO_INTEGER (ARG: SIGNED) return INTEGER is + begin + if (ARG'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_BIT.TO_INTEGER: null detected, returning 0" + severity WARNING; + return 0; + end if; + if ARG(ARG'LEFT) = '0' then + return TO_INTEGER(UNSIGNED(ARG)); + else + return (- (TO_INTEGER(UNSIGNED(- (ARG + 1)))) -1); + end if; + end TO_INTEGER; + + -- Id: D.3 + function TO_UNSIGNED (ARG, SIZE: NATURAL) return UNSIGNED is + variable RESULT: UNSIGNED(SIZE-1 downto 0); + variable I_VAL: NATURAL := ARG; + begin + if (SIZE < 1) then return NAU; + end if; + for I in 0 to RESULT'LEFT loop + if (I_VAL mod 2) = 0 then + RESULT(I) := '0'; + else RESULT(I) := '1'; + end if; + I_VAL := I_VAL/2; + end loop; + if not(I_VAL =0) then + assert NO_WARNING + report "NUMERIC_BIT.TO_UNSIGNED: vector truncated" + severity WARNING; + end if; + return RESULT; + end TO_UNSIGNED; + + -- Id: D.4 + function TO_SIGNED (ARG: INTEGER; + SIZE: NATURAL) return SIGNED is + variable RESULT: SIGNED(SIZE-1 downto 0); + variable B_VAL: BIT := '0'; + variable I_VAL: INTEGER := ARG; + begin + if (SIZE < 1) then return NAS; + end if; + if (ARG < 0) then + B_VAL := '1'; + I_VAL := -(ARG+1); + end if; + for I in 0 to RESULT'LEFT loop + if (I_VAL mod 2) = 0 then + RESULT(I) := B_VAL; + else + RESULT(I) := not B_VAL; + end if; + I_VAL := I_VAL/2; + end loop; + if ((I_VAL/=0) or (B_VAL/=RESULT(RESULT'LEFT))) then + assert NO_WARNING + report "NUMERIC_BIT.TO_SIGNED: vector truncated" + severity WARNING; + end if; + return RESULT; + end TO_SIGNED; + + --============================================================================ + + -- Id: R.1 + function RESIZE (ARG: SIGNED; NEW_SIZE: NATURAL) return SIGNED is + alias INVEC: SIGNED(ARG'LENGTH-1 downto 0) is ARG; + variable RESULT: SIGNED(NEW_SIZE-1 downto 0) := (others => '0'); + constant BOUND: INTEGER := MIN(ARG'LENGTH, RESULT'LENGTH)-2; + begin + if (NEW_SIZE < 1) then return NAS; + end if; + if (ARG'LENGTH = 0) then return RESULT; + end if; + RESULT := (others => ARG(ARG'LEFT)); + if BOUND >= 0 then + RESULT(BOUND downto 0) := INVEC(BOUND downto 0); + end if; + return RESULT; + end RESIZE; + + -- Id: R.2 + function RESIZE (ARG: UNSIGNED; NEW_SIZE: NATURAL) return UNSIGNED is + constant ARG_LEFT: INTEGER := ARG'LENGTH-1; + alias XARG: UNSIGNED(ARG_LEFT downto 0) is ARG; + variable RESULT: UNSIGNED(NEW_SIZE-1 downto 0) := (others => '0'); + begin + if (NEW_SIZE < 1) then return NAU; + end if; + if XARG'LENGTH =0 then return RESULT; + end if; + if (RESULT'LENGTH < ARG'LENGTH) then + RESULT(RESULT'LEFT downto 0) := XARG(RESULT'LEFT downto 0); + else + RESULT(RESULT'LEFT downto XARG'LEFT+1) := (others => '0'); + RESULT(XARG'LEFT downto 0) := XARG; + end if; + return RESULT; + end RESIZE; + + --============================================================================ + + -- Id: L.1 + function "not" (L: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(not(BIT_VECTOR(L))); + return RESULT; + end "not"; + + -- Id: L.2 + function "and" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(BIT_VECTOR(L) and BIT_VECTOR(R)); + return RESULT; + end "and"; + + -- Id: L.3 + function "or" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(BIT_VECTOR(L) or BIT_VECTOR(R)); + return RESULT; + end "or"; + + -- Id: L.4 + function "nand" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(BIT_VECTOR(L) nand BIT_VECTOR(R)); + return RESULT; + end "nand"; + + -- Id: L.5 + function "nor" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(BIT_VECTOR(L) nor BIT_VECTOR(R)); + return RESULT; + end "nor"; + + -- Id: L.6 + function "xor" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(BIT_VECTOR(L) xor BIT_VECTOR(R)); + return RESULT; + end "xor"; + +--START-V93 + ------------------------------------------------------------------------------ + -- Note : Function L.7 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: L.7 + function "xnor" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(BIT_VECTOR(L) xnor BIT_VECTOR(R)); + return RESULT; + end "xnor"; +--END-V93 + + -- Id: L.8 + function "not" (L: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(not(BIT_VECTOR(L))); + return RESULT; + end "not"; + + -- Id: L.9 + function "and" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(BIT_VECTOR(L) and BIT_VECTOR(R)); + return RESULT; + end "and"; + + -- Id: L.10 + function "or" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(BIT_VECTOR(L) or BIT_VECTOR(R)); + return RESULT; + end "or"; + + -- Id: L.11 + function "nand" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(BIT_VECTOR(L) nand BIT_VECTOR(R)); + return RESULT; + end "nand"; + + -- Id: L.12 + function "nor" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(BIT_VECTOR(L) nor BIT_VECTOR(R)); + return RESULT; + end "nor"; + + -- Id: L.13 + function "xor" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(BIT_VECTOR(L) xor BIT_VECTOR(R)); + return RESULT; + end "xor"; + +--START-V93 + ------------------------------------------------------------------------------ + -- Note : Function L.14 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: L.14 + function "xnor" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(BIT_VECTOR(L) xnor BIT_VECTOR(R)); + return RESULT; + end "xnor"; +--END-V93 + + --============================================================================ + + -- Id: E.1 + function RISING_EDGE (signal S: BIT) return BOOLEAN is + begin + return S'EVENT and S = '1'; + end RISING_EDGE; + + -- Id: E.2 + 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/ieee/numeric_bit.vhdl b/libraries/ieee/numeric_bit.vhdl new file mode 100644 index 000000000..8f049f21a --- /dev/null +++ b/libraries/ieee/numeric_bit.vhdl @@ -0,0 +1,813 @@ +-- ----------------------------------------------------------------------------- +-- +-- Copyright 1995 by IEEE. All rights reserved. +-- +-- This source file is considered by the IEEE to be an essential part of the use +-- of the standard 1076.3 and as such may be distributed without change, except +-- as permitted by the standard. This source file may not be sold or distributed +-- for profit. This package may be modified to include additional data required +-- by tools, but must in no way change the external interfaces or simulation +-- behaviour of the description. It is permissible to add comments and/or +-- attributes to the package declarations, but not to change or delete any +-- original lines of the approved package declaration. The package body may be +-- changed only in accordance with the terms of clauses 7.1 and 7.2 of the +-- standard. +-- +-- Title : Standard VHDL Synthesis Package (1076.3, NUMERIC_BIT) +-- +-- Library : This package shall be compiled into a library symbolically +-- : named IEEE. +-- +-- Developers : IEEE DASC Synthesis Working Group, PAR 1076.3 +-- +-- Purpose : This package defines numeric types and arithmetic functions +-- : for use with synthesis tools. Two numeric types are defined: +-- : -- > UNSIGNED: represents an UNSIGNED number in vector form +-- : -- > SIGNED: represents a SIGNED number in vector form +-- : The base element type is type BIT. +-- : The leftmost bit is treated as the most significant bit. +-- : Signed vectors are represented in two's complement form. +-- : This package contains overloaded arithmetic operators on +-- : the SIGNED and UNSIGNED types. The package also contains +-- : useful type conversions functions, clock detection +-- : functions, and other utility functions. +-- : +-- : If any argument to a function is a null array, a null array is +-- : returned (exceptions, if any, are noted individually). +-- +-- Limitation : +-- +-- Note : No declarations or definitions shall be included in, +-- : or excluded from this package. The "package declaration" +-- : defines the types, subtypes and declarations of +-- : NUMERIC_BIT. The NUMERIC_BIT package body shall be +-- : considered the formal definition of the semantics of +-- : this package. Tool developers may choose to implement +-- : the package body in the most efficient manner available +-- : to them. +-- : +-- ----------------------------------------------------------------------------- +-- Version : 2.4 +-- Date : 12 April 1995 +-- ----------------------------------------------------------------------------- + +package NUMERIC_BIT is + constant CopyRightNotice: STRING + := "Copyright 1995 IEEE. All rights reserved."; + + --============================================================================ + -- Numeric array type definitions + --============================================================================ + + type UNSIGNED is array (NATURAL range <> ) of BIT; + type SIGNED is array (NATURAL range <> ) of BIT; + + --============================================================================ + -- Arithmetic Operators: + --============================================================================ + + -- Id: A.1 + function "abs" (ARG: SIGNED) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0). + -- Result: Returns the absolute value of a SIGNED vector ARG. + + -- Id: A.2 + function "-" (ARG: SIGNED) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0). + -- Result: Returns the value of the unary minus operation on a + -- SIGNED vector ARG. + + --============================================================================ + + -- Id: A.3 + function "+" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0). + -- Result: Adds two UNSIGNED vectors that may be of different lengths. + + -- Id: A.4 + function "+" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0). + -- Result: Adds two SIGNED vectors that may be of different lengths. + + -- Id: A.5 + function "+" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0). + -- Result: Adds an UNSIGNED vector, L, with a non-negative INTEGER, R. + + -- Id: A.6 + function "+" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0). + -- Result: Adds a non-negative INTEGER, L, with an UNSIGNED vector, R. + + -- Id: A.7 + function "+" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0). + -- Result: Adds an INTEGER, L(may be positive or negative), to a SIGNED + -- vector, R. + + -- Id: A.8 + function "+" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0). + -- Result: Adds a SIGNED vector, L, to an INTEGER, R. + + --============================================================================ + + -- Id: A.9 + function "-" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0). + -- Result: Subtracts two UNSIGNED vectors that may be of different lengths. + + -- Id: A.10 + function "-" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0). + -- Result: Subtracts a SIGNED vector, R, from another SIGNED vector, L, + -- that may possibly be of different lengths. + + -- Id: A.11 + function "-" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0). + -- Result: Subtracts a non-negative INTEGER, R, from an UNSIGNED vector, L. + + -- Id: A.12 + function "-" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0). + -- Result: Subtracts an UNSIGNED vector, R, from a non-negative INTEGER, L. + + -- Id: A.13 + function "-" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0). + -- Result: Subtracts an INTEGER, R, from a SIGNED vector, L. + + -- Id: A.14 + function "-" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0). + -- Result: Subtracts a SIGNED vector, R, from an INTEGER, L. + + --============================================================================ + + -- Id: A.15 + function "*" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0). + -- Result: Performs the multiplication operation on two UNSIGNED vectors + -- that may possibly be of different lengths. + + -- Id: A.16 + function "*" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED((L'LENGTH+R'LENGTH-1) downto 0) + -- Result: Multiplies two SIGNED vectors that may possibly be of + -- different lengths. + + -- Id: A.17 + function "*" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED((L'LENGTH+L'LENGTH-1) downto 0). + -- Result: Multiplies an UNSIGNED vector, L, with a non-negative + -- INTEGER, R. R is converted to an UNSIGNED vector of + -- size L'LENGTH before multiplication. + + -- Id: A.18 + function "*" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED((R'LENGTH+R'LENGTH-1) downto 0). + -- Result: Multiplies an UNSIGNED vector, R, with a non-negative + -- INTEGER, L. L is converted to an UNSIGNED vector of + -- size R'LENGTH before multiplication. + + -- Id: A.19 + function "*" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED((L'LENGTH+L'LENGTH-1) downto 0) + -- Result: Multiplies a SIGNED vector, L, with an INTEGER, R. R is + -- converted to a SIGNED vector of size L'LENGTH before + -- multiplication. + + -- Id: A.20 + function "*" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED((R'LENGTH+R'LENGTH-1) downto 0) + -- Result: Multiplies a SIGNED vector, R, with an INTEGER, L. L is + -- converted to a SIGNED vector of size R'LENGTH before + -- multiplication. + + --============================================================================ + -- + -- NOTE: If second argument is zero for "/" operator, a severity level + -- of ERROR is issued. + + -- Id: A.21 + function "/" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Divides an UNSIGNED vector, L, by another UNSIGNED vector, R. + + -- Id: A.22 + function "/" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Divides an SIGNED vector, L, by another SIGNED vector, R. + + -- Id: A.23 + function "/" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Divides an UNSIGNED vector, L, by a non-negative INTEGER, R. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.24 + function "/" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0) + -- Result: Divides a non-negative INTEGER, L, by an UNSIGNED vector, R. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + -- Id: A.25 + function "/" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Divides a SIGNED vector, L, by an INTEGER, R. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.26 + function "/" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0) + -- Result: Divides an INTEGER, L, by a SIGNED vector, R. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + --============================================================================ + -- + -- NOTE: If second argument is zero for "rem" operator, a severity level + -- of ERROR is issued. + + -- Id: A.27 + function "rem" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where L and R are UNSIGNED vectors. + + -- Id: A.28 + function "rem" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where L and R are SIGNED vectors. + + -- Id: A.29 + function "rem" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where L is an UNSIGNED vector and R is a + -- non-negative INTEGER. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.30 + function "rem" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where R is an UNSIGNED vector and L is a + -- non-negative INTEGER. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + -- Id: A.31 + function "rem" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where L is SIGNED vector and R is an INTEGER. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.32 + function "rem" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where R is SIGNED vector and L is an INTEGER. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + --============================================================================ + -- + -- NOTE: If second argument is zero for "mod" operator, a severity level + -- of ERROR is issued. + + -- Id: A.33 + function "mod" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where L and R are UNSIGNED vectors. + + -- Id: A.34 + function "mod" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where L and R are SIGNED vectors. + + -- Id: A.35 + function "mod" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where L is an UNSIGNED vector and R + -- is a non-negative INTEGER. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.36 + function "mod" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where R is an UNSIGNED vector and L + -- is a non-negative INTEGER. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + -- Id: A.37 + function "mod" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where L is a SIGNED vector and + -- R is an INTEGER. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.38 + function "mod" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where L is an INTEGER and + -- R is a SIGNED vector. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + --============================================================================ + -- Comparison Operators + --============================================================================ + + -- Id: C.1 + function ">" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.2 + function ">" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.3 + function ">" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.4 + function ">" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L is a INTEGER and + -- R is a SIGNED vector. + + -- Id: C.5 + function ">" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.6 + function ">" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L is a SIGNED vector and + -- R is a INTEGER. + + --============================================================================ + + -- Id: C.7 + function "<" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.8 + function "<" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.9 + function "<" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.10 + function "<" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L is an INTEGER and + -- R is a SIGNED vector. + + -- Id: C.11 + function "<" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.12 + function "<" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L is a SIGNED vector and + -- R is an INTEGER. + + --============================================================================ + + -- Id: C.13 + function "<=" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.14 + function "<=" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.15 + function "<=" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.16 + function "<=" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L is an INTEGER and + -- R is a SIGNED vector. + + -- Id: C.17 + function "<=" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.18 + function "<=" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L is a SIGNED vector and + -- R is an INTEGER. + + --============================================================================ + + -- Id: C.19 + function ">=" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.20 + function ">=" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.21 + function ">=" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.22 + function ">=" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L is an INTEGER and + -- R is a SIGNED vector. + + -- Id: C.23 + function ">=" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.24 + function ">=" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L is a SIGNED vector and + -- R is an INTEGER. + + --============================================================================ + + -- Id: C.25 + function "=" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.26 + function "=" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.27 + function "=" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.28 + function "=" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L is an INTEGER and + -- R is a SIGNED vector. + + -- Id: C.29 + function "=" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.30 + function "=" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L is a SIGNED vector and + -- R is an INTEGER. + + --============================================================================ + + -- Id: C.31 + function "/=" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.32 + function "/=" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.33 + function "/=" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.34 + function "/=" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L is an INTEGER and + -- R is a SIGNED vector. + + -- Id: C.35 + function "/=" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.36 + function "/=" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L is a SIGNED vector and + -- R is an INTEGER. + + --============================================================================ + -- Shift and Rotate Functions + --============================================================================ + + -- Id: S.1 + function SHIFT_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a shift-left on an UNSIGNED vector COUNT times. + -- The vacated positions are filled with Bit '0'. + -- The COUNT leftmost bits are lost. + + -- Id: S.2 + function SHIFT_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a shift-right on an UNSIGNED vector COUNT times. + -- The vacated positions are filled with Bit '0'. + -- The COUNT rightmost bits are lost. + + -- Id: S.3 + function SHIFT_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a shift-left on a SIGNED vector COUNT times. + -- The vacated positions are filled with Bit '0'. + -- The COUNT leftmost bits, except ARG'LEFT, are lost. + + -- Id: S.4 + function SHIFT_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a shift-right on a SIGNED vector COUNT times. + -- The vacated positions are filled with the leftmost bit, ARG'LEFT. + -- The COUNT rightmost bits are lost. + + --============================================================================ + + -- Id: S.5 + function ROTATE_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a rotate-left of an UNSIGNED vector COUNT times. + + -- Id: S.6 + function ROTATE_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a rotate-right of an UNSIGNED vector COUNT times. + + -- Id: S.7 + function ROTATE_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a logical rotate-left of a SIGNED vector COUNT times. + + -- Id: S.8 + function ROTATE_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a logical rotate-right of a SIGNED vector COUNT times. + + --============================================================================ + + ------------------------------------------------------------------------------ + -- Note : Function S.9 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.9 + function "sll" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93 + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: SHIFT_LEFT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.10 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.10 + function "sll" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93 + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: SHIFT_LEFT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.11 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.11 + function "srl" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93 + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: SHIFT_RIGHT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.12 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.12 + function "srl" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93 + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), COUNT)) + + ------------------------------------------------------------------------------ + -- Note : Function S.13 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.13 + function "rol" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93 + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: ROTATE_LEFT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.14 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.14 + function "rol" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93 + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: ROTATE_LEFT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.15 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.15 + function "ror" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93 + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: ROTATE_RIGHT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.16 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.16 + function "ror" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93 + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: ROTATE_RIGHT(ARG, COUNT) + + --============================================================================ + -- RESIZE Functions + --============================================================================ + + -- Id: R.1 + function RESIZE (ARG: SIGNED; NEW_SIZE: NATURAL) return SIGNED; + -- Result subtype: SIGNED(NEW_SIZE-1 downto 0) + -- Result: Resizes the SIGNED vector ARG to the specified size. + -- To create a larger vector, the new [leftmost] bit positions + -- are filled with the sign bit (ARG'LEFT). When truncating, + -- the sign bit is retained along with the rightmost part. + + -- Id: R.2 + function RESIZE (ARG: UNSIGNED; NEW_SIZE: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(NEW_SIZE-1 downto 0) + -- Result: Resizes the UNSIGNED vector ARG to the specified size. + -- To create a larger vector, the new [leftmost] bit positions + -- are filled with '0'. When truncating, the leftmost bits + -- are dropped. + + --============================================================================ + -- Conversion Functions + --============================================================================ + + -- Id: D.1 + function TO_INTEGER (ARG: UNSIGNED) return NATURAL; + -- Result subtype: NATURAL. Value cannot be negative since parameter is an + -- UNSIGNED vector. + -- Result: Converts the UNSIGNED vector to an INTEGER. + + -- Id: D.2 + function TO_INTEGER (ARG: SIGNED) return INTEGER; + -- Result subtype: INTEGER + -- Result: Converts a SIGNED vector to an INTEGER. + + -- Id: D.3 + function TO_UNSIGNED (ARG, SIZE: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(SIZE-1 downto 0) + -- Result: Converts a non-negative INTEGER to an UNSIGNED vector with + -- the specified size. + + -- Id: D.4 + function TO_SIGNED (ARG: INTEGER; SIZE: NATURAL) return SIGNED; + -- Result subtype: SIGNED(SIZE-1 downto 0) + -- Result: Converts an INTEGER to a SIGNED vector of the specified size. + + --============================================================================ + -- Logical Operators + --============================================================================ + + -- Id: L.1 + function "not" (L: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Termwise inversion + + -- Id: L.2 + function "and" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector AND operation + + -- Id: L.3 + function "or" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector OR operation + + -- Id: L.4 + function "nand" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector NAND operation + + -- Id: L.5 + function "nor" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector NOR operation + + -- Id: L.6 + function "xor" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector XOR operation + + ------------------------------------------------------------------------------ + -- Note : Function L.7 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: L.7 + function "xnor" (L, R: UNSIGNED) return UNSIGNED; --V93 + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector XNOR operation + + -- Id: L.8 + function "not" (L: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Termwise inversion + + -- Id: L.9 + function "and" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector AND operation + + -- Id: L.10 + function "or" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector OR operation + + -- Id: L.11 + function "nand" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector NAND operation + + -- Id: L.12 + function "nor" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector NOR operation + + -- Id: L.13 + function "xor" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector XOR operation + + ------------------------------------------------------------------------------ + -- Note : Function L.14 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: L.14 + function "xnor" (L, R: SIGNED) return SIGNED; --V93 + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector XNOR operation + + --============================================================================ + -- Edge Detection Functions + --============================================================================ + + -- Id: E.1 + function RISING_EDGE (signal S: BIT) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Returns TRUE if an event is detected on signal S and the + -- value changed from a '0' to a '1'. + + -- Id: E.2 + function FALLING_EDGE (signal S: BIT) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Returns TRUE if an event is detected on signal S and the + -- value changed from a '1' to a '0'. + +end NUMERIC_BIT; diff --git a/libraries/ieee/numeric_std-body.vhdl b/libraries/ieee/numeric_std-body.vhdl new file mode 100644 index 000000000..a5d609dc3 --- /dev/null +++ b/libraries/ieee/numeric_std-body.vhdl @@ -0,0 +1,2545 @@ +-- -------------------------------------------------------------------- +-- +-- Copyright 1995 by IEEE. All rights reserved. +-- +-- This source file is considered by the IEEE to be an essential part of the use +-- of the standard 1076.3 and as such may be distributed without change, except +-- as permitted by the standard. This source file may not be sold or distributed +-- for profit. This package may be modified to include additional data required +-- by tools, but must in no way change the external interfaces or simulation +-- behaviour of the description. It is permissible to add comments and/or +-- attributes to the package declarations, but not to change or delete any +-- original lines of the approved package declaration. The package body may be +-- changed only in accordance with the terms of clauses 7.1 and 7.2 of the +-- standard. +-- +-- Title : Standard VHDL Synthesis Package (1076.3, NUMERIC_STD) +-- +-- Library : This package shall be compiled into a library symbolically +-- : named IEEE. +-- +-- Developers : IEEE DASC Synthesis Working Group, PAR 1076.3 +-- +-- Purpose : This package defines numeric types and arithmetic functions +-- : for use with synthesis tools. Two numeric types are defined: +-- : -- > UNSIGNED: represents UNSIGNED number in vector form +-- : -- > SIGNED: represents a SIGNED number in vector form +-- : The base element type is type STD_LOGIC. +-- : The leftmost bit is treated as the most significant bit. +-- : Signed vectors are represented in two's complement form. +-- : This package contains overloaded arithmetic operators on +-- : the SIGNED and UNSIGNED types. The package also contains +-- : useful type conversions functions. +-- : +-- : If any argument to a function is a null array, a null array is +-- : returned (exceptions, if any, are noted individually). +-- +-- Limitation : +-- +-- Note : No declarations or definitions shall be included in, +-- : or excluded from this package. The "package declaration" +-- : defines the types, subtypes and declarations of +-- : NUMERIC_STD. The NUMERIC_STD package body shall be +-- : considered the formal definition of the semantics of +-- : this package. Tool developers may choose to implement +-- : the package body in the most efficient manner available +-- : to them. +-- +-- -------------------------------------------------------------------- +-- modification history : +-- -------------------------------------------------------------------- +-- Version: 2.4 +-- Date : 12 April 1995 +-- ----------------------------------------------------------------------------- + +--============================================================================== +--============================= Package Body =================================== +--============================================================================== + +package body NUMERIC_STD is + + -- null range array constants + + constant NAU: UNSIGNED(0 downto 1) := (others => '0'); + constant NAS: SIGNED(0 downto 1) := (others => '0'); + + -- implementation controls + + constant NO_WARNING: BOOLEAN := FALSE; -- default to emit warnings + + --=========================Local Subprograms ================================= + + function MAX (LEFT, RIGHT: INTEGER) return INTEGER is + begin + if LEFT > RIGHT then return LEFT; + else return RIGHT; + end if; + end MAX; + + function MIN (LEFT, RIGHT: INTEGER) return INTEGER is + begin + if LEFT < RIGHT then return LEFT; + else return RIGHT; + end if; + end MIN; + + function SIGNED_NUM_BITS (ARG: INTEGER) return NATURAL is + variable NBITS: NATURAL; + variable N: NATURAL; + begin + if ARG >= 0 then + N := ARG; + else + N := -(ARG+1); + end if; + NBITS := 1; + while N > 0 loop + NBITS := NBITS+1; + N := N / 2; + end loop; + return NBITS; + end SIGNED_NUM_BITS; + + function UNSIGNED_NUM_BITS (ARG: NATURAL) return NATURAL is + variable NBITS: NATURAL; + variable N: NATURAL; + begin + N := ARG; + NBITS := 1; + while N > 1 loop + NBITS := NBITS+1; + N := N / 2; + end loop; + return NBITS; + end UNSIGNED_NUM_BITS; + + ------------------------------------------------------------------------ + + -- this internal function computes the addition of two UNSIGNED + -- with input CARRY + -- * the two arguments are of the same length + + function ADD_UNSIGNED (L, R: UNSIGNED; C: STD_LOGIC) return UNSIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + alias XR: UNSIGNED(L_LEFT downto 0) is R; + variable RESULT: UNSIGNED(L_LEFT downto 0); + variable CBIT: STD_LOGIC := C; + begin + for I in 0 to L_LEFT loop + RESULT(I) := CBIT xor XL(I) xor XR(I); + CBIT := (CBIT and XL(I)) or (CBIT and XR(I)) or (XL(I) and XR(I)); + end loop; + return RESULT; + end ADD_UNSIGNED; + + -- this internal function computes the addition of two SIGNED + -- with input CARRY + -- * the two arguments are of the same length + + function ADD_SIGNED (L, R: SIGNED; C: STD_LOGIC) return SIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + alias XR: SIGNED(L_LEFT downto 0) is R; + variable RESULT: SIGNED(L_LEFT downto 0); + variable CBIT: STD_LOGIC := C; + begin + for I in 0 to L_LEFT loop + RESULT(I) := CBIT xor XL(I) xor XR(I); + CBIT := (CBIT and XL(I)) or (CBIT and XR(I)) or (XL(I) and XR(I)); + end loop; + return RESULT; + end ADD_SIGNED; + + ----------------------------------------------------------------------------- + + -- this internal procedure computes UNSIGNED division + -- giving the quotient and remainder. + procedure DIVMOD (NUM, XDENOM: UNSIGNED; XQUOT, XREMAIN: out UNSIGNED) is + variable TEMP: UNSIGNED(NUM'LENGTH downto 0); + variable QUOT: UNSIGNED(MAX(NUM'LENGTH, XDENOM'LENGTH)-1 downto 0); + alias DENOM: UNSIGNED(XDENOM'LENGTH-1 downto 0) is XDENOM; + variable TOPBIT: INTEGER; + begin + TEMP := "0"&NUM; + QUOT := (others => '0'); + TOPBIT := -1; + for J in DENOM'RANGE loop + if DENOM(J)='1' then + TOPBIT := J; + exit; + end if; + end loop; + assert TOPBIT >= 0 report "DIV, MOD, or REM by zero" severity ERROR; + + for J in NUM'LENGTH-(TOPBIT+1) downto 0 loop + if TEMP(TOPBIT+J+1 downto J) >= "0"&DENOM(TOPBIT downto 0) then + TEMP(TOPBIT+J+1 downto J) := (TEMP(TOPBIT+J+1 downto J)) + -("0"&DENOM(TOPBIT downto 0)); + QUOT(J) := '1'; + end if; + assert TEMP(TOPBIT+J+1)='0' + report "internal error in the division algorithm" + severity ERROR; + end loop; + XQUOT := RESIZE(QUOT, XQUOT'LENGTH); + XREMAIN := RESIZE(TEMP, XREMAIN'LENGTH); + end DIVMOD; + + -----------------Local Subprograms - shift/rotate ops------------------------- + + function XSLL (ARG: STD_LOGIC_VECTOR; COUNT: NATURAL) return STD_LOGIC_VECTOR + is + constant ARG_L: INTEGER := ARG'LENGTH-1; + alias XARG: STD_LOGIC_VECTOR(ARG_L downto 0) is ARG; + variable RESULT: STD_LOGIC_VECTOR(ARG_L downto 0) := (others => '0'); + begin + if COUNT <= ARG_L then + RESULT(ARG_L downto COUNT) := XARG(ARG_L-COUNT downto 0); + end if; + return RESULT; + end XSLL; + + function XSRL (ARG: STD_LOGIC_VECTOR; COUNT: NATURAL) return STD_LOGIC_VECTOR + is + constant ARG_L: INTEGER := ARG'LENGTH-1; + alias XARG: STD_LOGIC_VECTOR(ARG_L downto 0) is ARG; + variable RESULT: STD_LOGIC_VECTOR(ARG_L downto 0) := (others => '0'); + begin + if COUNT <= ARG_L then + RESULT(ARG_L-COUNT downto 0) := XARG(ARG_L downto COUNT); + end if; + return RESULT; + end XSRL; + + function XSRA (ARG: STD_LOGIC_VECTOR; COUNT: NATURAL) return STD_LOGIC_VECTOR + is + constant ARG_L: INTEGER := ARG'LENGTH-1; + alias XARG: STD_LOGIC_VECTOR(ARG_L downto 0) is ARG; + variable RESULT: STD_LOGIC_VECTOR(ARG_L downto 0); + variable XCOUNT: NATURAL := COUNT; + begin + if ((ARG'LENGTH <= 1) or (XCOUNT = 0)) then return ARG; + else + if (XCOUNT > ARG_L) then XCOUNT := ARG_L; + end if; + RESULT(ARG_L-XCOUNT downto 0) := XARG(ARG_L downto XCOUNT); + RESULT(ARG_L downto (ARG_L - XCOUNT + 1)) := (others => XARG(ARG_L)); + end if; + return RESULT; + end XSRA; + + function XROL (ARG: STD_LOGIC_VECTOR; COUNT: NATURAL) return STD_LOGIC_VECTOR + is + constant ARG_L: INTEGER := ARG'LENGTH-1; + alias XARG: STD_LOGIC_VECTOR(ARG_L downto 0) is ARG; + variable RESULT: STD_LOGIC_VECTOR(ARG_L downto 0) := XARG; + variable COUNTM: INTEGER; + begin + COUNTM := COUNT mod (ARG_L + 1); + if COUNTM /= 0 then + RESULT(ARG_L downto COUNTM) := XARG(ARG_L-COUNTM downto 0); + RESULT(COUNTM-1 downto 0) := XARG(ARG_L downto ARG_L-COUNTM+1); + end if; + return RESULT; + end XROL; + + function XROR (ARG: STD_LOGIC_VECTOR; COUNT: NATURAL) return STD_LOGIC_VECTOR + is + constant ARG_L: INTEGER := ARG'LENGTH-1; + alias XARG: STD_LOGIC_VECTOR(ARG_L downto 0) is ARG; + variable RESULT: STD_LOGIC_VECTOR(ARG_L downto 0) := XARG; + variable COUNTM: INTEGER; + begin + COUNTM := COUNT mod (ARG_L + 1); + if COUNTM /= 0 then + RESULT(ARG_L-COUNTM downto 0) := XARG(ARG_L downto COUNTM); + RESULT(ARG_L downto ARG_L-COUNTM+1) := XARG(COUNTM-1 downto 0); + end if; + return RESULT; + end XROR; + + -----------------Local Subprograms - Relational ops--------------------------- + + -- + -- General "=" for UNSIGNED vectors, same length + -- + function UNSIGNED_EQUAL (L, R: UNSIGNED) return BOOLEAN is + begin + return STD_LOGIC_VECTOR(L) = STD_LOGIC_VECTOR(R); + end UNSIGNED_EQUAL; + + -- + -- General "=" for SIGNED vectors, same length + -- + function SIGNED_EQUAL (L, R: SIGNED) return BOOLEAN is + begin + return STD_LOGIC_VECTOR(L) = STD_LOGIC_VECTOR(R); + end SIGNED_EQUAL; + + -- + -- General "<" for UNSIGNED vectors, same length + -- + function UNSIGNED_LESS (L, R: UNSIGNED) return BOOLEAN is + begin + return STD_LOGIC_VECTOR(L) < STD_LOGIC_VECTOR(R); + end UNSIGNED_LESS; + + -- + -- General "<" function for SIGNED vectors, same length + -- + function SIGNED_LESS (L, R: SIGNED) return BOOLEAN is + variable INTERN_L: SIGNED(0 to L'LENGTH-1); + variable INTERN_R: SIGNED(0 to R'LENGTH-1); + begin + INTERN_L := L; + INTERN_R := R; + INTERN_L(0) := not INTERN_L(0); + INTERN_R(0) := not INTERN_R(0); + return STD_LOGIC_VECTOR(INTERN_L) < STD_LOGIC_VECTOR(INTERN_R); + end SIGNED_LESS; + + -- + -- General "<=" function for UNSIGNED vectors, same length + -- + function UNSIGNED_LESS_OR_EQUAL (L, R: UNSIGNED) return BOOLEAN is + begin + return STD_LOGIC_VECTOR(L) <= STD_LOGIC_VECTOR(R); + end UNSIGNED_LESS_OR_EQUAL; + + -- + -- General "<=" function for SIGNED vectors, same length + -- + function SIGNED_LESS_OR_EQUAL (L, R: SIGNED) return BOOLEAN is + -- Need aliases to assure index direction + variable INTERN_L: SIGNED(0 to L'LENGTH-1); + variable INTERN_R: SIGNED(0 to R'LENGTH-1); + begin + INTERN_L := L; + INTERN_R := R; + INTERN_L(0) := not INTERN_L(0); + INTERN_R(0) := not INTERN_R(0); + return STD_LOGIC_VECTOR(INTERN_L) <= STD_LOGIC_VECTOR(INTERN_R); + end SIGNED_LESS_OR_EQUAL; + + --=========================Exported Functions ========================== + + -- Id: A.1 + function "abs" (ARG: SIGNED) return SIGNED is + constant ARG_LEFT: INTEGER := ARG'LENGTH-1; + alias XARG: SIGNED(ARG_LEFT downto 0) is ARG; + variable RESULT: SIGNED(ARG_LEFT downto 0); + begin + if ARG'LENGTH < 1 then return NAS; + end if; + RESULT := TO_01(XARG, 'X'); + if (RESULT(RESULT'LEFT)='X') then return RESULT; + end if; + if RESULT(RESULT'LEFT) = '1' then + RESULT := -RESULT; + end if; + return RESULT; + end "abs"; + + -- Id: A.2 + function "-" (ARG: SIGNED) return SIGNED is + constant ARG_LEFT: INTEGER := ARG'LENGTH-1; + alias XARG: SIGNED(ARG_LEFT downto 0) is ARG; + variable RESULT, XARG01 : SIGNED(ARG_LEFT downto 0); + variable CBIT: STD_LOGIC := '1'; + begin + if ARG'LENGTH < 1 then return NAS; + end if; + XARG01 := TO_01(ARG, 'X'); + if (XARG01(XARG01'LEFT)='X') then return XARG01; + end if; + for I in 0 to RESULT'LEFT loop + RESULT(I) := not(XARG01(I)) xor CBIT; + CBIT := CBIT and not(XARG01(I)); + end loop; + return RESULT; + end "-"; + + --============================================================================ + + -- Id: A.3 + function "+" (L, R: UNSIGNED) return UNSIGNED is + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : UNSIGNED(SIZE-1 downto 0); + variable R01 : UNSIGNED(SIZE-1 downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + L01 := TO_01(RESIZE(L, SIZE), 'X'); + if (L01(L01'LEFT)='X') then return L01; + end if; + R01 := TO_01(RESIZE(R, SIZE), 'X'); + if (R01(R01'LEFT)='X') then return R01; + end if; + return ADD_UNSIGNED(L01, R01, '0'); + end "+"; + + -- Id: A.4 + function "+" (L, R: SIGNED) return SIGNED is + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : SIGNED(SIZE-1 downto 0); + variable R01 : SIGNED(SIZE-1 downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS; + end if; + L01 := TO_01(RESIZE(L, SIZE), 'X'); + if (L01(L01'LEFT)='X') then return L01; + end if; + R01 := TO_01(RESIZE(R, SIZE), 'X'); + if (R01(R01'LEFT)='X') then return R01; + end if; + return ADD_SIGNED(L01, R01, '0'); + end "+"; + + -- Id: A.5 + function "+" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + begin + return L + TO_UNSIGNED(R, L'LENGTH); + end "+"; + + -- Id: A.6 + function "+" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + begin + return TO_UNSIGNED(L, R'LENGTH) + R; + end "+"; + + -- Id: A.7 + function "+" (L: SIGNED; R: INTEGER) return SIGNED is + begin + return L + TO_SIGNED(R, L'LENGTH); + end "+"; + + -- Id: A.8 + function "+" (L: INTEGER; R: SIGNED) return SIGNED is + begin + return TO_SIGNED(L, R'LENGTH) + R; + end "+"; + + --============================================================================ + + -- Id: A.9 + function "-" (L, R: UNSIGNED) return UNSIGNED is + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : UNSIGNED(SIZE-1 downto 0); + variable R01 : UNSIGNED(SIZE-1 downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + L01 := TO_01(RESIZE(L, SIZE), 'X'); + if (L01(L01'LEFT)='X') then return L01; + end if; + R01 := TO_01(RESIZE(R, SIZE), 'X'); + if (R01(R01'LEFT)='X') then return R01; + end if; + return ADD_UNSIGNED(L01, not(R01), '1'); + end "-"; + + -- Id: A.10 + function "-" (L, R: SIGNED) return SIGNED is + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : SIGNED(SIZE-1 downto 0); + variable R01 : SIGNED(SIZE-1 downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS; + end if; + L01 := TO_01(RESIZE(L, SIZE), 'X'); + if (L01(L01'LEFT)='X') then return L01; + end if; + R01 := TO_01(RESIZE(R, SIZE), 'X'); + if (R01(R01'LEFT)='X') then return R01; + end if; + return ADD_SIGNED(L01, not(R01), '1'); + end "-"; + + -- Id: A.11 + function "-" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + begin + return L - TO_UNSIGNED(R, L'LENGTH); + end "-"; + + -- Id: A.12 + function "-" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + begin + return TO_UNSIGNED(L, R'LENGTH) - R; + end "-"; + + -- Id: A.13 + function "-" (L: SIGNED; R: INTEGER) return SIGNED is + begin + return L - TO_SIGNED(R, L'LENGTH); + end "-"; + + -- Id: A.14 + function "-" (L: INTEGER; R: SIGNED) return SIGNED is + begin + return TO_SIGNED(L, R'LENGTH) - R; + end "-"; + + --============================================================================ + + -- Id: A.15 + function "*" (L, R: UNSIGNED) return UNSIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XXL: UNSIGNED(L_LEFT downto 0) is L; + alias XXR: UNSIGNED(R_LEFT downto 0) is R; + variable XL: UNSIGNED(L_LEFT downto 0); + variable XR: UNSIGNED(R_LEFT downto 0); + variable RESULT: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0) := + (others => '0'); + variable ADVAL: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + XL := TO_01(XXL, 'X'); + XR := TO_01(XXR, 'X'); + if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then + RESULT := (others => 'X'); + return RESULT; + end if; + ADVAL := RESIZE(XR, RESULT'LENGTH); + for I in 0 to L_LEFT loop + if XL(I)='1' then RESULT := RESULT + ADVAL; + end if; + ADVAL := SHIFT_LEFT(ADVAL, 1); + end loop; + return RESULT; + end "*"; + + -- Id: A.16 + function "*" (L, R: SIGNED) return SIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + variable XL: SIGNED(L_LEFT downto 0); + variable XR: SIGNED(R_LEFT downto 0); + variable RESULT: SIGNED((L_LEFT+R_LEFT+1) downto 0) := (others => '0'); + variable ADVAL: SIGNED((L_LEFT+R_LEFT+1) downto 0); + begin + if ((L_LEFT < 0) or (R_LEFT < 0)) then return NAS; + end if; + XL := TO_01(L, 'X'); + XR := TO_01(R, 'X'); + if ((XL(L_LEFT)='X') or (XR(R_LEFT)='X')) then + RESULT := (others => 'X'); + return RESULT; + end if; + ADVAL := RESIZE(XR, RESULT'LENGTH); + for I in 0 to L_LEFT-1 loop + if XL(I)='1' then RESULT := RESULT + ADVAL; + end if; + ADVAL := SHIFT_LEFT(ADVAL, 1); + end loop; + if XL(L_LEFT)='1' then + RESULT := RESULT - ADVAL; + end if; + return RESULT; + end "*"; + + -- Id: A.17 + function "*" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + begin + return L * TO_UNSIGNED(R, L'LENGTH); + end "*"; + + -- Id: A.18 + function "*" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + begin + return TO_UNSIGNED(L, R'LENGTH) * R; + end "*"; + + -- Id: A.19 + function "*" (L: SIGNED; R: INTEGER) return SIGNED is + begin + return L * TO_SIGNED(R, L'LENGTH); + end "*"; + + -- Id: A.20 + function "*" (L: INTEGER; R: SIGNED) return SIGNED is + begin + return TO_SIGNED(L, R'LENGTH) * R; + end "*"; + + --============================================================================ + + -- Id: A.21 + function "/" (L, R: UNSIGNED) return UNSIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XXL: UNSIGNED(L_LEFT downto 0) is L; + alias XXR: UNSIGNED(R_LEFT downto 0) is R; + variable XL: UNSIGNED(L_LEFT downto 0); + variable XR: UNSIGNED(R_LEFT downto 0); + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + XL := TO_01(XXL, 'X'); + XR := TO_01(XXR, 'X'); + if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then + FQUOT := (others => 'X'); + return FQUOT; + end if; + DIVMOD(XL, XR, FQUOT, FREMAIN); + return FQUOT; + end "/"; + + -- Id: A.22 + function "/" (L, R: SIGNED) return SIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XXL: SIGNED(L_LEFT downto 0) is L; + alias XXR: SIGNED(R_LEFT downto 0) is R; + variable XL: SIGNED(L_LEFT downto 0); + variable XR: SIGNED(R_LEFT downto 0); + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + variable XNUM: UNSIGNED(L'LENGTH-1 downto 0); + variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0); + variable QNEG: BOOLEAN := FALSE; + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS; + end if; + XL := TO_01(XXL, 'X'); + XR := TO_01(XXR, 'X'); + if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then + FQUOT := (others => 'X'); + return SIGNED(FQUOT); + end if; + if XL(XL'LEFT)='1' then + XNUM := UNSIGNED(-XL); + QNEG := TRUE; + else + XNUM := UNSIGNED(XL); + end if; + if XR(XR'LEFT)='1' then + XDENOM := UNSIGNED(-XR); + QNEG := not QNEG; + else + XDENOM := UNSIGNED(XR); + end if; + DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN); + if QNEG then FQUOT := "0"-FQUOT; + end if; + return SIGNED(FQUOT); + end "/"; + + -- Id: A.23 + function "/" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R)); + variable XR, QUOT: UNSIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAU; + end if; + if (R_LENGTH > L'LENGTH) then + QUOT := (others => '0'); + return RESIZE(QUOT, L'LENGTH); + end if; + XR := TO_UNSIGNED(R, R_LENGTH); + QUOT := RESIZE((L / XR), QUOT'LENGTH); + return RESIZE(QUOT, L'LENGTH); + end "/"; + + -- Id: A.24 + function "/" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH); + variable XL, QUOT: UNSIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAU; + end if; + XL := TO_UNSIGNED(L, L_LENGTH); + QUOT := RESIZE((XL / R), QUOT'LENGTH); + if L_LENGTH > R'LENGTH and QUOT(0)/='X' + and QUOT(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => '0') + then + assert NO_WARNING report "NUMERIC_STD.""/"": Quotient Truncated" + severity WARNING; + end if; + return RESIZE(QUOT, R'LENGTH); + end "/"; + + -- Id: A.25 + function "/" (L: SIGNED; R: INTEGER) return SIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R)); + variable XR, QUOT: SIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAS; + end if; + if (R_LENGTH > L'LENGTH) then + QUOT := (others => '0'); + return RESIZE(QUOT, L'LENGTH); + end if; + XR := TO_SIGNED(R, R_LENGTH); + QUOT := RESIZE((L / XR), QUOT'LENGTH); + return RESIZE(QUOT, L'LENGTH); + end "/"; + + -- Id: A.26 + function "/" (L: INTEGER; R: SIGNED) return SIGNED is + constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH); + variable XL, QUOT: SIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAS; + end if; + XL := TO_SIGNED(L, L_LENGTH); + QUOT := RESIZE((XL / R), QUOT'LENGTH); + if L_LENGTH > R'LENGTH and QUOT(0)/='X' + and QUOT(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => QUOT(R'LENGTH-1)) + then + assert NO_WARNING report "NUMERIC_STD.""/"": Quotient Truncated" + severity WARNING; + end if; + return RESIZE(QUOT, R'LENGTH); + end "/"; + + --============================================================================ + + -- Id: A.27 + function "rem" (L, R: UNSIGNED) return UNSIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XXL: UNSIGNED(L_LEFT downto 0) is L; + alias XXR: UNSIGNED(R_LEFT downto 0) is R; + variable XL: UNSIGNED(L_LEFT downto 0); + variable XR: UNSIGNED(R_LEFT downto 0); + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + XL := TO_01(XXL, 'X'); + XR := TO_01(XXR, 'X'); + if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then + FREMAIN := (others => 'X'); + return FREMAIN; + end if; + DIVMOD(XL, XR, FQUOT, FREMAIN); + return FREMAIN; + end "rem"; + + -- Id: A.28 + function "rem" (L, R: SIGNED) return SIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XXL: SIGNED(L_LEFT downto 0) is L; + alias XXR: SIGNED(R_LEFT downto 0) is R; + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + variable XNUM: UNSIGNED(L'LENGTH-1 downto 0); + variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0); + variable RNEG: BOOLEAN := FALSE; + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS; + end if; + XNUM := UNSIGNED(TO_01(XXL, 'X')); + XDENOM := UNSIGNED(TO_01(XXR, 'X')); + if ((XNUM(XNUM'LEFT)='X') or (XDENOM(XDENOM'LEFT)='X')) then + FREMAIN := (others => 'X'); + return SIGNED(FREMAIN); + end if; + if XNUM(XNUM'LEFT)='1' then + XNUM := UNSIGNED(-SIGNED(XNUM)); + RNEG := TRUE; + else + XNUM := UNSIGNED(XNUM); + end if; + if XDENOM(XDENOM'LEFT)='1' then + XDENOM := UNSIGNED(-SIGNED(XDENOM)); + else + XDENOM := UNSIGNED(XDENOM); + end if; + DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN); + if RNEG then + FREMAIN := "0"-FREMAIN; + end if; + return SIGNED(FREMAIN); + end "rem"; + + -- Id: A.29 + function "rem" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R)); + variable XR, XREM: UNSIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAU; + end if; + XR := TO_UNSIGNED(R, R_LENGTH); + XREM := L rem XR; + if R_LENGTH > L'LENGTH and XREM(0)/='X' + and XREM(R_LENGTH-1 downto L'LENGTH) + /= (R_LENGTH-1 downto L'LENGTH => '0') + then + assert NO_WARNING report "NUMERIC_STD.""rem"": Remainder Truncated" + severity WARNING; + end if; + return RESIZE(XREM, L'LENGTH); + end "rem"; + + -- Id: A.30 + function "rem" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH); + variable XL, XREM: UNSIGNED(L_LENGTH-1 downto 0); + begin + XL := TO_UNSIGNED(L, L_LENGTH); + XREM := XL rem R; + if L_LENGTH > R'LENGTH and XREM(0)/='X' + and XREM(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => '0') + then + assert NO_WARNING report "NUMERIC_STD.""rem"": Remainder Truncated" + severity WARNING; + end if; + return RESIZE(XREM, R'LENGTH); + end "rem"; + + -- Id: A.31 + function "rem" (L: SIGNED; R: INTEGER) return SIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R)); + variable XR, XREM: SIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAS; + end if; + XR := TO_SIGNED(R, R_LENGTH); + XREM := RESIZE((L rem XR), XREM'LENGTH); + if R_LENGTH > L'LENGTH and XREM(0)/='X' + and XREM(R_LENGTH-1 downto L'LENGTH) + /= (R_LENGTH-1 downto L'LENGTH => XREM(L'LENGTH-1)) + then + assert NO_WARNING report "NUMERIC_STD.""rem"": Remainder Truncated" + severity WARNING; + end if; + return RESIZE(XREM, L'LENGTH); + end "rem"; + + -- Id: A.32 + function "rem" (L: INTEGER; R: SIGNED) return SIGNED is + constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH); + variable XL, XREM: SIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAS; + end if; + XL := TO_SIGNED(L, L_LENGTH); + XREM := RESIZE((XL rem R), XREM'LENGTH); + if L_LENGTH > R'LENGTH and XREM(0)/='X' + and XREM(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => XREM(R'LENGTH-1)) + then + assert NO_WARNING report "NUMERIC_STD.""rem"": Remainder Truncated" + severity WARNING; + end if; + return RESIZE(XREM, R'LENGTH); + end "rem"; + + --============================================================================ + + -- Id: A.33 + function "mod" (L, R: UNSIGNED) return UNSIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XXL: UNSIGNED(L_LEFT downto 0) is L; + alias XXR: UNSIGNED(R_LEFT downto 0) is R; + variable XL: UNSIGNED(L_LEFT downto 0); + variable XR: UNSIGNED(R_LEFT downto 0); + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAU; + end if; + XL := TO_01(XXL, 'X'); + XR := TO_01(XXR, 'X'); + if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then + FREMAIN := (others => 'X'); + return FREMAIN; + end if; + DIVMOD(XL, XR, FQUOT, FREMAIN); + return FREMAIN; + end "mod"; + + -- Id: A.34 + function "mod" (L, R: SIGNED) return SIGNED is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XXL: SIGNED(L_LEFT downto 0) is L; + alias XXR: SIGNED(R_LEFT downto 0) is R; + variable XL: SIGNED(L_LEFT downto 0); + variable XR: SIGNED(R_LEFT downto 0); + variable FQUOT: UNSIGNED(L'LENGTH-1 downto 0); + variable FREMAIN: UNSIGNED(R'LENGTH-1 downto 0); + variable XNUM: UNSIGNED(L'LENGTH-1 downto 0); + variable XDENOM: UNSIGNED(R'LENGTH-1 downto 0); + variable RNEG: BOOLEAN := FALSE; + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then return NAS; + end if; + XL := TO_01(XXL, 'X'); + XR := TO_01(XXR, 'X'); + if ((XL(XL'LEFT)='X') or (XR(XR'LEFT)='X')) then + FREMAIN := (others => 'X'); + return SIGNED(FREMAIN); + end if; + if XL(XL'LEFT)='1' then + XNUM := UNSIGNED(-XL); + else + XNUM := UNSIGNED(XL); + end if; + if XR(XR'LEFT)='1' then + XDENOM := UNSIGNED(-XR); + RNEG := TRUE; + else + XDENOM := UNSIGNED(XR); + end if; + DIVMOD(XNUM, XDENOM, FQUOT, FREMAIN); + if RNEG and L(L'LEFT)='1' then + FREMAIN := "0"-FREMAIN; + elsif RNEG and FREMAIN/="0" then + FREMAIN := FREMAIN-XDENOM; + elsif L(L'LEFT)='1' and FREMAIN/="0" then + FREMAIN := XDENOM-FREMAIN; + end if; + return SIGNED(FREMAIN); + end "mod"; + + -- Id: A.35 + function "mod" (L: UNSIGNED; R: NATURAL) return UNSIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, UNSIGNED_NUM_BITS(R)); + variable XR, XREM: UNSIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAU; + end if; + XR := TO_UNSIGNED(R, R_LENGTH); + XREM := RESIZE((L mod XR), XREM'LENGTH); + if R_LENGTH > L'LENGTH and XREM(0)/='X' + and XREM(R_LENGTH-1 downto L'LENGTH) + /= (R_LENGTH-1 downto L'LENGTH => '0') + then + assert NO_WARNING report "NUMERIC_STD.""mod"": Modulus Truncated" + severity WARNING; + end if; + return RESIZE(XREM, L'LENGTH); + end "mod"; + + -- Id: A.36 + function "mod" (L: NATURAL; R: UNSIGNED) return UNSIGNED is + constant L_LENGTH: NATURAL := MAX(UNSIGNED_NUM_BITS(L), R'LENGTH); + variable XL, XREM: UNSIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAU; + end if; + XL := TO_UNSIGNED(L, L_LENGTH); + XREM := RESIZE((XL mod R), XREM'LENGTH); + if L_LENGTH > R'LENGTH and XREM(0)/='X' + and XREM(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => '0') + then + assert NO_WARNING report "NUMERIC_STD.""mod"": Modulus Truncated" + severity WARNING; + end if; + return RESIZE(XREM, R'LENGTH); + end "mod"; + + -- Id: A.37 + function "mod" (L: SIGNED; R: INTEGER) return SIGNED is + constant R_LENGTH: NATURAL := MAX(L'LENGTH, SIGNED_NUM_BITS(R)); + variable XR, XREM: SIGNED(R_LENGTH-1 downto 0); + begin + if (L'LENGTH < 1) then return NAS; + end if; + XR := TO_SIGNED(R, R_LENGTH); + XREM := RESIZE((L mod XR), XREM'LENGTH); + if R_LENGTH > L'LENGTH and XREM(0)/='X' + and XREM(R_LENGTH-1 downto L'LENGTH) + /= (R_LENGTH-1 downto L'LENGTH => XREM(L'LENGTH-1)) + then + assert NO_WARNING report "NUMERIC_STD.""mod"": Modulus Truncated" + severity WARNING; + end if; + return RESIZE(XREM, L'LENGTH); + end "mod"; + + -- Id: A.38 + function "mod" (L: INTEGER; R: SIGNED) return SIGNED is + constant L_LENGTH: NATURAL := MAX(SIGNED_NUM_BITS(L), R'LENGTH); + variable XL, XREM: SIGNED(L_LENGTH-1 downto 0); + begin + if (R'LENGTH < 1) then return NAS; + end if; + XL := TO_SIGNED(L, L_LENGTH); + XREM := RESIZE((XL mod R), XREM'LENGTH); + if L_LENGTH > R'LENGTH and XREM(0)/='X' + and XREM(L_LENGTH-1 downto R'LENGTH) + /= (L_LENGTH-1 downto R'LENGTH => XREM(R'LENGTH-1)) + then + assert NO_WARNING report "NUMERIC_STD.""mod"": Modulus Truncated" + severity WARNING; + end if; + return RESIZE(XREM, R'LENGTH); + end "mod"; + + --============================================================================ + + -- Id: C.1 + function ">" (L, R: UNSIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : UNSIGNED(L_LEFT downto 0); + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD."">"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return not UNSIGNED_LESS_OR_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE)); + end ">"; + + -- Id: C.2 + function ">" (L, R: SIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + alias XR: SIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : SIGNED(L_LEFT downto 0); + variable R01 : SIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD."">"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return not SIGNED_LESS_OR_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE)); + end ">"; + + -- Id: C.3 + function ">" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD."">"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return TRUE; + end if; + return not UNSIGNED_LESS_OR_EQUAL(TO_UNSIGNED(L, R01'LENGTH), R01); + end ">"; + + -- Id: C.4 + function ">" (L: INTEGER; R: SIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: SIGNED(R_LEFT downto 0) is R; + variable R01 : SIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD."">"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return L > 0; + end if; + return not SIGNED_LESS_OR_EQUAL(TO_SIGNED(L, R01'LENGTH), R01); + end ">"; + + -- Id: C.5 + function ">" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + variable L01 : UNSIGNED(L_LEFT downto 0); + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD."">"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return FALSE; + end if; + return not UNSIGNED_LESS_OR_EQUAL(L01, TO_UNSIGNED(R, L01'LENGTH)); + end ">"; + + -- Id: C.6 + function ">" (L: SIGNED; R: INTEGER) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + variable L01 : SIGNED(L_LEFT downto 0); + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD."">"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD."">"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R; + end if; + return not SIGNED_LESS_OR_EQUAL(L01, TO_SIGNED(R, L01'LENGTH)); + end ">"; + + --============================================================================ + + -- Id: C.7 + function "<" (L, R: UNSIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : UNSIGNED(L_LEFT downto 0); + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD.""<"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return UNSIGNED_LESS(RESIZE(L01, SIZE), RESIZE(R01, SIZE)); + end "<"; + + -- Id: C.8 + function "<" (L, R: SIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + alias XR: SIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : SIGNED(L_LEFT downto 0); + variable R01 : SIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD.""<"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return SIGNED_LESS(RESIZE(L01, SIZE), RESIZE(R01, SIZE)); + end "<"; + + -- Id: C.9 + function "<" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""<"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L < 0; + end if; + return UNSIGNED_LESS(TO_UNSIGNED(L, R01'LENGTH), R01); + end "<"; + + -- Id: C.10 + function "<" (L: INTEGER; R: SIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: SIGNED(R_LEFT downto 0) is R; + variable R01 : SIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""<"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return L < 0; + end if; + return SIGNED_LESS(TO_SIGNED(L, R01'LENGTH), R01); + end "<"; + + -- Id: C.11 + function "<" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + variable L01 : UNSIGNED(L_LEFT downto 0); + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""<"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R; + end if; + return UNSIGNED_LESS(L01, TO_UNSIGNED(R, L01'LENGTH)); + end "<"; + + -- Id: C.12 + function "<" (L: SIGNED; R: INTEGER) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + variable L01 : SIGNED(L_LEFT downto 0); + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""<"": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""<"": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R; + end if; + return SIGNED_LESS(L01, TO_SIGNED(R, L01'LENGTH)); + end "<"; + + --============================================================================ + + -- Id: C.13 + function "<=" (L, R: UNSIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : UNSIGNED(L_LEFT downto 0); + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD.""<="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return UNSIGNED_LESS_OR_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE)); + end "<="; + + -- Id: C.14 + function "<=" (L, R: SIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + alias XR: SIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : SIGNED(L_LEFT downto 0); + variable R01 : SIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD.""<="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return SIGNED_LESS_OR_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE)); + end "<="; + + -- Id: C.15 + function "<=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""<="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L < 0; + end if; + return UNSIGNED_LESS_OR_EQUAL(TO_UNSIGNED(L, R01'LENGTH), R01); + end "<="; + + -- Id: C.16 + function "<=" (L: INTEGER; R: SIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: SIGNED(R_LEFT downto 0) is R; + variable R01 : SIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""<="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return L < 0; + end if; + return SIGNED_LESS_OR_EQUAL(TO_SIGNED(L, R01'LENGTH), R01); + end "<="; + + -- Id: C.17 + function "<=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + variable L01 : UNSIGNED(L_LEFT downto 0); + begin + if (L_LEFT < 0) then + assert NO_WARNING + report "NUMERIC_STD.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""<="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R; + end if; + return UNSIGNED_LESS_OR_EQUAL(L01, TO_UNSIGNED(R, L01'LENGTH)); + end "<="; + + -- Id: C.18 + function "<=" (L: SIGNED; R: INTEGER) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + variable L01 : SIGNED(L_LEFT downto 0); + begin + if (L_LEFT < 0) then + assert NO_WARNING + report "NUMERIC_STD.""<="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""<="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 < R; + end if; + return SIGNED_LESS_OR_EQUAL(L01, TO_SIGNED(R, L01'LENGTH)); + end "<="; + + --============================================================================ + + -- Id: C.19 + function ">=" (L, R: UNSIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : UNSIGNED(L_LEFT downto 0); + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD."">="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return not UNSIGNED_LESS(RESIZE(L01, SIZE), RESIZE(R01, SIZE)); + end ">="; + + -- Id: C.20 + function ">=" (L, R: SIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + alias XR: SIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : SIGNED(L_LEFT downto 0); + variable R01 : SIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD."">="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return not SIGNED_LESS(RESIZE(L01, SIZE), RESIZE(R01, SIZE)); + end ">="; + + -- Id: C.21 + function ">=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD."">="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return L > 0; + end if; + return not UNSIGNED_LESS(TO_UNSIGNED(L, R01'LENGTH), R01); + end ">="; + + -- Id: C.22 + function ">=" (L: INTEGER; R: SIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: SIGNED(R_LEFT downto 0) is R; + variable R01 : SIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD."">="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return L > 0; + end if; + return not SIGNED_LESS(TO_SIGNED(L, R01'LENGTH), R01); + end ">="; + + -- Id: C.23 + function ">=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + variable L01 : UNSIGNED(L_LEFT downto 0); + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD."">="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R; + end if; + return not UNSIGNED_LESS(L01, TO_UNSIGNED(R, L01'LENGTH)); + end ">="; + + -- Id: C.24 + function ">=" (L: SIGNED; R: INTEGER) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + variable L01 : SIGNED(L_LEFT downto 0); + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD."">="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD."">="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return 0 > R; + end if; + return not SIGNED_LESS(L01, TO_SIGNED(R, L01'LENGTH)); + end ">="; + + --============================================================================ + + -- Id: C.25 + function "=" (L, R: UNSIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : UNSIGNED(L_LEFT downto 0); + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD.""="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return UNSIGNED_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE)); + end "="; + + -- Id: C.26 + function "=" (L, R: SIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + alias XR: SIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : SIGNED(L_LEFT downto 0); + variable R01 : SIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD.""="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + return SIGNED_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE)); + end "="; + + -- Id: C.27 + function "=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return FALSE; + end if; + return UNSIGNED_EQUAL(TO_UNSIGNED(L, R01'LENGTH), R01); + end "="; + + -- Id: C.28 + function "=" (L: INTEGER; R: SIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: SIGNED(R_LEFT downto 0) is R; + variable R01 : SIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return FALSE; + end if; + return SIGNED_EQUAL(TO_SIGNED(L, R01'LENGTH), R01); + end "="; + + -- Id: C.29 + function "=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + variable L01 : UNSIGNED(L_LEFT downto 0); + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return FALSE; + end if; + return UNSIGNED_EQUAL(L01, TO_UNSIGNED(R, L01'LENGTH)); + end "="; + + -- Id: C.30 + function "=" (L: SIGNED; R: INTEGER) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + variable L01 : SIGNED(L_LEFT downto 0); + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""="": null argument detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""="": metavalue detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return FALSE; + end if; + return SIGNED_EQUAL(L01, TO_SIGNED(R, L01'LENGTH)); + end "="; + + --============================================================================ + + -- Id: C.31 + function "/=" (L, R: UNSIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : UNSIGNED(L_LEFT downto 0); + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD.""/="": metavalue detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + return not(UNSIGNED_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE))); + end "/="; + + -- Id: C.32 + function "/=" (L, R: SIGNED) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + alias XR: SIGNED(R_LEFT downto 0) is R; + constant SIZE: NATURAL := MAX(L'LENGTH, R'LENGTH); + variable L01 : SIGNED(L_LEFT downto 0); + variable R01 : SIGNED(R_LEFT downto 0); + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + L01 := TO_01(XL, 'X'); + R01 := TO_01(XR, 'X'); + if ((L01(L01'LEFT)='X') or (R01(R01'LEFT)='X')) then + assert NO_WARNING + report "NUMERIC_STD.""/="": metavalue detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + return not(SIGNED_EQUAL(RESIZE(L01, SIZE), RESIZE(R01, SIZE))); + end "/="; + + -- Id: C.33 + function "/=" (L: NATURAL; R: UNSIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: UNSIGNED(R_LEFT downto 0) is R; + variable R01 : UNSIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""/="": metavalue detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + if UNSIGNED_NUM_BITS(L) > R'LENGTH then return TRUE; + end if; + return not(UNSIGNED_EQUAL(TO_UNSIGNED(L, R01'LENGTH), R01)); + end "/="; + + -- Id: C.34 + function "/=" (L: INTEGER; R: SIGNED) return BOOLEAN is + constant R_LEFT: INTEGER := R'LENGTH-1; + alias XR: SIGNED(R_LEFT downto 0) is R; + variable R01 : SIGNED(R_LEFT downto 0); + begin + if (R'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + R01 := TO_01(XR, 'X'); + if (R01(R01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""/="": metavalue detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + if SIGNED_NUM_BITS(L) > R'LENGTH then return TRUE; + end if; + return not(SIGNED_EQUAL(TO_SIGNED(L, R01'LENGTH), R01)); + end "/="; + + -- Id: C.35 + function "/=" (L: UNSIGNED; R: NATURAL) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: UNSIGNED(L_LEFT downto 0) is L; + variable L01 : UNSIGNED(L_LEFT downto 0); + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""/="": metavalue detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + if UNSIGNED_NUM_BITS(R) > L'LENGTH then return TRUE; + end if; + return not(UNSIGNED_EQUAL(L01, TO_UNSIGNED(R, L01'LENGTH))); + end "/="; + + -- Id: C.36 + function "/=" (L: SIGNED; R: INTEGER) return BOOLEAN is + constant L_LEFT: INTEGER := L'LENGTH-1; + alias XL: SIGNED(L_LEFT downto 0) is L; + variable L01 : SIGNED(L_LEFT downto 0); + begin + if (L'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.""/="": null argument detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + L01 := TO_01(XL, 'X'); + if (L01(L01'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.""/="": metavalue detected, returning TRUE" + severity WARNING; + return TRUE; + end if; + if SIGNED_NUM_BITS(R) > L'LENGTH then return TRUE; + end if; + return not(SIGNED_EQUAL(L01, TO_SIGNED(R, L01'LENGTH))); + end "/="; + + --============================================================================ + + -- Id: S.1 + function SHIFT_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is + begin + if (ARG'LENGTH < 1) then return NAU; + end if; + return UNSIGNED(XSLL(STD_LOGIC_VECTOR(ARG), COUNT)); + end SHIFT_LEFT; + + -- Id: S.2 + function SHIFT_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is + begin + if (ARG'LENGTH < 1) then return NAU; + end if; + return UNSIGNED(XSRL(STD_LOGIC_VECTOR(ARG), COUNT)); + end SHIFT_RIGHT; + + -- Id: S.3 + function SHIFT_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is + begin + if (ARG'LENGTH < 1) then return NAS; + end if; + return SIGNED(XSLL(STD_LOGIC_VECTOR(ARG), COUNT)); + end SHIFT_LEFT; + + -- Id: S.4 + function SHIFT_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is + begin + if (ARG'LENGTH < 1) then return NAS; + end if; + return SIGNED(XSRA(STD_LOGIC_VECTOR(ARG), COUNT)); + end SHIFT_RIGHT; + + --============================================================================ + + -- Id: S.5 + function ROTATE_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is + begin + if (ARG'LENGTH < 1) then return NAU; + end if; + return UNSIGNED(XROL(STD_LOGIC_VECTOR(ARG), COUNT)); + end ROTATE_LEFT; + + -- Id: S.6 + function ROTATE_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED is + begin + if (ARG'LENGTH < 1) then return NAU; + end if; + return UNSIGNED(XROR(STD_LOGIC_VECTOR(ARG), COUNT)); + end ROTATE_RIGHT; + + + -- Id: S.7 + function ROTATE_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is + begin + if (ARG'LENGTH < 1) then return NAS; + end if; + return SIGNED(XROL(STD_LOGIC_VECTOR(ARG), COUNT)); + end ROTATE_LEFT; + + -- Id: S.8 + function ROTATE_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED is + begin + if (ARG'LENGTH < 1) then return NAS; + end if; + return SIGNED(XROR(STD_LOGIC_VECTOR(ARG), COUNT)); + end ROTATE_RIGHT; + + --============================================================================ +--START-V93 + + ------------------------------------------------------------------------------ + -- Note : Function S.9 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.9 + function "sll" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is + begin + if (COUNT >= 0) then + return SHIFT_LEFT(ARG, COUNT); + else + return SHIFT_RIGHT(ARG, -COUNT); + end if; + end "sll"; + + ------------------------------------------------------------------------------ + -- Note : Function S.10 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.10 + function "sll" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is + begin + if (COUNT >= 0) then + return SHIFT_LEFT(ARG, COUNT); + else + return SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), -COUNT)); + end if; + end "sll"; + + ------------------------------------------------------------------------------ + -- Note : Function S.11 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.11 + function "srl" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is + begin + if (COUNT >= 0) then + return SHIFT_RIGHT(ARG, COUNT); + else + return SHIFT_LEFT(ARG, -COUNT); + end if; + end "srl"; + + ------------------------------------------------------------------------------ + -- Note : Function S.12 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.12 + function "srl" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is + begin + if (COUNT >= 0) then + return SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), COUNT)); + else + return SHIFT_LEFT(ARG, -COUNT); + end if; + end "srl"; + + ------------------------------------------------------------------------------ + -- Note : Function S.13 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.13 + function "rol" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is + begin + if (COUNT >= 0) then + return ROTATE_LEFT(ARG, COUNT); + else + return ROTATE_RIGHT(ARG, -COUNT); + end if; + end "rol"; + + ------------------------------------------------------------------------------ + -- Note : Function S.14 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.14 + function "rol" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is + begin + if (COUNT >= 0) then + return ROTATE_LEFT(ARG, COUNT); + else + return ROTATE_RIGHT(ARG, -COUNT); + end if; + end "rol"; + + ------------------------------------------------------------------------------ + -- Note : Function S.15 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.15 + function "ror" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED is + begin + if (COUNT >= 0) then + return ROTATE_RIGHT(ARG, COUNT); + else + return ROTATE_LEFT(ARG, -COUNT); + end if; + end "ror"; + + ------------------------------------------------------------------------------ + -- Note : Function S.16 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.16 + function "ror" (ARG: SIGNED; COUNT: INTEGER) return SIGNED is + begin + if (COUNT >= 0) then + return ROTATE_RIGHT(ARG, COUNT); + else + return ROTATE_LEFT(ARG, -COUNT); + end if; + end "ror"; + +--END-V93 + --============================================================================ + + -- Id: D.1 + function TO_INTEGER (ARG: UNSIGNED) return NATURAL is + constant ARG_LEFT: INTEGER := ARG'LENGTH-1; + alias XXARG: UNSIGNED(ARG_LEFT downto 0) is ARG; + variable XARG: UNSIGNED(ARG_LEFT downto 0); + variable RESULT: NATURAL := 0; + begin + if (ARG'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.TO_INTEGER: null detected, returning 0" + severity WARNING; + return 0; + end if; + XARG := TO_01(XXARG, 'X'); + if (XARG(XARG'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.TO_INTEGER: metavalue detected, returning 0" + severity WARNING; + return 0; + end if; + for I in XARG'RANGE loop + RESULT := RESULT+RESULT; + if XARG(I) = '1' then + RESULT := RESULT + 1; + end if; + end loop; + return RESULT; + end TO_INTEGER; + + -- Id: D.2 + function TO_INTEGER (ARG: SIGNED) return INTEGER is + variable XARG: SIGNED(ARG'LENGTH-1 downto 0); + begin + if (ARG'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.TO_INTEGER: null detected, returning 0" + severity WARNING; + return 0; + end if; + XARG := TO_01(ARG, 'X'); + if (XARG(XARG'LEFT)='X') then + assert NO_WARNING + report "NUMERIC_STD.TO_INTEGER: metavalue detected, returning 0" + severity WARNING; + return 0; + end if; + if XARG(XARG'LEFT) = '0' then + return TO_INTEGER(UNSIGNED(XARG)); + else + return (- (TO_INTEGER(UNSIGNED(- (XARG + 1)))) -1); + end if; + end TO_INTEGER; + + -- Id: D.3 + function TO_UNSIGNED (ARG, SIZE: NATURAL) return UNSIGNED is + variable RESULT: UNSIGNED(SIZE-1 downto 0); + variable I_VAL: NATURAL := ARG; + begin + if (SIZE < 1) then return NAU; + end if; + for I in 0 to RESULT'LEFT loop + if (I_VAL mod 2) = 0 then + RESULT(I) := '0'; + else RESULT(I) := '1'; + end if; + I_VAL := I_VAL/2; + end loop; + if not(I_VAL =0) then + assert NO_WARNING + report "NUMERIC_STD.TO_UNSIGNED: vector truncated" + severity WARNING; + end if; + return RESULT; + end TO_UNSIGNED; + + -- Id: D.4 + function TO_SIGNED (ARG: INTEGER; SIZE: NATURAL) return SIGNED is + variable RESULT: SIGNED(SIZE-1 downto 0); + variable B_VAL: STD_LOGIC := '0'; + variable I_VAL: INTEGER := ARG; + begin + if (SIZE < 1) then return NAS; + end if; + if (ARG < 0) then + B_VAL := '1'; + I_VAL := -(ARG+1); + end if; + for I in 0 to RESULT'LEFT loop + if (I_VAL mod 2) = 0 then + RESULT(I) := B_VAL; + else + RESULT(I) := not B_VAL; + end if; + I_VAL := I_VAL/2; + end loop; + if ((I_VAL/=0) or (B_VAL/=RESULT(RESULT'LEFT))) then + assert NO_WARNING + report "NUMERIC_STD.TO_SIGNED: vector truncated" + severity WARNING; + end if; + return RESULT; + end TO_SIGNED; + + --============================================================================ + + -- Id: R.1 + function RESIZE (ARG: SIGNED; NEW_SIZE: NATURAL) return SIGNED is + alias INVEC: SIGNED(ARG'LENGTH-1 downto 0) is ARG; + variable RESULT: SIGNED(NEW_SIZE-1 downto 0) := (others => '0'); + constant BOUND: INTEGER := MIN(ARG'LENGTH, RESULT'LENGTH)-2; + begin + if (NEW_SIZE < 1) then return NAS; + end if; + if (ARG'LENGTH = 0) then return RESULT; + end if; + RESULT := (others => ARG(ARG'LEFT)); + if BOUND >= 0 then + RESULT(BOUND downto 0) := INVEC(BOUND downto 0); + end if; + return RESULT; + end RESIZE; + + -- Id: R.2 + function RESIZE (ARG: UNSIGNED; NEW_SIZE: NATURAL) return UNSIGNED is + constant ARG_LEFT: INTEGER := ARG'LENGTH-1; + alias XARG: UNSIGNED(ARG_LEFT downto 0) is ARG; + variable RESULT: UNSIGNED(NEW_SIZE-1 downto 0) := (others => '0'); + begin + if (NEW_SIZE < 1) then return NAU; + end if; + if XARG'LENGTH =0 then return RESULT; + end if; + if (RESULT'LENGTH < ARG'LENGTH) then + RESULT(RESULT'LEFT downto 0) := XARG(RESULT'LEFT downto 0); + else + RESULT(RESULT'LEFT downto XARG'LEFT+1) := (others => '0'); + RESULT(XARG'LEFT downto 0) := XARG; + end if; + return RESULT; + end RESIZE; + + --============================================================================ + + -- Id: L.1 + function "not" (L: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(not(STD_LOGIC_VECTOR(L))); + return RESULT; + end "not"; + + -- Id: L.2 + function "and" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) and STD_LOGIC_VECTOR(R)); + return RESULT; + end "and"; + + -- Id: L.3 + function "or" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) or STD_LOGIC_VECTOR(R)); + return RESULT; + end "or"; + + -- Id: L.4 + function "nand" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) nand STD_LOGIC_VECTOR(R)); + return RESULT; + end "nand"; + + -- Id: L.5 + function "nor" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) nor STD_LOGIC_VECTOR(R)); + return RESULT; + end "nor"; + + -- Id: L.6 + function "xor" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) xor STD_LOGIC_VECTOR(R)); + return RESULT; + end "xor"; + +--START-V93 + ------------------------------------------------------------------------------ + -- Note : Function L.7 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: L.7 + function "xnor" (L, R: UNSIGNED) return UNSIGNED is + variable RESULT: UNSIGNED(L'LENGTH-1 downto 0); + begin + RESULT := UNSIGNED(STD_LOGIC_VECTOR(L) xnor STD_LOGIC_VECTOR(R)); + return RESULT; + end "xnor"; +--END-V93 + + -- Id: L.8 + function "not" (L: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(not(STD_LOGIC_VECTOR(L))); + return RESULT; + end "not"; + + -- Id: L.9 + function "and" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(STD_LOGIC_VECTOR(L) and STD_LOGIC_VECTOR(R)); + return RESULT; + end "and"; + + -- Id: L.10 + function "or" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(STD_LOGIC_VECTOR(L) or STD_LOGIC_VECTOR(R)); + return RESULT; + end "or"; + + -- Id: L.11 + function "nand" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(STD_LOGIC_VECTOR(L) nand STD_LOGIC_VECTOR(R)); + return RESULT; + end "nand"; + + -- Id: L.12 + function "nor" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(STD_LOGIC_VECTOR(L) nor STD_LOGIC_VECTOR(R)); + return RESULT; + end "nor"; + + -- Id: L.13 + function "xor" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(STD_LOGIC_VECTOR(L) xor STD_LOGIC_VECTOR(R)); + return RESULT; + end "xor"; + +--START-V93 + ------------------------------------------------------------------------------ + -- Note : Function L.14 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: L.14 + function "xnor" (L, R: SIGNED) return SIGNED is + variable RESULT: SIGNED(L'LENGTH-1 downto 0); + begin + RESULT := SIGNED(STD_LOGIC_VECTOR(L) xnor STD_LOGIC_VECTOR(R)); + return RESULT; + end "xnor"; +--END-V93 + + --============================================================================ + + -- support constants for STD_MATCH: + + type BOOLEAN_TABLE is array(STD_ULOGIC, STD_ULOGIC) of BOOLEAN; + + constant MATCH_TABLE: BOOLEAN_TABLE := ( + -------------------------------------------------------------------------- + -- U X 0 1 Z W L H - + -------------------------------------------------------------------------- + (FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE), -- | U | + (FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE), -- | X | + (FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE), -- | 0 | + (FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE), -- | 1 | + (FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE), -- | Z | + (FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE), -- | W | + (FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE), -- | L | + (FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE), -- | H | + ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE) -- | - | + ); + + -- Id: M.1 + function STD_MATCH (L, R: STD_ULOGIC) return BOOLEAN is + variable VALUE: STD_ULOGIC; + begin + return MATCH_TABLE(L, R); + end STD_MATCH; + + -- Id: M.2 + function STD_MATCH (L, R: UNSIGNED) return BOOLEAN is + alias LV: UNSIGNED(1 to L'LENGTH) is L; + alias RV: UNSIGNED(1 to R'LENGTH) is R; + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.STD_MATCH: null detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if LV'LENGTH /= RV'LENGTH then + assert NO_WARNING + report "NUMERIC_STD.STD_MATCH: L'LENGTH /= R'LENGTH, returning FALSE" + severity WARNING; + return FALSE; + else + for I in LV'LOW to LV'HIGH loop + if not (MATCH_TABLE(LV(I), RV(I))) then + return FALSE; + end if; + end loop; + return TRUE; + end if; + end STD_MATCH; + + -- Id: M.3 + function STD_MATCH (L, R: SIGNED) return BOOLEAN is + alias LV: SIGNED(1 to L'LENGTH) is L; + alias RV: SIGNED(1 to R'LENGTH) is R; + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.STD_MATCH: null detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if LV'LENGTH /= RV'LENGTH then + assert NO_WARNING + report "NUMERIC_STD.STD_MATCH: L'LENGTH /= R'LENGTH, returning FALSE" + severity WARNING; + return FALSE; + else + for I in LV'LOW to LV'HIGH loop + if not (MATCH_TABLE(LV(I), RV(I))) then + return FALSE; + end if; + end loop; + return TRUE; + end if; + end STD_MATCH; + + -- Id: M.4 + function STD_MATCH (L, R: STD_LOGIC_VECTOR) return BOOLEAN is + alias LV: STD_LOGIC_VECTOR(1 to L'LENGTH) is L; + alias RV: STD_LOGIC_VECTOR(1 to R'LENGTH) is R; + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.STD_MATCH: null detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if LV'LENGTH /= RV'LENGTH then + assert NO_WARNING + report "NUMERIC_STD.STD_MATCH: L'LENGTH /= R'LENGTH, returning FALSE" + severity WARNING; + return FALSE; + else + for I in LV'LOW to LV'HIGH loop + if not (MATCH_TABLE(LV(I), RV(I))) then + return FALSE; + end if; + end loop; + return TRUE; + end if; + end STD_MATCH; + + -- Id: M.5 + function STD_MATCH (L, R: STD_ULOGIC_VECTOR) return BOOLEAN is + alias LV: STD_ULOGIC_VECTOR(1 to L'LENGTH) is L; + alias RV: STD_ULOGIC_VECTOR(1 to R'LENGTH) is R; + begin + if ((L'LENGTH < 1) or (R'LENGTH < 1)) then + assert NO_WARNING + report "NUMERIC_STD.STD_MATCH: null detected, returning FALSE" + severity WARNING; + return FALSE; + end if; + if LV'LENGTH /= RV'LENGTH then + assert NO_WARNING + report "NUMERIC_STD.STD_MATCH: L'LENGTH /= R'LENGTH, returning FALSE" + severity WARNING; + return FALSE; + else + for I in LV'LOW to LV'HIGH loop + if not (MATCH_TABLE(LV(I), RV(I))) then + return FALSE; + end if; + end loop; + return TRUE; + end if; + end STD_MATCH; + + --============================================================================ + + -- function TO_01 is used to convert vectors to the + -- correct form for exported functions, + -- and to report if there is an element which + -- is not in (0, 1, H, L). + + -- Id: T.1 + function TO_01 (S: UNSIGNED; XMAP: STD_LOGIC := '0') return UNSIGNED is + variable RESULT: UNSIGNED(S'LENGTH-1 downto 0); + variable BAD_ELEMENT: BOOLEAN := FALSE; + alias XS: UNSIGNED(S'LENGTH-1 downto 0) is S; + begin + if (S'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.TO_01: null detected, returning NAU" + severity WARNING; + return NAU; + end if; + for I in RESULT'RANGE loop + case XS(I) is + when '0' | 'L' => RESULT(I) := '0'; + when '1' | 'H' => RESULT(I) := '1'; + when others => BAD_ELEMENT := TRUE; + end case; + end loop; + if BAD_ELEMENT then + for I in RESULT'RANGE loop + RESULT(I) := XMAP; -- standard fixup + end loop; + end if; + return RESULT; + end TO_01; + + -- Id: T.2 + function TO_01 (S: SIGNED; XMAP: STD_LOGIC := '0') return SIGNED is + variable RESULT: SIGNED(S'LENGTH-1 downto 0); + variable BAD_ELEMENT: BOOLEAN := FALSE; + alias XS: SIGNED(S'LENGTH-1 downto 0) is S; + begin + if (S'LENGTH < 1) then + assert NO_WARNING + report "NUMERIC_STD.TO_01: null detected, returning NAS" + severity WARNING; + return NAS; + end if; + for I in RESULT'RANGE loop + case XS(I) is + when '0' | 'L' => RESULT(I) := '0'; + when '1' | 'H' => RESULT(I) := '1'; + when others => BAD_ELEMENT := TRUE; + end case; + end loop; + if BAD_ELEMENT then + for I in RESULT'RANGE loop + RESULT(I) := XMAP; -- standard fixup + end loop; + end if; + return RESULT; + end TO_01; + + --============================================================================ + +end NUMERIC_STD; diff --git a/libraries/ieee/numeric_std.vhdl b/libraries/ieee/numeric_std.vhdl new file mode 100644 index 000000000..da22c32b0 --- /dev/null +++ b/libraries/ieee/numeric_std.vhdl @@ -0,0 +1,853 @@ +-- -------------------------------------------------------------------- +-- +-- Copyright 1995 by IEEE. All rights reserved. +-- +-- This source file is considered by the IEEE to be an essential part of the use +-- of the standard 1076.3 and as such may be distributed without change, except +-- as permitted by the standard. This source file may not be sold or distributed +-- for profit. This package may be modified to include additional data required +-- by tools, but must in no way change the external interfaces or simulation +-- behaviour of the description. It is permissible to add comments and/or +-- attributes to the package declarations, but not to change or delete any +-- original lines of the approved package declaration. The package body may be +-- changed only in accordance with the terms of clauses 7.1 and 7.2 of the +-- standard. +-- +-- Title : Standard VHDL Synthesis Package (1076.3, NUMERIC_STD) +-- +-- Library : This package shall be compiled into a library symbolically +-- : named IEEE. +-- +-- Developers : IEEE DASC Synthesis Working Group, PAR 1076.3 +-- +-- Purpose : This package defines numeric types and arithmetic functions +-- : for use with synthesis tools. Two numeric types are defined: +-- : -- > UNSIGNED: represents UNSIGNED number in vector form +-- : -- > SIGNED: represents a SIGNED number in vector form +-- : The base element type is type STD_LOGIC. +-- : The leftmost bit is treated as the most significant bit. +-- : Signed vectors are represented in two's complement form. +-- : This package contains overloaded arithmetic operators on +-- : the SIGNED and UNSIGNED types. The package also contains +-- : useful type conversions functions. +-- : +-- : If any argument to a function is a null array, a null array is +-- : returned (exceptions, if any, are noted individually). +-- +-- Limitation : +-- +-- Note : No declarations or definitions shall be included in, +-- : or excluded from this package. The "package declaration" +-- : defines the types, subtypes and declarations of +-- : NUMERIC_STD. The NUMERIC_STD package body shall be +-- : considered the formal definition of the semantics of +-- : this package. Tool developers may choose to implement +-- : the package body in the most efficient manner available +-- : to them. +-- +-- -------------------------------------------------------------------- +-- modification history : +-- -------------------------------------------------------------------- +-- Version: 2.4 +-- Date : 12 April 1995 +-- ----------------------------------------------------------------------------- +library IEEE; +use IEEE.STD_LOGIC_1164.all; + +package NUMERIC_STD is + constant CopyRightNotice: STRING + := "Copyright 1995 IEEE. All rights reserved."; + + --============================================================================ + -- Numeric array type definitions + --============================================================================ + + type UNSIGNED is array (NATURAL range <>) of STD_LOGIC; + type SIGNED is array (NATURAL range <>) of STD_LOGIC; + + --============================================================================ + -- Arithmetic Operators: + --=========================================================================== + + -- Id: A.1 + function "abs" (ARG: SIGNED) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0). + -- Result: Returns the absolute value of a SIGNED vector ARG. + + -- Id: A.2 + function "-" (ARG: SIGNED) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0). + -- Result: Returns the value of the unary minus operation on a + -- SIGNED vector ARG. + + --============================================================================ + + -- Id: A.3 + function "+" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0). + -- Result: Adds two UNSIGNED vectors that may be of different lengths. + + -- Id: A.4 + function "+" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0). + -- Result: Adds two SIGNED vectors that may be of different lengths. + + -- Id: A.5 + function "+" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0). + -- Result: Adds an UNSIGNED vector, L, with a non-negative INTEGER, R. + + -- Id: A.6 + function "+" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0). + -- Result: Adds a non-negative INTEGER, L, with an UNSIGNED vector, R. + + -- Id: A.7 + function "+" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0). + -- Result: Adds an INTEGER, L(may be positive or negative), to a SIGNED + -- vector, R. + + -- Id: A.8 + function "+" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0). + -- Result: Adds a SIGNED vector, L, to an INTEGER, R. + + --============================================================================ + + -- Id: A.9 + function "-" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0). + -- Result: Subtracts two UNSIGNED vectors that may be of different lengths. + + -- Id: A.10 + function "-" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(MAX(L'LENGTH, R'LENGTH)-1 downto 0). + -- Result: Subtracts a SIGNED vector, R, from another SIGNED vector, L, + -- that may possibly be of different lengths. + + -- Id: A.11 + function "-" (L: UNSIGNED;R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0). + -- Result: Subtracts a non-negative INTEGER, R, from an UNSIGNED vector, L. + + -- Id: A.12 + function "-" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0). + -- Result: Subtracts an UNSIGNED vector, R, from a non-negative INTEGER, L. + + -- Id: A.13 + function "-" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0). + -- Result: Subtracts an INTEGER, R, from a SIGNED vector, L. + + -- Id: A.14 + function "-" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0). + -- Result: Subtracts a SIGNED vector, R, from an INTEGER, L. + + --============================================================================ + + -- Id: A.15 + function "*" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED((L'LENGTH+R'LENGTH-1) downto 0). + -- Result: Performs the multiplication operation on two UNSIGNED vectors + -- that may possibly be of different lengths. + + -- Id: A.16 + function "*" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED((L'LENGTH+R'LENGTH-1) downto 0) + -- Result: Multiplies two SIGNED vectors that may possibly be of + -- different lengths. + + -- Id: A.17 + function "*" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED((L'LENGTH+L'LENGTH-1) downto 0). + -- Result: Multiplies an UNSIGNED vector, L, with a non-negative + -- INTEGER, R. R is converted to an UNSIGNED vector of + -- SIZE L'LENGTH before multiplication. + + -- Id: A.18 + function "*" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED((R'LENGTH+R'LENGTH-1) downto 0). + -- Result: Multiplies an UNSIGNED vector, R, with a non-negative + -- INTEGER, L. L is converted to an UNSIGNED vector of + -- SIZE R'LENGTH before multiplication. + + -- Id: A.19 + function "*" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED((L'LENGTH+L'LENGTH-1) downto 0) + -- Result: Multiplies a SIGNED vector, L, with an INTEGER, R. R is + -- converted to a SIGNED vector of SIZE L'LENGTH before + -- multiplication. + + -- Id: A.20 + function "*" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED((R'LENGTH+R'LENGTH-1) downto 0) + -- Result: Multiplies a SIGNED vector, R, with an INTEGER, L. L is + -- converted to a SIGNED vector of SIZE R'LENGTH before + -- multiplication. + + --============================================================================ + -- + -- NOTE: If second argument is zero for "/" operator, a severity level + -- of ERROR is issued. + + -- Id: A.21 + function "/" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Divides an UNSIGNED vector, L, by another UNSIGNED vector, R. + + -- Id: A.22 + function "/" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Divides an SIGNED vector, L, by another SIGNED vector, R. + + -- Id: A.23 + function "/" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Divides an UNSIGNED vector, L, by a non-negative INTEGER, R. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.24 + function "/" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0) + -- Result: Divides a non-negative INTEGER, L, by an UNSIGNED vector, R. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + -- Id: A.25 + function "/" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Divides a SIGNED vector, L, by an INTEGER, R. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.26 + function "/" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0) + -- Result: Divides an INTEGER, L, by a SIGNED vector, R. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + --============================================================================ + -- + -- NOTE: If second argument is zero for "rem" operator, a severity level + -- of ERROR is issued. + + -- Id: A.27 + function "rem" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where L and R are UNSIGNED vectors. + + -- Id: A.28 + function "rem" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where L and R are SIGNED vectors. + + -- Id: A.29 + function "rem" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where L is an UNSIGNED vector and R is a + -- non-negative INTEGER. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.30 + function "rem" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where R is an UNSIGNED vector and L is a + -- non-negative INTEGER. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + -- Id: A.31 + function "rem" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where L is SIGNED vector and R is an INTEGER. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.32 + function "rem" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L rem R" where R is SIGNED vector and L is an INTEGER. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + --============================================================================ + -- + -- NOTE: If second argument is zero for "mod" operator, a severity level + -- of ERROR is issued. + + -- Id: A.33 + function "mod" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where L and R are UNSIGNED vectors. + + -- Id: A.34 + function "mod" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where L and R are SIGNED vectors. + + -- Id: A.35 + function "mod" (L: UNSIGNED; R: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where L is an UNSIGNED vector and R + -- is a non-negative INTEGER. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.36 + function "mod" (L: NATURAL; R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where R is an UNSIGNED vector and L + -- is a non-negative INTEGER. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + -- Id: A.37 + function "mod" (L: SIGNED; R: INTEGER) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where L is a SIGNED vector and + -- R is an INTEGER. + -- If NO_OF_BITS(R) > L'LENGTH, result is truncated to L'LENGTH. + + -- Id: A.38 + function "mod" (L: INTEGER; R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(R'LENGTH-1 downto 0) + -- Result: Computes "L mod R" where L is an INTEGER and + -- R is a SIGNED vector. + -- If NO_OF_BITS(L) > R'LENGTH, result is truncated to R'LENGTH. + + --============================================================================ + -- Comparison Operators + --============================================================================ + + -- Id: C.1 + function ">" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.2 + function ">" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.3 + function ">" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.4 + function ">" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L is a INTEGER and + -- R is a SIGNED vector. + + -- Id: C.5 + function ">" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.6 + function ">" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L > R" where L is a SIGNED vector and + -- R is a INTEGER. + + --============================================================================ + + -- Id: C.7 + function "<" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.8 + function "<" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.9 + function "<" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.10 + function "<" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L is an INTEGER and + -- R is a SIGNED vector. + + -- Id: C.11 + function "<" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.12 + function "<" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L < R" where L is a SIGNED vector and + -- R is an INTEGER. + + --============================================================================ + + -- Id: C.13 + function "<=" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.14 + function "<=" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.15 + function "<=" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.16 + function "<=" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L is an INTEGER and + -- R is a SIGNED vector. + + -- Id: C.17 + function "<=" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.18 + function "<=" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L <= R" where L is a SIGNED vector and + -- R is an INTEGER. + + --============================================================================ + + -- Id: C.19 + function ">=" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.20 + function ">=" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.21 + function ">=" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.22 + function ">=" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L is an INTEGER and + -- R is a SIGNED vector. + + -- Id: C.23 + function ">=" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.24 + function ">=" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L >= R" where L is a SIGNED vector and + -- R is an INTEGER. + + --============================================================================ + + -- Id: C.25 + function "=" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.26 + function "=" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.27 + function "=" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.28 + function "=" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L is an INTEGER and + -- R is a SIGNED vector. + + -- Id: C.29 + function "=" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.30 + function "=" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L = R" where L is a SIGNED vector and + -- R is an INTEGER. + + --============================================================================ + + -- Id: C.31 + function "/=" (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L and R are UNSIGNED vectors possibly + -- of different lengths. + + -- Id: C.32 + function "/=" (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L and R are SIGNED vectors possibly + -- of different lengths. + + -- Id: C.33 + function "/=" (L: NATURAL; R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L is a non-negative INTEGER and + -- R is an UNSIGNED vector. + + -- Id: C.34 + function "/=" (L: INTEGER; R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L is an INTEGER and + -- R is a SIGNED vector. + + -- Id: C.35 + function "/=" (L: UNSIGNED; R: NATURAL) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L is an UNSIGNED vector and + -- R is a non-negative INTEGER. + + -- Id: C.36 + function "/=" (L: SIGNED; R: INTEGER) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: Computes "L /= R" where L is a SIGNED vector and + -- R is an INTEGER. + + --============================================================================ + -- Shift and Rotate Functions + --============================================================================ + + -- Id: S.1 + function SHIFT_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a shift-left on an UNSIGNED vector COUNT times. + -- The vacated positions are filled with '0'. + -- The COUNT leftmost elements are lost. + + -- Id: S.2 + function SHIFT_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a shift-right on an UNSIGNED vector COUNT times. + -- The vacated positions are filled with '0'. + -- The COUNT rightmost elements are lost. + + -- Id: S.3 + function SHIFT_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a shift-left on a SIGNED vector COUNT times. + -- The vacated positions are filled with '0'. + -- The COUNT leftmost elements are lost. + + -- Id: S.4 + function SHIFT_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a shift-right on a SIGNED vector COUNT times. + -- The vacated positions are filled with the leftmost + -- element, ARG'LEFT. The COUNT rightmost elements are lost. + + --============================================================================ + + -- Id: S.5 + function ROTATE_LEFT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a rotate-left of an UNSIGNED vector COUNT times. + + -- Id: S.6 + function ROTATE_RIGHT (ARG: UNSIGNED; COUNT: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a rotate-right of an UNSIGNED vector COUNT times. + + -- Id: S.7 + function ROTATE_LEFT (ARG: SIGNED; COUNT: NATURAL) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a logical rotate-left of a SIGNED + -- vector COUNT times. + + -- Id: S.8 + function ROTATE_RIGHT (ARG: SIGNED; COUNT: NATURAL) return SIGNED; + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: Performs a logical rotate-right of a SIGNED + -- vector COUNT times. + + --============================================================================ + + --============================================================================ + + ------------------------------------------------------------------------------ + -- Note : Function S.9 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.9 + function "sll" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93 + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: SHIFT_LEFT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.10 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.10 + function "sll" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93 + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: SHIFT_LEFT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.11 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.11 + function "srl" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93 + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: SHIFT_RIGHT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.12 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.12 + function "srl" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93 + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: SIGNED(SHIFT_RIGHT(UNSIGNED(ARG), COUNT)) + + ------------------------------------------------------------------------------ + -- Note : Function S.13 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.13 + function "rol" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93 + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: ROTATE_LEFT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.14 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.14 + function "rol" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93 + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: ROTATE_LEFT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.15 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.15 + function "ror" (ARG: UNSIGNED; COUNT: INTEGER) return UNSIGNED; --V93 + -- Result subtype: UNSIGNED(ARG'LENGTH-1 downto 0) + -- Result: ROTATE_RIGHT(ARG, COUNT) + + ------------------------------------------------------------------------------ + -- Note : Function S.16 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + ------------------------------------------------------------------------------ + -- Id: S.16 + function "ror" (ARG: SIGNED; COUNT: INTEGER) return SIGNED; --V93 + -- Result subtype: SIGNED(ARG'LENGTH-1 downto 0) + -- Result: ROTATE_RIGHT(ARG, COUNT) + + --============================================================================ + -- RESIZE Functions + --============================================================================ + + -- Id: R.1 + function RESIZE (ARG: SIGNED; NEW_SIZE: NATURAL) return SIGNED; + -- Result subtype: SIGNED(NEW_SIZE-1 downto 0) + -- Result: Resizes the SIGNED vector ARG to the specified size. + -- To create a larger vector, the new [leftmost] bit positions + -- are filled with the sign bit (ARG'LEFT). When truncating, + -- the sign bit is retained along with the rightmost part. + + -- Id: R.2 + function RESIZE (ARG: UNSIGNED; NEW_SIZE: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(NEW_SIZE-1 downto 0) + -- Result: Resizes the SIGNED vector ARG to the specified size. + -- To create a larger vector, the new [leftmost] bit positions + -- are filled with '0'. When truncating, the leftmost bits + -- are dropped. + + --============================================================================ + -- Conversion Functions + --============================================================================ + + -- Id: D.1 + function TO_INTEGER (ARG: UNSIGNED) return NATURAL; + -- Result subtype: NATURAL. Value cannot be negative since parameter is an + -- UNSIGNED vector. + -- Result: Converts the UNSIGNED vector to an INTEGER. + + -- Id: D.2 + function TO_INTEGER (ARG: SIGNED) return INTEGER; + -- Result subtype: INTEGER + -- Result: Converts a SIGNED vector to an INTEGER. + + -- Id: D.3 + function TO_UNSIGNED (ARG, SIZE: NATURAL) return UNSIGNED; + -- Result subtype: UNSIGNED(SIZE-1 downto 0) + -- Result: Converts a non-negative INTEGER to an UNSIGNED vector with + -- the specified SIZE. + + -- Id: D.4 + function TO_SIGNED (ARG: INTEGER; SIZE: NATURAL) return SIGNED; + -- Result subtype: SIGNED(SIZE-1 downto 0) + -- Result: Converts an INTEGER to a SIGNED vector of the specified SIZE. + + --============================================================================ + -- Logical Operators + --============================================================================ + + -- Id: L.1 + function "not" (L: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Termwise inversion + + -- Id: L.2 + function "and" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector AND operation + + -- Id: L.3 + function "or" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector OR operation + + -- Id: L.4 + function "nand" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector NAND operation + + -- Id: L.5 + function "nor" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector NOR operation + + -- Id: L.6 + function "xor" (L, R: UNSIGNED) return UNSIGNED; + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector XOR operation + + -- --------------------------------------------------------------------------- + -- Note : Function L.7 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + -- --------------------------------------------------------------------------- + -- Id: L.7 + function "xnor" (L, R: UNSIGNED) return UNSIGNED; --V93 + -- Result subtype: UNSIGNED(L'LENGTH-1 downto 0) + -- Result: Vector XNOR operation + + -- Id: L.8 + function "not" (L: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Termwise inversion + + -- Id: L.9 + function "and" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector AND operation + + -- Id: L.10 + function "or" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector OR operation + + -- Id: L.11 + function "nand" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector NAND operation + + -- Id: L.12 + function "nor" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector NOR operation + + -- Id: L.13 + function "xor" (L, R: SIGNED) return SIGNED; + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector XOR operation + + -- --------------------------------------------------------------------------- + -- Note : Function L.14 is not compatible with VHDL 1076-1987. Comment + -- out the function (declaration and body) for VHDL 1076-1987 compatibility. + -- --------------------------------------------------------------------------- + -- Id: L.14 + function "xnor" (L, R: SIGNED) return SIGNED; --V93 + -- Result subtype: SIGNED(L'LENGTH-1 downto 0) + -- Result: Vector XNOR operation + + --============================================================================ + -- Match Functions + --============================================================================ + + -- Id: M.1 + function STD_MATCH (L, R: STD_ULOGIC) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: terms compared per STD_LOGIC_1164 intent + + -- Id: M.2 + function STD_MATCH (L, R: UNSIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: terms compared per STD_LOGIC_1164 intent + + -- Id: M.3 + function STD_MATCH (L, R: SIGNED) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: terms compared per STD_LOGIC_1164 intent + + -- Id: M.4 + function STD_MATCH (L, R: STD_LOGIC_VECTOR) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: terms compared per STD_LOGIC_1164 intent + + -- Id: M.5 + function STD_MATCH (L, R: STD_ULOGIC_VECTOR) return BOOLEAN; + -- Result subtype: BOOLEAN + -- Result: terms compared per STD_LOGIC_1164 intent + + --============================================================================ + -- Translation Functions + --============================================================================ + + -- Id: T.1 + function TO_01 (S: UNSIGNED; XMAP: STD_LOGIC := '0') return UNSIGNED; + -- Result subtype: UNSIGNED(S'RANGE) + -- Result: Termwise, 'H' is translated to '1', and 'L' is translated + -- to '0'. If a value other than '0'|'1'|'H'|'L' is found, + -- the array is set to (others => XMAP), and a warning is + -- issued. + + -- Id: T.2 + function TO_01 (S: SIGNED; XMAP: STD_LOGIC := '0') return SIGNED; + -- Result subtype: SIGNED(S'RANGE) + -- Result: Termwise, 'H' is translated to '1', and 'L' is translated + -- to '0'. If a value other than '0'|'1'|'H'|'L' is found, + -- the array is set to (others => XMAP), and a warning is + -- issued. + +end NUMERIC_STD; diff --git a/libraries/ieee/std_logic_1164.vhdl b/libraries/ieee/std_logic_1164.vhdl new file mode 100644 index 000000000..c53113be9 --- /dev/null +++ b/libraries/ieee/std_logic_1164.vhdl @@ -0,0 +1,175 @@ +-- -------------------------------------------------------------------- +-- +-- Title : std_logic_1164 multi-value logic system +-- Library : This package shall be compiled into a library +-- : symbolically named IEEE. +-- : +-- Developers: IEEE model standards group (par 1164) +-- Purpose : This packages defines a standard for designers +-- : to use in describing the interconnection data types +-- : used in vhdl modeling. +-- : +-- Limitation: The logic system defined in this package may +-- : be insufficient for modeling switched transistors, +-- : since such a requirement is out of the scope of this +-- : effort. Furthermore, mathematics, primitives, +-- : timing standards, etc. are considered orthogonal +-- : issues as it relates to this package and are therefore +-- : beyond the scope of this effort. +-- : +-- Note : No declarations or definitions shall be included in, +-- : or excluded from this package. The "package declaration" +-- : defines the types, subtypes and declarations of +-- : std_logic_1164. The std_logic_1164 package body shall be +-- : considered the formal definition of the semantics of +-- : this package. Tool developers may choose to implement +-- : the package body in the most efficient manner available +-- : to them. +-- : +-- -------------------------------------------------------------------- +-- modification history : +-- -------------------------------------------------------------------- +-- version | mod. date:| +-- v4.200 | 01/02/92 | +-- -------------------------------------------------------------------- + +PACKAGE std_logic_1164 IS + + ------------------------------------------------------------------- + -- logic state system (unresolved) + ------------------------------------------------------------------- + TYPE std_ulogic IS ( 'U', -- Uninitialized + 'X', -- Forcing Unknown + '0', -- Forcing 0 + '1', -- Forcing 1 + 'Z', -- High Impedance + 'W', -- Weak Unknown + 'L', -- Weak 0 + 'H', -- Weak 1 + '-' -- Don't care + ); + ------------------------------------------------------------------- + -- unconstrained array of std_ulogic for use with the resolution function + ------------------------------------------------------------------- + TYPE std_ulogic_vector IS ARRAY ( NATURAL RANGE <> ) OF std_ulogic; + + ------------------------------------------------------------------- + -- resolution function + ------------------------------------------------------------------- + FUNCTION resolved ( s : std_ulogic_vector ) RETURN std_ulogic; + + ------------------------------------------------------------------- + -- *** industry standard logic type *** + ------------------------------------------------------------------- + SUBTYPE std_logic IS resolved std_ulogic; + + ------------------------------------------------------------------- + -- unconstrained array of std_logic for use in declaring signal arrays + ------------------------------------------------------------------- + TYPE std_logic_vector IS ARRAY ( NATURAL RANGE <>) OF std_logic; + + ------------------------------------------------------------------- + -- common subtypes + ------------------------------------------------------------------- + SUBTYPE X01 IS resolved std_ulogic RANGE 'X' TO '1'; -- ('X','0','1') + SUBTYPE X01Z IS resolved std_ulogic RANGE 'X' TO 'Z'; -- ('X','0','1','Z') + SUBTYPE UX01 IS resolved std_ulogic RANGE 'U' TO '1'; -- ('U','X','0','1') + SUBTYPE UX01Z IS resolved std_ulogic RANGE 'U' TO 'Z'; -- ('U','X','0','1','Z') + + ------------------------------------------------------------------- + -- overloaded logical operators + ------------------------------------------------------------------- + + 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; --V93 + FUNCTION "not" ( l : std_ulogic ) RETURN UX01; + + ------------------------------------------------------------------- + -- vectorized overloaded logical operators + ------------------------------------------------------------------- + FUNCTION "and" ( l, r : std_logic_vector ) RETURN std_logic_vector; + FUNCTION "and" ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector; + + FUNCTION "nand" ( l, r : std_logic_vector ) RETURN std_logic_vector; + FUNCTION "nand" ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector; + + FUNCTION "or" ( l, r : std_logic_vector ) RETURN std_logic_vector; + FUNCTION "or" ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector; + + FUNCTION "nor" ( l, r : std_logic_vector ) RETURN std_logic_vector; + FUNCTION "nor" ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector; + + FUNCTION "xor" ( l, r : std_logic_vector ) RETURN std_logic_vector; + FUNCTION "xor" ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector; + +-- ----------------------------------------------------------------------- +-- Note : The declaration and implementation of the "xnor" function is +-- specifically commented until at which time the VHDL language has been +-- officially adopted as containing such a function. At such a point, +-- the following comments may be removed along with this notice without +-- further "official" ballotting of this std_logic_1164 package. It is +-- the intent of this effort to provide such a function once it becomes +-- available in the VHDL standard. +-- ----------------------------------------------------------------------- + FUNCTION "xnor" ( l, r : std_logic_vector ) RETURN std_logic_vector; --V93 + FUNCTION "xnor" ( l, r : std_ulogic_vector ) RETURN std_ulogic_vector;--V93 + + FUNCTION "not" ( l : std_logic_vector ) RETURN std_logic_vector; + FUNCTION "not" ( l : std_ulogic_vector ) RETURN std_ulogic_vector; + + ------------------------------------------------------------------- + -- conversion functions + ------------------------------------------------------------------- + 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; + + ------------------------------------------------------------------- + -- strength strippers and type convertors + ------------------------------------------------------------------- + + 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 + ------------------------------------------------------------------- + FUNCTION rising_edge (SIGNAL s : std_ulogic) RETURN BOOLEAN; + FUNCTION falling_edge (SIGNAL s : std_ulogic) RETURN BOOLEAN; + + ------------------------------------------------------------------- + -- object contains an unknown + ------------------------------------------------------------------- + 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/ieee/std_logic_1164_body.vhdl b/libraries/ieee/std_logic_1164_body.vhdl new file mode 100644 index 000000000..65c5965e0 --- /dev/null +++ b/libraries/ieee/std_logic_1164_body.vhdl @@ -0,0 +1,830 @@ +-- -------------------------------------------------------------------- +-- +-- Title : std_logic_1164 multi-value logic system +-- Library : This package shall be compiled into a library +-- : symbolically named IEEE. +-- : +-- Developers: IEEE model standards group (par 1164) +-- Purpose : This packages defines a standard for designers +-- : to use in describing the interconnection data types +-- : used in vhdl modeling. +-- : +-- Limitation: The logic system defined in this package may +-- : be insufficient for modeling switched transistors, +-- : since such a requirement is out of the scope of this +-- : effort. Furthermore, mathematics, primitives, +-- : timing standards, etc. are considered orthogonal +-- : issues as it relates to this package and are therefore +-- : beyond the scope of this effort. +-- : +-- Note : No declarations or definitions shall be included in, +-- : or excluded from this package. The "package declaration" +-- : defines the types, subtypes and declarations of +-- : std_logic_1164. The std_logic_1164 package body shall be +-- : considered the formal definition of the semantics of +-- : this package. Tool developers may choose to implement +-- : the package body in the most efficient manner available +-- : to them. +-- : +-- -------------------------------------------------------------------- +-- modification history : +-- -------------------------------------------------------------------- +-- version | mod. date:| +-- v4.200 | 01/02/91 | +-- -------------------------------------------------------------------- + +PACKAGE BODY std_logic_1164 IS + ------------------------------------------------------------------- + -- local types + ------------------------------------------------------------------- + TYPE stdlogic_1d IS ARRAY (std_ulogic) OF std_ulogic; + TYPE stdlogic_table IS ARRAY(std_ulogic, std_ulogic) OF std_ulogic; + + ------------------------------------------------------------------- + -- resolution function + ------------------------------------------------------------------- + CONSTANT resolution_table : stdlogic_table := ( + -- --------------------------------------------------------- + -- | U X 0 1 Z W L H - | | + -- --------------------------------------------------------- + ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ), -- | U | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | X | + ( 'U', 'X', '0', 'X', '0', '0', '0', '0', 'X' ), -- | 0 | + ( 'U', 'X', 'X', '1', '1', '1', '1', '1', 'X' ), -- | 1 | + ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', 'X' ), -- | Z | + ( 'U', 'X', '0', '1', 'W', 'W', 'W', 'W', 'X' ), -- | W | + ( 'U', 'X', '0', '1', 'L', 'W', 'L', 'W', 'X' ), -- | L | + ( 'U', 'X', '0', '1', 'H', 'W', 'W', 'H', 'X' ), -- | H | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ) -- | - | + ); + + FUNCTION resolved ( s : std_ulogic_vector ) RETURN std_ulogic IS + VARIABLE result : std_ulogic := 'Z'; -- weakest state default + BEGIN + -- the test for a single driver is essential otherwise the + -- loop would return 'X' for a single driver of '-' and that + -- would conflict with the value of a single driver unresolved + -- signal. + IF (s'LENGTH = 1) THEN RETURN s(s'LOW); + ELSE + FOR i IN s'RANGE LOOP + result := resolution_table(result, s(i)); + END LOOP; + END IF; + RETURN result; + END resolved; + + ------------------------------------------------------------------- + -- tables for logical operations + ------------------------------------------------------------------- + + -- truth table for "and" function + CONSTANT and_table : stdlogic_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H - | | + -- ---------------------------------------------------- + ( 'U', 'U', '0', 'U', 'U', 'U', '0', 'U', 'U' ), -- | U | + ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | X | + ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ), -- | 0 | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | 1 | + ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | Z | + ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | W | + ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ), -- | L | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | H | + ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ) -- | - | + ); + + -- truth table for "or" function + CONSTANT or_table : stdlogic_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H - | | + -- ---------------------------------------------------- + ( 'U', 'U', 'U', '1', 'U', 'U', 'U', '1', 'U' ), -- | U | + ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | X | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | 0 | + ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ), -- | 1 | + ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | Z | + ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | W | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | L | + ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ), -- | H | + ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ) -- | - | + ); + + -- truth table for "xor" function + CONSTANT xor_table : stdlogic_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H - | | + -- ---------------------------------------------------- + ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ), -- | U | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | X | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | 0 | + ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ), -- | 1 | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | Z | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | W | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | L | + ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ), -- | H | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ) -- | - | + ); + + -- truth table for "not" function + CONSTANT not_table: stdlogic_1d := + -- ------------------------------------------------- + -- | U X 0 1 Z W L H - | + -- ------------------------------------------------- + ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ); + + ------------------------------------------------------------------- + -- overloaded logical operators ( with optimizing hints ) + ------------------------------------------------------------------- + + 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 (not_table ( and_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 (not_table ( or_table( l, r ))); + END "nor"; + + FUNCTION "xor" ( l : std_ulogic; r : std_ulogic ) RETURN UX01 IS + BEGIN + RETURN (xor_table(l, r)); + END "xor"; + +--START-V93 + FUNCTION "xnor" ( l : std_ulogic; r : std_ulogic ) RETURN UX01 IS + BEGIN + RETURN not_table(xor_table(l, r)); + END "xnor"; +--END-V93 + + FUNCTION "not" ( l : std_ulogic ) RETURN UX01 IS + BEGIN + RETURN (not_table(l)); + END "not"; + + ------------------------------------------------------------------- + -- and + ------------------------------------------------------------------- + FUNCTION "and" ( l,r : std_logic_vector ) RETURN std_logic_vector IS + ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_logic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'and' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := and_table (lv(i), rv(i)); + END LOOP; + END IF; + RETURN result; + END "and"; + --------------------------------------------------------------------- + FUNCTION "and" ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS + ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'and' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := and_table (lv(i), rv(i)); + END LOOP; + END IF; + RETURN result; + END "and"; + ------------------------------------------------------------------- + -- nand + ------------------------------------------------------------------- + FUNCTION "nand" ( l,r : std_logic_vector ) RETURN std_logic_vector IS + ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_logic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'nand' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := not_table(and_table (lv(i), rv(i))); + END LOOP; + END IF; + RETURN result; + END "nand"; + --------------------------------------------------------------------- + FUNCTION "nand" ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS + ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'nand' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := not_table(and_table (lv(i), rv(i))); + END LOOP; + END IF; + RETURN result; + END "nand"; + ------------------------------------------------------------------- + -- or + ------------------------------------------------------------------- + FUNCTION "or" ( l,r : std_logic_vector ) RETURN std_logic_vector IS + ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_logic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'or' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := or_table (lv(i), rv(i)); + END LOOP; + END IF; + RETURN result; + END "or"; + --------------------------------------------------------------------- + FUNCTION "or" ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS + ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'or' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := or_table (lv(i), rv(i)); + END LOOP; + END IF; + RETURN result; + END "or"; + ------------------------------------------------------------------- + -- nor + ------------------------------------------------------------------- + FUNCTION "nor" ( l,r : std_logic_vector ) RETURN std_logic_vector IS + ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_logic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'nor' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := not_table(or_table (lv(i), rv(i))); + END LOOP; + END IF; + RETURN result; + END "nor"; + --------------------------------------------------------------------- + FUNCTION "nor" ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS + ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'nor' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := not_table(or_table (lv(i), rv(i))); + END LOOP; + END IF; + RETURN result; + END "nor"; + --------------------------------------------------------------------- + -- xor + ------------------------------------------------------------------- + FUNCTION "xor" ( l,r : std_logic_vector ) RETURN std_logic_vector IS + ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_logic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'xor' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := xor_table (lv(i), rv(i)); + END LOOP; + END IF; + RETURN result; + END "xor"; + --------------------------------------------------------------------- + FUNCTION "xor" ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS + ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'xor' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := xor_table (lv(i), rv(i)); + END LOOP; + END IF; + RETURN result; + END "xor"; +-- ------------------------------------------------------------------- +-- -- xnor +-- ------------------------------------------------------------------- +-- ----------------------------------------------------------------------- +-- Note : The declaration and implementation of the "xnor" function is +-- specifically commented until at which time the VHDL language has been +-- officially adopted as containing such a function. At such a point, +-- the following comments may be removed along with this notice without +-- further "official" ballotting of this std_logic_1164 package. It is +-- the intent of this effort to provide such a function once it becomes +-- available in the VHDL standard. +-- ----------------------------------------------------------------------- +--START-V93 + FUNCTION "xnor" ( l,r : std_logic_vector ) RETURN std_logic_vector IS + ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_logic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_logic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'xnor' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := not_table(xor_table (lv(i), rv(i))); + END LOOP; + END IF; + RETURN result; + END "xnor"; + --------------------------------------------------------------------- + FUNCTION "xnor" ( l,r : std_ulogic_vector ) RETURN std_ulogic_vector IS + ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l; + ALIAS rv : std_ulogic_vector ( 1 TO r'LENGTH ) IS r; + VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH ); + BEGIN + IF ( l'LENGTH /= r'LENGTH ) THEN + ASSERT FALSE + REPORT "arguments of overloaded 'xnor' operator are not of the same length" + SEVERITY FAILURE; + ELSE + FOR i IN result'RANGE LOOP + result(i) := not_table(xor_table (lv(i), rv(i))); + END LOOP; + END IF; + RETURN result; + END "xnor"; +--END-V93 + ------------------------------------------------------------------- + -- not + ------------------------------------------------------------------- + FUNCTION "not" ( l : std_logic_vector ) RETURN std_logic_vector IS + ALIAS lv : std_logic_vector ( 1 TO l'LENGTH ) IS l; + VARIABLE result : std_logic_vector ( 1 TO l'LENGTH ) := (OTHERS => 'X'); + BEGIN + FOR i IN result'RANGE LOOP + result(i) := not_table( lv(i) ); + END LOOP; + RETURN result; + END; + --------------------------------------------------------------------- + FUNCTION "not" ( l : std_ulogic_vector ) RETURN std_ulogic_vector IS + ALIAS lv : std_ulogic_vector ( 1 TO l'LENGTH ) IS l; + VARIABLE result : std_ulogic_vector ( 1 TO l'LENGTH ) := (OTHERS => 'X'); + BEGIN + FOR i IN result'RANGE LOOP + result(i) := not_table( lv(i) ); + END LOOP; + RETURN result; + END; + ------------------------------------------------------------------- + -- conversion tables + ------------------------------------------------------------------- + TYPE logic_x01_table IS ARRAY (std_ulogic'LOW TO std_ulogic'HIGH) OF X01; + TYPE logic_x01z_table IS ARRAY (std_ulogic'LOW TO std_ulogic'HIGH) OF X01Z; + TYPE logic_ux01_table IS ARRAY (std_ulogic'LOW TO std_ulogic'HIGH) OF UX01; + ---------------------------------------------------------- + -- table name : cvt_to_x01 + -- + -- parameters : + -- in : std_ulogic -- some logic value + -- returns : x01 -- state value of logic value + -- purpose : to convert state-strength to state only + -- + -- example : if (cvt_to_x01 (input_signal) = '1' ) then ... + -- + ---------------------------------------------------------- + CONSTANT cvt_to_x01 : logic_x01_table := ( + 'X', -- 'U' + 'X', -- 'X' + '0', -- '0' + '1', -- '1' + 'X', -- 'Z' + 'X', -- 'W' + '0', -- 'L' + '1', -- 'H' + 'X' -- '-' + ); + + ---------------------------------------------------------- + -- table name : cvt_to_x01z + -- + -- parameters : + -- in : std_ulogic -- some logic value + -- returns : x01z -- state value of logic value + -- purpose : to convert state-strength to state only + -- + -- example : if (cvt_to_x01z (input_signal) = '1' ) then ... + -- + ---------------------------------------------------------- + CONSTANT cvt_to_x01z : logic_x01z_table := ( + 'X', -- 'U' + 'X', -- 'X' + '0', -- '0' + '1', -- '1' + 'Z', -- 'Z' + 'X', -- 'W' + '0', -- 'L' + '1', -- 'H' + 'X' -- '-' + ); + + ---------------------------------------------------------- + -- table name : cvt_to_ux01 + -- + -- parameters : + -- in : std_ulogic -- some logic value + -- returns : ux01 -- state value of logic value + -- purpose : to convert state-strength to state only + -- + -- example : if (cvt_to_ux01 (input_signal) = '1' ) then ... + -- + ---------------------------------------------------------- + CONSTANT cvt_to_ux01 : logic_ux01_table := ( + 'U', -- 'U' + 'X', -- 'X' + '0', -- '0' + '1', -- '1' + 'X', -- 'Z' + 'X', -- 'W' + '0', -- 'L' + '1', -- 'H' + 'X' -- '-' + ); + + ------------------------------------------------------------------- + -- conversion functions + ------------------------------------------------------------------- + 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; + -------------------------------------------------------------------- + FUNCTION To_bitvector ( s : std_logic_vector ; xmap : BIT := '0') RETURN BIT_VECTOR IS + ALIAS sv : std_logic_vector ( s'LENGTH-1 DOWNTO 0 ) IS s; + VARIABLE result : BIT_VECTOR ( s'LENGTH-1 DOWNTO 0 ); + BEGIN + FOR i IN result'RANGE LOOP + CASE sv(i) IS + WHEN '0' | 'L' => result(i) := '0'; + WHEN '1' | 'H' => result(i) := '1'; + WHEN OTHERS => result(i) := xmap; + END CASE; + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_bitvector ( s : std_ulogic_vector; xmap : BIT := '0') RETURN BIT_VECTOR IS + ALIAS sv : std_ulogic_vector ( s'LENGTH-1 DOWNTO 0 ) IS s; + VARIABLE result : BIT_VECTOR ( s'LENGTH-1 DOWNTO 0 ); + BEGIN + FOR i IN result'RANGE LOOP + CASE sv(i) IS + WHEN '0' | 'L' => result(i) := '0'; + WHEN '1' | 'H' => result(i) := '1'; + WHEN OTHERS => result(i) := xmap; + END CASE; + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_StdULogic ( b : BIT ) RETURN std_ulogic IS + BEGIN + CASE b IS + WHEN '0' => RETURN '0'; + WHEN '1' => RETURN '1'; + END CASE; + END; + -------------------------------------------------------------------- + FUNCTION To_StdLogicVector ( b : BIT_VECTOR ) RETURN std_logic_vector IS + ALIAS bv : BIT_VECTOR ( b'LENGTH-1 DOWNTO 0 ) IS b; + VARIABLE result : std_logic_vector ( b'LENGTH-1 DOWNTO 0 ); + BEGIN + FOR i IN result'RANGE LOOP + CASE bv(i) IS + WHEN '0' => result(i) := '0'; + WHEN '1' => result(i) := '1'; + END CASE; + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_StdLogicVector ( s : std_ulogic_vector ) RETURN std_logic_vector IS + ALIAS sv : std_ulogic_vector ( s'LENGTH-1 DOWNTO 0 ) IS s; + VARIABLE result : std_logic_vector ( s'LENGTH-1 DOWNTO 0 ); + BEGIN + FOR i IN result'RANGE LOOP + result(i) := sv(i); + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_StdULogicVector ( b : BIT_VECTOR ) RETURN std_ulogic_vector IS + ALIAS bv : BIT_VECTOR ( b'LENGTH-1 DOWNTO 0 ) IS b; + VARIABLE result : std_ulogic_vector ( b'LENGTH-1 DOWNTO 0 ); + BEGIN + FOR i IN result'RANGE LOOP + CASE bv(i) IS + WHEN '0' => result(i) := '0'; + WHEN '1' => result(i) := '1'; + END CASE; + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_StdULogicVector ( s : std_logic_vector ) RETURN std_ulogic_vector IS + ALIAS sv : std_logic_vector ( s'LENGTH-1 DOWNTO 0 ) IS s; + VARIABLE result : std_ulogic_vector ( s'LENGTH-1 DOWNTO 0 ); + BEGIN + FOR i IN result'RANGE LOOP + result(i) := sv(i); + END LOOP; + RETURN result; + END; + + ------------------------------------------------------------------- + -- strength strippers and type convertors + ------------------------------------------------------------------- + -- to_x01 + ------------------------------------------------------------------- + FUNCTION To_X01 ( s : std_logic_vector ) RETURN std_logic_vector IS + ALIAS sv : std_logic_vector ( 1 TO s'LENGTH ) IS s; + VARIABLE result : std_logic_vector ( 1 TO s'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + result(i) := cvt_to_x01 (sv(i)); + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_X01 ( s : std_ulogic_vector ) RETURN std_ulogic_vector IS + ALIAS sv : std_ulogic_vector ( 1 TO s'LENGTH ) IS s; + VARIABLE result : std_ulogic_vector ( 1 TO s'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + result(i) := cvt_to_x01 (sv(i)); + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_X01 ( s : std_ulogic ) RETURN X01 IS + BEGIN + RETURN (cvt_to_x01(s)); + END; + -------------------------------------------------------------------- + FUNCTION To_X01 ( b : BIT_VECTOR ) RETURN std_logic_vector IS + ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b; + VARIABLE result : std_logic_vector ( 1 TO b'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + CASE bv(i) IS + WHEN '0' => result(i) := '0'; + WHEN '1' => result(i) := '1'; + END CASE; + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_X01 ( b : BIT_VECTOR ) RETURN std_ulogic_vector IS + ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b; + VARIABLE result : std_ulogic_vector ( 1 TO b'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + CASE bv(i) IS + WHEN '0' => result(i) := '0'; + WHEN '1' => result(i) := '1'; + END CASE; + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_X01 ( b : BIT ) RETURN X01 IS + BEGIN + CASE b IS + WHEN '0' => RETURN('0'); + WHEN '1' => RETURN('1'); + END CASE; + END; + -------------------------------------------------------------------- + -- to_x01z + ------------------------------------------------------------------- + FUNCTION To_X01Z ( s : std_logic_vector ) RETURN std_logic_vector IS + ALIAS sv : std_logic_vector ( 1 TO s'LENGTH ) IS s; + VARIABLE result : std_logic_vector ( 1 TO s'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + result(i) := cvt_to_x01z (sv(i)); + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_X01Z ( s : std_ulogic_vector ) RETURN std_ulogic_vector IS + ALIAS sv : std_ulogic_vector ( 1 TO s'LENGTH ) IS s; + VARIABLE result : std_ulogic_vector ( 1 TO s'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + result(i) := cvt_to_x01z (sv(i)); + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_X01Z ( s : std_ulogic ) RETURN X01Z IS + BEGIN + RETURN (cvt_to_x01z(s)); + END; + -------------------------------------------------------------------- + FUNCTION To_X01Z ( b : BIT_VECTOR ) RETURN std_logic_vector IS + ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b; + VARIABLE result : std_logic_vector ( 1 TO b'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + CASE bv(i) IS + WHEN '0' => result(i) := '0'; + WHEN '1' => result(i) := '1'; + END CASE; + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_X01Z ( b : BIT_VECTOR ) RETURN std_ulogic_vector IS + ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b; + VARIABLE result : std_ulogic_vector ( 1 TO b'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + CASE bv(i) IS + WHEN '0' => result(i) := '0'; + WHEN '1' => result(i) := '1'; + END CASE; + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_X01Z ( b : BIT ) RETURN X01Z IS + BEGIN + CASE b IS + WHEN '0' => RETURN('0'); + WHEN '1' => RETURN('1'); + END CASE; + END; + -------------------------------------------------------------------- + -- to_ux01 + ------------------------------------------------------------------- + FUNCTION To_UX01 ( s : std_logic_vector ) RETURN std_logic_vector IS + ALIAS sv : std_logic_vector ( 1 TO s'LENGTH ) IS s; + VARIABLE result : std_logic_vector ( 1 TO s'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + result(i) := cvt_to_ux01 (sv(i)); + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_UX01 ( s : std_ulogic_vector ) RETURN std_ulogic_vector IS + ALIAS sv : std_ulogic_vector ( 1 TO s'LENGTH ) IS s; + VARIABLE result : std_ulogic_vector ( 1 TO s'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + result(i) := cvt_to_ux01 (sv(i)); + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_UX01 ( s : std_ulogic ) RETURN UX01 IS + BEGIN + RETURN (cvt_to_ux01(s)); + END; + -------------------------------------------------------------------- + FUNCTION To_UX01 ( b : BIT_VECTOR ) RETURN std_logic_vector IS + ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b; + VARIABLE result : std_logic_vector ( 1 TO b'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + CASE bv(i) IS + WHEN '0' => result(i) := '0'; + WHEN '1' => result(i) := '1'; + END CASE; + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_UX01 ( b : BIT_VECTOR ) RETURN std_ulogic_vector IS + ALIAS bv : BIT_VECTOR ( 1 TO b'LENGTH ) IS b; + VARIABLE result : std_ulogic_vector ( 1 TO b'LENGTH ); + BEGIN + FOR i IN result'RANGE LOOP + CASE bv(i) IS + WHEN '0' => result(i) := '0'; + WHEN '1' => result(i) := '1'; + END CASE; + END LOOP; + RETURN result; + END; + -------------------------------------------------------------------- + FUNCTION To_UX01 ( b : BIT ) RETURN UX01 IS + BEGIN + CASE b IS + WHEN '0' => RETURN('0'); + WHEN '1' => RETURN('1'); + END CASE; + END; + + ------------------------------------------------------------------- + -- edge detection + ------------------------------------------------------------------- + FUNCTION rising_edge (SIGNAL s : std_ulogic) RETURN BOOLEAN IS + BEGIN + RETURN (s'EVENT AND (To_X01(s) = '1') AND + (To_X01(s'LAST_VALUE) = '0')); + END; + + FUNCTION falling_edge (SIGNAL s : std_ulogic) RETURN BOOLEAN IS + BEGIN + RETURN (s'EVENT AND (To_X01(s) = '0') AND + (To_X01(s'LAST_VALUE) = '1')); + END; + + ------------------------------------------------------------------- + -- object contains an unknown + ------------------------------------------------------------------- + FUNCTION Is_X ( s : std_ulogic_vector ) RETURN BOOLEAN IS + BEGIN + FOR i IN s'RANGE LOOP + CASE s(i) IS + WHEN 'U' | 'X' | 'Z' | 'W' | '-' => RETURN TRUE; + WHEN OTHERS => NULL; + END CASE; + END LOOP; + RETURN FALSE; + END; + -------------------------------------------------------------------- + FUNCTION Is_X ( s : std_logic_vector ) RETURN BOOLEAN IS + BEGIN + FOR i IN s'RANGE LOOP + CASE s(i) IS + WHEN 'U' | 'X' | 'Z' | 'W' | '-' => RETURN TRUE; + WHEN OTHERS => NULL; + END CASE; + END LOOP; + RETURN FALSE; + END; + -------------------------------------------------------------------- + FUNCTION Is_X ( s : std_ulogic ) RETURN BOOLEAN IS + BEGIN + CASE s IS + WHEN 'U' | 'X' | 'Z' | 'W' | '-' => RETURN TRUE; + WHEN OTHERS => NULL; + END CASE; + RETURN FALSE; + END; + +END std_logic_1164; diff --git a/libraries/mentor/std_logic_arith.vhdl b/libraries/mentor/std_logic_arith.vhdl new file mode 100644 index 000000000..7bbd1d80b --- /dev/null +++ b/libraries/mentor/std_logic_arith.vhdl @@ -0,0 +1,254 @@ +---------------------------------------------------------------------------- +-- -- +-- Copyright (c) 1993 by Mentor Graphics -- +-- -- +-- This source file is proprietary information of Mentor Graphics,Inc. -- +-- It may be distributed in whole without restriction provided that -- +-- this copyright statement is not removed from the file and that -- +-- any derivative work contains this copyright notice. -- +-- -- +-- Package Name : std_logic_arith -- +-- -- +-- Purpose : This package is to allow the synthesis of the 1164 package. -- +-- This package add the capability of SIGNED/UNSIGNED math. -- +-- -- +---------------------------------------------------------------------------- + +LIBRARY ieee ; + +PACKAGE std_logic_arith IS + + + USE ieee.std_logic_1164.ALL; + + TYPE SIGNED IS ARRAY (Natural RANGE <>) OF STD_LOGIC ; + TYPE UNSIGNED IS ARRAY (Natural RANGE <>) OF STD_LOGIC ; + + FUNCTION std_ulogic_wired_or ( input : std_ulogic_vector ) RETURN std_ulogic; + FUNCTION std_ulogic_wired_and ( input : std_ulogic_vector ) RETURN std_ulogic; + + ------------------------------------------------------------------------------- + -- Note that all functions that take two vector arguments will + -- handle unequal argument lengths + ------------------------------------------------------------------------------- + + ------------------------------------------------------------------- + -- Conversion Functions + ------------------------------------------------------------------- + + -- Except for the to_integer and conv_integer functions for the + -- signed argument all others assume the input vector to be of + -- magnitude representation. The signed functions assume + -- a 2's complement representation. + FUNCTION to_integer ( arg1 : STD_ULOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER; + FUNCTION to_integer ( arg1 : STD_LOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER; + FUNCTION to_integer ( arg1 : STD_LOGIC; x : INTEGER := 0 ) RETURN NATURAL; + FUNCTION to_integer ( arg1 : UNSIGNED; x : INTEGER := 0 ) RETURN NATURAL; + FUNCTION to_integer ( arg1 : SIGNED; x : INTEGER := 0 ) RETURN INTEGER; + + FUNCTION conv_integer ( arg1 : STD_ULOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER; + FUNCTION conv_integer ( arg1 : STD_LOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER; + FUNCTION conv_integer ( arg1 : STD_LOGIC; x : INTEGER := 0 ) RETURN NATURAL; + FUNCTION conv_integer ( arg1 : UNSIGNED; x : INTEGER := 0 ) RETURN NATURAL; + FUNCTION conv_integer ( arg1 : SIGNED; x : INTEGER := 0 ) RETURN INTEGER; + + -- Following functions will return the natural argument in magnitude representation. + FUNCTION to_stdlogic ( arg1 : BOOLEAN ) RETURN STD_LOGIC; + FUNCTION to_stdlogicvector ( arg1 : INTEGER; size : NATURAL ) RETURN STD_LOGIC_VECTOR; + FUNCTION to_stdulogicvector ( arg1 : INTEGER; size : NATURAL ) RETURN STD_ULOGIC_VECTOR; + + FUNCTION to_unsigned ( arg1 : NATURAL; size : NATURAL ) RETURN UNSIGNED; + FUNCTION conv_unsigned ( arg1 : NATURAL; size : NATURAL ) RETURN UNSIGNED; + + -- The integer argument is returned in 2's complement representation. + FUNCTION to_signed ( arg1 : INTEGER; size : NATURAL ) RETURN SIGNED; + FUNCTION conv_signed ( arg1 : INTEGER; size : NATURAL ) RETURN SIGNED; + + + ------------------------------------------------------------------------------- + -- sign/zero extend FUNCTIONs + ------------------------------------------------------------------------------- + + -- The zero_extend functions will perform zero padding to the input vector, + -- returning a vector of length equal to size (the second argument). Note that + -- if size is less than the length of the input argument an assertion will occur. + FUNCTION zero_extend ( arg1 : STD_ULOGIC_VECTOR; size : NATURAL ) RETURN STD_ULOGIC_VECTOR; + FUNCTION zero_extend ( arg1 : STD_LOGIC_VECTOR; size : NATURAL ) RETURN STD_LOGIC_VECTOR; + FUNCTION zero_extend ( arg1 : STD_LOGIC; size : NATURAL ) RETURN STD_LOGIC_VECTOR; + FUNCTION zero_extend ( arg1 : UNSIGNED; size : NATURAL ) RETURN UNSIGNED; + FUNCTION sign_extend ( arg1 : SIGNED; size : NATURAL ) RETURN SIGNED; + + + ------------------------------------------------------------------------------- + -- Arithmetic functions + ------------------------------------------------------------------------------- + + -- All arithmetic functions except multiplication will return a vector + -- of size equal to the size of its largest argument. For multiplication, + -- the resulting vector has a size equal to the sum of the size of its inputs. + -- Note that arguments of unequal lengths are allowed. + FUNCTION "+" ( arg1, arg2 : STD_LOGIC ) RETURN STD_LOGIC; + FUNCTION "+" ( arg1, arg2 : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR; + FUNCTION "+" ( arg1, arg2 : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR; + FUNCTION "+" ( arg1, arg2 : UNSIGNED ) RETURN UNSIGNED ; + FUNCTION "+" ( arg1, arg2 : SIGNED ) RETURN SIGNED ; + + FUNCTION "-" ( arg1, arg2 : STD_LOGIC ) RETURN STD_LOGIC; + FUNCTION "-" ( arg1, arg2 : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR; + FUNCTION "-" ( arg1, arg2 : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR; + FUNCTION "-" ( arg1, arg2 : UNSIGNED ) RETURN UNSIGNED; + FUNCTION "-" ( arg1, arg2 : SIGNED ) RETURN SIGNED; + + FUNCTION "+" ( arg1 : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR; + FUNCTION "+" ( arg1 : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR; + FUNCTION "+" ( arg1 : UNSIGNED ) RETURN UNSIGNED; + FUNCTION "+" ( arg1 : SIGNED ) RETURN SIGNED; + FUNCTION "-" ( arg1 : SIGNED ) RETURN SIGNED; + + FUNCTION "*" ( arg1, arg2 : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR; + FUNCTION "*" ( arg1, arg2 : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR; + FUNCTION "*" ( arg1, arg2 : UNSIGNED ) RETURN UNSIGNED ; + FUNCTION "*" ( arg1, arg2 : SIGNED ) RETURN SIGNED ; + + FUNCTION "abs" ( arg1 : SIGNED) RETURN SIGNED; + + -- Vectorized Overloaded Arithmetic Operators, not supported for synthesis. + -- The following operators are not supported for synthesis. + FUNCTION "/" ( l, r : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR; + FUNCTION "/" ( l, r : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR; + FUNCTION "/" ( l, r : UNSIGNED ) RETURN UNSIGNED; + FUNCTION "/" ( l, r : SIGNED ) RETURN SIGNED; + FUNCTION "MOD" ( l, r : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR; + FUNCTION "MOD" ( l, r : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR; + FUNCTION "MOD" ( l, r : UNSIGNED ) RETURN UNSIGNED; + FUNCTION "REM" ( l, r : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR; + FUNCTION "REM" ( l, r : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR; + FUNCTION "REM" ( l, r : UNSIGNED ) RETURN UNSIGNED; + FUNCTION "**" ( l, r : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR; + FUNCTION "**" ( l, r : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR; + FUNCTION "**" ( l, r : UNSIGNED ) RETURN UNSIGNED; + + + ------------------------------------------------------------------------------- + -- Shift and rotate functions. + ------------------------------------------------------------------------------- + + -- Note that all the shift and rotate functions below will change to overloaded + -- operators in the train1 release. + FUNCTION "sla" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED ; + FUNCTION "sla" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED ; + FUNCTION "sla" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR ; + FUNCTION "sla" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR ; + + FUNCTION "sra" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED ; + FUNCTION "sra" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED ; + FUNCTION "sra" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR ; + FUNCTION "sra" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR ; + + FUNCTION "sll" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED ; + FUNCTION "sll" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED ; + FUNCTION "sll" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR ; + FUNCTION "sll" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR ; + + FUNCTION "srl" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED ; + FUNCTION "srl" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED ; + FUNCTION "srl" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR ; + FUNCTION "srl" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR ; + + FUNCTION "rol" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED ; + FUNCTION "rol" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED ; + FUNCTION "rol" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR ; + FUNCTION "rol" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR ; + + FUNCTION "ror" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED ; + FUNCTION "ror" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED ; + FUNCTION "ror" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR ; + FUNCTION "ror" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR ; + + + ------------------------------------------------------------------------------- + -- Comparision functions and operators. + ------------------------------------------------------------------------------- + + -- For all comparision operators, the default operator for signed and unsigned + -- types has been overloaded to perform logical comparisions. Note that for + -- other types the default operator is not overloaded and the use will result + -- in literal comparisions which is not supported for synthesis. + -- + -- Unequal operator widths are supported for all the comparision functions. + FUNCTION eq ( l, r : STD_LOGIC ) RETURN BOOLEAN; + FUNCTION eq ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION eq ( l, r : STD_LOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION eq ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION eq ( l, r : SIGNED ) RETURN BOOLEAN ; + FUNCTION "=" ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION "=" ( l, r : SIGNED ) RETURN BOOLEAN ; + + FUNCTION ne ( l, r : STD_LOGIC ) RETURN BOOLEAN; + FUNCTION ne ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION ne ( l, r : STD_LOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION ne ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION ne ( l, r : SIGNED ) RETURN BOOLEAN ; + FUNCTION "/=" ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION "/=" ( l, r : SIGNED ) RETURN BOOLEAN ; + + FUNCTION lt ( l, r : STD_LOGIC ) RETURN BOOLEAN; + FUNCTION lt ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION lt ( l, r : STD_LOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION lt ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION lt ( l, r : SIGNED ) RETURN BOOLEAN ; + FUNCTION "<" ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION "<" ( l, r : SIGNED ) RETURN BOOLEAN ; + + FUNCTION gt ( l, r : STD_LOGIC ) RETURN BOOLEAN; + FUNCTION gt ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION gt ( l, r : STD_LOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION gt ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION gt ( l, r : SIGNED ) RETURN BOOLEAN ; + FUNCTION ">" ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION ">" ( l, r : SIGNED ) RETURN BOOLEAN ; + + FUNCTION le ( l, r : STD_LOGIC ) RETURN BOOLEAN; + FUNCTION le ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION le ( l, r : STD_LOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION le ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION le ( l, r : SIGNED ) RETURN BOOLEAN ; + FUNCTION "<=" ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION "<=" ( l, r : SIGNED ) RETURN BOOLEAN ; + + FUNCTION ge ( l, r : STD_LOGIC ) RETURN BOOLEAN; + FUNCTION ge ( l, r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION ge ( l, r : STD_LOGIC_VECTOR ) RETURN BOOLEAN; + FUNCTION ge ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION ge ( l, r : SIGNED ) RETURN BOOLEAN ; + FUNCTION ">=" ( l, r : UNSIGNED ) RETURN BOOLEAN ; + FUNCTION ">=" ( l, r : SIGNED ) RETURN BOOLEAN ; + + ------------------------------------------------------------------------------- + -- Logical operators. + ------------------------------------------------------------------------------- + + -- allows operands of unequal lengths, return vector is + -- equal to the size of the largest argument. + + FUNCTION "and" (arg1, arg2:SIGNED) RETURN SIGNED; + FUNCTION "and" (arg1, arg2:UNSIGNED) RETURN UNSIGNED; + FUNCTION "nand" (arg1, arg2:SIGNED) RETURN SIGNED; + FUNCTION "nand" (arg1, arg2:UNSIGNED) RETURN UNSIGNED; + FUNCTION "or" (arg1, arg2:SIGNED) RETURN SIGNED; + FUNCTION "or" (arg1, arg2:UNSIGNED) RETURN UNSIGNED; + FUNCTION "nor" (arg1, arg2:SIGNED) RETURN SIGNED; + FUNCTION "nor" (arg1, arg2:UNSIGNED) RETURN UNSIGNED; + FUNCTION "xor" (arg1, arg2:SIGNED) RETURN SIGNED; + FUNCTION "xor" (arg1, arg2:UNSIGNED) RETURN UNSIGNED; + FUNCTION "not" (arg1:SIGNED) RETURN SIGNED; + FUNCTION "not" (arg1:UNSIGNED) RETURN UNSIGNED; + + FUNCTION "xnor" (arg1, arg2:STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR; + FUNCTION "xnor" (arg1, arg2:STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR; + FUNCTION "xnor" (arg1, arg2:SIGNED) RETURN SIGNED; + FUNCTION "xnor" (arg1, arg2:UNSIGNED) RETURN UNSIGNED; + +END std_logic_arith ; + + diff --git a/libraries/mentor/std_logic_arith_body.vhdl b/libraries/mentor/std_logic_arith_body.vhdl new file mode 100644 index 000000000..36f76cb7d --- /dev/null +++ b/libraries/mentor/std_logic_arith_body.vhdl @@ -0,0 +1,2915 @@ +LIBRARY ieee; +-- LIBRARY arithmetic; + +PACKAGE BODY std_logic_arith IS + + USE ieee.std_logic_1164.ALL; + -- USE arithmetic.utils.all; + + ------------------------------------------------------------------- + -- Local Types + ------------------------------------------------------------------- + TYPE stdlogic_1d IS ARRAY (std_ulogic) OF std_ulogic; + TYPE stdlogic_table IS ARRAY(std_ulogic, std_ulogic) OF std_ulogic; + TYPE stdlogic_boolean_table IS ARRAY(std_ulogic, std_ulogic) OF BOOLEAN; + + -------------------------------------------------------------------- + -------------------------------------------------------------------- + -- FUNCTIONS DEFINED FOR SYNTHESIS + -------------------------------------------------------------------- + -------------------------------------------------------------------- + + FUNCTION std_ulogic_wired_or ( input : std_ulogic_vector ) RETURN std_ulogic IS + VARIABLE result : std_ulogic := '-'; -- weakest state default + CONSTANT resolution_table : stdlogic_table := ( + -- --------------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- --------------------------------------------------------- + ( 'X', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | U | + ( 'X', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | X | + ( 'X', 'X', '0', '1', '0', 'X', '0', '1', '0' ), -- | 0 | + ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ), -- | 1 | + ( 'X', 'X', '0', '1', 'Z', 'X', '0', '1', 'Z' ), -- | Z | + ( 'X', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | W | + ( 'X', 'X', '0', '1', '0', 'X', '0', '1', '0' ), -- | L | + ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ), -- | H | + ( 'X', 'X', '0', '1', 'Z', 'X', '0', '1', 'Z' ) -- | D | + ); + + BEGIN + -- Iterate through all inputs + FOR i IN input'range LOOP + result := resolution_table(result, input(i)); + END LOOP; + -- Return the resultant value + RETURN result; + END std_ulogic_wired_or; + + FUNCTION std_ulogic_wired_and ( input : std_ulogic_vector ) RETURN std_ulogic IS + VARIABLE result : std_ulogic := '-'; -- weakest state default + CONSTANT resolution_table : stdlogic_table := ( + -- --------------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- --------------------------------------------------------- + ( 'X', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | U | + ( 'X', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | X | + ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ), -- | 0 | + ( 'X', 'X', '0', '1', '1', 'X', '0', '1', '1' ), -- | 1 | + ( 'X', 'X', '0', '1', 'Z', 'X', '0', '1', 'Z' ), -- | Z | + ( 'X', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | W | + ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ), -- | L | + ( 'X', 'X', '0', '1', '1', 'X', '0', '1', '1' ), -- | H | + ( 'X', 'X', '0', '1', 'Z', 'X', '0', '1', 'Z' ) -- | D | + ); + + BEGIN + -- Iterate through all inputs + FOR i IN input'range LOOP + result := resolution_table(result, input(i)); + END LOOP; + -- Return the resultant value + RETURN result; + END std_ulogic_wired_and; + +-- +-- MGC base level functions +-- +-- +-- Convert Base Type to Integer +-- + FUNCTION to_integer (arg1 : STD_ULOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER IS + VARIABLE tmp : SIGNED( arg1'length - 1 DOWNTO 0 ) := (OTHERS => '0'); + VARIABLE result : INTEGER; + BEGIN + tmp := SIGNED(arg1); + result := TO_INTEGER( tmp, x ); + RETURN (result); + END to_integer; + + FUNCTION to_integer (arg1 : STD_LOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER IS + VARIABLE tmp : SIGNED( arg1'length - 1 DOWNTO 0 ) := (OTHERS => '0'); + VARIABLE result : INTEGER; + BEGIN + tmp := SIGNED(arg1); + result := TO_INTEGER( tmp, x ); + RETURN (result); + END to_integer; + + FUNCTION to_integer (arg1 : UNSIGNED; x : INTEGER := 0 ) RETURN NATURAL IS + VARIABLE tmp : SIGNED( arg1'length DOWNTO 0 ) := (OTHERS => '0'); + VARIABLE result : NATURAL; + BEGIN + tmp := '0' & SIGNED(arg1); + result := TO_INTEGER( tmp, x ); + RETURN (result); + END to_integer; + + FUNCTION TO_INTEGER (arg1 : SIGNED; x : INTEGER := 0 ) RETURN INTEGER IS + VARIABLE return_int,x_tmp : INTEGER := 0; + BEGIN + ASSERT arg1'length > 0 + REPORT "NULL vector, returning 0" + SEVERITY NOTE; + assert arg1'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + ASSERT arg1'length <= 32 -- implementation dependent limit + REPORT "vector too large, conversion may cause overflow" + SEVERITY WARNING; + IF x /= 0 THEN + x_tmp := 1; + END IF; + IF arg1(arg1'left) = '0' OR arg1(arg1'left) = 'L' OR -- positive value + ( x_tmp = 0 AND arg1(arg1'left) /= '1' AND arg1(arg1'left) /= 'H') THEN + FOR i IN arg1'range LOOP + return_int := return_int * 2; + CASE arg1(i) IS + WHEN '0'|'L' => NULL; + WHEN '1'|'H' => return_int := return_int + 1; + WHEN OTHERS => return_int := return_int + x_tmp; + END CASE; + END LOOP; + ELSE -- negative value + IF (x_tmp = 0) THEN + x_tmp := 1; + ELSE + x_tmp := 0; + END IF; + FOR i IN arg1'range LOOP + return_int := return_int * 2; + CASE arg1(i) IS + WHEN '0'|'L' => return_int := return_int + 1; + WHEN '1'|'H' => NULL; + WHEN OTHERS => return_int := return_int + x_tmp; + END CASE; + END LOOP; + return_int := (-return_int) - 1; + END IF; + RETURN return_int; + END TO_INTEGER; + + FUNCTION to_integer (arg1:STD_LOGIC; x : INTEGER := 0 ) RETURN NATURAL IS + BEGIN + IF(arg1 = '0' OR arg1 = 'L' OR (x = 0 AND arg1 /= '1' AND arg1 /= 'H')) THEN + RETURN(0); + ELSE + RETURN(1) ; + END IF ; + END ; + + FUNCTION conv_integer (arg1 : STD_ULOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER IS + VARIABLE tmp : SIGNED( arg1'length - 1 DOWNTO 0 ) := (OTHERS => '0'); + VARIABLE result : INTEGER; + BEGIN + tmp := SIGNED(arg1); + result := TO_INTEGER( tmp, x ); + RETURN (result); + END ; + + FUNCTION conv_integer (arg1 : STD_LOGIC_VECTOR; x : INTEGER := 0 ) RETURN INTEGER IS + VARIABLE tmp : SIGNED( arg1'length -1 DOWNTO 0 ) := (OTHERS => '0'); + VARIABLE result : INTEGER; + BEGIN + tmp := SIGNED(arg1); + result := TO_INTEGER( tmp, x ); + RETURN (result); + END ; + + FUNCTION conv_integer (arg1 : UNSIGNED; x : INTEGER := 0 ) RETURN NATURAL IS + VARIABLE tmp : SIGNED( arg1'length DOWNTO 0 ) := (OTHERS => '0'); + VARIABLE result : NATURAL; + BEGIN + tmp := '0' & SIGNED(arg1); + result := TO_INTEGER( tmp, x ); + RETURN (result); + END ; + + FUNCTION conv_INTEGER (arg1 : SIGNED; x : INTEGER := 0 ) RETURN INTEGER IS + VARIABLE return_int,x_tmp : INTEGER := 0; + BEGIN + ASSERT arg1'length > 0 + REPORT "NULL vector, returning 0" + SEVERITY NOTE; + assert arg1'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + ASSERT arg1'length <= 32 -- implementation dependent limit + REPORT "vector too large, conversion may cause overflow" + SEVERITY WARNING; + IF x /= 0 THEN + x_tmp := 1; + END IF; + IF arg1(arg1'left) = '0' OR arg1(arg1'left) = 'L' OR -- positive value + ( x_tmp = 0 AND arg1(arg1'left) /= '1' AND arg1(arg1'left) /= 'H') THEN + FOR i IN arg1'range LOOP + return_int := return_int * 2; + CASE arg1(i) IS + WHEN '0'|'L' => NULL; + WHEN '1'|'H' => return_int := return_int + 1; + WHEN OTHERS => return_int := return_int + x_tmp; + END CASE; + END LOOP; + ELSE -- negative value + IF (x_tmp = 0) THEN + x_tmp := 1; + ELSE + x_tmp := 0; + END IF; + FOR i IN arg1'range LOOP + return_int := return_int * 2; + CASE arg1(i) IS + WHEN '0'|'L' => return_int := return_int + 1; + WHEN '1'|'H' => NULL; + WHEN OTHERS => return_int := return_int + x_tmp; + END CASE; + END LOOP; + return_int := (-return_int) - 1; + END IF; + RETURN return_int; + END ; + + FUNCTION conv_integer (arg1:STD_LOGIC; x : INTEGER := 0 ) RETURN NATURAL IS + BEGIN + IF(arg1 = '0' OR arg1 = 'L' OR (x = 0 AND arg1 /= '1' AND arg1 /= 'H')) THEN + RETURN(0); + ELSE + RETURN(1) ; + END IF ; + END ; + +-- +-- Convert Base Type to STD_LOGIC +-- + + FUNCTION to_stdlogic (arg1:BOOLEAN) RETURN STD_LOGIC IS + BEGIN + IF(arg1) THEN + RETURN('1') ; + ELSE + RETURN('0') ; + END IF ; + END ; + +-- +-- Convert Base Type to STD_LOGIC_VECTOR +-- + FUNCTION To_StdlogicVector (arg1 : integer; size : NATURAL) RETURN std_logic_vector IS + VARIABLE vector : std_logic_vector(0 TO size-1); + VARIABLE tmp_int : integer := arg1; + VARIABLE carry : std_logic := '1'; -- setup to add 1 if needed + VARIABLE carry2 : std_logic; + BEGIN + FOR i IN size-1 DOWNTO 0 LOOP + IF tmp_int MOD 2 = 1 THEN + vector(i) := '1'; + ELSE + vector(i) := '0'; + END IF; + tmp_int := tmp_int / 2; + END LOOP; + + IF arg1 < 0 THEN + FOR i IN size-1 DOWNTO 0 LOOP + carry2 := (NOT vector(i)) AND carry; + vector(i) := (NOT vector(i)) XOR carry; + carry := carry2; + END LOOP; + END IF; + RETURN vector; + END To_StdlogicVector; + + FUNCTION To_StdUlogicVector (arg1 : integer; size : NATURAL) RETURN std_ulogic_vector IS + VARIABLE vector : std_ulogic_vector(0 TO size-1); + VARIABLE tmp_int : integer := arg1; + VARIABLE carry : std_ulogic := '1'; -- setup to add 1 if needed + VARIABLE carry2 : std_ulogic; + BEGIN + FOR i IN size-1 DOWNTO 0 LOOP + IF tmp_int MOD 2 = 1 THEN + vector(i) := '1'; + ELSE + vector(i) := '0'; + END IF; + tmp_int := tmp_int / 2; + END LOOP; + + IF arg1 < 0 THEN + FOR i IN size-1 DOWNTO 0 LOOP + carry2 := (NOT vector(i)) AND carry; + vector(i) := (NOT vector(i)) XOR carry; + carry := carry2; + END LOOP; + END IF; + RETURN vector; + END To_StdUlogicVector; + + +-- +-- Convert Base Type to UNSIGNED +-- + + FUNCTION to_unsigned (arg1:NATURAL ; size:NATURAL) RETURN UNSIGNED IS + VARIABLE vector : UNSIGNED(0 TO size-1) := (OTHERS => '0'); + VARIABLE tmp_int : INTEGER := arg1; + BEGIN + FOR i IN size-1 DOWNTO 0 LOOP + IF tmp_int MOD 2 = 1 THEN + vector(i) := '1'; + ELSE + vector(i) := '0'; + END IF; + tmp_int := tmp_int / 2; + END LOOP; + + RETURN vector; + END ; + + FUNCTION conv_unsigned (arg1:NATURAL ; size:NATURAL) RETURN UNSIGNED IS + VARIABLE vector : UNSIGNED(0 TO size-1) := (OTHERS => '0'); + VARIABLE tmp_int : INTEGER := arg1; + BEGIN + FOR i IN size-1 DOWNTO 0 LOOP + IF tmp_int MOD 2 = 1 THEN + vector(i) := '1'; + ELSE + vector(i) := '0'; + END IF; + tmp_int := tmp_int / 2; + END LOOP; + + RETURN vector; + END ; + +-- +-- Convert Base Type to SIGNED +-- + + FUNCTION to_signed (arg1:INTEGER ; size : NATURAL) RETURN SIGNED IS + VARIABLE vector : SIGNED(0 TO size-1) := (OTHERS => '0'); + VARIABLE tmp_int : INTEGER := arg1; + VARIABLE carry : STD_LOGIC := '1'; -- setup to add 1 if needed + VARIABLE carry2 : STD_LOGIC := '0'; + BEGIN + FOR i IN size-1 DOWNTO 0 LOOP + IF tmp_int MOD 2 = 1 THEN + vector(i) := '1'; + ELSE + vector(i) := '0'; + END IF; + tmp_int := tmp_int / 2; + END LOOP; + + IF arg1 < 0 THEN + FOR i IN size-1 DOWNTO 0 LOOP + carry2 := (NOT vector(i)) AND carry; + vector(i) := (NOT vector(i)) XOR carry; + carry := carry2; + END LOOP; + END IF; + RETURN vector; + END ; + + FUNCTION conv_signed (arg1:INTEGER ; size : NATURAL) RETURN SIGNED IS + VARIABLE vector : SIGNED(0 TO size-1) := (OTHERS => '0'); + VARIABLE tmp_int : INTEGER := arg1; + VARIABLE carry : STD_LOGIC := '1'; -- setup to add 1 if needed + VARIABLE carry2 : STD_LOGIC := '0'; + BEGIN + FOR i IN size-1 DOWNTO 0 LOOP + IF tmp_int MOD 2 = 1 THEN + vector(i) := '1'; + ELSE + vector(i) := '0'; + END IF; + tmp_int := tmp_int / 2; + END LOOP; + + IF arg1 < 0 THEN + FOR i IN size-1 DOWNTO 0 LOOP + carry2 := (NOT vector(i)) AND carry; + vector(i) := (NOT vector(i)) XOR carry; + carry := carry2; + END LOOP; + END IF; + RETURN vector; + END ; + + -- sign/zero extend functions + -- + + FUNCTION zero_extend ( arg1 : STD_ULOGIC_VECTOR; size : NATURAL ) RETURN STD_ULOGIC_VECTOR + IS + VARIABLE answer : STD_ULOGIC_VECTOR(size-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + ASSERT arg1'length <= size + REPORT "Vector is already larger then size." + SEVERITY WARNING ; + answer := (OTHERS => '0') ; + answer(arg1'length-1 DOWNTO 0) := arg1; + RETURN(answer) ; + END ; + + FUNCTION zero_extend ( arg1 : STD_LOGIC_VECTOR; size : NATURAL ) RETURN STD_LOGIC_VECTOR + IS + VARIABLE answer : STD_LOGIC_VECTOR(size-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + ASSERT arg1'length <= size + REPORT "Vector is already larger then size." + SEVERITY WARNING ; + answer := (OTHERS => '0') ; + answer(arg1'length-1 DOWNTO 0) := arg1; + RETURN(answer) ; + END ; + + FUNCTION zero_extend ( arg1 : STD_LOGIC; size : NATURAL ) RETURN STD_LOGIC_VECTOR + IS + VARIABLE answer : STD_LOGIC_VECTOR(size-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + answer := (OTHERS => '0') ; + answer(0) := arg1; + RETURN(answer) ; + END ; + + FUNCTION zero_extend ( arg1 : UNSIGNED; size : NATURAL ) RETURN UNSIGNED IS + VARIABLE answer : UNSIGNED(size-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + ASSERT arg1'length <= size + REPORT "Vector is already larger then size." + SEVERITY WARNING ; + answer := (OTHERS => '0') ; + answer(arg1'length - 1 DOWNTO 0) := arg1; + RETURN(answer) ; + END ; + + FUNCTION sign_extend ( arg1 : SIGNED; size : NATURAL ) RETURN SIGNED IS + VARIABLE answer : SIGNED(size-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + ASSERT arg1'length <= size + REPORT "Vector is already larger then size." + SEVERITY WARNING ; + answer := (OTHERS => arg1(arg1'left)) ; + answer(arg1'length - 1 DOWNTO 0) := arg1; + RETURN(answer) ; + END ; + + + + -- Some useful generic functions + + --//// Zero Extend //// + -- + -- Function zxt + -- + FUNCTION zxt( q : STD_ULOGIC_VECTOR; i : INTEGER ) RETURN STD_ULOGIC_VECTOR IS + VARIABLE qs : STD_ULOGIC_VECTOR (1 TO i); + VARIABLE qt : STD_ULOGIC_VECTOR (1 TO q'length); + BEGIN + qt := q; + IF i < q'length THEN + qs := qt( (q'length-i+1) TO qt'right); + ELSIF i > q'length THEN + qs := (OTHERS=>'0'); + qs := qs(1 TO (i-q'length)) & qt; + ELSE + qs := qt; + END IF; + RETURN qs; + END; + + --//// Zero Extend //// + -- + -- Function zxt + -- + FUNCTION zxt( q : STD_LOGIC_VECTOR; i : INTEGER ) RETURN STD_LOGIC_VECTOR IS + VARIABLE qs : STD_LOGIC_VECTOR (1 TO i); + VARIABLE qt : STD_LOGIC_VECTOR (1 TO q'length); + BEGIN + qt := q; + IF i < q'length THEN + qs := qt( (q'length-i+1) TO qt'right); + ELSIF i > q'length THEN + qs := (OTHERS=>'0'); + qs := qs(1 TO (i-q'length)) & qt; + ELSE + qs := qt; + END IF; + RETURN qs; + END; + + --//// Zero Extend //// + -- + -- Function zxt + -- + FUNCTION zxt( q : UNSIGNED; i : INTEGER ) RETURN UNSIGNED IS + VARIABLE qs : UNSIGNED (1 TO i); + VARIABLE qt : UNSIGNED (1 TO q'length); + BEGIN + qt := q; + IF i < q'length THEN + qs := qt( (q'length-i+1) TO qt'right); + ELSIF i > q'length THEN + qs := (OTHERS=>'0'); + qs := qs(1 TO (i-q'length)) & qt; + ELSE + qs := qt; + END IF; + RETURN qs; + END; + +-------------------------------------- +-- Synthesizable addition Functions -- +-------------------------------------- + + FUNCTION "+" ( arg1, arg2 : STD_LOGIC ) RETURN STD_LOGIC IS + -- truth table for "xor" function + CONSTANT xor_table : stdlogic_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------- + ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ), -- | U | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | X | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | 0 | + ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ), -- | 1 | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | Z | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | W | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | L | + ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ), -- | H | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ) -- | D | + ); + BEGIN + RETURN xor_table( arg1, arg2 ); + END "+"; + + function maximum (arg1, arg2: integer) return integer is + begin + if arg1 > arg2 then + return arg1; + else + return arg2; + end if; + end; + + FUNCTION "+" (arg1, arg2 :STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS + CONSTANT ml : INTEGER := maximum(arg1'length,arg2'length); + VARIABLE lt : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE rt : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE res : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE carry : STD_ULOGIC := '0'; + VARIABLE a,b,s1 : STD_ULOGIC; + BEGIN + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + + FOR i IN res'reverse_range LOOP + a := lt(i); + b := rt(i); + s1 := a + b; + res(i) := s1 + carry; + carry := (a AND b) OR (s1 AND carry); + END LOOP; + RETURN res; + END; + + FUNCTION "+" (arg1, arg2 :STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS + CONSTANT ml : INTEGER := maximum(arg1'length,arg2'length); + VARIABLE lt : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE rt : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE res : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE carry : STD_LOGIC := '0'; + VARIABLE a,b,s1 : STD_LOGIC; + BEGIN + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + + FOR i IN res'reverse_range LOOP + a := lt(i); + b := rt(i); + s1 := a + b; + res(i) := s1 + carry; + carry := (a AND b) OR (s1 AND carry); + END LOOP; + RETURN res; + END; + + FUNCTION "+" (arg1, arg2:UNSIGNED) RETURN UNSIGNED IS + CONSTANT ml : INTEGER := maximum(arg1'length,arg2'length); + VARIABLE lt : UNSIGNED(1 TO ml); + VARIABLE rt : UNSIGNED(1 TO ml); + VARIABLE res : UNSIGNED(1 TO ml); + VARIABLE carry : STD_LOGIC := '0'; + VARIABLE a,b,s1 : STD_LOGIC; + BEGIN + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + + FOR i IN res'reverse_range LOOP + a := lt(i); + b := rt(i); + s1 := a + b; + res(i) := s1 + carry; + carry := (a AND b) OR (s1 AND carry); + END LOOP; + RETURN res; + END; + + FUNCTION "+" (arg1, arg2:SIGNED) RETURN SIGNED IS + CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ; + VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + assert arg1'length > 1 AND arg2'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + a := (OTHERS => arg1(arg1'left)) ; + a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1); + b := (OTHERS => arg2(arg2'left)) ; + b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2); + answer := SIGNED(a + b); + RETURN (answer); + END ; + +----------------------------------------- +-- Synthesizable subtraction Functions -- +----------------------------------------- + + FUNCTION "-" ( arg1, arg2 : std_logic ) RETURN std_logic IS + -- truth table for "xor" function + CONSTANT xor_table : stdlogic_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------- + ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ), -- | U | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | X | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | 0 | + ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ), -- | 1 | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | Z | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | W | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | L | + ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ), -- | H | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ) -- | D | + ); + BEGIN + RETURN xor_table( arg1, arg2 ); + END "-"; + + FUNCTION "-" (arg1, arg2:STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS + CONSTANT ml : INTEGER := maximum(arg1'length,arg2'length); + VARIABLE lt : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE rt : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE res : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE borrow : STD_ULOGIC := '1'; + VARIABLE a,b,s1 : STD_ULOGIC; + BEGIN + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + + FOR i IN res'reverse_range LOOP + a := lt(i); + b := NOT rt(i); + s1 := a + b; + res(i) := s1 + borrow; + borrow := (a AND b) OR (s1 AND borrow); + END LOOP; + RETURN res; + END "-"; + + FUNCTION "-" (arg1, arg2:STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS + CONSTANT ml : INTEGER := maximum(arg1'length,arg2'length); + VARIABLE lt : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE rt : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE res : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE borrow : STD_LOGIC := '1'; + VARIABLE a,b,s1 : STD_LOGIC; + BEGIN + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + + FOR i IN res'reverse_range LOOP + a := lt(i); + b := NOT rt(i); + s1 := a + b; + res(i) := s1 + borrow; + borrow := (a AND b) OR (s1 AND borrow); + END LOOP; + RETURN res; + END "-"; + + FUNCTION "-" (arg1, arg2:UNSIGNED) RETURN UNSIGNED IS + CONSTANT ml : INTEGER := maximum(arg1'length,arg2'length); + VARIABLE lt : UNSIGNED(1 TO ml); + VARIABLE rt : UNSIGNED(1 TO ml); + VARIABLE res : UNSIGNED(1 TO ml); + VARIABLE borrow : STD_LOGIC := '1'; + VARIABLE a,b,s1 : STD_LOGIC; + BEGIN + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + + FOR i IN res'reverse_range LOOP + a := lt(i); + b := NOT rt(i); + s1 := a + b; + res(i) := s1 + borrow; + borrow := (a AND b) OR (s1 AND borrow); + END LOOP; + RETURN res; + END "-"; + + + FUNCTION "-" (arg1, arg2:SIGNED) RETURN SIGNED IS + CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ; + VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + assert arg1'length > 1 AND arg2'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + a := (OTHERS => arg1(arg1'left)) ; + a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1); + b := (OTHERS => arg2(arg2'left)) ; + b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2); + answer := SIGNED( a - b ); + RETURN (answer); + END ; + +----------------------------------------- +-- Unary subtract and add Functions -- +----------------------------------------- + FUNCTION "+" (arg1:STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS + BEGIN + RETURN (arg1); + END; + + FUNCTION "+" (arg1:STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS + BEGIN + RETURN (arg1); + END; + + FUNCTION "+" (arg1:UNSIGNED) RETURN UNSIGNED IS + BEGIN + RETURN (arg1); + END; + + FUNCTION "+" (arg1:SIGNED) RETURN SIGNED IS + BEGIN + RETURN (arg1); + END; + + FUNCTION hasx( v : SIGNED ) RETURN BOOLEAN IS + BEGIN + FOR i IN v'range LOOP + IF v(i) = '0' OR v(i) = '1' OR v(i) = 'L' OR v(i) = 'H'THEN + NULL; + ELSE + RETURN TRUE; + END IF; + END LOOP; + RETURN FALSE; + END hasx; + + FUNCTION "-" (arg1:SIGNED) RETURN SIGNED IS + constant len : integer := arg1'length; + VARIABLE answer, tmp : SIGNED( len-1 downto 0 ) := (others=>'0'); + VARIABLE index : integer := len; + BEGIN + assert arg1'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + IF hasx(arg1) THEN + answer := (OTHERS => 'X'); + ELSE + tmp := arg1; + lp1 : FOR i IN answer'REVERSE_RANGE LOOP + IF (tmp(i) = '1' OR tmp(i) = 'H') THEN + index := i+1; + answer(i downto 0) := tmp(i downto 0); + exit; + END IF; + END LOOP lp1; + answer(len-1 downto index) := NOT tmp(len-1 downto index); + end if; + RETURN (answer); + END ; + +-------------------------------------------- +-- Synthesizable multiplication Functions -- +-------------------------------------------- + FUNCTION shift( v : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR IS + VARIABLE v1 : STD_ULOGIC_VECTOR( v'range ); + BEGIN + FOR i IN (v'left+1) TO v'right LOOP + v1(i-1) := v(i); + END LOOP; + v1(v1'right) := '0'; + RETURN v1; + END shift; + + PROCEDURE copy(a : IN STD_ULOGIC_VECTOR; b : OUT STD_ULOGIC_VECTOR) IS + VARIABLE bi : INTEGER := b'right; + BEGIN + FOR i IN a'reverse_range LOOP + b(bi) := a(i); + bi := bi - 1; + END LOOP; + END copy; + + FUNCTION shift( v : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR IS + VARIABLE v1 : STD_LOGIC_VECTOR( v'range ); + BEGIN + FOR i IN (v'left+1) TO v'right LOOP + v1(i-1) := v(i); + END LOOP; + v1(v1'right) := '0'; + RETURN v1; + END shift; + + PROCEDURE copy(a : IN STD_LOGIC_VECTOR; b : OUT STD_LOGIC_VECTOR) IS + VARIABLE bi : INTEGER := b'right; + BEGIN + FOR i IN a'reverse_range LOOP + b(bi) := a(i); + bi := bi - 1; + END LOOP; + END copy; + + FUNCTION shift( v : SIGNED ) RETURN SIGNED IS + VARIABLE v1 : SIGNED( v'range ); + BEGIN + FOR i IN (v'left+1) TO v'right LOOP + v1(i-1) := v(i); + END LOOP; + v1(v1'right) := '0'; + RETURN v1; + END shift; + + PROCEDURE copy(a : IN SIGNED; b : OUT SIGNED) IS + VARIABLE bi : INTEGER := b'right; + BEGIN + FOR i IN a'reverse_range LOOP + b(bi) := a(i); + bi := bi - 1; + END LOOP; + END copy; + + FUNCTION shift( v : UNSIGNED ) RETURN UNSIGNED IS + VARIABLE v1 : UNSIGNED( v'range ); + BEGIN + FOR i IN (v'left+1) TO v'right LOOP + v1(i-1) := v(i); + END LOOP; + v1(v1'right) := '0'; + RETURN v1; + END shift; + + PROCEDURE copy(a : IN UNSIGNED; b : OUT UNSIGNED) IS + VARIABLE bi : INTEGER := b'right; + BEGIN + FOR i IN a'reverse_range LOOP + b(bi) := a(i); + bi := bi - 1; + END LOOP; + END copy; + + FUNCTION "*" (arg1, arg2:STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS + VARIABLE ml : INTEGER := arg1'length + arg2'length; + VARIABLE lt : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE rt : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE prod : STD_ULOGIC_VECTOR(1 TO ml) := (OTHERS=>'0'); + BEGIN + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN rt'reverse_range LOOP + IF rt(i) = '1' THEN + prod := prod + lt; + END IF; + lt := shift(lt); + END LOOP; + RETURN prod; + END "*"; + + FUNCTION "*" (arg1, arg2:STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS + VARIABLE ml : INTEGER := arg1'length + arg2'length; + VARIABLE lt : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE rt : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE prod : STD_LOGIC_VECTOR(1 TO ml) := (OTHERS=>'0'); + BEGIN + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN rt'reverse_range LOOP + IF rt(i) = '1' THEN + prod := prod + lt; + END IF; + lt := shift(lt); + END LOOP; + RETURN prod; + END "*"; + + FUNCTION "*" (arg1, arg2:UNSIGNED) RETURN UNSIGNED IS + VARIABLE ml : INTEGER := arg1'length + arg2'length; + VARIABLE lt : UNSIGNED(1 TO ml); + VARIABLE rt : UNSIGNED(1 TO ml); + VARIABLE prod : UNSIGNED(1 TO ml) := (OTHERS=>'0'); + BEGIN + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN rt'reverse_range LOOP + IF rt(i) = '1' THEN + prod := prod + lt; + END IF; + lt := shift(lt); + END LOOP; + RETURN prod; + END "*"; + + --//// Sign Extend //// + -- + -- Function sxt + -- + FUNCTION sxt( q : SIGNED; i : INTEGER ) RETURN SIGNED IS + VARIABLE qs : SIGNED (1 TO i); + VARIABLE qt : SIGNED (1 TO q'length); + BEGIN + qt := q; + IF i < q'length THEN + qs := qt( (q'length-i+1) TO qt'right); + ELSIF i > q'length THEN + qs := (OTHERS=>q(q'left)); + qs := qs(1 TO (i-q'length)) & qt; + ELSE + qs := qt; + END IF; + RETURN qs; + END; + + FUNCTION "*" (arg1, arg2:SIGNED) RETURN SIGNED IS + VARIABLE ml : INTEGER := arg1'length + arg2'length; + VARIABLE lt : SIGNED(1 TO ml); + VARIABLE rt : SIGNED(1 TO ml); + VARIABLE prod : SIGNED(1 TO ml) := (OTHERS=>'0'); + BEGIN + assert arg1'length > 1 AND arg2'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := sxt( arg1, ml ); + rt := sxt( arg2, ml ); + FOR i IN rt'reverse_range LOOP + IF rt(i) = '1' THEN + prod := prod + lt; + END IF; + lt := shift(lt); + END LOOP; + RETURN prod; + END "*"; + + FUNCTION rshift( v : STD_ULOGIC_VECTOR ) RETURN STD_ULOGIC_VECTOR IS + VARIABLE v1 : STD_ULOGIC_VECTOR( v'range ); + BEGIN + FOR i IN v'left TO v'right-1 LOOP + v1(i+1) := v(i); + END LOOP; + v1(v1'left) := '0'; + RETURN v1; + END rshift; + + FUNCTION hasx( v : STD_ULOGIC_VECTOR ) RETURN BOOLEAN IS + BEGIN + FOR i IN v'range LOOP + IF v(i) = '0' OR v(i) = '1' OR v(i) = 'L' OR v(i) = 'H'THEN + NULL; + ELSE + RETURN TRUE; + END IF; + END LOOP; + RETURN FALSE; + END hasx; + + FUNCTION rshift( v : STD_LOGIC_VECTOR ) RETURN STD_LOGIC_VECTOR IS + VARIABLE v1 : STD_LOGIC_VECTOR( v'range ); + BEGIN + FOR i IN v'left TO v'right-1 LOOP + v1(i+1) := v(i); + END LOOP; + v1(v1'left) := '0'; + RETURN v1; + END rshift; + + FUNCTION hasx( v : STD_LOGIC_VECTOR ) RETURN BOOLEAN IS + BEGIN + FOR i IN v'range LOOP + IF v(i) = '0' OR v(i) = '1' OR v(i) = 'L' OR v(i) = 'H'THEN + NULL; + ELSE + RETURN TRUE; + END IF; + END LOOP; + RETURN FALSE; + END hasx; + + FUNCTION rshift( v : UNSIGNED ) RETURN UNSIGNED IS + VARIABLE v1 : UNSIGNED( v'range ); + BEGIN + FOR i IN v'left TO v'right-1 LOOP + v1(i+1) := v(i); + END LOOP; + v1(v1'left) := '0'; + RETURN v1; + END rshift; + + FUNCTION hasx( v : UNSIGNED ) RETURN BOOLEAN IS + BEGIN + FOR i IN v'range LOOP + IF v(i) = '0' OR v(i) = '1' OR v(i) = 'L' OR v(i) = 'H'THEN + NULL; + ELSE + RETURN TRUE; + END IF; + END LOOP; + RETURN FALSE; + END hasx; + + FUNCTION rshift( v : SIGNED ) RETURN SIGNED IS + VARIABLE v1 : SIGNED( v'range ); + BEGIN + FOR i IN v'left TO v'right-1 LOOP + v1(i+1) := v(i); + END LOOP; + v1(v1'left) := '0'; + RETURN v1; + END rshift; + + FUNCTION "/" (l, r :STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS + + CONSTANT ml : INTEGER := maximum(l'length,r'length); + VARIABLE lt : STD_ULOGIC_VECTOR(0 TO ml+1); + VARIABLE rt : STD_ULOGIC_VECTOR(0 TO ml+1); + VARIABLE quote : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE tmp : STD_ULOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0'); + VARIABLE n : STD_ULOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0'); + + BEGIN + ASSERT NOT (r = "0") + REPORT "Attempted divide by ZERO" + SEVERITY ERROR; + IF hasx(l) OR hasx(r) THEN + FOR i IN quote'range LOOP + quote(i) := 'X'; + END LOOP; + ELSE + lt := zxt( l, ml+2 ); + WHILE lt >= r LOOP + rt := zxt( r, ml+2 ); + n := (OTHERS=>'0'); + n(n'right) := '1'; + WHILE rt <= lt LOOP + rt := shift(rt); + n := shift(n); + END LOOP; + rt := rshift(rt); + lt := lt - rt; + n := rshift(n); + tmp := tmp + n; + END LOOP; + END IF; + quote := tmp(2 TO ml+1); + RETURN quote; + END "/"; + + FUNCTION "/" (l, r :STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS + + CONSTANT ml : INTEGER := maximum(l'length,r'length); + VARIABLE lt : STD_LOGIC_VECTOR(0 TO ml+1); + VARIABLE rt : STD_LOGIC_VECTOR(0 TO ml+1); + VARIABLE quote : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE tmp : STD_LOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0'); + VARIABLE n : STD_LOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0'); + + BEGIN + ASSERT NOT (r = "0") + REPORT "Attempted divide by ZERO" + SEVERITY ERROR; + IF hasx(l) OR hasx(r) THEN + FOR i IN quote'range LOOP + quote(i) := 'X'; + END LOOP; + ELSE + lt := zxt( l, ml+2 ); + WHILE lt >= r LOOP + rt := zxt( r, ml+2 ); + n := (OTHERS=>'0'); + n(n'right) := '1'; + WHILE rt <= lt LOOP + rt := shift(rt); + n := shift(n); + END LOOP; + rt := rshift(rt); + lt := lt - rt; + n := rshift(n); + tmp := tmp + n; + END LOOP; + END IF; + quote := tmp(2 TO ml+1); + RETURN quote; + END "/"; + + FUNCTION "/" (l, r :UNSIGNED) RETURN UNSIGNED IS + + CONSTANT ml : INTEGER := maximum(l'length,r'length); + VARIABLE lt : UNSIGNED(0 TO ml+1); + VARIABLE rt : UNSIGNED(0 TO ml+1); + VARIABLE quote : UNSIGNED(1 TO ml); + VARIABLE tmp : UNSIGNED(0 TO ml+1) := (OTHERS=>'0'); + VARIABLE n : UNSIGNED(0 TO ml+1) := (OTHERS=>'0'); + + BEGIN + ASSERT NOT (r = "0") + REPORT "Attempted divide by ZERO" + SEVERITY ERROR; + IF hasx(l) OR hasx(r) THEN + FOR i IN quote'range LOOP + quote(i) := 'X'; + END LOOP; + ELSE + lt := zxt( l, ml+2 ); + WHILE lt >= r LOOP + rt := zxt( r, ml+2 ); + n := (OTHERS=>'0'); + n(n'right) := '1'; + WHILE rt <= lt LOOP + rt := shift(rt); + n := shift(n); + END LOOP; + rt := rshift(rt); + lt := lt - rt; + n := rshift(n); + tmp := tmp + n; + END LOOP; + END IF; + quote := tmp(2 TO ml+1); + RETURN quote; + END "/"; + + FUNCTION "/" (l, r :SIGNED) RETURN SIGNED IS + + CONSTANT ml : INTEGER := maximum(l'length,r'length); + VARIABLE lt : SIGNED(0 TO ml+1); + VARIABLE rt : SIGNED(0 TO ml+1); + VARIABLE quote : SIGNED(1 TO ml); + VARIABLE tmp : SIGNED(0 TO ml+1) := (OTHERS=>'0'); + VARIABLE n : SIGNED(0 TO ml+1) := (OTHERS=>'0'); + + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + ASSERT NOT (r = "0") + REPORT "Attempted divide by ZERO" + SEVERITY ERROR; + IF hasx(l) OR hasx(r) THEN + FOR i IN quote'range LOOP + quote(i) := 'X'; + END LOOP; + ELSE + lt := sxt( l, ml+2 ); + WHILE lt >= r LOOP + rt := sxt( r, ml+2 ); + n := (OTHERS=>'0'); + n(n'right) := '1'; + WHILE rt <= lt LOOP + rt := shift(rt); + n := shift(n); + END LOOP; + rt := rshift(rt); + lt := lt - rt; + n := rshift(n); + tmp := tmp + n; + END LOOP; + END IF; + quote := tmp(2 TO ml+1); + RETURN quote; + END "/"; + + FUNCTION "MOD" (l, r :STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS + + CONSTANT ml : INTEGER := maximum(l'length,r'length); + VARIABLE lt : STD_ULOGIC_VECTOR(0 TO ml+1); + VARIABLE rt : STD_ULOGIC_VECTOR(0 TO ml+1); + VARIABLE quote : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE tmp : STD_ULOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0'); + VARIABLE n : STD_ULOGIC_VECTOR(0 TO ml) := (OTHERS=>'0'); + + BEGIN + ASSERT NOT (r = "0") + REPORT "Attempted divide by ZERO" + SEVERITY ERROR; + IF hasx(l) OR hasx(r) THEN + FOR i IN lt'range LOOP + lt(i) := 'X'; + END LOOP; + ELSE + lt := zxt( l, ml+2 ); + WHILE lt >= r LOOP + rt := zxt( r, ml+2 ); + WHILE rt <= lt LOOP + rt := shift(rt); + END LOOP; + rt := rshift(rt); + lt := lt - rt; + END LOOP; + END IF; + RETURN lt(2 TO ml+1); + END "MOD"; + + FUNCTION "MOD" (l, r :STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS + + CONSTANT ml : INTEGER := maximum(l'length,r'length); + VARIABLE lt : STD_LOGIC_VECTOR(0 TO ml+1); + VARIABLE rt : STD_LOGIC_VECTOR(0 TO ml+1); + VARIABLE quote : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE tmp : STD_LOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0'); + VARIABLE n : STD_LOGIC_VECTOR(0 TO ml) := (OTHERS=>'0'); + + BEGIN + ASSERT NOT (r = "0") + REPORT "Attempted divide by ZERO" + SEVERITY ERROR; + IF hasx(l) OR hasx(r) THEN + FOR i IN lt'range LOOP + lt(i) := 'X'; + END LOOP; + ELSE + lt := zxt( l, ml+2 ); + WHILE lt >= r LOOP + rt := zxt( r, ml+2 ); + WHILE rt <= lt LOOP + rt := shift(rt); + END LOOP; + rt := rshift(rt); + lt := lt - rt; + END LOOP; + END IF; + RETURN lt(2 TO ml+1); + END "MOD"; + + FUNCTION "MOD" (l, r :UNSIGNED) RETURN UNSIGNED IS + + CONSTANT ml : INTEGER := maximum(l'length,r'length); + VARIABLE lt : UNSIGNED(0 TO ml+1); + VARIABLE rt : UNSIGNED(0 TO ml+1); + VARIABLE quote : UNSIGNED(1 TO ml); + VARIABLE tmp : UNSIGNED(0 TO ml+1) := (OTHERS=>'0'); + VARIABLE n : UNSIGNED(0 TO ml) := (OTHERS=>'0'); + + BEGIN + ASSERT NOT (r = "0") + REPORT "Attempted divide by ZERO" + SEVERITY ERROR; + IF hasx(l) OR hasx(r) THEN + FOR i IN lt'range LOOP + lt(i) := 'X'; + END LOOP; + ELSE + lt := zxt( l, ml+2 ); + WHILE lt >= r LOOP + rt := zxt( r, ml+2 ); + WHILE rt <= lt LOOP + rt := shift(rt); + END LOOP; + rt := rshift(rt); + lt := lt - rt; + END LOOP; + END IF; + RETURN lt(2 TO ml+1); + END "MOD"; + + FUNCTION "REM" (l, r :STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS + + CONSTANT ml : INTEGER := maximum(l'length,r'length); + VARIABLE lt : STD_ULOGIC_VECTOR(0 TO ml+1); + VARIABLE rt : STD_ULOGIC_VECTOR(0 TO ml+1); + VARIABLE quote : STD_ULOGIC_VECTOR(1 TO ml); + VARIABLE tmp : STD_ULOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0'); + VARIABLE n : STD_ULOGIC_VECTOR(0 TO ml) := (OTHERS=>'0'); + + BEGIN + ASSERT NOT (r = "0") + REPORT "Attempted divide by ZERO" + SEVERITY ERROR; + IF hasx(l) OR hasx(r) THEN + FOR i IN lt'range LOOP + lt(i) := 'X'; + END LOOP; + ELSE + lt := zxt( l, ml+2 ); + WHILE lt >= r LOOP + rt := zxt( r, ml+2 ); + WHILE rt <= lt LOOP + rt := shift(rt); + END LOOP; + rt := rshift(rt); + lt := lt - rt; + END LOOP; + END IF; + RETURN lt(2 TO ml+1); + END "REM"; + + FUNCTION "REM" (l, r :STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS + + CONSTANT ml : INTEGER := maximum(l'length,r'length); + VARIABLE lt : STD_LOGIC_VECTOR(0 TO ml+1); + VARIABLE rt : STD_LOGIC_VECTOR(0 TO ml+1); + VARIABLE quote : STD_LOGIC_VECTOR(1 TO ml); + VARIABLE tmp : STD_LOGIC_VECTOR(0 TO ml+1) := (OTHERS=>'0'); + VARIABLE n : STD_LOGIC_VECTOR(0 TO ml) := (OTHERS=>'0'); + + BEGIN + ASSERT NOT (r = "0") + REPORT "Attempted divide by ZERO" + SEVERITY ERROR; + IF hasx(l) OR hasx(r) THEN + FOR i IN lt'range LOOP + lt(i) := 'X'; + END LOOP; + ELSE + lt := zxt( l, ml+2 ); + WHILE lt >= r LOOP + rt := zxt( r, ml+2 ); + WHILE rt <= lt LOOP + rt := shift(rt); + END LOOP; + rt := rshift(rt); + lt := lt - rt; + END LOOP; + END IF; + RETURN lt(2 TO ml+1); + END "REM"; + + FUNCTION "REM" (l, r :UNSIGNED) RETURN UNSIGNED IS + + CONSTANT ml : INTEGER := maximum(l'length,r'length); + VARIABLE lt : UNSIGNED(0 TO ml+1); + VARIABLE rt : UNSIGNED(0 TO ml+1); + VARIABLE quote : UNSIGNED(1 TO ml); + VARIABLE tmp : UNSIGNED(0 TO ml+1) := (OTHERS=>'0'); + VARIABLE n : UNSIGNED(0 TO ml) := (OTHERS=>'0'); + + BEGIN + ASSERT NOT (r = "0") + REPORT "Attempted divide by ZERO" + SEVERITY ERROR; + IF hasx(l) OR hasx(r) THEN + FOR i IN lt'range LOOP + lt(i) := 'X'; + END LOOP; + ELSE + lt := zxt( l, ml+2 ); + WHILE lt >= r LOOP + rt := zxt( r, ml+2 ); + WHILE rt <= lt LOOP + rt := shift(rt); + END LOOP; + rt := rshift(rt); + lt := lt - rt; + END LOOP; + END IF; + RETURN lt(2 TO ml+1); + END "REM"; + + FUNCTION "**" (l, r :STD_ULOGIC_VECTOR) RETURN STD_ULOGIC_VECTOR IS + + VARIABLE return_vector : STD_ULOGIC_VECTOR(l'range) := (OTHERS=>'0'); + VARIABLE tmp : STD_ULOGIC_VECTOR(1 TO (2 * l'length)) := (OTHERS=>'0'); + CONSTANT lsh_l : INTEGER := l'length+1; + CONSTANT lsh_r : INTEGER := 2 * l'length; + VARIABLE pow : INTEGER; + + BEGIN + IF (hasx(l) OR hasx(r)) THEN + FOR i IN return_vector'range LOOP + return_vector(i) := 'X'; + END LOOP; + ELSE + pow := to_integer( r, 0 ); + tmp( tmp'right ) := '1'; + FOR i IN 1 TO pow LOOP + tmp := tmp(lsh_l TO lsh_r) * l; + END LOOP; + return_vector := tmp(lsh_l TO lsh_r); + END IF; + RETURN return_vector; + END "**"; + + FUNCTION "**" (l, r :STD_LOGIC_VECTOR) RETURN STD_LOGIC_VECTOR IS + + VARIABLE return_vector : STD_LOGIC_VECTOR(l'range) := (OTHERS=>'0'); + VARIABLE tmp : STD_LOGIC_VECTOR(1 TO (2 * l'length)) := (OTHERS=>'0'); + CONSTANT lsh_l : INTEGER := l'length+1; + CONSTANT lsh_r : INTEGER := 2 * l'length; + VARIABLE pow : INTEGER; + + BEGIN + IF (hasx(l) OR hasx(r)) THEN + FOR i IN return_vector'range LOOP + return_vector(i) := 'X'; + END LOOP; + ELSE + pow := to_integer( r, 0 ); + tmp( tmp'right ) := '1'; + FOR i IN 1 TO pow LOOP + tmp := tmp(lsh_l TO lsh_r) * l; + END LOOP; + return_vector := tmp(lsh_l TO lsh_r); + END IF; + RETURN return_vector; + END "**"; + + FUNCTION "**" (l, r :UNSIGNED) RETURN UNSIGNED IS + + VARIABLE return_vector : UNSIGNED(l'range) := (OTHERS=>'0'); + VARIABLE tmp : UNSIGNED(1 TO (2 * l'length)) := (OTHERS=>'0'); + CONSTANT lsh_l : INTEGER := l'length+1; + CONSTANT lsh_r : INTEGER := 2 * l'length; + VARIABLE pow : INTEGER; + + BEGIN + IF (hasx(l) OR hasx(r)) THEN + FOR i IN return_vector'range LOOP + return_vector(i) := 'X'; + END LOOP; + ELSE + pow := to_integer( r, 0 ); + tmp( tmp'right ) := '1'; + FOR i IN 1 TO pow LOOP + tmp := tmp(lsh_l TO lsh_r) * l; + END LOOP; + return_vector := tmp(lsh_l TO lsh_r); + END IF; + RETURN return_vector; + END "**"; + +-- +-- Absolute Value Functions +-- + FUNCTION "abs" (arg1:SIGNED) RETURN SIGNED IS + constant len : integer := arg1'length; + VARIABLE answer, tmp : SIGNED( len-1 downto 0 ) := (others=>'0'); + VARIABLE index : integer := len; + BEGIN + assert arg1'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + IF hasx(arg1) THEN + answer := (OTHERS => 'X'); + ELSIF (arg1(arg1'left) = '0' OR arg1(arg1'left) = 'L') THEN + answer := arg1; + ELSE + tmp := arg1; + lp1 : FOR i IN answer'REVERSE_RANGE LOOP + IF (tmp(i) = '1' OR tmp(i) = 'H') THEN + index := i+1; + answer(i downto 0) := tmp(i downto 0); + exit; + END IF; + END LOOP lp1; + answer(len-1 downto index) := NOT tmp(len-1 downto index); + end if; + RETURN (answer); + END ; + +-- +-- Shift Left (arithmetic) Functions +-- + + FUNCTION "sla" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : std_ulogic_vector(1 to len) := (others => arg1(arg1'right)); + VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(arg2+1 to len) & se(1 to arg2)); + END IF; + END ; + + FUNCTION "sla" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : std_logic_vector(1 to len) := (others => arg1(arg1'right)); + VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(arg2+1 to len) & se(1 to arg2)); + END IF; + END ; + + FUNCTION "sla" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : UNSIGNED(1 to len) := (others => arg1(arg1'right)); + VARIABLE ans : UNSIGNED(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(arg2+1 to len) & se(1 to arg2)); + END IF; + END ; + + FUNCTION "sla" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : SIGNED(1 to len) := (others => arg1(arg1'right)); + VARIABLE ans : SIGNED(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(arg2+1 to len) & se(1 to arg2)); + END IF; + END ; + +-- +-- Shift Right (arithmetics) Functions +-- + FUNCTION "sra" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : std_ulogic_vector(1 to len) := (others => arg1(arg1'left)); + VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (se(1 to arg2) & ans(1 to len-arg2)); + END IF; + END ; + + FUNCTION "sra" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : std_logic_vector(1 to len) := (others => arg1(arg1'left)); + VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (se(1 to arg2) & ans(1 to len-arg2)); + END IF; + END ; + + FUNCTION "sra" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : UNSIGNED(1 to len) := (others => arg1(arg1'left)); + VARIABLE ans : UNSIGNED(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (se(1 to arg2) & ans(1 to len-arg2)); + END IF; + END ; + + FUNCTION "sra" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : SIGNED(1 to len) := (others => arg1(arg1'left)); + VARIABLE ans : SIGNED(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (se(1 to arg2) & ans(1 to len-arg2)); + END IF; + END ; + +-- +-- Shift Left (logical) Functions +-- + + FUNCTION "sll" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : std_ulogic_vector(1 to len) := (others =>'0'); + VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(arg2+1 to len) & se(1 to arg2)); + END IF; + END ; + + FUNCTION "sll" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : std_logic_vector(1 to len) := (others =>'0'); + VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(arg2+1 to len) & se(1 to arg2)); + END IF; + END ; + + FUNCTION "sll" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : UNSIGNED(1 to len) := (others =>'0'); + VARIABLE ans : UNSIGNED(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(arg2+1 to len) & se(1 to arg2)); + END IF; + END ; + + FUNCTION "sll" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : SIGNED(1 to len) := (others =>'0'); + VARIABLE ans : SIGNED(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(arg2+1 to len) & se(1 to arg2)); + END IF; + END ; + +-- +-- Shift Right (logical) Functions +-- + FUNCTION "srl" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : std_ulogic_vector(1 to len) := (others => '0'); + VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (se(1 to arg2) & ans(1 to len-arg2)); + END IF; + END ; + + FUNCTION "srl" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : std_logic_vector(1 to len) := (others => '0'); + VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (se(1 to arg2) & ans(1 to len-arg2)); + END IF; + END ; + + FUNCTION "srl" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : UNSIGNED(1 to len) := (others => '0'); + VARIABLE ans : UNSIGNED(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (se(1 to arg2) & ans(1 to len-arg2)); + END IF; + END ; + + FUNCTION "srl" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT se : SIGNED(1 to len) := (others => '0'); + VARIABLE ans : SIGNED(1 to len) := arg1; + BEGIN + IF (arg2 >= len) THEN + RETURN (se); + ELSIF (arg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (se(1 to arg2) & ans(1 to len-arg2)); + END IF; + END ; + +-- +-- Rotate Left (Logical) Functions +-- + FUNCTION "rol" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT marg2 : integer := arg2 mod len; + VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (marg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(marg2+1 to len) & ans(1 to marg2)); + END IF; + END ; + + FUNCTION "rol" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT marg2 : integer := arg2 mod len; + VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (marg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(marg2+1 to len) & ans(1 to marg2)); + END IF; + END ; + + FUNCTION "rol" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT marg2 : integer := arg2 mod len; + VARIABLE ans : UNSIGNED(1 to len) := arg1; + BEGIN + IF (marg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(marg2+1 to len) & ans(1 to marg2)); + END IF; + END ; + + FUNCTION "rol" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT marg2 : integer := arg2 mod len; + VARIABLE ans : SIGNED(1 to len) := arg1; + BEGIN + IF (marg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(marg2+1 to len) & ans(1 to marg2)); + END IF; + END ; + +-- +-- Rotate Right (Logical) Functions +-- + FUNCTION "ror" (arg1:STD_ULOGIC_VECTOR ; arg2:NATURAL) RETURN STD_ULOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT marg2 : integer := arg2 mod len; + VARIABLE ans : STD_ULOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (marg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(len-marg2+1 to len) & ans(1 to len-marg2)); + END IF; + END ; + + FUNCTION "ror" (arg1:STD_LOGIC_VECTOR ; arg2:NATURAL) RETURN STD_LOGIC_VECTOR IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT marg2 : integer := arg2 mod len; + VARIABLE ans : STD_LOGIC_VECTOR(1 to len) := arg1; + BEGIN + IF (marg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(len-marg2+1 to len) & ans(1 to len-marg2)); + END IF; + END ; + + FUNCTION "ror" (arg1:UNSIGNED ; arg2:NATURAL) RETURN UNSIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT marg2 : integer := arg2 mod len; + VARIABLE ans : UNSIGNED(1 to len) := arg1; + BEGIN + IF (marg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(len-marg2+1 to len) & ans(1 to len-marg2)); + END IF; + END ; + + FUNCTION "ror" (arg1:SIGNED ; arg2:NATURAL) RETURN SIGNED IS + CONSTANT len : INTEGER := arg1'length ; + CONSTANT marg2 : integer := arg2 mod len; + VARIABLE ans : SIGNED(1 to len) := arg1; + BEGIN + IF (marg2 = 0) THEN + RETURN (arg1); + ELSE + RETURN (ans(len-marg2+1 to len) & ans(1 to len-marg2)); + END IF; + END ; + +-- +-- Equal functions. +-- + CONSTANT eq_table : stdlogic_boolean_table := ( + -- ---------------------------------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------------------------------- + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | U | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | X | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | 0 | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | 1 | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | Z | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | W | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | L | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | H | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ) -- | D | + ); + + FUNCTION eq ( l, r : STD_LOGIC ) RETURN BOOLEAN IS + BEGIN + RETURN eq_table( l, r ); + END; + + FUNCTION eq ( l,r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : STD_ULOGIC_VECTOR ( 1 TO ml ); + VARIABLE rt : STD_ULOGIC_VECTOR ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF NOT eq( lt(i), rt(i) ) THEN + RETURN FALSE; + END IF; + END LOOP; + RETURN TRUE; + END; + + FUNCTION eq ( l,r : STD_LOGIC_VECTOR ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : STD_LOGIC_VECTOR ( 1 TO ml ); + VARIABLE rt : STD_LOGIC_VECTOR ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF NOT eq( lt(i), rt(i) ) THEN + RETURN FALSE; + END IF; + END LOOP; + RETURN TRUE; + END; + + FUNCTION eq ( l,r : UNSIGNED ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : UNSIGNED ( 1 TO ml ); + VARIABLE rt : UNSIGNED ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF NOT eq( lt(i), rt(i) ) THEN + RETURN FALSE; + END IF; + END LOOP; + RETURN TRUE; + END; + + FUNCTION eq ( l,r : SIGNED ) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE lt, rt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := (OTHERS => l(l'left)) ; + lt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rt := (OTHERS => r(r'left)) ; + rt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + RETURN (eq( lt, rt )); + END; + + FUNCTION "=" ( l,r : UNSIGNED ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : UNSIGNED ( 1 TO ml ); + VARIABLE rt : UNSIGNED ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF NOT eq( lt(i), rt(i) ) THEN + RETURN FALSE; + END IF; + END LOOP; + RETURN TRUE; + END; + + FUNCTION "=" ( l,r : SIGNED ) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE lt, rt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := (OTHERS => l(l'left)) ; + lt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rt := (OTHERS => r(r'left)) ; + rt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + RETURN (eq( lt, rt )); + END; + +-- +-- Not Equal function. +-- + CONSTANT neq_table : stdlogic_boolean_table := ( + -- ---------------------------------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------------------------------- + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | U | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | X | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | 0 | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | 1 | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | Z | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | W | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | L | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | H | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ) -- | D | + ); + + + FUNCTION ne ( l, r : STD_LOGIC ) RETURN BOOLEAN IS + BEGIN + RETURN neq_table( l, r ); + END; + + FUNCTION ne ( l,r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : STD_ULOGIC_VECTOR ( 1 TO ml ); + VARIABLE rt : STD_ULOGIC_VECTOR ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF ne( lt(i), rt(i) ) THEN + RETURN TRUE; + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION ne ( l,r : STD_LOGIC_VECTOR ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : STD_LOGIC_VECTOR ( 1 TO ml ); + VARIABLE rt : STD_LOGIC_VECTOR ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF ne( lt(i), rt(i) ) THEN + RETURN TRUE; + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION ne ( l,r : UNSIGNED ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : UNSIGNED ( 1 TO ml ); + VARIABLE rt : UNSIGNED ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF ne( lt(i), rt(i) ) THEN + RETURN TRUE; + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION ne ( l,r : SIGNED ) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE lt, rt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := (OTHERS => l(l'left)) ; + lt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rt := (OTHERS => r(r'left)) ; + rt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + RETURN (ne( lt, rt )); + END; + + FUNCTION "/=" ( l,r : UNSIGNED ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : UNSIGNED ( 1 TO ml ); + VARIABLE rt : UNSIGNED ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF ne( lt(i), rt(i) ) THEN + RETURN TRUE; + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION "/=" ( l,r : SIGNED ) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE lt, rt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := (OTHERS => l(l'left)) ; + lt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rt := (OTHERS => r(r'left)) ; + rt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + RETURN (ne( lt, rt )); + END; + +-- +-- Less Than functions. +-- + CONSTANT ltb_table : stdlogic_boolean_table := ( + -- ---------------------------------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------------------------------- + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | U | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | X | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | 0 | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | 1 | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | Z | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | W | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | L | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | H | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ) -- | D | + ); + + FUNCTION lt ( l, r : STD_LOGIC ) RETURN BOOLEAN IS + BEGIN + RETURN ltb_table( l, r ); + END; + + FUNCTION lt ( l,r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE ltt : STD_ULOGIC_VECTOR ( 1 TO ml ); + VARIABLE rtt : STD_ULOGIC_VECTOR ( 1 TO ml ); + BEGIN + ltt := zxt( l, ml ); + rtt := zxt( r, ml ); + FOR i IN ltt'range LOOP + IF NOT eq( ltt(i), rtt(i) ) THEN + RETURN lt( ltt(i), rtt(i) ); + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION lt ( l,r : STD_LOGIC_VECTOR ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE ltt : STD_LOGIC_VECTOR ( 1 TO ml ); + VARIABLE rtt : STD_LOGIC_VECTOR ( 1 TO ml ); + BEGIN + ltt := zxt( l, ml ); + rtt := zxt( r, ml ); + FOR i IN ltt'range LOOP + IF NOT eq( ltt(i), rtt(i) ) THEN + RETURN lt( ltt(i), rtt(i) ); + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION lt ( l,r : UNSIGNED ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE ltt : UNSIGNED ( 1 TO ml ); + VARIABLE rtt : UNSIGNED ( 1 TO ml ); + BEGIN + ltt := zxt( l, ml ); + rtt := zxt( r, ml ); + FOR i IN ltt'range LOOP + IF NOT eq( ltt(i), rtt(i) ) THEN + RETURN lt( ltt(i), rtt(i) ); + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION lt ( l,r : SIGNED ) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE ltt, rtt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + ltt := (OTHERS => l(l'left)) ; + ltt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rtt := (OTHERS => r(r'left)) ; + rtt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + IF(ltt(ltt'left) = '1' AND rtt(rtt'left) = '0') THEN + RETURN(TRUE) ; + ELSIF(ltt(ltt'left) = '0' AND rtt(rtt'left) = '1') THEN + RETURN(FALSE) ; + ELSE + RETURN (lt( ltt, rtt )); + END IF ; + END; + + FUNCTION "<" ( l,r : UNSIGNED ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE ltt : UNSIGNED ( 1 TO ml ); + VARIABLE rtt : UNSIGNED ( 1 TO ml ); + BEGIN + ltt := zxt( l, ml ); + rtt := zxt( r, ml ); + FOR i IN ltt'range LOOP + IF NOT eq( ltt(i), rtt(i) ) THEN + RETURN lt( ltt(i), rtt(i) ); + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION "<" ( l,r : SIGNED ) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE ltt, rtt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + ltt := (OTHERS => l(l'left)) ; + ltt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rtt := (OTHERS => r(r'left)) ; + rtt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + IF(ltt(ltt'left) = '1' AND rtt(rtt'left) = '0') THEN + RETURN(TRUE) ; + ELSIF(ltt(ltt'left) = '0' AND rtt(rtt'left) = '1') THEN + RETURN(FALSE) ; + ELSE + RETURN (lt( ltt, rtt )); + END IF ; + END; + +-- +-- Greater Than functions. +-- + CONSTANT gtb_table : stdlogic_boolean_table := ( + -- ---------------------------------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------------------------------- + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | U | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | X | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | 0 | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | 1 | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | Z | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | W | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- | L | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | H | + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ) -- | D | + ); + + FUNCTION gt ( l, r : std_logic ) RETURN BOOLEAN IS + BEGIN + RETURN gtb_table( l, r ); + END ; + + FUNCTION gt ( l,r : STD_ULOGIC_VECTOR ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : STD_ULOGIC_VECTOR ( 1 TO ml ); + VARIABLE rt : STD_ULOGIC_VECTOR ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF NOT eq( lt(i), rt(i) ) THEN + RETURN gt( lt(i), rt(i) ); + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION gt ( l,r : STD_LOGIC_VECTOR ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : STD_LOGIC_VECTOR ( 1 TO ml ); + VARIABLE rt : STD_LOGIC_VECTOR ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF NOT eq( lt(i), rt(i) ) THEN + RETURN gt( lt(i), rt(i) ); + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION gt ( l,r : UNSIGNED ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : UNSIGNED ( 1 TO ml ); + VARIABLE rt : UNSIGNED ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF NOT eq( lt(i), rt(i) ) THEN + RETURN gt( lt(i), rt(i) ); + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION gt ( l,r : SIGNED ) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE lt, rt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := (OTHERS => l(l'left)) ; + lt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rt := (OTHERS => r(r'left)) ; + rt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN + RETURN(FALSE) ; + ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN + RETURN(TRUE) ; + ELSE + RETURN (gt( lt, rt )); + END IF ; + END; + + FUNCTION ">" ( l,r : UNSIGNED ) RETURN BOOLEAN IS + CONSTANT ml : INTEGER := maximum( l'length, r'length ); + VARIABLE lt : UNSIGNED ( 1 TO ml ); + VARIABLE rt : UNSIGNED ( 1 TO ml ); + BEGIN + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'range LOOP + IF NOT eq( lt(i), rt(i) ) THEN + RETURN gt( lt(i), rt(i) ); + END IF; + END LOOP; + RETURN FALSE; + END; + + FUNCTION ">" ( l,r : SIGNED ) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE lt, rt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := (OTHERS => l(l'left)) ; + lt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rt := (OTHERS => r(r'left)) ; + rt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN + RETURN(FALSE) ; + ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN + RETURN(TRUE) ; + ELSE + RETURN (gt( lt, rt )); + END IF ; + END; + +-- +-- Less Than or Equal to functions. +-- + CONSTANT leb_table : stdlogic_boolean_table := ( + -- ---------------------------------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------------------------------- + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | U | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | X | + ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE ), -- | 0 | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | 1 | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | Z | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | W | + ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE ), -- | L | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ), -- | H | + ( FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE ) -- | D | + ); + + FUNCTION le ( l, r : std_logic ) RETURN BOOLEAN IS + BEGIN + RETURN leb_table( l, r ); + END ; + + TYPE std_ulogic_fuzzy_state IS ('U', 'X', 'T', 'F', 'N'); + TYPE std_ulogic_fuzzy_state_table IS ARRAY ( std_ulogic, std_ulogic ) OF std_ulogic_fuzzy_state; + + CONSTANT le_fuzzy_table : std_ulogic_fuzzy_state_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------- + ( 'U', 'U', 'U', 'N', 'U', 'U', 'U', 'N', 'U' ), -- | U | + ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ), -- | X | + ( 'N', 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N' ), -- | 0 | + ( 'U', 'X', 'F', 'N', 'X', 'X', 'F', 'N', 'X' ), -- | 1 | + ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ), -- | Z | + ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ), -- | W | + ( 'N', 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N' ), -- | L | + ( 'U', 'X', 'F', 'N', 'X', 'X', 'F', 'N', 'X' ), -- | H | + ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ) -- | D | + ); + + FUNCTION le ( L,R : std_ulogic_vector ) RETURN boolean IS + CONSTANT ml : integer := maximum( L'LENGTH, R'LENGTH ); + VARIABLE lt : std_ulogic_vector ( 1 to ml ); + VARIABLE rt : std_ulogic_vector ( 1 to ml ); + VARIABLE res : std_ulogic_fuzzy_state; + begin + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'RANGE LOOP + res := le_fuzzy_table( lt(i), rt(i) ); + CASE res IS + WHEN 'U' => RETURN FALSE; + WHEN 'X' => RETURN FALSE; + WHEN 'T' => RETURN TRUE; + WHEN 'F' => RETURN FALSE; + WHEN OTHERS => null; + END CASE; + END LOOP; + RETURN TRUE; + end ; + + TYPE std_logic_fuzzy_state IS ('U', 'X', 'T', 'F', 'N'); + TYPE std_logic_fuzzy_state_table IS ARRAY ( std_logic, std_logic ) OF std_logic_fuzzy_state; + + CONSTANT le_lfuzzy_table : std_logic_fuzzy_state_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------- + ( 'U', 'U', 'U', 'N', 'U', 'U', 'U', 'N', 'U' ), -- | U | + ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ), -- | X | + ( 'N', 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N' ), -- | 0 | + ( 'U', 'X', 'F', 'N', 'X', 'X', 'F', 'N', 'X' ), -- | 1 | + ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ), -- | Z | + ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ), -- | W | + ( 'N', 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N' ), -- | L | + ( 'U', 'X', 'F', 'N', 'X', 'X', 'F', 'N', 'X' ), -- | H | + ( 'U', 'X', 'X', 'N', 'X', 'X', 'X', 'N', 'X' ) -- | D | + ); + + FUNCTION le ( L,R : std_logic_vector ) RETURN boolean IS + CONSTANT ml : integer := maximum( L'LENGTH, R'LENGTH ); + VARIABLE lt : std_logic_vector ( 1 to ml ); + VARIABLE rt : std_logic_vector ( 1 to ml ); + VARIABLE res : std_logic_fuzzy_state; + begin + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'RANGE LOOP + res := le_lfuzzy_table( lt(i), rt(i) ); + CASE res IS + WHEN 'U' => RETURN FALSE; + WHEN 'X' => RETURN FALSE; + WHEN 'T' => RETURN TRUE; + WHEN 'F' => RETURN FALSE; + WHEN OTHERS => null; + END CASE; + END LOOP; + RETURN TRUE; + end ; + + FUNCTION le ( L,R : UNSIGNED ) RETURN boolean IS + CONSTANT ml : integer := maximum( L'LENGTH, R'LENGTH ); + VARIABLE lt : UNSIGNED ( 1 to ml ); + VARIABLE rt : UNSIGNED ( 1 to ml ); + VARIABLE res : std_logic_fuzzy_state; + begin + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'RANGE LOOP + res := le_lfuzzy_table( lt(i), rt(i) ); + CASE res IS + WHEN 'U' => RETURN FALSE; + WHEN 'X' => RETURN FALSE; + WHEN 'T' => RETURN TRUE; + WHEN 'F' => RETURN FALSE; + WHEN OTHERS => null; + END CASE; + END LOOP; + RETURN TRUE; + end ; + + FUNCTION le (l, r:SIGNED) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE lt, rt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := (OTHERS => l(l'left)) ; + lt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rt := (OTHERS => r(r'left)) ; + rt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN + RETURN(TRUE) ; + ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN + RETURN(FALSE) ; + ELSE + RETURN (le( lt, rt )); + END IF ; + END; + + FUNCTION "<=" ( L,R : UNSIGNED ) RETURN boolean IS + CONSTANT ml : integer := maximum( L'LENGTH, R'LENGTH ); + VARIABLE lt : UNSIGNED ( 1 to ml ); + VARIABLE rt : UNSIGNED ( 1 to ml ); + VARIABLE res : std_logic_fuzzy_state; + begin + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'RANGE LOOP + res := le_lfuzzy_table( lt(i), rt(i) ); + CASE res IS + WHEN 'U' => RETURN FALSE; + WHEN 'X' => RETURN FALSE; + WHEN 'T' => RETURN TRUE; + WHEN 'F' => RETURN FALSE; + WHEN OTHERS => null; + END CASE; + END LOOP; + RETURN TRUE; + end ; + + FUNCTION "<=" (l, r:SIGNED) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE lt, rt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := (OTHERS => l(l'left)) ; + lt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rt := (OTHERS => r(r'left)) ; + rt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN + RETURN(TRUE) ; + ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN + RETURN(FALSE) ; + ELSE + RETURN (le( lt, rt )); + END IF ; + END; + +-- +-- Greater Than or Equal to functions. +-- + CONSTANT geb_table : stdlogic_boolean_table := ( + -- ---------------------------------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------------------------------- + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | U | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | X | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | 0 | + ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE ), -- | 1 | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | Z | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | W | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- | L | + ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE ), -- | H | + ( FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE ) -- | D | + ); + + FUNCTION ge ( l, r : std_logic ) RETURN BOOLEAN IS + BEGIN + RETURN geb_table( l, r ); + END ; + + CONSTANT ge_fuzzy_table : std_ulogic_fuzzy_state_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------- + ( 'U', 'U', 'N', 'U', 'U', 'U', 'N', 'U', 'U' ), -- | U | + ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ), -- | X | + ( 'U', 'X', 'N', 'F', 'X', 'X', 'N', 'F', 'X' ), -- | 0 | + ( 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N', 'N' ), -- | 1 | + ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ), -- | Z | + ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ), -- | W | + ( 'U', 'X', 'N', 'F', 'X', 'X', 'N', 'F', 'X' ), -- | L | + ( 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N', 'N' ), -- | H | + ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ) -- | D | + ); + + FUNCTION ge ( L,R : std_ulogic_vector ) RETURN boolean IS + CONSTANT ml : integer := maximum( L'LENGTH, R'LENGTH ); + VARIABLE lt : std_ulogic_vector ( 1 to ml ); + VARIABLE rt : std_ulogic_vector ( 1 to ml ); + VARIABLE res : std_ulogic_fuzzy_state; + begin + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'RANGE LOOP + res := ge_fuzzy_table( lt(i), rt(i) ); + CASE res IS + WHEN 'U' => RETURN FALSE; + WHEN 'X' => RETURN FALSE; + WHEN 'T' => RETURN TRUE; + WHEN 'F' => RETURN FALSE; + WHEN OTHERS => null; + END CASE; + END LOOP; + RETURN TRUE; + end ; + + CONSTANT ge_lfuzzy_table : std_logic_fuzzy_state_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------- + ( 'U', 'U', 'N', 'U', 'U', 'U', 'N', 'U', 'U' ), -- | U | + ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ), -- | X | + ( 'U', 'X', 'N', 'F', 'X', 'X', 'N', 'F', 'X' ), -- | 0 | + ( 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N', 'N' ), -- | 1 | + ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ), -- | Z | + ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ), -- | W | + ( 'U', 'X', 'N', 'F', 'X', 'X', 'N', 'F', 'X' ), -- | L | + ( 'N', 'N', 'T', 'N', 'N', 'N', 'T', 'N', 'N' ), -- | H | + ( 'U', 'X', 'N', 'X', 'X', 'X', 'N', 'X', 'X' ) -- | D | + ); + + FUNCTION ge ( L,R : std_logic_vector ) RETURN boolean IS + CONSTANT ml : integer := maximum( L'LENGTH, R'LENGTH ); + VARIABLE lt : std_logic_vector ( 1 to ml ); + VARIABLE rt : std_logic_vector ( 1 to ml ); + VARIABLE res : std_logic_fuzzy_state; + begin + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'RANGE LOOP + res := ge_lfuzzy_table( lt(i), rt(i) ); + CASE res IS + WHEN 'U' => RETURN FALSE; + WHEN 'X' => RETURN FALSE; + WHEN 'T' => RETURN TRUE; + WHEN 'F' => RETURN FALSE; + WHEN OTHERS => null; + END CASE; + END LOOP; + RETURN TRUE; + end ; + + FUNCTION ge ( L,R : UNSIGNED ) RETURN boolean IS + CONSTANT ml : integer := maximum( L'LENGTH, R'LENGTH ); + VARIABLE lt : UNSIGNED ( 1 to ml ); + VARIABLE rt : UNSIGNED ( 1 to ml ); + VARIABLE res : std_logic_fuzzy_state; + begin + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'RANGE LOOP + res := ge_lfuzzy_table( lt(i), rt(i) ); + CASE res IS + WHEN 'U' => RETURN FALSE; + WHEN 'X' => RETURN FALSE; + WHEN 'T' => RETURN TRUE; + WHEN 'F' => RETURN FALSE; + WHEN OTHERS => null; + END CASE; + END LOOP; + RETURN TRUE; + end ; + + FUNCTION ge ( l,r : SIGNED ) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE lt, rt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := (OTHERS => l(l'left)) ; + lt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rt := (OTHERS => r(r'left)) ; + rt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN + RETURN(FALSE) ; + ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN + RETURN(TRUE) ; + ELSE + RETURN (ge( lt, rt )); + END IF ; + END; + + FUNCTION ">=" ( L,R : UNSIGNED ) RETURN boolean IS + CONSTANT ml : integer := maximum( L'LENGTH, R'LENGTH ); + VARIABLE lt : UNSIGNED ( 1 to ml ); + VARIABLE rt : UNSIGNED ( 1 to ml ); + VARIABLE res : std_logic_fuzzy_state; + begin + lt := zxt( l, ml ); + rt := zxt( r, ml ); + FOR i IN lt'RANGE LOOP + res := ge_lfuzzy_table( lt(i), rt(i) ); + CASE res IS + WHEN 'U' => RETURN FALSE; + WHEN 'X' => RETURN FALSE; + WHEN 'T' => RETURN TRUE; + WHEN 'F' => RETURN FALSE; + WHEN OTHERS => null; + END CASE; + END LOOP; + RETURN TRUE; + end ; + + FUNCTION ">=" ( l,r : SIGNED ) RETURN BOOLEAN IS + CONSTANT len : INTEGER := maximum( l'length, r'length ); + VARIABLE lt, rt : UNSIGNED ( len-1 downto 0 ) := (OTHERS => '0'); + BEGIN + assert l'length > 1 AND r'length > 1 + report "SIGNED vector must be atleast 2 bits wide" + severity ERROR; + lt := (OTHERS => l(l'left)) ; + lt(l'length - 1 DOWNTO 0) := UNSIGNED(l); + rt := (OTHERS => r(r'left)) ; + rt(r'length - 1 DOWNTO 0) := UNSIGNED(r); + IF(lt(lt'left) = '1' AND rt(rt'left) = '0') THEN + RETURN(FALSE) ; + ELSIF(lt(lt'left) = '0' AND rt(rt'left) = '1') THEN + RETURN(TRUE) ; + ELSE + RETURN (ge( lt, rt )); + END IF ; + END; + + ------------------------------------------------------------------------------- + -- Logical Operations + ------------------------------------------------------------------------------- + + -- truth table for "and" function + CONSTANT and_table : stdlogic_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------- + ( 'U', 'U', '0', 'U', 'U', 'U', '0', 'U', 'U' ), -- | U | + ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | X | + ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ), -- | 0 | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | 1 | + ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | Z | + ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ), -- | W | + ( '0', '0', '0', '0', '0', '0', '0', '0', '0' ), -- | L | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | H | + ( 'U', 'X', '0', 'X', 'X', 'X', '0', 'X', 'X' ) -- | D | + ); + + -- truth table for "or" function + CONSTANT or_table : stdlogic_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------- + ( 'U', 'U', 'U', '1', 'U', 'U', 'U', '1', 'U' ), -- | U | + ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | X | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | 0 | + ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ), -- | 1 | + ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | Z | + ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ), -- | W | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | L | + ( '1', '1', '1', '1', '1', '1', '1', '1', '1' ), -- | H | + ( 'U', 'X', 'X', '1', 'X', 'X', 'X', '1', 'X' ) -- | D | + ); + + + -- truth table for "xor" function + CONSTANT xor_table : stdlogic_table := ( + -- ---------------------------------------------------- + -- | U X 0 1 Z W L H D | | + -- ---------------------------------------------------- + ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ), -- | U | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | X | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | 0 | + ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ), -- | 1 | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | Z | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | W | + ( 'U', 'X', '0', '1', 'X', 'X', '0', '1', 'X' ), -- | L | + ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ), -- | H | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ) -- | D | + ); + + -- truth table for "not" function + CONSTANT not_table: stdlogic_1D := + -- ------------------------------------------------- + -- | U X 0 1 Z W L H D | + -- ------------------------------------------------- + ( 'U', 'X', '1', '0', 'X', 'X', '1', '0', 'X' ); + + FUNCTION "and" ( arg1,arg2 : UNSIGNED ) RETURN UNSIGNED IS + CONSTANT ml : integer := maximum( arg1'LENGTH, arg2'LENGTH ); + VARIABLE lt : UNSIGNED ( 1 to ml ); + VARIABLE rt : UNSIGNED ( 1 to ml ); + VARIABLE res : UNSIGNED ( 1 to ml ); + begin + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN res'RANGE LOOP + res(i) := and_table( lt(i), rt(i) ); + END LOOP; + RETURN res; + end "and"; + + FUNCTION "nand" ( arg1,arg2 : UNSIGNED ) RETURN UNSIGNED IS + CONSTANT ml : integer := maximum( arg1'LENGTH, arg2'LENGTH ); + VARIABLE lt : UNSIGNED ( 1 to ml ); + VARIABLE rt : UNSIGNED ( 1 to ml ); + VARIABLE res : UNSIGNED ( 1 to ml ); + begin + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN res'RANGE LOOP + res(i) := not_table( and_table( lt(i), rt(i) ) ); + END LOOP; + RETURN res; + end "nand"; + + FUNCTION "or" ( arg1,arg2 : UNSIGNED ) RETURN UNSIGNED IS + CONSTANT ml : integer := maximum( arg1'LENGTH, arg2'LENGTH ); + VARIABLE lt : UNSIGNED ( 1 to ml ); + VARIABLE rt : UNSIGNED ( 1 to ml ); + VARIABLE res : UNSIGNED ( 1 to ml ); + begin + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN res'RANGE LOOP + res(i) := or_table( lt(i), rt(i) ); + END LOOP; + RETURN res; + end "or"; + + FUNCTION "nor" ( arg1,arg2 : UNSIGNED ) RETURN UNSIGNED IS + CONSTANT ml : integer := maximum( arg1'LENGTH, arg2'LENGTH ); + VARIABLE lt : UNSIGNED ( 1 to ml ); + VARIABLE rt : UNSIGNED ( 1 to ml ); + VARIABLE res : UNSIGNED ( 1 to ml ); + begin + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN res'RANGE LOOP + res(i) := not_table( or_table( lt(i), rt(i) ) ); + END LOOP; + RETURN res; + end "nor"; + + FUNCTION "xor" ( arg1, arg2 : UNSIGNED ) RETURN UNSIGNED IS + CONSTANT ml : integer := maximum( arg1'LENGTH, arg2'LENGTH ); + VARIABLE lt : UNSIGNED ( 1 to ml ); + VARIABLE rt : UNSIGNED ( 1 to ml ); + VARIABLE res : UNSIGNED ( 1 to ml ); + begin + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN res'RANGE LOOP + res(i) := xor_table( lt(i), rt(i) ); + END LOOP; + RETURN res; + end "xor"; + + FUNCTION "not" ( arg1 : UNSIGNED ) RETURN UNSIGNED IS + VARIABLE result : UNSIGNED ( arg1'RANGE ) := (Others => 'X'); + begin + for i in result'range loop + result(i) := not_table( arg1(i) ); + end loop; + return result; + end "not"; + + FUNCTION "and" ( arg1,arg2 : SIGNED ) RETURN SIGNED IS + CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ; + VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + a := (OTHERS => arg1(arg1'left)) ; + a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1); + b := (OTHERS => arg2(arg2'left)) ; + b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2); + answer := SIGNED(a and b); + RETURN (answer); + end "and"; + + FUNCTION "nand" ( arg1,arg2 : SIGNED ) RETURN SIGNED IS + CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ; + VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + a := (OTHERS => arg1(arg1'left)) ; + a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1); + b := (OTHERS => arg2(arg2'left)) ; + b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2); + answer := SIGNED(a nand b); + RETURN (answer); + end "nand"; + + FUNCTION "or" ( arg1,arg2 : SIGNED ) RETURN SIGNED IS + CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ; + VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + a := (OTHERS => arg1(arg1'left)) ; + a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1); + b := (OTHERS => arg2(arg2'left)) ; + b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2); + answer := SIGNED(a or b); + RETURN (answer); + end "or"; + + FUNCTION "nor" ( arg1,arg2 : SIGNED ) RETURN SIGNED IS + CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ; + VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + a := (OTHERS => arg1(arg1'left)) ; + a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1); + b := (OTHERS => arg2(arg2'left)) ; + b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2); + answer := SIGNED(a nor b); + RETURN (answer); + end "nor"; + + FUNCTION "xor" ( arg1, arg2 : SIGNED ) RETURN SIGNED IS + CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ; + VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + a := (OTHERS => arg1(arg1'left)) ; + a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1); + b := (OTHERS => arg2(arg2'left)) ; + b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2); + answer := SIGNED(a xor b); + RETURN (answer); + end "xor"; + + FUNCTION "not" ( arg1 : SIGNED ) RETURN SIGNED IS + VARIABLE result : SIGNED ( arg1'RANGE ) := (Others => 'X'); + begin + for i in result'range loop + result(i) := not_table( arg1(i) ); + end loop; + return result; + end "not"; + + FUNCTION "xnor" ( arg1, arg2 : std_ulogic_vector ) RETURN std_ulogic_vector IS + CONSTANT ml : integer := maximum( arg1'LENGTH, arg2'LENGTH ); + VARIABLE lt : std_ulogic_vector ( 1 to ml ); + VARIABLE rt : std_ulogic_vector ( 1 to ml ); + VARIABLE res : std_ulogic_vector ( 1 to ml ); + begin + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN res'RANGE LOOP + res(i) := not_table( xor_table( lt(i), rt(i) ) ); + END LOOP; + RETURN res; + end "xnor"; + + FUNCTION "xnor" ( arg1, arg2 : std_logic_vector ) RETURN std_logic_vector IS + CONSTANT ml : integer := maximum( arg1'LENGTH, arg2'LENGTH ); + VARIABLE lt : std_logic_vector ( 1 to ml ); + VARIABLE rt : std_logic_vector ( 1 to ml ); + VARIABLE res : std_logic_vector ( 1 to ml ); + begin + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN res'RANGE LOOP + res(i) := not_table( xor_table( lt(i), rt(i) ) ); + END LOOP; + RETURN res; + end "xnor"; + + FUNCTION "xnor" ( arg1, arg2 : UNSIGNED ) RETURN UNSIGNED IS + CONSTANT ml : integer := maximum( arg1'LENGTH, arg2'LENGTH ); + VARIABLE lt : UNSIGNED ( 1 to ml ); + VARIABLE rt : UNSIGNED ( 1 to ml ); + VARIABLE res : UNSIGNED ( 1 to ml ); + begin + lt := zxt( arg1, ml ); + rt := zxt( arg2, ml ); + FOR i IN res'RANGE LOOP + res(i) := not_table( xor_table( lt(i), rt(i) ) ); + END LOOP; + RETURN res; + end "xnor"; + + FUNCTION "xnor" ( arg1, arg2 : SIGNED ) RETURN SIGNED IS + CONSTANT len : INTEGER := maximum(arg1'length,arg2'length) ; + VARIABLE a,b : UNSIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + VARIABLE answer : SIGNED(len-1 DOWNTO 0) := (OTHERS => '0') ; + BEGIN + a := (OTHERS => arg1(arg1'left)) ; + a(arg1'length - 1 DOWNTO 0) := UNSIGNED(arg1); + b := (OTHERS => arg2(arg2'left)) ; + b(arg2'length - 1 DOWNTO 0) := UNSIGNED(arg2); + answer := SIGNED(a xnor b); + RETURN (answer); + end "xnor"; + +END ; diff --git a/libraries/std/textio.vhdl b/libraries/std/textio.vhdl new file mode 100644 index 000000000..71b3ca72e --- /dev/null +++ b/libraries/std/textio.vhdl @@ -0,0 +1,130 @@ +-- Std.Textio package declaration. This file is part of GHDL. +-- This file was written from the clause 14.3 of the VHDL LRM. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +package textio is + +-- type definitions for text i/o + + -- a LINE is a pointer to a string value. + type line is access string; + + -- A file of variable-length ASCII records. + -- Note: in order to work correctly, the TEXT file type must be declared in + -- the textio package of library std. Otherwise, a file of string has a + -- non-ASCII format. + type text is file of string; + + type side is (right, left); -- For justifying ouput data within fields. + subtype width is natural; -- For specifying widths of output fields. + +-- standard text files + + file input: text is in "STD_INPUT"; --V87 + file output: text is out "STD_OUTPUT"; --V87 + file input : text open read_mode is "STD_INPUT"; --V93 + file output : text open write_mode is "STD_OUTPUT"; --V93 + +-- input routines for standard types + + procedure readline (variable f: in text; l: inout line); --V87 + procedure readline (file f: text; l: inout line); --V93 + + -- For READ procedures: + -- In this implementation, any L is accepted (ie, there is no constraints + -- on direction, or left bound). Therefore, even variable of type LINE + -- not initialized by READLINE are accepted. Strictly speaking, this is + -- not required by LRM, nor prevented. However, other implementations may + -- fail at parsing such strings. + -- + -- Also, in case of error (GOOD is false), this implementation do not + -- modify L (as specified by the LRM) nor VALUE. + -- + -- For READ procedures without a GOOD argument, an assertion fails in case + -- of error. + -- + -- In case of overflow (ie, if the number is out of the bounds of the type), + -- the procedure will fail with an execution error. + -- FIXME: this should not occur for a bad string. + + procedure read (l: inout line; value: out bit; good: out boolean); + procedure read (l: inout line; value: out bit); + + procedure read (l: inout line; value: out bit_vector; good: out boolean); + procedure read (l: inout line; value: out bit_vector); + + procedure read (l: inout line; value: out boolean; good: out boolean); + procedure read (l: inout line; value: out boolean); + + procedure read (l: inout line; value: out character; good: out boolean); + procedure read (l: inout line; value: out character); + + procedure read (l: inout line; value: out integer; good: out boolean); + procedure read (l: inout line; value: out integer); + + procedure read (l: inout line; value: out real; good: out boolean); + procedure read (l: inout line; value: out real); + + procedure read (l: inout line; value: out string; good: out boolean); + procedure read (l: inout line; value: out string); + + -- This implementation requires no space after the unit identifier, + -- ie "7.5 nsv" is parsed as 7.5 ns. + -- The unit identifier can be in lower case, upper case or mixed case. + procedure read (l: inout line; value: out time; good: out boolean); + procedure read (l: inout line; value: out time); + +-- output routines for standard types + + procedure writeline (variable f: out text; l: inout line); --V87 + procedure writeline (file f: text; l: inout line); --V93 + + -- This implementation accept any value for all the types. + procedure write + (l: inout line; value: in bit; + justified: in side := right; field: in width := 0); + procedure write + (l: inout line; value: in bit_vector; + justified: in side := right; field: in width := 0); + procedure write + (l: inout line; value: in boolean; + justified: in side := right; field: in width := 0); + procedure write + (l: inout line; value: in character; + justified: in side := right; field: in width := 0); + procedure write + (l: inout line; value: in integer; + justified: in side := right; field: in width := 0); + procedure write + (L: inout line; value: in real; + justified: in side := right; field: in width := 0; + digits: in natural := 0); + procedure write + (l: inout line; value: in string; + justified: in side := right; field: in width := 0); + + -- UNIT must be a unit name declared in std.standard. Of course, no rules + -- in the core VHDL language prevent you from using a value that is not a + -- unit (eg: 10 ns or even 5 fs). + -- An assertion error message is generated in this case, and question mark + -- (?) is written at the place of the unit name. + procedure write + (l: inout line; value : in time; + justified: in side := right; field: in width := 0; unit : in TIME := ns); + +end textio; diff --git a/libraries/std/textio_body.vhdl b/libraries/std/textio_body.vhdl new file mode 100644 index 000000000..0362ef61a --- /dev/null +++ b/libraries/std/textio_body.vhdl @@ -0,0 +1,1320 @@ +-- Std.Textio package body. This file is part of GHDL. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +package body textio is + -- output routines for standard types + + -- TIME_NAMES associates time units with textual names. + -- Textual names are in lower cases, since according to LRM93 14.3: + -- when written, the identifier is expressed in lowercase characters. + -- The length of the names are 3 characters, the last one may be a space + -- for 2 characters long names. + type time_unit is + record + val : time; + name : string (1 to 3); + end record; + type time_names_type is array (1 to 8) of time_unit; + constant time_names : time_names_type := + ((fs, "fs "), (ps, "ps "), (ns, "ns "), (us, "us "), + (ms, "ms "), (sec, "sec"), (min, "min"), (hr, "hr ")); + + -- Non breaking space character. --V93 + constant nbsp : character := character'val (160); --V93 + + procedure writeline (f: out text; l: inout line) is --V87 + procedure writeline (file f: text; l: inout line) is --V93 + begin + if l = null then + -- LRM93 14.3 + -- If parameter L contains a null access value at the start of the call, + -- the a null string is written to the file. + write (f, ""); + else + -- LRM93 14.3 + -- Procedure WRITELINE causes the current line designated by parameter L + -- to be written to the file and returns with the value of parameter L + -- designating a null string. + write (f, l.all); + deallocate (l); + l := new string'(""); + end if; + end writeline; + + procedure write + (l: inout line; value: in string; + justified: in side := right; field: in width := 0) + is + variable length: natural; + variable nl: line; + begin + -- l can be null. + if l = null then + length := 0; + else + length := l.all'length; + end if; + if value'length < field then + nl := new string (1 to length + field); + if length /= 0 then + nl (1 to length) := l.all; + end if; + if justified = right then + nl (length + 1 to length + field - value'length) := (others => ' '); + nl (nl.all'high - value'length + 1 to nl.all'high) := value; + else + nl (length + 1 to length + value'length) := value; + nl (length + value'length + 1 to nl.all'high) := (others => ' '); + end if; + else + nl := new string (1 to length + value'length); + if length /= 0 then + nl (1 to length) := l.all; + end if; + nl (length + 1 to nl.all'high) := value; + end if; + deallocate (l); + l := nl; + end write; + + procedure write + (l: inout line; value: in integer; + justified: in side := right; field: in width := 0) + is + variable str: string (11 downto 1); + variable val: integer := value; + variable digit: natural; + variable index: natural := 0; + begin + -- Note: the absolute value of VAL cannot be directly taken, since + -- it may be greather that the maximum value of an INTEGER. + loop + -- LRM93 7.2.6 + -- (A rem B) has the sign of A and an absolute value less then + -- the absoulte value of B. + digit := abs (val rem 10); + val := val / 10; + index := index + 1; + str (index) := character'val(48 + digit); + exit when val = 0; + end loop; + if value < 0 then + index := index + 1; + str(index) := '-'; + end if; + write (l, str (index downto 1), justified, field); + end write; + + procedure write + (l: inout line; value: in boolean; + justified: in side := right; field: in width := 0) + is + begin + if value then + write (l, string'("TRUE"), justified, field); + else + write (l, string'("FALSE"), justified, field); + end if; + end write; + + procedure write + (l: inout line; value: in character; + justified: in side := right; field: in width := 0) + is + variable str: string (1 to 1); + begin + str (1) := value; + write (l, str, justified, field); + end write; + + function bit_to_char (value : in bit) return character is + begin + case value is + when '0' => + return '0'; + when '1' => + return '1'; + end case; + end bit_to_char; + + procedure write + (l: inout line; value: in bit; + justified: in side := right; field: in width := 0) + is + variable str : string (1 to 1); + begin + str (1) := bit_to_char (value); + write (l, str, justified, field); + end write; + + procedure write + (l: inout line; value: in bit_vector; + justified: in side := right; field: in width := 0) + is + constant length : natural := value'length; + alias n_value : bit_vector (1 to value'length) is value; + variable str : string (1 to length); + begin + for i in str'range loop + str (i) := bit_to_char (n_value (i)); + end loop; + write (l, str, justified, field); + end write; + + procedure write + (l: inout line; value : in time; + justified: in side := right; field: in width := 0; unit : in TIME := ns) + is + -- Copy of VALUE on which we are working. + variable val : time := value; + + -- Copy of UNIT on which we are working. + variable un : time := unit; + + -- Digit extract from VAL/UN. + variable d : integer; -- natural range 0 to 9; + + -- Index for unit name. + variable n : integer; + + -- Result. + variable str : string (1 to 28); + + -- Current character in RES. + variable pos : natural := 1; + + -- Add a character to STR. + procedure add_char (c : character) is + begin + str (pos) := c; + pos := pos + 1; + end add_char; + begin + -- Note: + -- Care is taken to avoid overflow. Time may be 64 bits while integer + -- may be only 32 bits. + + -- Handle sign. + -- Note: VAL cannot be negated since its range may be not symetric + -- around 0. + if val < 0 ns then + add_char ('-'); + end if; + + -- Search for the first digit. + -- Note: we must start from unit, since all units are not a power of 10. + -- Note: UN can be multiplied only after we know it is possible. This + -- is a to avoid overflow. + if un <= 0 fs then + assert false report "UNIT argument is not positive" severity error; + un := 1 ns; + end if; + while val / 10 >= un or val / 10 <= -un loop + un := un * 10; + end loop; + + -- Extract digits one per one. + loop + d := val / un; + add_char (character'val (abs d + character'pos ('0'))); + val := val - d * un; + exit when val = 0 ns and un <= unit; + if un = unit then + add_char ('.'); + end if; + -- Stop as soon as precision will be lost. + -- This can happen only for hr and min. + -- FIXME: change the algorithm to display all the digits. + exit when (un / 10) * 10 /= un; + un := un / 10; + end loop; + + add_char (' '); + + -- Search the time unit name in the time table. + n := 0; + for i in time_names'range loop + if time_names (i).val = unit then + n := i; + exit; + end if; + end loop; + assert n /= 0 report "UNIT argument is not a unit name" severity error; + if n = 0 then + add_char ('?'); + else + add_char (time_names (n).name (1)); + add_char (time_names (n).name (2)); + if time_names (n).name (3) /= ' ' then + add_char (time_names (n).name (3)); + end if; + end if; + + -- Write the result. + write (l, str (1 to pos - 1), justified, field); + end write; + + -- Parameter DIGITS specifies how many digits to the right of the decimal + -- point are to be output when writing a real number; the default value 0 + -- indicates that the number should be output in standard form, consisting + -- of a normalized mantissa plus exponent (e.g., 1.079236E23). If DIGITS is + -- nonzero, then the real number is output as an integer part followed by + -- '.' followed by the fractional part, using the specified number of digits + -- (e.g., 3.14159). + -- Note: Nan, +Inf, -Inf are not to be considered, since these numbers are + -- not in the bounds defined by any real range. + procedure write (L: inout line; value: in real; + justified: in side := right; field: in width := 0; + digits: in natural := 0) + is + -- STR contains the result of the conversion. + variable str : string (1 to 320); + + -- POS is the index of the next character to be put in STR. + variable pos : positive := str'left; + + -- VAL contains the value to be converted. + variable val : real; + + -- The exponent or mantissa computed is stored in MANTISSA. This is + -- a signed number. + variable mantissa : integer; + + variable b : boolean; + variable d : natural; + + -- Append character C in STR. + procedure add_char (c : character) is + begin + str (pos) := c; + pos := pos + 1; + end add_char; + + -- Add digit V in STR. + procedure add_digit (v : natural) is + begin + add_char (character'val (character'pos ('0') + v)); + end add_digit; + + -- Add leading digit and substract it. + procedure extract_leading_digit is + variable d : natural range 0 to 10; + begin + -- Note: We need truncation but type conversion does rounding. + -- FIXME: should consider precision. + d := natural (val); + if real (d) > val then + d := d - 1; + end if; + + val := (val - real (d)) * 10.0; + + add_digit (d); + end extract_leading_digit; + begin + -- Handle sign. + -- There is no overflow here, since with IEEE implementations, sign is + -- independant of the mantissa. + -- LRM93 14.3 + -- The sign is never written if the value is non-negative. + if value < 0.0 then + add_char ('-'); + val := -value; + else + val := value; + end if; + + -- Compute the mantissa. + -- FIXME: should do a dichotomy. + if val = 0.0 then + mantissa := 0; + elsif val < 1.0 then + mantissa := -1; + while val * (10.0 ** (-mantissa)) < 1.0 loop + mantissa := mantissa - 1; + end loop; + else + mantissa := 0; + while val / (10.0 ** mantissa) >= 10.0 loop + mantissa := mantissa + 1; + end loop; + end if; + + -- Normalize VAL: in [0; 10[ + if mantissa >= 0 then + val := val / (10.0 ** mantissa); + else + val := val * 10.0 ** (-mantissa); + end if; + + if digits = 0 then + for i in 0 to 15 loop + extract_leading_digit; + + if i = 0 then + add_char ('.'); + end if; + exit when i > 0 and val < 10.0 ** (i + 1 - 15); + end loop; + + -- LRM93 14.3 + -- if the exponent is present, the `e' is written as a lower case + -- character. + add_char ('e'); + + if mantissa < 0 then + add_char ('-'); + mantissa := -mantissa; + end if; + b := false; + for i in 4 downto 0 loop + d := (mantissa / 10000) mod 10; + if d /= 0 or b or i = 0 then + add_digit (d); + b := true; + end if; + mantissa := (mantissa - d * 10000) * 10; + end loop; + else + if mantissa < 0 then + add_char ('0'); + mantissa := mantissa + 1; + else + loop + extract_leading_digit; + exit when mantissa = 0; + mantissa := mantissa - 1; + end loop; + end if; + add_char ('.'); + for i in 1 to digits loop + if mantissa = 0 then + extract_leading_digit; + else + add_char ('0'); + mantissa := mantissa + 1; + end if; + end loop; + end if; + write (l, str (1 to pos - 1), justified, field); + end write; + + procedure untruncated_text_read --V87 + (variable f : text; str : out string; len : out natural); --V87 + procedure untruncated_text_read --V93 + (file f : text; str : out string; len : out natural); --V93 + + attribute foreign : string; --V87 + attribute foreign of untruncated_text_read : procedure is "GHDL intrinsic"; + + procedure untruncated_text_read + (variable f : text; str : out string; len : out natural) is --V87 + (file f : text; str : out string; len : out natural) is --V93 + begin + assert false report "must not be called" severity failure; + end untruncated_text_read; + + procedure readline (variable f: in text; l: inout line) --V87 + procedure readline (file f: text; l: inout line) --V93 + is + variable len, nlen, posn : natural; + variable nl, old_l : line; + variable str : string (1 to 128); + variable is_eol : boolean; + begin + -- LRM93 14.3 + -- If parameter L contains a non-null access value at the start of the + -- call, the object designated by that value is deallocated before the + -- new object is created. + if l /= null then + deallocate (l); + end if; + + -- We read the input in 128-byte chunks. + -- We keep reading until we reach a newline or there is no more input. + -- The loop invariant is that old_l is allocated and contains the + -- previous chunks read, and posn = old_l.all'length. + posn := 0; + loop + untruncated_text_read (f, str, len); + exit when len = 0; + if str (len) = LF then + -- LRM 14.3 + -- The representation of the line does not contain the representation + -- of the end of the line. + is_eol := true; + len := len - 1; + else + is_eol := false; + end if; + l := new string (1 to posn + len); + if old_l /= null then + l (1 to posn) := old_l (1 to posn); + deallocate (old_l); + end if; + l (posn + 1 to posn + len) := str (1 to len); + exit when is_eol; + posn := posn + len; + old_l := l; + end loop; + end readline; + + -- Replaces L with L (LEFT to/downto L'RIGHT) + procedure trim (l : inout line; left : natural) + is + variable nl : line; + begin + if l = null then + return; + end if; + if l'left < l'right then + -- Ascending. + if left > l'right then + nl := new string'(""); + else + nl := new string (left to l'right); +-- nl := new string (1 to l'right + 1 - left); + nl.all := l (left to l'right); + end if; + else + -- Descending + if left < l'right then + nl := new string'(""); + else + nl := new string (left downto l'right); +-- nl := new string (left - l'right + 1 downto 1); + nl.all := l (left downto l'right); + end if; + end if; + deallocate (l); + l := nl; + end trim; + + -- Replaces L with L (LEFT + 1 to L'RIGHT or LEFT - 1 downto L'RIGHT) + procedure trim_next (l : inout line; left : natural) + is + variable nl : line; + begin + if l = null then + return; + end if; + if l'left < l'right then + -- Ascending. + trim (l, left + 1); + else + -- Descending + trim (l, left - 1); + end if; + end trim_next; + + function to_lower (c : character) return character is + begin + if c >= 'A' and c <= 'Z' then + return character'val (character'pos (c) + 32); + else + return c; + end if; + end to_lower; + + procedure read (l: inout line; value: out character; good: out boolean) + is + variable nl : line; + begin + if l'length = 0 then + good := false; + else + value := l (l'left); + trim_next (l, l'left); + good := true; + end if; + end read; + + procedure read (l: inout line; value: out character) + is + variable res : boolean; + begin + read (l, value, res); + assert res = true + report "character read failure" + severity failure; + end read; + + procedure read (l: inout line; value: out bit; good: out boolean) + is + begin + good := false; + for i in l'range loop + case l(i) is + when ' ' + | NBSP --V93 + | HT => + null; + when '1' => + value := '1'; + good := true; + trim_next (l, i); + return; + when '0' => + value := '0'; + good := true; + trim_next (l, i); + return; + when others => + return; + end case; + end loop; + return; + end read; + + procedure read (l: inout line; value: out bit) + is + variable res : boolean; + begin + read (l, value, res); + assert res = true + report "bit read failure" + severity failure; + end read; + + procedure read (l: inout line; value: out bit_vector; good: out boolean) + is + -- Number of bit to parse. + variable len : natural; + + variable pos, last : natural; + variable res : bit_vector (1 to value'length); + + -- State of the previous byte: + -- LEADING: blank before the bit vector. + -- FOUND: bit of the vector. + type state_type is (leading, found); + variable state : state_type; + begin + -- Initialization. + len := value'length; + if len = 0 then + -- If VALUE is a nul array, return now. + -- L stay unchanged. + -- FIXME: should blanks be removed ? + good := true; + return; + end if; + good := false; + state := leading; + pos := res'left; + for i in l'range loop + case l(i) is + when ' ' + | NBSP --V93 + | HT => + case state is + when leading => + null; + when found => + return; + end case; + when '1' | '0' => + case state is + when leading => + state := found; + when found => + null; + end case; + if l(i) = '0' then + res (pos) := '0'; + else + res (pos) := '1'; + end if; + pos := pos + 1; + len := len - 1; + last := i; + exit when len = 0; + when others => + return; + end case; + end loop; + + if len /= 0 then + -- Not enough bits. + return; + end if; + + -- Note: if LEN = 0, then FIRST and LAST have been set. + good := true; + value := res; + trim_next (l, last); + return; + end read; + + procedure read (l: inout line; value: out bit_vector) + is + variable res : boolean; + begin + read (l, value, res); + assert res = true + report "bit_vector read failure" + severity failure; + end read; + + procedure read (l: inout line; value: out boolean; good: out boolean) + is + -- State: + -- BLANK: space are being scaned. + -- L_TF : T(rue) or F(alse) has been scanned. + -- L_RA : (t)R(ue) or (f)A(lse) has been scanned. + -- L_UL : (tr)U(e) or (fa)L(se) has been scanned. + -- L_ES : (tru)E or (fal)S(e) has been scanned. + type state_type is (blank, l_tf, l_ra, l_ul, l_es); + variable state : state_type; + + -- Set to TRUE if T has been scanned, to FALSE if F has been scanned. + variable res : boolean; + begin + -- By default, it is a failure. + good := false; + state := blank; + for i in l'range loop + case state is + when blank => + if l (i) = ' ' + or l (i) = nbsp --V93 + or l (i) = HT + then + null; + elsif to_lower (l (i)) = 't' then + res := true; + state := l_tf; + elsif to_lower (l (i)) = 'f' then + res := false; + state := l_tf; + else + return; + end if; + when l_tf => + if res = true and to_lower (l (i)) = 'r' then + state := l_ra; + elsif res = false and to_lower (l (i)) = 'a' then + state := l_ra; + else + return; + end if; + when l_ra => + if res = true and to_lower (l (i)) = 'u' then + state := l_ul; + elsif res = false and to_lower (l (i)) = 'l' then + state := l_ul; + else + return; + end if; + when l_ul => + if res = true and to_lower (l (i)) = 'e' then + trim_next (l, i); + good := true; + value := true; + return; + elsif res = false and to_lower (l (i)) = 's' then + state := l_es; + else + return; + end if; + when l_es => + if res = false and to_lower (l (i)) = 'e' then + trim_next (l, i); + good := true; + value := false; + return; + else + return; + end if; + end case; + end loop; + return; + end read; + + procedure read (l: inout line; value: out boolean) + is + variable res : boolean; + begin + read (l, value, res); + assert res = true + report "boolean read failure" + severity failure; + end read; + + function char_to_nat (c : character) return natural + is + begin + return character'pos (c) - character'pos ('0'); + end char_to_nat; + + procedure read (l: inout line; value: out integer; good: out boolean) + is + variable val : integer; + variable d : natural; + + type state_t is (leading, sign, digits); + variable cur_state : state_t := leading; + begin + val := 1; + for i in l'range loop + case cur_state is + when leading => + case l(i) is + when ' ' + | NBSP --V93 + | ht => + null; + when '+' => + cur_state := sign; + when '-' => + val := -1; + cur_state := sign; + when '0' to '9' => + val := char_to_nat (l(i)); + cur_state := digits; + when others => + good := false; + return; + end case; + when sign => + case l(i) is + when '0' to '9' => + val := val * char_to_nat (l(i)); + cur_state := digits; + when others => + good := false; + return; + end case; + when digits => + case l(i) is + when '0' to '9' => + d := char_to_nat (l(i)); + val := val * 10; + if val < 0 then + val := val - d; + else + val := val + d; + end if; + when others => + trim (l, i); + good := true; + value := val; + return; + end case; + end case; + end loop; + deallocate (l); + l := new string'(""); + if cur_state /= leading then + good := true; + value := val; + else + good := false; + end if; + end read; + + procedure read (l: inout line; value: out integer) + is + variable res : boolean; + begin + read (l, value, res); + assert res = true + report "integer read failure" + severity failure; + end read; + + procedure read (l: inout line; value: out real; good: out boolean) + is + -- The result. + variable val : real; + -- True if the result is negative. + variable val_neg : boolean; + + -- Number of digits after the dot. + variable nbr_dec : natural; + + -- Value of the exponent. + variable exp : integer; + -- True if the exponent is negative. + variable exp_neg : boolean; + + -- The parsing is done with a state machine. + -- LEADING: leading blank suppression. + -- SIGN: a sign has been found. + -- DIGITS: integer parts + -- DECIMALS: digits after the dot. + -- EXPONENT_SIGN: sign after "E" + -- EXPONENT_1: first digit of the exponent. + -- EXPONENT: digits of the exponent. + type state_t is (leading, sign, digits, decimals, + exponent_sign, exponent_1, exponent); + variable cur_state : state_t := leading; + + -- Set VALUE to the result, and set GOOD to TRUE. + procedure set_value is + begin + good := true; + + if exp_neg then + val := val * 10.0 ** (-exp); + else + val := val * 10.0 ** exp; + end if; + if val_neg then + value := -val; + else + value := val; + end if; + end set_value; + + begin + -- Initialization. + val_neg := false; + nbr_dec := 1; + exp := 0; + exp_neg := false; + + -- By default, parsing has failed. + good := false; + + -- Iterate over all characters of the string. + -- Return immediatly in case of parse error. + -- Trim L and call SET_VALUE and return in case of success. + for i in l'range loop + case cur_state is + when leading => + case l(i) is + when ' ' + | NBSP --V93 + | ht => + null; + when '+' => + cur_state := sign; + when '-' => + val_neg := true; + cur_state := sign; + when '0' to '9' => + val := real (char_to_nat (l(i))); + cur_state := digits; + when others => + return; + end case; + when sign => + case l(i) is + when '0' to '9' => + val := real (char_to_nat (l(i))); + cur_state := digits; + when others => + return; + end case; + when digits => + case l(i) is + when '0' to '9' => + val := val * 10.0 + real (char_to_nat (l(i))); + when '.' => + cur_state := decimals; + when others => + -- A "." (dot) is required in the string. + return; + end case; + when decimals => + case l(i) is + when '0' to '9' => + val := val + real (char_to_nat (l(i))) / (10.0 ** nbr_dec); + nbr_dec := nbr_dec + 1; + when 'e' | 'E' => + -- "nnn.E" is erroneous. + if nbr_dec = 1 then + return; + end if; + cur_state := exponent_sign; + when others => + -- "nnn.XX" is erroneous. + if nbr_dec = 1 then + return; + end if; + trim (l, i); + set_value; + return; + end case; + when exponent_sign => + case l(i) is + when '+' => + cur_state := exponent_1; + when '-' => + exp_neg := true; + cur_state := exponent_1; + when '0' to '9' => + exp := char_to_nat (l(i)); + cur_state := exponent; + when others => + -- Error. + return; + end case; + when exponent_1 | exponent => + case l(i) is + when '0' to '9' => + exp := exp * 10 + char_to_nat (l(i)); + cur_state := exponent; + when others => + trim (l, i); + set_value; + return; + end case; + end case; + end loop; + + -- End of string. + case cur_state is + when leading | sign | digits => + -- Erroneous. + return; + when decimals => + -- "nnn.XX" is erroneous. + if nbr_dec = 1 then + return; + end if; + when exponent_sign => + -- Erroneous ("NNN.NNNE") + return; + when exponent_1 => + -- "NNN.NNNE-" + return; + when exponent => + null; + end case; + + deallocate (l); + l := new string'(""); + set_value; + end read; + + procedure read (l: inout line; value: out real) + is + variable res : boolean; + begin + read (l, value, res); + assert res = true + report "real read failure" + severity failure; + end read; + + procedure read (l: inout line; value: out time; good: out boolean) + is + -- The result. + variable res : time; + + -- UNIT is computed from the unit name, the exponent and the number of + -- digits before the dot. UNIT is the weight of the current digit. + variable unit : time; + + -- Number of digits before the dot. + variable nbr_digits : integer; + + -- True if a unit name has been found. Used temporaly to know the status + -- at the end of the search loop. + variable unit_found : boolean; + + -- True if the number is negative. + variable is_neg : boolean; + + -- Value of the exponent. + variable exp : integer; + + -- True if the exponent is negative. + variable exp_neg : boolean; + + -- Unit name extracted from the string. + variable unit_name : string (1 to 3); + + -- state is the kind of the previous character parsed. + -- LEADING: leading blanks + -- SIGN: + or - as the first character of the number. + -- DIGITS: digit of the integer part of the number. + -- DOT: dot (.) after the integer part and before the decimal part. + -- DECIMALS: digit of the decimal part. + -- EXPONENT_MARK: e or E. + -- EXPONENT_SIGN: + or - just after the exponent mark (E). + -- EXPONENT: digit of the exponent. + -- UNIT_BLANK: blank after the exponent. + -- UNIT_1, UNIT_2, UNIT_3: first, second, third character of the unit. + type state_type is (leading, sign, digits, dot, decimals, + exponent_mark, exponent_sign, exponent, + unit_blank, unit_1, unit_2, unit_3); + variable state : state_type; + + -- Used during the second scan of the string, TRUE is digits is being + -- scaned. + variable has_digits : boolean; + + -- Position at the end of the string. + variable pos : integer; + + -- Used to compute POS. + variable length : integer; + begin + -- Initialization. + -- Fail by default; therefore, in case of error, a return statement is + -- ok. + good := false; + + nbr_digits := 0; + is_neg := false; + exp := 0; + exp_neg := false; + res := 0 fs; + + -- Look for exponent and unit name. + -- Parse the string: this loop checks the correctness of the format, and + -- must return (GOOD has been set to FALSE) in case of error. + -- Set: NBR_DIGITS, IS_NEG, EXP, EXP_NEG. + state := leading; + for i in l'range loop + case l (i) is + when ' ' + | NBSP --V93 + | HT => + case state is + when leading | unit_blank => + null; + when sign | dot | exponent_mark | exponent_sign => + return; + when digits | decimals | exponent => + state := unit_blank; + when unit_1 | unit_2 => + exit; + when unit_3 => + -- Cannot happen, since an exit is performed at unit_3. + assert false report "internal error" severity failure; + end case; + when '+' | '-' => + case state is + when leading => + if l(i) = '-' then + is_neg := true; + end if; + state := sign; + when exponent_mark => + if l(i) = '-' then + exp_neg := true; + end if; + state := exponent_sign; + when others => + return; + end case; + when '0' to '9' => + case state is + when exponent_mark | exponent_sign | exponent => + exp := exp * 10 + char_to_nat (l (i)); + state := exponent; + when leading | sign | digits => + -- Leading "0" are not significant. + if nbr_digits > 0 or l (i) /= '0' then + nbr_digits := nbr_digits + 1; + end if; + state := digits; + when decimals => + null; + when dot => + state := decimals; + when others => + return; + end case; + when 'a' to 'z' | 'A' to 'Z' => + case state is + when digits | decimals => + -- "E" has exponent mark. + if l (i) = 'e' or l(i) = 'E' then + state := exponent_mark; + else + return; + end if; + when unit_blank => + unit_name (1) := to_lower (l(i)); + state := unit_1; + when unit_1 => + unit_name (2) := to_lower (l(i)); + state := unit_2; + pos := i; + when unit_2 => + unit_name (3) := to_lower (l(i)); + state := unit_3; + exit; + when others => + return; + end case; + when '.' => + case state is + when digits => + state := decimals; + when others => + return; + end case; + when others => + return; + end case; + end loop; + + -- A unit name (2 or 3 letters) must have been found. + -- The string may end anywhere. + if state /= unit_2 and state /= unit_3 then + return; + end if; + + -- Compute EXP with the sign. + if exp_neg then + exp := -exp; + end if; + + -- Search the unit name in the list of time names. + unit_found := false; + for i in time_names'range loop + -- The first two characters must match (case insensitive). + -- The third character must match if: + -- * the unit name is a three characters identifier (ie, not a blank). + -- * there is a third character in STR. + if time_names (i).name (1) = unit_name (1) + and time_names (i).name (2) = unit_name (2) + and (time_names (i).name (3) = ' ' + or time_names (i).name (3) = unit_name (3)) + then + unit := time_names (i).val; + unit_found := true; + -- POS is set to the position of the first invalid character. + if time_names (i).name (3) = ' ' then + length := 1; + else + length := 2; + end if; + if l'left < l'right then + pos := pos + length; + else + pos := pos - length; + end if; + exit; + end if; + end loop; + if not unit_found then + return; + end if; + + -- Compute UNIT, the weight of the first non-significant character. + nbr_digits := nbr_digits + exp - 1; + if nbr_digits < 0 then + unit := unit / 10 ** (-nbr_digits); + else + unit := unit * 10 ** nbr_digits; + end if; + + -- HAS_DIGITS will be set as soon as a digit is found. + -- No error is expected here (this has been checked during the first + -- pass). + has_digits := false; + for i in l'range loop + case l (i) is + when ' ' + | NBSP --V93 + | HT => + if has_digits then + exit; + end if; + when '+' | '-' => + if not has_digits then + has_digits := true; + else + assert false report "internal error" severity failure; + return; + end if; + when '0' to '9' => + -- Leading "0" are not significant. + if l (i) /= '0' or res /= 0 fs then + res := res + char_to_nat (l (i)) * unit; + unit := unit / 10; + end if; + has_digits := true; + when 'a' to 'z' | 'A' to 'Z' => + if has_digits then + exit; + else + assert false report "internal error" severity failure; + return; + end if; + when '.' => + if not has_digits then + assert false report "internal error" severity failure; + return; + end if; + when others => + assert false report "internal error" severity failure; + return; + end case; + end loop; + + -- Set VALUE. + if is_neg then + value := -res; + else + value := res; + end if; + good := true; + trim (l, pos); + return; + end read; + + procedure read (l: inout line; value: out time) + is + variable res : boolean; + begin + read (l, value, res); + assert res = true + report "time read failure" + severity failure; + end read; + + procedure read (l: inout line; value: out string; good: out boolean) + is + constant len : natural := value'length; + begin + if l'length < len then + good := false; + return; + end if; + good := true; + if len = 0 then + return; + end if; + if l'left < l'right then + value := l (l'left to l'left + len - 1); + trim (l, l'left + len); + else + value := l (l'left downto l'left - len + 1); + trim (l, l'left - len); + end if; + end read; + + procedure read (l: inout line; value: out string) + is + variable res : boolean; + begin + read (l, value, res); + assert res = true + report "string read failure" + severity failure; + end read; + +end textio; diff --git a/libraries/synopsys/std_logic_arith.vhdl b/libraries/synopsys/std_logic_arith.vhdl new file mode 100644 index 000000000..685b64732 --- /dev/null +++ b/libraries/synopsys/std_logic_arith.vhdl @@ -0,0 +1,2391 @@ +-------------------------------------------------------------------------- +-- -- +-- Copyright (c) 1990,1991,1992 by Synopsys, Inc. All rights reserved. -- +-- -- +-- This source file may be used and distributed without restriction -- +-- provided that this copyright statement is not removed from the file -- +-- and that any derivative work contains this copyright notice. -- +-- -- +-- Package name: STD_LOGIC_ARITH -- +-- -- +-- Purpose: -- +-- A set of arithemtic, conversion, and comparison functions -- +-- for SIGNED, UNSIGNED, SMALL_INT, INTEGER, -- +-- STD_ULOGIC, STD_LOGIC, and STD_LOGIC_VECTOR. -- +-- -- +-------------------------------------------------------------------------- + +library IEEE; +use IEEE.std_logic_1164.all; + +package std_logic_arith is + + type UNSIGNED is array (NATURAL range <>) of STD_LOGIC; + type SIGNED is array (NATURAL range <>) of STD_LOGIC; + subtype SMALL_INT is INTEGER range 0 to 1; + + function "+"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED; + function "+"(L: SIGNED; R: SIGNED) return SIGNED; + function "+"(L: UNSIGNED; R: SIGNED) return SIGNED; + function "+"(L: SIGNED; R: UNSIGNED) return SIGNED; + function "+"(L: UNSIGNED; R: INTEGER) return UNSIGNED; + function "+"(L: INTEGER; R: UNSIGNED) return UNSIGNED; + function "+"(L: SIGNED; R: INTEGER) return SIGNED; + function "+"(L: INTEGER; R: SIGNED) return SIGNED; + function "+"(L: UNSIGNED; R: STD_ULOGIC) return UNSIGNED; + function "+"(L: STD_ULOGIC; R: UNSIGNED) return UNSIGNED; + function "+"(L: SIGNED; R: STD_ULOGIC) return SIGNED; + function "+"(L: STD_ULOGIC; R: SIGNED) return SIGNED; + + function "+"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR; + function "+"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR; + function "+"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR; + function "+"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR; + function "+"(L: UNSIGNED; R: INTEGER) return STD_LOGIC_VECTOR; + function "+"(L: INTEGER; R: UNSIGNED) return STD_LOGIC_VECTOR; + function "+"(L: SIGNED; R: INTEGER) return STD_LOGIC_VECTOR; + function "+"(L: INTEGER; R: SIGNED) return STD_LOGIC_VECTOR; + function "+"(L: UNSIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR; + function "+"(L: STD_ULOGIC; R: UNSIGNED) return STD_LOGIC_VECTOR; + function "+"(L: SIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR; + function "+"(L: STD_ULOGIC; R: SIGNED) return STD_LOGIC_VECTOR; + + function "-"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED; + function "-"(L: SIGNED; R: SIGNED) return SIGNED; + function "-"(L: UNSIGNED; R: SIGNED) return SIGNED; + function "-"(L: SIGNED; R: UNSIGNED) return SIGNED; + function "-"(L: UNSIGNED; R: INTEGER) return UNSIGNED; + function "-"(L: INTEGER; R: UNSIGNED) return UNSIGNED; + function "-"(L: SIGNED; R: INTEGER) return SIGNED; + function "-"(L: INTEGER; R: SIGNED) return SIGNED; + function "-"(L: UNSIGNED; R: STD_ULOGIC) return UNSIGNED; + function "-"(L: STD_ULOGIC; R: UNSIGNED) return UNSIGNED; + function "-"(L: SIGNED; R: STD_ULOGIC) return SIGNED; + function "-"(L: STD_ULOGIC; R: SIGNED) return SIGNED; + + function "-"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR; + function "-"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR; + function "-"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR; + function "-"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR; + function "-"(L: UNSIGNED; R: INTEGER) return STD_LOGIC_VECTOR; + function "-"(L: INTEGER; R: UNSIGNED) return STD_LOGIC_VECTOR; + function "-"(L: SIGNED; R: INTEGER) return STD_LOGIC_VECTOR; + function "-"(L: INTEGER; R: SIGNED) return STD_LOGIC_VECTOR; + function "-"(L: UNSIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR; + function "-"(L: STD_ULOGIC; R: UNSIGNED) return STD_LOGIC_VECTOR; + function "-"(L: SIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR; + function "-"(L: STD_ULOGIC; R: SIGNED) return STD_LOGIC_VECTOR; + + function "+"(L: UNSIGNED) return UNSIGNED; + function "+"(L: SIGNED) return SIGNED; + function "-"(L: SIGNED) return SIGNED; + function "ABS"(L: SIGNED) return SIGNED; + + function "+"(L: UNSIGNED) return STD_LOGIC_VECTOR; + function "+"(L: SIGNED) return STD_LOGIC_VECTOR; + function "-"(L: SIGNED) return STD_LOGIC_VECTOR; + function "ABS"(L: SIGNED) return STD_LOGIC_VECTOR; + + function "*"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED; + function "*"(L: SIGNED; R: SIGNED) return SIGNED; + function "*"(L: SIGNED; R: UNSIGNED) return SIGNED; + function "*"(L: UNSIGNED; R: SIGNED) return SIGNED; + + function "*"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR; + function "*"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR; + function "*"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR; + function "*"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR; + + function "<"(L: UNSIGNED; R: UNSIGNED) return BOOLEAN; + function "<"(L: SIGNED; R: SIGNED) return BOOLEAN; + function "<"(L: UNSIGNED; R: SIGNED) return BOOLEAN; + function "<"(L: SIGNED; R: UNSIGNED) return BOOLEAN; + function "<"(L: UNSIGNED; R: INTEGER) return BOOLEAN; + function "<"(L: INTEGER; R: UNSIGNED) return BOOLEAN; + function "<"(L: SIGNED; R: INTEGER) return BOOLEAN; + function "<"(L: INTEGER; R: SIGNED) return BOOLEAN; + + function "<="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN; + function "<="(L: SIGNED; R: SIGNED) return BOOLEAN; + function "<="(L: UNSIGNED; R: SIGNED) return BOOLEAN; + function "<="(L: SIGNED; R: UNSIGNED) return BOOLEAN; + function "<="(L: UNSIGNED; R: INTEGER) return BOOLEAN; + function "<="(L: INTEGER; R: UNSIGNED) return BOOLEAN; + function "<="(L: SIGNED; R: INTEGER) return BOOLEAN; + function "<="(L: INTEGER; R: SIGNED) return BOOLEAN; + + function ">"(L: UNSIGNED; R: UNSIGNED) return BOOLEAN; + function ">"(L: SIGNED; R: SIGNED) return BOOLEAN; + function ">"(L: UNSIGNED; R: SIGNED) return BOOLEAN; + function ">"(L: SIGNED; R: UNSIGNED) return BOOLEAN; + function ">"(L: UNSIGNED; R: INTEGER) return BOOLEAN; + function ">"(L: INTEGER; R: UNSIGNED) return BOOLEAN; + function ">"(L: SIGNED; R: INTEGER) return BOOLEAN; + function ">"(L: INTEGER; R: SIGNED) return BOOLEAN; + + function ">="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN; + function ">="(L: SIGNED; R: SIGNED) return BOOLEAN; + function ">="(L: UNSIGNED; R: SIGNED) return BOOLEAN; + function ">="(L: SIGNED; R: UNSIGNED) return BOOLEAN; + function ">="(L: UNSIGNED; R: INTEGER) return BOOLEAN; + function ">="(L: INTEGER; R: UNSIGNED) return BOOLEAN; + function ">="(L: SIGNED; R: INTEGER) return BOOLEAN; + function ">="(L: INTEGER; R: SIGNED) return BOOLEAN; + + function "="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN; + function "="(L: SIGNED; R: SIGNED) return BOOLEAN; + function "="(L: UNSIGNED; R: SIGNED) return BOOLEAN; + function "="(L: SIGNED; R: UNSIGNED) return BOOLEAN; + function "="(L: UNSIGNED; R: INTEGER) return BOOLEAN; + function "="(L: INTEGER; R: UNSIGNED) return BOOLEAN; + function "="(L: SIGNED; R: INTEGER) return BOOLEAN; + function "="(L: INTEGER; R: SIGNED) return BOOLEAN; + + function "/="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN; + function "/="(L: SIGNED; R: SIGNED) return BOOLEAN; + function "/="(L: UNSIGNED; R: SIGNED) return BOOLEAN; + function "/="(L: SIGNED; R: UNSIGNED) return BOOLEAN; + function "/="(L: UNSIGNED; R: INTEGER) return BOOLEAN; + function "/="(L: INTEGER; R: UNSIGNED) return BOOLEAN; + function "/="(L: SIGNED; R: INTEGER) return BOOLEAN; + function "/="(L: INTEGER; R: SIGNED) return BOOLEAN; + + function SHL(ARG: UNSIGNED; COUNT: UNSIGNED) return UNSIGNED; + function SHL(ARG: SIGNED; COUNT: UNSIGNED) return SIGNED; + function SHR(ARG: UNSIGNED; COUNT: UNSIGNED) return UNSIGNED; + function SHR(ARG: SIGNED; COUNT: UNSIGNED) return SIGNED; + + function CONV_INTEGER(ARG: INTEGER) return INTEGER; + function CONV_INTEGER(ARG: UNSIGNED) return INTEGER; + function CONV_INTEGER(ARG: SIGNED) return INTEGER; + function CONV_INTEGER(ARG: STD_ULOGIC) return SMALL_INT; + + function CONV_UNSIGNED(ARG: INTEGER; SIZE: INTEGER) return UNSIGNED; + function CONV_UNSIGNED(ARG: UNSIGNED; SIZE: INTEGER) return UNSIGNED; + function CONV_UNSIGNED(ARG: SIGNED; SIZE: INTEGER) return UNSIGNED; + function CONV_UNSIGNED(ARG: STD_ULOGIC; SIZE: INTEGER) return UNSIGNED; + + function CONV_SIGNED(ARG: INTEGER; SIZE: INTEGER) return SIGNED; + function CONV_SIGNED(ARG: UNSIGNED; SIZE: INTEGER) return SIGNED; + function CONV_SIGNED(ARG: SIGNED; SIZE: INTEGER) return SIGNED; + function CONV_SIGNED(ARG: STD_ULOGIC; SIZE: INTEGER) return SIGNED; + + function CONV_STD_LOGIC_VECTOR(ARG: INTEGER; SIZE: INTEGER) + return STD_LOGIC_VECTOR; + function CONV_STD_LOGIC_VECTOR(ARG: UNSIGNED; SIZE: INTEGER) + return STD_LOGIC_VECTOR; + function CONV_STD_LOGIC_VECTOR(ARG: SIGNED; SIZE: INTEGER) + return STD_LOGIC_VECTOR; + function CONV_STD_LOGIC_VECTOR(ARG: STD_ULOGIC; SIZE: INTEGER) + return STD_LOGIC_VECTOR; + -- zero extend STD_LOGIC_VECTOR (ARG) to SIZE, + -- SIZE < 0 is same as SIZE = 0 + -- returns STD_LOGIC_VECTOR(SIZE-1 downto 0) + function EXT(ARG: STD_LOGIC_VECTOR; SIZE: INTEGER) return STD_LOGIC_VECTOR; + + -- sign extend STD_LOGIC_VECTOR (ARG) to SIZE, + -- SIZE < 0 is same as SIZE = 0 + -- return STD_LOGIC_VECTOR(SIZE-1 downto 0) + function SXT(ARG: STD_LOGIC_VECTOR; SIZE: INTEGER) return STD_LOGIC_VECTOR; + +end Std_logic_arith; + + + +library IEEE; +use IEEE.std_logic_1164.all; + +package body std_logic_arith is + + function max(L, R: INTEGER) return INTEGER is + begin + if L > R then + return L; + else + return R; + end if; + end; + + + function min(L, R: INTEGER) return INTEGER is + begin + if L < R then + return L; + else + return R; + end if; + end; + + -- synopsys synthesis_off + type tbl_type is array (STD_ULOGIC) of STD_ULOGIC; + constant tbl_BINARY : tbl_type := + ('X', 'X', '0', '1', 'X', 'X', '0', '1', 'X'); + -- synopsys synthesis_on + + -- synopsys synthesis_off + type tbl_mvl9_boolean is array (STD_ULOGIC) of boolean; + constant IS_X : tbl_mvl9_boolean := + (true, true, false, false, true, true, false, false, true); + -- synopsys synthesis_on + + + + function MAKE_BINARY(A : STD_ULOGIC) return STD_ULOGIC is + -- synopsys built_in SYN_FEED_THRU + begin + -- synopsys synthesis_off + if (IS_X(A)) then + assert false + report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)." + severity warning; + return ('X'); + end if; + return tbl_BINARY(A); + -- synopsys synthesis_on + end; + + function MAKE_BINARY(A : UNSIGNED) return UNSIGNED is + -- synopsys built_in SYN_FEED_THRU + variable one_bit : STD_ULOGIC; + variable result : UNSIGNED (A'range); + begin + -- synopsys synthesis_off + for i in A'range loop + if (IS_X(A(i))) then + assert false + report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)." + severity warning; + result := (others => 'X'); + return result; + end if; + result(i) := tbl_BINARY(A(i)); + end loop; + return result; + -- synopsys synthesis_on + end; + + function MAKE_BINARY(A : UNSIGNED) return SIGNED is + -- synopsys built_in SYN_FEED_THRU + variable one_bit : STD_ULOGIC; + variable result : SIGNED (A'range); + begin + -- synopsys synthesis_off + for i in A'range loop + if (IS_X(A(i))) then + assert false + report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)." + severity warning; + result := (others => 'X'); + return result; + end if; + result(i) := tbl_BINARY(A(i)); + end loop; + return result; + -- synopsys synthesis_on + end; + + function MAKE_BINARY(A : SIGNED) return UNSIGNED is + -- synopsys built_in SYN_FEED_THRU + variable one_bit : STD_ULOGIC; + variable result : UNSIGNED (A'range); + begin + -- synopsys synthesis_off + for i in A'range loop + if (IS_X(A(i))) then + assert false + report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)." + severity warning; + result := (others => 'X'); + return result; + end if; + result(i) := tbl_BINARY(A(i)); + end loop; + return result; + -- synopsys synthesis_on + end; + + function MAKE_BINARY(A : SIGNED) return SIGNED is + -- synopsys built_in SYN_FEED_THRU + variable one_bit : STD_ULOGIC; + variable result : SIGNED (A'range); + begin + -- synopsys synthesis_off + for i in A'range loop + if (IS_X(A(i))) then + assert false + report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)." + severity warning; + result := (others => 'X'); + return result; + end if; + result(i) := tbl_BINARY(A(i)); + end loop; + return result; + -- synopsys synthesis_on + end; + + function MAKE_BINARY(A : STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- synopsys built_in SYN_FEED_THRU + variable one_bit : STD_ULOGIC; + variable result : STD_LOGIC_VECTOR (A'range); + begin + -- synopsys synthesis_off + for i in A'range loop + if (IS_X(A(i))) then + assert false + report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)." + severity warning; + result := (others => 'X'); + return result; + end if; + result(i) := tbl_BINARY(A(i)); + end loop; + return result; + -- synopsys synthesis_on + end; + + function MAKE_BINARY(A : UNSIGNED) return STD_LOGIC_VECTOR is + -- synopsys built_in SYN_FEED_THRU + variable one_bit : STD_ULOGIC; + variable result : STD_LOGIC_VECTOR (A'range); + begin + -- synopsys synthesis_off + for i in A'range loop + if (IS_X(A(i))) then + assert false + report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)." + severity warning; + result := (others => 'X'); + return result; + end if; + result(i) := tbl_BINARY(A(i)); + end loop; + return result; + -- synopsys synthesis_on + end; + + function MAKE_BINARY(A : SIGNED) return STD_LOGIC_VECTOR is + -- synopsys built_in SYN_FEED_THRU + variable one_bit : STD_ULOGIC; + variable result : STD_LOGIC_VECTOR (A'range); + begin + -- synopsys synthesis_off + for i in A'range loop + if (IS_X(A(i))) then + assert false + report "There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, the result will be 'X'(es)." + severity warning; + result := (others => 'X'); + return result; + end if; + result(i) := tbl_BINARY(A(i)); + end loop; + return result; + -- synopsys synthesis_on + end; + + + + -- Type propagation function which returns a signed type with the + -- size of the left arg. + function LEFT_SIGNED_ARG(A,B: SIGNED) return SIGNED is + variable Z: SIGNED (A'left downto 0); + -- pragma return_port_name Z + begin + return(Z); + end; + + -- Type propagation function which returns an unsigned type with the + -- size of the left arg. + function LEFT_UNSIGNED_ARG(A,B: UNSIGNED) return UNSIGNED is + variable Z: UNSIGNED (A'left downto 0); + -- pragma return_port_name Z + begin + return(Z); + end; + + -- Type propagation function which returns a signed type with the + -- size of the result of a signed multiplication + function MULT_SIGNED_ARG(A,B: SIGNED) return SIGNED is + variable Z: SIGNED ((A'length+B'length-1) downto 0); + -- pragma return_port_name Z + begin + return(Z); + end; + + -- Type propagation function which returns an unsigned type with the + -- size of the result of a unsigned multiplication + function MULT_UNSIGNED_ARG(A,B: UNSIGNED) return UNSIGNED is + variable Z: UNSIGNED ((A'length+B'length-1) downto 0); + -- pragma return_port_name Z + begin + return(Z); + end; + + + + function mult(A,B: SIGNED) return SIGNED is + + variable BA: SIGNED((A'length+B'length-1) downto 0); + variable PA: SIGNED((A'length+B'length-1) downto 0); + variable AA: SIGNED(A'length downto 0); + variable neg: STD_ULOGIC; + constant one : UNSIGNED(1 downto 0) := "01"; + + -- pragma map_to_operator MULT_TC_OP + -- pragma type_function MULT_SIGNED_ARG + -- pragma return_port_name Z + + begin + if (A(A'left) = 'X' or B(B'left) = 'X') then + PA := (others => 'X'); + return(PA); + end if; + PA := (others => '0'); + neg := B(B'left) xor A(A'left); + BA := CONV_SIGNED(('0' & ABS(B)),(A'length+B'length)); + AA := '0' & ABS(A); + for i in integer range 0 to A'length-1 loop + if AA(i) = '1' then + PA := PA+BA; + end if; + BA := SHL(BA,one); + end loop; + if (neg= '1') then + return(-PA); + else + return(PA); + end if; + end; + + function mult(A,B: UNSIGNED) return UNSIGNED is + + variable BA: UNSIGNED((A'length+B'length-1) downto 0); + variable PA: UNSIGNED((A'length+B'length-1) downto 0); + constant one : UNSIGNED(1 downto 0) := "01"; + + -- pragma map_to_operator MULT_UNS_OP + -- pragma type_function MULT_UNSIGNED_ARG + -- pragma return_port_name Z + + begin + if (A(A'left) = 'X' or B(B'left) = 'X') then + PA := (others => 'X'); + return(PA); + end if; + PA := (others => '0'); + BA := CONV_UNSIGNED(B,(A'length+B'length)); + for i in integer range 0 to A'length-1 loop + if A(i) = '1' then + PA := PA+BA; + end if; + BA := SHL(BA,one); + end loop; + return(PA); + end; + + -- subtract two signed numbers of the same length + -- both arrays must have range (msb downto 0) + function minus(A, B: SIGNED) return SIGNED is + variable carry: STD_ULOGIC; + variable BV: STD_ULOGIC_VECTOR (A'left downto 0); + variable sum: SIGNED (A'left downto 0); + + -- pragma map_to_operator SUB_TC_OP + + -- pragma type_function LEFT_SIGNED_ARG + -- pragma return_port_name Z + + begin + if (A(A'left) = 'X' or B(B'left) = 'X') then + sum := (others => 'X'); + return(sum); + end if; + carry := '1'; + BV := not STD_ULOGIC_VECTOR(B); + + for i in 0 to A'left loop + sum(i) := A(i) xor BV(i) xor carry; + carry := (A(i) and BV(i)) or + (A(i) and carry) or + (carry and BV(i)); + end loop; + return sum; + end; + + -- add two signed numbers of the same length + -- both arrays must have range (msb downto 0) + function plus(A, B: SIGNED) return SIGNED is + variable carry: STD_ULOGIC; + variable BV, sum: SIGNED (A'left downto 0); + + -- pragma map_to_operator ADD_TC_OP + -- pragma type_function LEFT_SIGNED_ARG + -- pragma return_port_name Z + + begin + if (A(A'left) = 'X' or B(B'left) = 'X') then + sum := (others => 'X'); + return(sum); + end if; + carry := '0'; + BV := B; + + for i in 0 to A'left loop + sum(i) := A(i) xor BV(i) xor carry; + carry := (A(i) and BV(i)) or + (A(i) and carry) or + (carry and BV(i)); + end loop; + return sum; + end; + + + -- subtract two unsigned numbers of the same length + -- both arrays must have range (msb downto 0) + function unsigned_minus(A, B: UNSIGNED) return UNSIGNED is + variable carry: STD_ULOGIC; + variable BV: STD_ULOGIC_VECTOR (A'left downto 0); + variable sum: UNSIGNED (A'left downto 0); + + -- pragma map_to_operator SUB_UNS_OP + -- pragma type_function LEFT_UNSIGNED_ARG + -- pragma return_port_name Z + + begin + if (A(A'left) = 'X' or B(B'left) = 'X') then + sum := (others => 'X'); + return(sum); + end if; + carry := '1'; + BV := not STD_ULOGIC_VECTOR(B); + + for i in 0 to A'left loop + sum(i) := A(i) xor BV(i) xor carry; + carry := (A(i) and BV(i)) or + (A(i) and carry) or + (carry and BV(i)); + end loop; + return sum; + end; + + -- add two unsigned numbers of the same length + -- both arrays must have range (msb downto 0) + function unsigned_plus(A, B: UNSIGNED) return UNSIGNED is + variable carry: STD_ULOGIC; + variable BV, sum: UNSIGNED (A'left downto 0); + + -- pragma map_to_operator ADD_UNS_OP + -- pragma type_function LEFT_UNSIGNED_ARG + -- pragma return_port_name Z + + begin + if (A(A'left) = 'X' or B(B'left) = 'X') then + sum := (others => 'X'); + return(sum); + end if; + carry := '0'; + BV := B; + + for i in 0 to A'left loop + sum(i) := A(i) xor BV(i) xor carry; + carry := (A(i) and BV(i)) or + (A(i) and carry) or + (carry and BV(i)); + end loop; + return sum; + end; + + + + function "*"(L: SIGNED; R: SIGNED) return SIGNED is + -- pragma label_applies_to mult + -- synopsys subpgm_id 296 + begin + return mult(CONV_SIGNED(L, L'length), + CONV_SIGNED(R, R'length)); -- pragma label mult + end; + + function "*"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED is + -- pragma label_applies_to mult + -- synopsys subpgm_id 295 + begin + return mult(CONV_UNSIGNED(L, L'length), + CONV_UNSIGNED(R, R'length)); -- pragma label mult + end; + + function "*"(L: UNSIGNED; R: SIGNED) return SIGNED is + -- pragma label_applies_to mult + -- synopsys subpgm_id 297 + begin + return mult(CONV_SIGNED(L, L'length+1), + CONV_SIGNED(R, R'length)); -- pragma label mult + end; + + function "*"(L: SIGNED; R: UNSIGNED) return SIGNED is + -- pragma label_applies_to mult + -- synopsys subpgm_id 298 + begin + return mult(CONV_SIGNED(L, L'length), + CONV_SIGNED(R, R'length+1)); -- pragma label mult + end; + + + function "*"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to mult + -- synopsys subpgm_id 301 + begin + return STD_LOGIC_VECTOR ( + mult(-- pragma label mult + CONV_SIGNED(L, L'length), CONV_SIGNED(R, R'length))); + end; + + function "*"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to mult + -- synopsys subpgm_id 300 + begin + return STD_LOGIC_VECTOR ( + mult(-- pragma label mult + CONV_UNSIGNED(L, L'length), CONV_UNSIGNED(R, R'length))); + end; + + function "*"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to mult + -- synopsys subpgm_id 302 + begin + return STD_LOGIC_VECTOR ( + mult(-- pragma label mult + CONV_SIGNED(L, L'length+1), CONV_SIGNED(R, R'length))); + end; + + function "*"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to mult + -- synopsys subpgm_id 303 + begin + return STD_LOGIC_VECTOR ( + mult(-- pragma label mult + CONV_SIGNED(L, L'length), CONV_SIGNED(R, R'length+1))); + end; + + + function "+"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 236 + constant length: INTEGER := max(L'length, R'length); + begin + return unsigned_plus(CONV_UNSIGNED(L, length), + CONV_UNSIGNED(R, length)); -- pragma label plus + end; + + + function "+"(L: SIGNED; R: SIGNED) return SIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 237 + constant length: INTEGER := max(L'length, R'length); + begin + return plus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label plus + end; + + + function "+"(L: UNSIGNED; R: SIGNED) return SIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 238 + constant length: INTEGER := max(L'length + 1, R'length); + begin + return plus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label plus + end; + + + function "+"(L: SIGNED; R: UNSIGNED) return SIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 239 + constant length: INTEGER := max(L'length, R'length + 1); + begin + return plus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label plus + end; + + + function "+"(L: UNSIGNED; R: INTEGER) return UNSIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 240 + constant length: INTEGER := L'length + 1; + begin + return CONV_UNSIGNED( + plus( -- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1); + end; + + + function "+"(L: INTEGER; R: UNSIGNED) return UNSIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 241 + constant length: INTEGER := R'length + 1; + begin + return CONV_UNSIGNED( + plus( -- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1); + end; + + + function "+"(L: SIGNED; R: INTEGER) return SIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 242 + constant length: INTEGER := L'length; + begin + return plus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label plus + end; + + + function "+"(L: INTEGER; R: SIGNED) return SIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 243 + constant length: INTEGER := R'length; + begin + return plus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label plus + end; + + + function "+"(L: UNSIGNED; R: STD_ULOGIC) return UNSIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 244 + constant length: INTEGER := L'length; + begin + return unsigned_plus(CONV_UNSIGNED(L, length), + CONV_UNSIGNED(R, length)) ; -- pragma label plus + end; + + + function "+"(L: STD_ULOGIC; R: UNSIGNED) return UNSIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 245 + constant length: INTEGER := R'length; + begin + return unsigned_plus(CONV_UNSIGNED(L, length), + CONV_UNSIGNED(R, length)); -- pragma label plus + end; + + + function "+"(L: SIGNED; R: STD_ULOGIC) return SIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 246 + constant length: INTEGER := L'length; + begin + return plus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label plus + end; + + + function "+"(L: STD_ULOGIC; R: SIGNED) return SIGNED is + -- pragma label_applies_to plus + -- synopsys subpgm_id 247 + constant length: INTEGER := R'length; + begin + return plus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label plus + end; + + + + function "+"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 260 + constant length: INTEGER := max(L'length, R'length); + begin + return STD_LOGIC_VECTOR ( + unsigned_plus(-- pragma label plus + CONV_UNSIGNED(L, length), CONV_UNSIGNED(R, length))); + end; + + + function "+"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 261 + constant length: INTEGER := max(L'length, R'length); + begin + return STD_LOGIC_VECTOR ( + plus(-- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "+"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 262 + constant length: INTEGER := max(L'length + 1, R'length); + begin + return STD_LOGIC_VECTOR ( + plus(-- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "+"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 263 + constant length: INTEGER := max(L'length, R'length + 1); + begin + return STD_LOGIC_VECTOR ( + plus(-- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "+"(L: UNSIGNED; R: INTEGER) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 264 + constant length: INTEGER := L'length + 1; + begin + return STD_LOGIC_VECTOR (CONV_UNSIGNED( + plus( -- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1)); + end; + + + function "+"(L: INTEGER; R: UNSIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 265 + constant length: INTEGER := R'length + 1; + begin + return STD_LOGIC_VECTOR (CONV_UNSIGNED( + plus( -- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1)); + end; + + + function "+"(L: SIGNED; R: INTEGER) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 266 + constant length: INTEGER := L'length; + begin + return STD_LOGIC_VECTOR ( + plus(-- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "+"(L: INTEGER; R: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 267 + constant length: INTEGER := R'length; + begin + return STD_LOGIC_VECTOR ( + plus(-- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "+"(L: UNSIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 268 + constant length: INTEGER := L'length; + begin + return STD_LOGIC_VECTOR ( + unsigned_plus(-- pragma label plus + CONV_UNSIGNED(L, length), CONV_UNSIGNED(R, length))) ; + end; + + + function "+"(L: STD_ULOGIC; R: UNSIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 269 + constant length: INTEGER := R'length; + begin + return STD_LOGIC_VECTOR ( + unsigned_plus(-- pragma label plus + CONV_UNSIGNED(L, length), CONV_UNSIGNED(R, length))); + end; + + + function "+"(L: SIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 270 + constant length: INTEGER := L'length; + begin + return STD_LOGIC_VECTOR ( + plus(-- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "+"(L: STD_ULOGIC; R: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + -- synopsys subpgm_id 271 + constant length: INTEGER := R'length; + begin + return STD_LOGIC_VECTOR ( + plus(-- pragma label plus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + + function "-"(L: UNSIGNED; R: UNSIGNED) return UNSIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 248 + constant length: INTEGER := max(L'length, R'length); + begin + return unsigned_minus(CONV_UNSIGNED(L, length), + CONV_UNSIGNED(R, length)); -- pragma label minus + end; + + + function "-"(L: SIGNED; R: SIGNED) return SIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 249 + constant length: INTEGER := max(L'length, R'length); + begin + return minus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label minus + end; + + + function "-"(L: UNSIGNED; R: SIGNED) return SIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 250 + constant length: INTEGER := max(L'length + 1, R'length); + begin + return minus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label minus + end; + + + function "-"(L: SIGNED; R: UNSIGNED) return SIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 251 + constant length: INTEGER := max(L'length, R'length + 1); + begin + return minus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label minus + end; + + + function "-"(L: UNSIGNED; R: INTEGER) return UNSIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 252 + constant length: INTEGER := L'length + 1; + begin + return CONV_UNSIGNED( + minus( -- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1); + end; + + + function "-"(L: INTEGER; R: UNSIGNED) return UNSIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 253 + constant length: INTEGER := R'length + 1; + begin + return CONV_UNSIGNED( + minus( -- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1); + end; + + + function "-"(L: SIGNED; R: INTEGER) return SIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 254 + constant length: INTEGER := L'length; + begin + return minus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label minus + end; + + + function "-"(L: INTEGER; R: SIGNED) return SIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 255 + constant length: INTEGER := R'length; + begin + return minus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label minus + end; + + + function "-"(L: UNSIGNED; R: STD_ULOGIC) return UNSIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 256 + constant length: INTEGER := L'length + 1; + begin + return CONV_UNSIGNED( + minus( -- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1); + end; + + + function "-"(L: STD_ULOGIC; R: UNSIGNED) return UNSIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 257 + constant length: INTEGER := R'length + 1; + begin + return CONV_UNSIGNED( + minus( -- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1); + end; + + + function "-"(L: SIGNED; R: STD_ULOGIC) return SIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 258 + constant length: INTEGER := L'length; + begin + return minus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label minus + end; + + + function "-"(L: STD_ULOGIC; R: SIGNED) return SIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 259 + constant length: INTEGER := R'length; + begin + return minus(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label minus + end; + + + + + function "-"(L: UNSIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 272 + constant length: INTEGER := max(L'length, R'length); + begin + return STD_LOGIC_VECTOR ( + unsigned_minus(-- pragma label minus + CONV_UNSIGNED(L, length), CONV_UNSIGNED(R, length))); + end; + + + function "-"(L: SIGNED; R: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 273 + constant length: INTEGER := max(L'length, R'length); + begin + return STD_LOGIC_VECTOR ( + minus(-- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "-"(L: UNSIGNED; R: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 274 + constant length: INTEGER := max(L'length + 1, R'length); + begin + return STD_LOGIC_VECTOR ( + minus(-- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "-"(L: SIGNED; R: UNSIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 275 + constant length: INTEGER := max(L'length, R'length + 1); + begin + return STD_LOGIC_VECTOR ( + minus(-- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "-"(L: UNSIGNED; R: INTEGER) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 276 + constant length: INTEGER := L'length + 1; + begin + return STD_LOGIC_VECTOR (CONV_UNSIGNED( + minus( -- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1)); + end; + + + function "-"(L: INTEGER; R: UNSIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 277 + constant length: INTEGER := R'length + 1; + begin + return STD_LOGIC_VECTOR (CONV_UNSIGNED( + minus( -- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1)); + end; + + + function "-"(L: SIGNED; R: INTEGER) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 278 + constant length: INTEGER := L'length; + begin + return STD_LOGIC_VECTOR ( + minus(-- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "-"(L: INTEGER; R: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 279 + constant length: INTEGER := R'length; + begin + return STD_LOGIC_VECTOR ( + minus(-- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "-"(L: UNSIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 280 + constant length: INTEGER := L'length + 1; + begin + return STD_LOGIC_VECTOR (CONV_UNSIGNED( + minus( -- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1)); + end; + + + function "-"(L: STD_ULOGIC; R: UNSIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 281 + constant length: INTEGER := R'length + 1; + begin + return STD_LOGIC_VECTOR (CONV_UNSIGNED( + minus( -- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length)), length-1)); + end; + + + function "-"(L: SIGNED; R: STD_ULOGIC) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 282 + constant length: INTEGER := L'length; + begin + return STD_LOGIC_VECTOR ( + minus(-- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + function "-"(L: STD_ULOGIC; R: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 283 + constant length: INTEGER := R'length; + begin + return STD_LOGIC_VECTOR ( + minus(-- pragma label minus + CONV_SIGNED(L, length), CONV_SIGNED(R, length))); + end; + + + + + function "+"(L: UNSIGNED) return UNSIGNED is + -- synopsys subpgm_id 284 + begin + return L; + end; + + + function "+"(L: SIGNED) return SIGNED is + -- synopsys subpgm_id 285 + begin + return L; + end; + + + function "-"(L: SIGNED) return SIGNED is + -- pragma label_applies_to minus + -- synopsys subpgm_id 286 + begin + return 0 - L; -- pragma label minus + end; + + + function "ABS"(L: SIGNED) return SIGNED is + -- synopsys subpgm_id 287 + begin + if (L(L'left) = '0' or L(L'left) = 'L') then + return L; + else + return 0 - L; + end if; + end; + + + function "+"(L: UNSIGNED) return STD_LOGIC_VECTOR is + -- synopsys subpgm_id 289 + begin + return STD_LOGIC_VECTOR (L); + end; + + + function "+"(L: SIGNED) return STD_LOGIC_VECTOR is + -- synopsys subpgm_id 290 + begin + return STD_LOGIC_VECTOR (L); + end; + + + function "-"(L: SIGNED) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + -- synopsys subpgm_id 292 + variable tmp: SIGNED(L'length-1 downto 0); + begin + tmp := 0 - L; -- pragma label minus + return STD_LOGIC_VECTOR (tmp); + end; + + + function "ABS"(L: SIGNED) return STD_LOGIC_VECTOR is + -- synopsys subpgm_id 294 + variable tmp: SIGNED(L'length-1 downto 0); + begin + if (L(L'left) = '0' or L(L'left) = 'L') then + return STD_LOGIC_VECTOR (L); + else + tmp := 0 - L; + return STD_LOGIC_VECTOR (tmp); + end if; + end; + + + -- Type propagation function which returns the type BOOLEAN + function UNSIGNED_RETURN_BOOLEAN(A,B: UNSIGNED) return BOOLEAN is + variable Z: BOOLEAN; + -- pragma return_port_name Z + begin + return(Z); + end; + + -- Type propagation function which returns the type BOOLEAN + function SIGNED_RETURN_BOOLEAN(A,B: SIGNED) return BOOLEAN is + variable Z: BOOLEAN; + -- pragma return_port_name Z + begin + return(Z); + end; + + + -- compare two signed numbers of the same length + -- both arrays must have range (msb downto 0) + function is_less(A, B: SIGNED) return BOOLEAN is + constant sign: INTEGER := A'left; + variable a_is_0, b_is_1, result : boolean; + + -- pragma map_to_operator LT_TC_OP + -- pragma type_function SIGNED_RETURN_BOOLEAN + -- pragma return_port_name Z + + begin + if A(sign) /= B(sign) then + result := A(sign) = '1'; + else + result := FALSE; + for i in 0 to sign-1 loop + a_is_0 := A(i) = '0'; + b_is_1 := B(i) = '1'; + result := (a_is_0 and b_is_1) or + (a_is_0 and result) or + (b_is_1 and result); + end loop; + end if; + return result; + end; + + + -- compare two signed numbers of the same length + -- both arrays must have range (msb downto 0) + function is_less_or_equal(A, B: SIGNED) return BOOLEAN is + constant sign: INTEGER := A'left; + variable a_is_0, b_is_1, result : boolean; + + -- pragma map_to_operator LEQ_TC_OP + -- pragma type_function SIGNED_RETURN_BOOLEAN + -- pragma return_port_name Z + + begin + if A(sign) /= B(sign) then + result := A(sign) = '1'; + else + result := TRUE; + for i in 0 to sign-1 loop + a_is_0 := A(i) = '0'; + b_is_1 := B(i) = '1'; + result := (a_is_0 and b_is_1) or + (a_is_0 and result) or + (b_is_1 and result); + end loop; + end if; + return result; + end; + + + + -- compare two unsigned numbers of the same length + -- both arrays must have range (msb downto 0) + function unsigned_is_less(A, B: UNSIGNED) return BOOLEAN is + constant sign: INTEGER := A'left; + variable a_is_0, b_is_1, result : boolean; + + -- pragma map_to_operator LT_UNS_OP + -- pragma type_function UNSIGNED_RETURN_BOOLEAN + -- pragma return_port_name Z + + begin + result := FALSE; + for i in 0 to sign loop + a_is_0 := A(i) = '0'; + b_is_1 := B(i) = '1'; + result := (a_is_0 and b_is_1) or + (a_is_0 and result) or + (b_is_1 and result); + end loop; + return result; + end; + + + -- compare two unsigned numbers of the same length + -- both arrays must have range (msb downto 0) + function unsigned_is_less_or_equal(A, B: UNSIGNED) return BOOLEAN is + constant sign: INTEGER := A'left; + variable a_is_0, b_is_1, result : boolean; + + -- pragma map_to_operator LEQ_UNS_OP + -- pragma type_function UNSIGNED_RETURN_BOOLEAN + -- pragma return_port_name Z + + begin + result := TRUE; + for i in 0 to sign loop + a_is_0 := A(i) = '0'; + b_is_1 := B(i) = '1'; + result := (a_is_0 and b_is_1) or + (a_is_0 and result) or + (b_is_1 and result); + end loop; + return result; + end; + + + + + function "<"(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to lt + -- synopsys subpgm_id 305 + constant length: INTEGER := max(L'length, R'length); + begin + return unsigned_is_less(CONV_UNSIGNED(L, length), + CONV_UNSIGNED(R, length)); -- pragma label lt + end; + + + function "<"(L: SIGNED; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to lt + -- synopsys subpgm_id 306 + constant length: INTEGER := max(L'length, R'length); + begin + return is_less(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label lt + end; + + + function "<"(L: UNSIGNED; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to lt + -- synopsys subpgm_id 307 + constant length: INTEGER := max(L'length + 1, R'length); + begin + return is_less(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label lt + end; + + + function "<"(L: SIGNED; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to lt + -- synopsys subpgm_id 308 + constant length: INTEGER := max(L'length, R'length + 1); + begin + return is_less(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label lt + end; + + + function "<"(L: UNSIGNED; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to lt + -- synopsys subpgm_id 309 + constant length: INTEGER := L'length + 1; + begin + return is_less(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label lt + end; + + + function "<"(L: INTEGER; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to lt + -- synopsys subpgm_id 310 + constant length: INTEGER := R'length + 1; + begin + return is_less(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label lt + end; + + + function "<"(L: SIGNED; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to lt + -- synopsys subpgm_id 311 + constant length: INTEGER := L'length; + begin + return is_less(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label lt + end; + + + function "<"(L: INTEGER; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to lt + -- synopsys subpgm_id 312 + constant length: INTEGER := R'length; + begin + return is_less(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label lt + end; + + + + + function "<="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to leq + -- synopsys subpgm_id 314 + constant length: INTEGER := max(L'length, R'length); + begin + return unsigned_is_less_or_equal(CONV_UNSIGNED(L, length), + CONV_UNSIGNED(R, length)); -- pragma label leq + end; + + + function "<="(L: SIGNED; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to leq + -- synopsys subpgm_id 315 + constant length: INTEGER := max(L'length, R'length); + begin + return is_less_or_equal(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label leq + end; + + + function "<="(L: UNSIGNED; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to leq + -- synopsys subpgm_id 316 + constant length: INTEGER := max(L'length + 1, R'length); + begin + return is_less_or_equal(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label leq + end; + + + function "<="(L: SIGNED; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to leq + -- synopsys subpgm_id 317 + constant length: INTEGER := max(L'length, R'length + 1); + begin + return is_less_or_equal(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label leq + end; + + + function "<="(L: UNSIGNED; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to leq + -- synopsys subpgm_id 318 + constant length: INTEGER := L'length + 1; + begin + return is_less_or_equal(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label leq + end; + + + function "<="(L: INTEGER; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to leq + -- synopsys subpgm_id 319 + constant length: INTEGER := R'length + 1; + begin + return is_less_or_equal(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label leq + end; + + + function "<="(L: SIGNED; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to leq + -- synopsys subpgm_id 320 + constant length: INTEGER := L'length; + begin + return is_less_or_equal(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label leq + end; + + + function "<="(L: INTEGER; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to leq + -- synopsys subpgm_id 321 + constant length: INTEGER := R'length; + begin + return is_less_or_equal(CONV_SIGNED(L, length), + CONV_SIGNED(R, length)); -- pragma label leq + end; + + + + + function ">"(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to gt + -- synopsys subpgm_id 323 + constant length: INTEGER := max(L'length, R'length); + begin + return unsigned_is_less(CONV_UNSIGNED(R, length), + CONV_UNSIGNED(L, length)); -- pragma label gt + end; + + + function ">"(L: SIGNED; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to gt + -- synopsys subpgm_id 324 + constant length: INTEGER := max(L'length, R'length); + begin + return is_less(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label gt + end; + + + function ">"(L: UNSIGNED; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to gt + -- synopsys subpgm_id 325 + constant length: INTEGER := max(L'length + 1, R'length); + begin + return is_less(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label gt + end; + + + function ">"(L: SIGNED; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to gt + -- synopsys subpgm_id 326 + constant length: INTEGER := max(L'length, R'length + 1); + begin + return is_less(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label gt + end; + + + function ">"(L: UNSIGNED; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to gt + -- synopsys subpgm_id 327 + constant length: INTEGER := L'length + 1; + begin + return is_less(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label gt + end; + + + function ">"(L: INTEGER; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to gt + -- synopsys subpgm_id 328 + constant length: INTEGER := R'length + 1; + begin + return is_less(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label gt + end; + + + function ">"(L: SIGNED; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to gt + -- synopsys subpgm_id 329 + constant length: INTEGER := L'length; + begin + return is_less(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label gt + end; + + + function ">"(L: INTEGER; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to gt + -- synopsys subpgm_id 330 + constant length: INTEGER := R'length; + begin + return is_less(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label gt + end; + + + + + function ">="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to geq + -- synopsys subpgm_id 332 + constant length: INTEGER := max(L'length, R'length); + begin + return unsigned_is_less_or_equal(CONV_UNSIGNED(R, length), + CONV_UNSIGNED(L, length)); -- pragma label geq + end; + + + function ">="(L: SIGNED; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to geq + -- synopsys subpgm_id 333 + constant length: INTEGER := max(L'length, R'length); + begin + return is_less_or_equal(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label geq + end; + + + function ">="(L: UNSIGNED; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to geq + -- synopsys subpgm_id 334 + constant length: INTEGER := max(L'length + 1, R'length); + begin + return is_less_or_equal(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label geq + end; + + + function ">="(L: SIGNED; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to geq + -- synopsys subpgm_id 335 + constant length: INTEGER := max(L'length, R'length + 1); + begin + return is_less_or_equal(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label geq + end; + + + function ">="(L: UNSIGNED; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to geq + -- synopsys subpgm_id 336 + constant length: INTEGER := L'length + 1; + begin + return is_less_or_equal(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label geq + end; + + + function ">="(L: INTEGER; R: UNSIGNED) return BOOLEAN is + -- pragma label_applies_to geq + -- synopsys subpgm_id 337 + constant length: INTEGER := R'length + 1; + begin + return is_less_or_equal(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label geq + end; + + + function ">="(L: SIGNED; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to geq + -- synopsys subpgm_id 338 + constant length: INTEGER := L'length; + begin + return is_less_or_equal(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label geq + end; + + + function ">="(L: INTEGER; R: SIGNED) return BOOLEAN is + -- pragma label_applies_to geq + -- synopsys subpgm_id 339 + constant length: INTEGER := R'length; + begin + return is_less_or_equal(CONV_SIGNED(R, length), + CONV_SIGNED(L, length)); -- pragma label geq + end; + + + + + -- for internal use only. Assumes SIGNED arguments of equal length. + function bitwise_eql(L: STD_ULOGIC_VECTOR; R: STD_ULOGIC_VECTOR) + return BOOLEAN is + -- pragma built_in SYN_EQL + begin + for i in L'range loop + if L(i) /= R(i) then + return FALSE; + end if; + end loop; + return TRUE; + end; + + -- for internal use only. Assumes SIGNED arguments of equal length. + function bitwise_neq(L: STD_ULOGIC_VECTOR; R: STD_ULOGIC_VECTOR) + return BOOLEAN is + -- pragma built_in SYN_NEQ + begin + for i in L'range loop + if L(i) /= R(i) then + return TRUE; + end if; + end loop; + return FALSE; + end; + + + function "="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is + -- synopsys subpgm_id 341 + constant length: INTEGER := max(L'length, R'length); + begin + return bitwise_eql( STD_ULOGIC_VECTOR( CONV_UNSIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_UNSIGNED(R, length) ) ); + end; + + + function "="(L: SIGNED; R: SIGNED) return BOOLEAN is + -- synopsys subpgm_id 342 + constant length: INTEGER := max(L'length, R'length); + begin + return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "="(L: UNSIGNED; R: SIGNED) return BOOLEAN is + -- synopsys subpgm_id 343 + constant length: INTEGER := max(L'length + 1, R'length); + begin + return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "="(L: SIGNED; R: UNSIGNED) return BOOLEAN is + -- synopsys subpgm_id 344 + constant length: INTEGER := max(L'length, R'length + 1); + begin + return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "="(L: UNSIGNED; R: INTEGER) return BOOLEAN is + -- synopsys subpgm_id 345 + constant length: INTEGER := L'length + 1; + begin + return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "="(L: INTEGER; R: UNSIGNED) return BOOLEAN is + -- synopsys subpgm_id 346 + constant length: INTEGER := R'length + 1; + begin + return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "="(L: SIGNED; R: INTEGER) return BOOLEAN is + -- synopsys subpgm_id 347 + constant length: INTEGER := L'length; + begin + return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "="(L: INTEGER; R: SIGNED) return BOOLEAN is + -- synopsys subpgm_id 348 + constant length: INTEGER := R'length; + begin + return bitwise_eql( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + + + function "/="(L: UNSIGNED; R: UNSIGNED) return BOOLEAN is + -- synopsys subpgm_id 350 + constant length: INTEGER := max(L'length, R'length); + begin + return bitwise_neq( STD_ULOGIC_VECTOR( CONV_UNSIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_UNSIGNED(R, length) ) ); + end; + + + function "/="(L: SIGNED; R: SIGNED) return BOOLEAN is + -- synopsys subpgm_id 351 + constant length: INTEGER := max(L'length, R'length); + begin + return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "/="(L: UNSIGNED; R: SIGNED) return BOOLEAN is + -- synopsys subpgm_id 352 + constant length: INTEGER := max(L'length + 1, R'length); + begin + return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "/="(L: SIGNED; R: UNSIGNED) return BOOLEAN is + -- synopsys subpgm_id 353 + constant length: INTEGER := max(L'length, R'length + 1); + begin + return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "/="(L: UNSIGNED; R: INTEGER) return BOOLEAN is + -- synopsys subpgm_id 354 + constant length: INTEGER := L'length + 1; + begin + return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "/="(L: INTEGER; R: UNSIGNED) return BOOLEAN is + -- synopsys subpgm_id 355 + constant length: INTEGER := R'length + 1; + begin + return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "/="(L: SIGNED; R: INTEGER) return BOOLEAN is + -- synopsys subpgm_id 356 + constant length: INTEGER := L'length; + begin + return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + function "/="(L: INTEGER; R: SIGNED) return BOOLEAN is + -- synopsys subpgm_id 357 + constant length: INTEGER := R'length; + begin + return bitwise_neq( STD_ULOGIC_VECTOR( CONV_SIGNED(L, length) ), + STD_ULOGIC_VECTOR( CONV_SIGNED(R, length) ) ); + end; + + + + function SHL(ARG: UNSIGNED; COUNT: UNSIGNED) return UNSIGNED is + -- synopsys subpgm_id 358 + constant control_msb: INTEGER := COUNT'length - 1; + variable control: UNSIGNED (control_msb downto 0); + constant result_msb: INTEGER := ARG'length-1; + subtype rtype is UNSIGNED (result_msb downto 0); + variable result, temp: rtype; + begin + control := MAKE_BINARY(COUNT); + -- synopsys synthesis_off + if (control(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + -- synopsys synthesis_on + result := ARG; + for i in 0 to control_msb loop + if control(i) = '1' then + temp := rtype'(others => '0'); + if 2**i <= result_msb then + temp(result_msb downto 2**i) := + result(result_msb - 2**i downto 0); + end if; + result := temp; + end if; + end loop; + return result; + end; + + function SHL(ARG: SIGNED; COUNT: UNSIGNED) return SIGNED is + -- synopsys subpgm_id 359 + constant control_msb: INTEGER := COUNT'length - 1; + variable control: UNSIGNED (control_msb downto 0); + constant result_msb: INTEGER := ARG'length-1; + subtype rtype is SIGNED (result_msb downto 0); + variable result, temp: rtype; + begin + control := MAKE_BINARY(COUNT); + -- synopsys synthesis_off + if (control(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + -- synopsys synthesis_on + result := ARG; + for i in 0 to control_msb loop + if control(i) = '1' then + temp := rtype'(others => '0'); + if 2**i <= result_msb then + temp(result_msb downto 2**i) := + result(result_msb - 2**i downto 0); + end if; + result := temp; + end if; + end loop; + return result; + end; + + + function SHR(ARG: UNSIGNED; COUNT: UNSIGNED) return UNSIGNED is + -- synopsys subpgm_id 360 + constant control_msb: INTEGER := COUNT'length - 1; + variable control: UNSIGNED (control_msb downto 0); + constant result_msb: INTEGER := ARG'length-1; + subtype rtype is UNSIGNED (result_msb downto 0); + variable result, temp: rtype; + begin + control := MAKE_BINARY(COUNT); + -- synopsys synthesis_off + if (control(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + -- synopsys synthesis_on + result := ARG; + for i in 0 to control_msb loop + if control(i) = '1' then + temp := rtype'(others => '0'); + if 2**i <= result_msb then + temp(result_msb - 2**i downto 0) := + result(result_msb downto 2**i); + end if; + result := temp; + end if; + end loop; + return result; + end; + + function SHR(ARG: SIGNED; COUNT: UNSIGNED) return SIGNED is + -- synopsys subpgm_id 361 + constant control_msb: INTEGER := COUNT'length - 1; + variable control: UNSIGNED (control_msb downto 0); + constant result_msb: INTEGER := ARG'length-1; + subtype rtype is SIGNED (result_msb downto 0); + variable result, temp: rtype; + variable sign_bit: STD_ULOGIC; + begin + control := MAKE_BINARY(COUNT); + -- synopsys synthesis_off + if (control(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + -- synopsys synthesis_on + result := ARG; + sign_bit := ARG(ARG'left); + for i in 0 to control_msb loop + if control(i) = '1' then + temp := rtype'(others => sign_bit); + if 2**i <= result_msb then + temp(result_msb - 2**i downto 0) := + result(result_msb downto 2**i); + end if; + result := temp; + end if; + end loop; + return result; + end; + + + + + function CONV_INTEGER(ARG: INTEGER) return INTEGER is + -- synopsys subpgm_id 365 + begin + return ARG; + end; + + function CONV_INTEGER(ARG: UNSIGNED) return INTEGER is + variable result: INTEGER; + variable tmp: STD_ULOGIC; + -- synopsys built_in SYN_UNSIGNED_TO_INTEGER + -- synopsys subpgm_id 366 + begin + -- synopsys synthesis_off + assert ARG'length <= 31 + report "ARG is too large in CONV_INTEGER" + severity FAILURE; + result := 0; + for i in ARG'range loop + result := result * 2; + tmp := tbl_BINARY(ARG(i)); + if tmp = '1' then + result := result + 1; + elsif tmp = 'X' then + assert false + report "CONV_INTEGER: There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, and it has been converted to 0." + severity WARNING; + end if; + end loop; + return result; + -- synopsys synthesis_on + end; + + + function CONV_INTEGER(ARG: SIGNED) return INTEGER is + variable result: INTEGER; + variable tmp: STD_ULOGIC; + -- synopsys built_in SYN_SIGNED_TO_INTEGER + -- synopsys subpgm_id 367 + begin + -- synopsys synthesis_off + assert ARG'length <= 32 + report "ARG is too large in CONV_INTEGER" + severity FAILURE; + result := 0; + for i in ARG'range loop + if i /= ARG'left then + result := result * 2; + tmp := tbl_BINARY(ARG(i)); + if tmp = '1' then + result := result + 1; + elsif tmp = 'X' then + assert false + report "CONV_INTEGER: There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, and it has been converted to 0." + severity WARNING; + end if; + end if; + end loop; + tmp := MAKE_BINARY(ARG(ARG'left)); + if tmp = '1' then + if ARG'length = 32 then + result := (result - 2**30) - 2**30; + else + result := result - (2 ** (ARG'length-1)); + end if; + end if; + return result; + -- synopsys synthesis_on + end; + + + function CONV_INTEGER(ARG: STD_ULOGIC) return SMALL_INT is + variable tmp: STD_ULOGIC; + -- synopsys built_in SYN_FEED_THRU + -- synopsys subpgm_id 370 + begin + -- synopsys synthesis_off + tmp := tbl_BINARY(ARG); + if tmp = '1' then + return 1; + elsif tmp = 'X' then + assert false + report "CONV_INTEGER: There is an 'U'|'X'|'W'|'Z'|'-' in an arithmetic operand, and it has been converted to 0." + severity WARNING; + return 0; + else + return 0; + end if; + -- synopsys synthesis_on + end; + + + -- convert an integer to a unsigned STD_ULOGIC_VECTOR + function CONV_UNSIGNED(ARG: INTEGER; SIZE: INTEGER) return UNSIGNED is + variable result: UNSIGNED(SIZE-1 downto 0); + variable temp: integer; + -- synopsys built_in SYN_INTEGER_TO_UNSIGNED + -- synopsys subpgm_id 371 + begin + -- synopsys synthesis_off + temp := ARG; + for i in 0 to SIZE-1 loop + if (temp mod 2) = 1 then + result(i) := '1'; + else + result(i) := '0'; + end if; + if temp > 0 then + temp := temp / 2; + else + temp := (temp - 1) / 2; -- simulate ASR + end if; + end loop; + return result; + -- synopsys synthesis_on + end; + + + function CONV_UNSIGNED(ARG: UNSIGNED; SIZE: INTEGER) return UNSIGNED is + constant msb: INTEGER := min(ARG'length, SIZE) - 1; + subtype rtype is UNSIGNED (SIZE-1 downto 0); + variable new_bounds: UNSIGNED (ARG'length-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_ZERO_EXTEND + -- synopsys subpgm_id 372 + begin + -- synopsys synthesis_off + new_bounds := MAKE_BINARY(ARG); + if (new_bounds(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + result := rtype'(others => '0'); + result(msb downto 0) := new_bounds(msb downto 0); + return result; + -- synopsys synthesis_on + end; + + + function CONV_UNSIGNED(ARG: SIGNED; SIZE: INTEGER) return UNSIGNED is + constant msb: INTEGER := min(ARG'length, SIZE) - 1; + subtype rtype is UNSIGNED (SIZE-1 downto 0); + variable new_bounds: UNSIGNED (ARG'length-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_SIGN_EXTEND + -- synopsys subpgm_id 373 + begin + -- synopsys synthesis_off + new_bounds := MAKE_BINARY(ARG); + if (new_bounds(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + result := rtype'(others => new_bounds(new_bounds'left)); + result(msb downto 0) := new_bounds(msb downto 0); + return result; + -- synopsys synthesis_on + end; + + + function CONV_UNSIGNED(ARG: STD_ULOGIC; SIZE: INTEGER) return UNSIGNED is + subtype rtype is UNSIGNED (SIZE-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_ZERO_EXTEND + -- synopsys subpgm_id 375 + begin + -- synopsys synthesis_off + result := rtype'(others => '0'); + result(0) := MAKE_BINARY(ARG); + if (result(0) = 'X') then + result := rtype'(others => 'X'); + end if; + return result; + -- synopsys synthesis_on + end; + + + -- convert an integer to a 2's complement STD_ULOGIC_VECTOR + function CONV_SIGNED(ARG: INTEGER; SIZE: INTEGER) return SIGNED is + variable result: SIGNED (SIZE-1 downto 0); + variable temp: integer; + -- synopsys built_in SYN_INTEGER_TO_SIGNED + -- synopsys subpgm_id 376 + begin + -- synopsys synthesis_off + temp := ARG; + for i in 0 to SIZE-1 loop + if (temp mod 2) = 1 then + result(i) := '1'; + else + result(i) := '0'; + end if; + if temp > 0 then + temp := temp / 2; + elsif (temp > integer'low) then + temp := (temp - 1) / 2; -- simulate ASR + else + temp := temp / 2; -- simulate ASR + end if; + end loop; + return result; + -- synopsys synthesis_on + end; + + + function CONV_SIGNED(ARG: UNSIGNED; SIZE: INTEGER) return SIGNED is + constant msb: INTEGER := min(ARG'length, SIZE) - 1; + subtype rtype is SIGNED (SIZE-1 downto 0); + variable new_bounds : SIGNED (ARG'length-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_ZERO_EXTEND + -- synopsys subpgm_id 377 + begin + -- synopsys synthesis_off + new_bounds := MAKE_BINARY(ARG); + if (new_bounds(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + result := rtype'(others => '0'); + result(msb downto 0) := new_bounds(msb downto 0); + return result; + -- synopsys synthesis_on + end; + + function CONV_SIGNED(ARG: SIGNED; SIZE: INTEGER) return SIGNED is + constant msb: INTEGER := min(ARG'length, SIZE) - 1; + subtype rtype is SIGNED (SIZE-1 downto 0); + variable new_bounds : SIGNED (ARG'length-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_SIGN_EXTEND + -- synopsys subpgm_id 378 + begin + -- synopsys synthesis_off + new_bounds := MAKE_BINARY(ARG); + if (new_bounds(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + result := rtype'(others => new_bounds(new_bounds'left)); + result(msb downto 0) := new_bounds(msb downto 0); + return result; + -- synopsys synthesis_on + end; + + + function CONV_SIGNED(ARG: STD_ULOGIC; SIZE: INTEGER) return SIGNED is + subtype rtype is SIGNED (SIZE-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_ZERO_EXTEND + -- synopsys subpgm_id 380 + begin + -- synopsys synthesis_off + result := rtype'(others => '0'); + result(0) := MAKE_BINARY(ARG); + if (result(0) = 'X') then + result := rtype'(others => 'X'); + end if; + return result; + -- synopsys synthesis_on + end; + + + -- convert an integer to an STD_LOGIC_VECTOR + function CONV_STD_LOGIC_VECTOR(ARG: INTEGER; SIZE: INTEGER) return STD_LOGIC_VECTOR is + variable result: STD_LOGIC_VECTOR (SIZE-1 downto 0); + variable temp: integer; + -- synopsys built_in SYN_INTEGER_TO_SIGNED + -- synopsys subpgm_id 381 + begin + -- synopsys synthesis_off + temp := ARG; + for i in 0 to SIZE-1 loop + if (temp mod 2) = 1 then + result(i) := '1'; + else + result(i) := '0'; + end if; + if temp > 0 then + temp := temp / 2; + elsif (temp > integer'low) then + temp := (temp - 1) / 2; -- simulate ASR + else + temp := temp / 2; -- simulate ASR + end if; + end loop; + return result; + -- synopsys synthesis_on + end; + + + function CONV_STD_LOGIC_VECTOR(ARG: UNSIGNED; SIZE: INTEGER) return STD_LOGIC_VECTOR is + constant msb: INTEGER := min(ARG'length, SIZE) - 1; + subtype rtype is STD_LOGIC_VECTOR (SIZE-1 downto 0); + variable new_bounds : STD_LOGIC_VECTOR (ARG'length-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_ZERO_EXTEND + -- synopsys subpgm_id 382 + begin + -- synopsys synthesis_off + new_bounds := MAKE_BINARY(ARG); + if (new_bounds(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + result := rtype'(others => '0'); + result(msb downto 0) := new_bounds(msb downto 0); + return result; + -- synopsys synthesis_on + end; + + function CONV_STD_LOGIC_VECTOR(ARG: SIGNED; SIZE: INTEGER) return STD_LOGIC_VECTOR is + constant msb: INTEGER := min(ARG'length, SIZE) - 1; + subtype rtype is STD_LOGIC_VECTOR (SIZE-1 downto 0); + variable new_bounds : STD_LOGIC_VECTOR (ARG'length-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_SIGN_EXTEND + -- synopsys subpgm_id 383 + begin + -- synopsys synthesis_off + new_bounds := MAKE_BINARY(ARG); + if (new_bounds(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + result := rtype'(others => new_bounds(new_bounds'left)); + result(msb downto 0) := new_bounds(msb downto 0); + return result; + -- synopsys synthesis_on + end; + + + function CONV_STD_LOGIC_VECTOR(ARG: STD_ULOGIC; SIZE: INTEGER) return STD_LOGIC_VECTOR is + subtype rtype is STD_LOGIC_VECTOR (SIZE-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_ZERO_EXTEND + -- synopsys subpgm_id 384 + begin + -- synopsys synthesis_off + result := rtype'(others => '0'); + result(0) := MAKE_BINARY(ARG); + if (result(0) = 'X') then + result := rtype'(others => 'X'); + end if; + return result; + -- synopsys synthesis_on + end; + + function EXT(ARG: STD_LOGIC_VECTOR; SIZE: INTEGER) + return STD_LOGIC_VECTOR is + constant msb: INTEGER := min(ARG'length, SIZE) - 1; + subtype rtype is STD_LOGIC_VECTOR (SIZE-1 downto 0); + variable new_bounds: STD_LOGIC_VECTOR (ARG'length-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_ZERO_EXTEND + -- synopsys subpgm_id 385 + begin + -- synopsys synthesis_off + new_bounds := MAKE_BINARY(ARG); + if (new_bounds(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + result := rtype'(others => '0'); + result(msb downto 0) := new_bounds(msb downto 0); + return result; + -- synopsys synthesis_on + end; + + + function SXT(ARG: STD_LOGIC_VECTOR; SIZE: INTEGER) return STD_LOGIC_VECTOR is + constant msb: INTEGER := min(ARG'length, SIZE) - 1; + subtype rtype is STD_LOGIC_VECTOR (SIZE-1 downto 0); + variable new_bounds : STD_LOGIC_VECTOR (ARG'length-1 downto 0); + variable result: rtype; + -- synopsys built_in SYN_SIGN_EXTEND + -- synopsys subpgm_id 386 + begin + -- synopsys synthesis_off + new_bounds := MAKE_BINARY(ARG); + if (new_bounds(0) = 'X') then + result := rtype'(others => 'X'); + return result; + end if; + result := rtype'(others => new_bounds(new_bounds'left)); + result(msb downto 0) := new_bounds(msb downto 0); + return result; + -- synopsys synthesis_on + end; + + +end std_logic_arith; diff --git a/libraries/synopsys/std_logic_misc-body.vhdl b/libraries/synopsys/std_logic_misc-body.vhdl new file mode 100644 index 000000000..531328c3f --- /dev/null +++ b/libraries/synopsys/std_logic_misc-body.vhdl @@ -0,0 +1,811 @@ +-------------------------------------------------------------------------- +-- +-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc. All rights reserved. +-- +-- This source file may be used and distributed without restriction +-- provided that this copyright statement is not removed from the file +-- and that any derivative work contains this copyright notice. +-- +-- Package name: std_logic_misc +-- +-- Purpose: This package defines supplemental types, subtypes, +-- constants, and functions for the Std_logic_1164 Package. +-- +-- Author: GWH +-- +-------------------------------------------------------------------------- + +package body std_logic_misc is + +--synopsys synthesis_off + + type STRN_STD_ULOGIC_TABLE is array (STD_ULOGIC,STRENGTH) of STD_ULOGIC; + + -------------------------------------------------------------------- + -- + -- Truth tables for output strength --> STD_ULOGIC lookup + -- + -------------------------------------------------------------------- + + -- truth table for output strength --> STD_ULOGIC lookup + constant tbl_STRN_STD_ULOGIC: STRN_STD_ULOGIC_TABLE := + -- ------------------------------------------------------------------ + -- | X01 X0H XL1 X0Z XZ1 WLH WLZ WZH W0H WL1 | strn/ output| + -- ------------------------------------------------------------------ + (('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U'), -- | U | + ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W'), -- | X | + ('0', '0', 'L', '0', 'Z', 'L', 'L', 'Z', '0', 'L'), -- | 0 | + ('1', 'H', '1', 'Z', '1', 'H', 'Z', 'H', 'H', '1'), -- | 1 | + ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W'), -- | Z | + ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W'), -- | W | + ('0', '0', 'L', '0', 'Z', 'L', 'L', 'Z', '0', 'L'), -- | L | + ('1', 'H', '1', 'Z', '1', 'H', 'Z', 'H', 'H', '1'), -- | H | + ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W')); -- | - | + + + + -------------------------------------------------------------------- + -- + -- Truth tables for strength --> STD_ULOGIC mapping ('Z' pass through) + -- + -------------------------------------------------------------------- + + -- truth table for output strength --> STD_ULOGIC lookup + constant tbl_STRN_STD_ULOGIC_Z: STRN_STD_ULOGIC_TABLE := + -- ------------------------------------------------------------------ + -- | X01 X0H XL1 X0Z XZ1 WLH WLZ WZH W0H WL1 | strn/ output| + -- ------------------------------------------------------------------ + (('U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U'), -- | U | + ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W'), -- | X | + ('0', '0', 'L', '0', 'Z', 'L', 'L', 'Z', '0', 'L'), -- | 0 | + ('1', 'H', '1', 'Z', '1', 'H', 'Z', 'H', 'H', '1'), -- | 1 | + ('Z', 'Z', 'Z', 'Z', 'Z', 'Z', 'Z', 'Z', 'Z', 'Z'), -- | Z | + ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W'), -- | W | + ('0', '0', 'L', '0', 'Z', 'L', 'L', 'Z', '0', 'L'), -- | L | + ('1', 'H', '1', 'Z', '1', 'H', 'Z', 'H', 'H', '1'), -- | H | + ('X', 'X', 'X', 'X', 'X', 'W', 'W', 'W', 'W', 'W')); -- | - | + + + + --------------------------------------------------------------------- + -- + -- functions for mapping the STD_(U)LOGIC according to STRENGTH + -- + --------------------------------------------------------------------- + + function strength_map(input: STD_ULOGIC; strn: STRENGTH) return STD_LOGIC is + -- pragma subpgm_id 387 + begin + return tbl_STRN_STD_ULOGIC(input, strn); + end strength_map; + + + function strength_map_z(input:STD_ULOGIC; strn:STRENGTH) return STD_LOGIC is + -- pragma subpgm_id 388 + begin + return tbl_STRN_STD_ULOGIC_Z(input, strn); + end strength_map_z; + + + --------------------------------------------------------------------- + -- + -- conversion functions for STD_LOGIC_VECTOR and STD_ULOGIC_VECTOR + -- + --------------------------------------------------------------------- + +--synopsys synthesis_on + function Drive (V: STD_LOGIC_VECTOR) return STD_ULOGIC_VECTOR is + -- pragma built_in SYN_FEED_THRU + -- pragma subpgm_id 389 +--synopsys synthesis_off + alias Value: STD_LOGIC_VECTOR (V'length-1 downto 0) is V; +--synopsys synthesis_on + begin +--synopsys synthesis_off + return STD_ULOGIC_VECTOR(Value); +--synopsys synthesis_on + end Drive; + + + function Drive (V: STD_ULOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma built_in SYN_FEED_THRU + -- pragma subpgm_id 390 +--synopsys synthesis_off + alias Value: STD_ULOGIC_VECTOR (V'length-1 downto 0) is V; +--synopsys synthesis_on + begin +--synopsys synthesis_off + return STD_LOGIC_VECTOR(Value); +--synopsys synthesis_on + end Drive; +--synopsys synthesis_off + + + --------------------------------------------------------------------- + -- + -- conversion functions for sensing various types + -- + -- (the second argument allows the user to specify the value to + -- be returned when the network is undriven) + -- + --------------------------------------------------------------------- + + function Sense (V: STD_ULOGIC; vZ, vU, vDC: STD_ULOGIC) + return STD_LOGIC is + -- pragma subpgm_id 391 + begin + if V = 'Z' then + return vZ; + elsif V = 'U' then + return vU; + elsif V = '-' then + return vDC; + else + return V; + end if; + end Sense; + + + function Sense (V: STD_ULOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) + return STD_LOGIC_VECTOR is + -- pragma subpgm_id 392 + alias Value: STD_ULOGIC_VECTOR (V'length-1 downto 0) is V; + variable Result: STD_LOGIC_VECTOR (V'length-1 downto 0); + begin + for i in Value'range loop + if ( Value(i) = 'Z' ) then + Result(i) := vZ; + elsif Value(i) = 'U' then + Result(i) := vU; + elsif Value(i) = '-' then + Result(i) := vDC; + else + Result(i) := Value(i); + end if; + end loop; + return Result; + end Sense; + + + function Sense (V: STD_ULOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) + return STD_ULOGIC_VECTOR is + -- pragma subpgm_id 393 + alias Value: STD_ULOGIC_VECTOR (V'length-1 downto 0) is V; + variable Result: STD_ULOGIC_VECTOR (V'length-1 downto 0); + begin + for i in Value'range loop + if ( Value(i) = 'Z' ) then + Result(i) := vZ; + elsif Value(i) = 'U' then + Result(i) := vU; + elsif Value(i) = '-' then + Result(i) := vDC; + else + Result(i) := Value(i); + end if; + end loop; + return Result; + end Sense; + + + function Sense (V: STD_LOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) + return STD_LOGIC_VECTOR is + -- pragma subpgm_id 394 + alias Value: STD_LOGIC_VECTOR (V'length-1 downto 0) is V; + variable Result: STD_LOGIC_VECTOR (V'length-1 downto 0); + begin + for i in Value'range loop + if ( Value(i) = 'Z' ) then + Result(i) := vZ; + elsif Value(i) = 'U' then + Result(i) := vU; + elsif Value(i) = '-' then + Result(i) := vDC; + else + Result(i) := Value(i); + end if; + end loop; + return Result; + end Sense; + + + function Sense (V: STD_LOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) + return STD_ULOGIC_VECTOR is + -- pragma subpgm_id 395 + alias Value: STD_LOGIC_VECTOR (V'length-1 downto 0) is V; + variable Result: STD_ULOGIC_VECTOR (V'length-1 downto 0); + begin + for i in Value'range loop + if ( Value(i) = 'Z' ) then + Result(i) := vZ; + elsif Value(i) = 'U' then + Result(i) := vU; + elsif Value(i) = '-' then + Result(i) := vDC; + else + Result(i) := Value(i); + end if; + end loop; + return Result; + end Sense; + + --------------------------------------------------------------------- + -- + -- Function: STD_LOGIC_VECTORtoBIT_VECTOR + -- + -- Purpose: Conversion fun. from STD_LOGIC_VECTOR to BIT_VECTOR + -- + -- Mapping: 0, L --> 0 + -- 1, H --> 1 + -- X, W --> vX if Xflag is TRUE + -- X, W --> 0 if Xflag is FALSE + -- Z --> vZ if Zflag is TRUE + -- Z --> 0 if Zflag is FALSE + -- U --> vU if Uflag is TRUE + -- U --> 0 if Uflag is FALSE + -- - --> vDC if DCflag is TRUE + -- - --> 0 if DCflag is FALSE + -- + --------------------------------------------------------------------- + +--synopsys synthesis_on + function STD_LOGIC_VECTORtoBIT_VECTOR (V: STD_LOGIC_VECTOR +--synopsys synthesis_off + ; vX, vZ, vU, vDC: BIT := '0'; + Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE +--synopsys synthesis_on + ) return BIT_VECTOR is + -- pragma built_in SYN_FEED_THRU + -- pragma subpgm_id 396 +--synopsys synthesis_off + alias Value: STD_LOGIC_VECTOR (V'length-1 downto 0) is V; + variable Result: BIT_VECTOR (V'length-1 downto 0); +--synopsys synthesis_on + begin +--synopsys synthesis_off + for i in Value'range loop + case Value(i) is + when '0' | 'L' => + Result(i) := '0'; + when '1' | 'H' => + Result(i) := '1'; + when 'X' => + if ( Xflag ) then + Result(i) := vX; + else + Result(i) := '0'; + assert FALSE + report "STD_LOGIC_VECTORtoBIT_VECTOR: X --> 0" + severity WARNING; + end if; + when 'W' => + if ( Xflag ) then + Result(i) := vX; + else + Result(i) := '0'; + assert FALSE + report "STD_LOGIC_VECTORtoBIT_VECTOR: W --> 0" + severity WARNING; + end if; + when 'Z' => + if ( Zflag ) then + Result(i) := vZ; + else + Result(i) := '0'; + assert FALSE + report "STD_LOGIC_VECTORtoBIT_VECTOR: Z --> 0" + severity WARNING; + end if; + when 'U' => + if ( Uflag ) then + Result(i) := vU; + else + Result(i) := '0'; + assert FALSE + report "STD_LOGIC_VECTORtoBIT_VECTOR: U --> 0" + severity WARNING; + end if; + when '-' => + if ( DCflag ) then + Result(i) := vDC; + else + Result(i) := '0'; + assert FALSE + report "STD_LOGIC_VECTORtoBIT_VECTOR: - --> 0" + severity WARNING; + end if; + end case; + end loop; + return Result; +--synopsys synthesis_on + end STD_LOGIC_VECTORtoBIT_VECTOR; + + + + + --------------------------------------------------------------------- + -- + -- Function: STD_ULOGIC_VECTORtoBIT_VECTOR + -- + -- Purpose: Conversion fun. from STD_ULOGIC_VECTOR to BIT_VECTOR + -- + -- Mapping: 0, L --> 0 + -- 1, H --> 1 + -- X, W --> vX if Xflag is TRUE + -- X, W --> 0 if Xflag is FALSE + -- Z --> vZ if Zflag is TRUE + -- Z --> 0 if Zflag is FALSE + -- U --> vU if Uflag is TRUE + -- U --> 0 if Uflag is FALSE + -- - --> vDC if DCflag is TRUE + -- - --> 0 if DCflag is FALSE + -- + --------------------------------------------------------------------- + + function STD_ULOGIC_VECTORtoBIT_VECTOR (V: STD_ULOGIC_VECTOR +--synopsys synthesis_off + ; vX, vZ, vU, vDC: BIT := '0'; + Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE +--synopsys synthesis_on + ) return BIT_VECTOR is + -- pragma built_in SYN_FEED_THRU + -- pragma subpgm_id 397 +--synopsys synthesis_off + alias Value: STD_ULOGIC_VECTOR (V'length-1 downto 0) is V; + variable Result: BIT_VECTOR (V'length-1 downto 0); +--synopsys synthesis_on + begin +--synopsys synthesis_off + for i in Value'range loop + case Value(i) is + when '0' | 'L' => + Result(i) := '0'; + when '1' | 'H' => + Result(i) := '1'; + when 'X' => + if ( Xflag ) then + Result(i) := vX; + else + Result(i) := '0'; + assert FALSE + report "STD_ULOGIC_VECTORtoBIT_VECTOR: X --> 0" + severity WARNING; + end if; + when 'W' => + if ( Xflag ) then + Result(i) := vX; + else + Result(i) := '0'; + assert FALSE + report "STD_ULOGIC_VECTORtoBIT_VECTOR: W --> 0" + severity WARNING; + end if; + when 'Z' => + if ( Zflag ) then + Result(i) := vZ; + else + Result(i) := '0'; + assert FALSE + report "STD_ULOGIC_VECTORtoBIT_VECTOR: Z --> 0" + severity WARNING; + end if; + when 'U' => + if ( Uflag ) then + Result(i) := vU; + else + Result(i) := '0'; + assert FALSE + report "STD_ULOGIC_VECTORtoBIT_VECTOR: U --> 0" + severity WARNING; + end if; + when '-' => + if ( DCflag ) then + Result(i) := vDC; + else + Result(i) := '0'; + assert FALSE + report "STD_ULOGIC_VECTORtoBIT_VECTOR: - --> 0" + severity WARNING; + end if; + end case; + end loop; + return Result; +--synopsys synthesis_on + end STD_ULOGIC_VECTORtoBIT_VECTOR; + + + + + --------------------------------------------------------------------- + -- + -- Function: STD_ULOGICtoBIT + -- + -- Purpose: Conversion function from STD_ULOGIC to BIT + -- + -- Mapping: 0, L --> 0 + -- 1, H --> 1 + -- X, W --> vX if Xflag is TRUE + -- X, W --> 0 if Xflag is FALSE + -- Z --> vZ if Zflag is TRUE + -- Z --> 0 if Zflag is FALSE + -- U --> vU if Uflag is TRUE + -- U --> 0 if Uflag is FALSE + -- - --> vDC if DCflag is TRUE + -- - --> 0 if DCflag is FALSE + -- + --------------------------------------------------------------------- + + function STD_ULOGICtoBIT (V: STD_ULOGIC +--synopsys synthesis_off + ; vX, vZ, vU, vDC: BIT := '0'; + Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE +--synopsys synthesis_on + ) return BIT is + -- pragma built_in SYN_FEED_THRU + -- pragma subpgm_id 398 + variable Result: BIT; + begin +--synopsys synthesis_off + case V is + when '0' | 'L' => + Result := '0'; + when '1' | 'H' => + Result := '1'; + when 'X' => + if ( Xflag ) then + Result := vX; + else + Result := '0'; + assert FALSE + report "STD_ULOGICtoBIT: X --> 0" + severity WARNING; + end if; + when 'W' => + if ( Xflag ) then + Result := vX; + else + Result := '0'; + assert FALSE + report "STD_ULOGICtoBIT: W --> 0" + severity WARNING; + end if; + when 'Z' => + if ( Zflag ) then + Result := vZ; + else + Result := '0'; + assert FALSE + report "STD_ULOGICtoBIT: Z --> 0" + severity WARNING; + end if; + when 'U' => + if ( Uflag ) then + Result := vU; + else + Result := '0'; + assert FALSE + report "STD_ULOGICtoBIT: U --> 0" + severity WARNING; + end if; + when '-' => + if ( DCflag ) then + Result := vDC; + else + Result := '0'; + assert FALSE + report "STD_ULOGICtoBIT: - --> 0" + severity WARNING; + end if; + end case; + return Result; +--synopsys synthesis_on + end STD_ULOGICtoBIT; + + + -------------------------------------------------------------------------- + + function AND_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 399 + variable result: STD_LOGIC; + begin + result := '1'; + for i in ARG'range loop + result := result and ARG(i); + end loop; + return result; + end; + + function NAND_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 400 + begin + return not AND_REDUCE(ARG); + end; + + function OR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 401 + variable result: STD_LOGIC; + begin + result := '0'; + for i in ARG'range loop + result := result or ARG(i); + end loop; + return result; + end; + + function NOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 402 + begin + return not OR_REDUCE(ARG); + end; + + function XOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 403 + variable result: STD_LOGIC; + begin + result := '0'; + for i in ARG'range loop + result := result xor ARG(i); + end loop; + return result; + end; + + function XNOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 404 + begin + return not XOR_REDUCE(ARG); + end; + + function AND_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 405 + variable result: STD_LOGIC; + begin + result := '1'; + for i in ARG'range loop + result := result and ARG(i); + end loop; + return result; + end; + + function NAND_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 406 + begin + return not AND_REDUCE(ARG); + end; + + function OR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 407 + variable result: STD_LOGIC; + begin + result := '0'; + for i in ARG'range loop + result := result or ARG(i); + end loop; + return result; + end; + + function NOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 408 + begin + return not OR_REDUCE(ARG); + end; + + function XOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 409 + variable result: STD_LOGIC; + begin + result := '0'; + for i in ARG'range loop + result := result xor ARG(i); + end loop; + return result; + end; + + function XNOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01 is + -- pragma subpgm_id 410 + begin + return not XOR_REDUCE(ARG); + end; + +--synopsys synthesis_off + + function fun_BUF3S(Input, Enable: UX01; Strn: STRENGTH) return STD_LOGIC is + -- pragma subpgm_id 411 + type TRISTATE_TABLE is array(STRENGTH, UX01, UX01) of STD_LOGIC; + + -- truth table for tristate "buf" function (Enable active Low) + constant tbl_BUF3S: TRISTATE_TABLE := + -- ---------------------------------------------------- + -- | Input U X 0 1 | Enable Strength | + -- ---------------------------------|-----------------| + ((('U', 'U', 'U', 'U'), --| U X01 | + ('U', 'X', 'X', 'X'), --| X X01 | + ('Z', 'Z', 'Z', 'Z'), --| 0 X01 | + ('U', 'X', '0', '1')), --| 1 X01 | + (('U', 'U', 'U', 'U'), --| U X0H | + ('U', 'X', 'X', 'X'), --| X X0H | + ('Z', 'Z', 'Z', 'Z'), --| 0 X0H | + ('U', 'X', '0', 'H')), --| 1 X0H | + (('U', 'U', 'U', 'U'), --| U XL1 | + ('U', 'X', 'X', 'X'), --| X XL1 | + ('Z', 'Z', 'Z', 'Z'), --| 0 XL1 | + ('U', 'X', 'L', '1')), --| 1 XL1 | + (('U', 'U', 'U', 'Z'), --| U X0Z | + ('U', 'X', 'X', 'Z'), --| X X0Z | + ('Z', 'Z', 'Z', 'Z'), --| 0 X0Z | + ('U', 'X', '0', 'Z')), --| 1 X0Z | + (('U', 'U', 'U', 'U'), --| U XZ1 | + ('U', 'X', 'X', 'X'), --| X XZ1 | + ('Z', 'Z', 'Z', 'Z'), --| 0 XZ1 | + ('U', 'X', 'Z', '1')), --| 1 XZ1 | + (('U', 'U', 'U', 'U'), --| U WLH | + ('U', 'W', 'W', 'W'), --| X WLH | + ('Z', 'Z', 'Z', 'Z'), --| 0 WLH | + ('U', 'W', 'L', 'H')), --| 1 WLH | + (('U', 'U', 'U', 'U'), --| U WLZ | + ('U', 'W', 'W', 'Z'), --| X WLZ | + ('Z', 'Z', 'Z', 'Z'), --| 0 WLZ | + ('U', 'W', 'L', 'Z')), --| 1 WLZ | + (('U', 'U', 'U', 'U'), --| U WZH | + ('U', 'W', 'W', 'W'), --| X WZH | + ('Z', 'Z', 'Z', 'Z'), --| 0 WZH | + ('U', 'W', 'Z', 'H')), --| 1 WZH | + (('U', 'U', 'U', 'U'), --| U W0H | + ('U', 'W', 'W', 'W'), --| X W0H | + ('Z', 'Z', 'Z', 'Z'), --| 0 W0H | + ('U', 'W', '0', 'H')), --| 1 W0H | + (('U', 'U', 'U', 'U'), --| U WL1 | + ('U', 'W', 'W', 'W'), --| X WL1 | + ('Z', 'Z', 'Z', 'Z'), --| 0 WL1 | + ('U', 'W', 'L', '1')));--| 1 WL1 | + begin + return tbl_BUF3S(Strn, Enable, Input); + end fun_BUF3S; + + + function fun_BUF3SL(Input, Enable: UX01; Strn: STRENGTH) return STD_LOGIC is + -- pragma subpgm_id 412 + type TRISTATE_TABLE is array(STRENGTH, UX01, UX01) of STD_LOGIC; + + -- truth table for tristate "buf" function (Enable active Low) + constant tbl_BUF3SL: TRISTATE_TABLE := + -- ---------------------------------------------------- + -- | Input U X 0 1 | Enable Strength | + -- ---------------------------------|-----------------| + ((('U', 'U', 'U', 'U'), --| U X01 | + ('U', 'X', 'X', 'X'), --| X X01 | + ('U', 'X', '0', '1'), --| 0 X01 | + ('Z', 'Z', 'Z', 'Z')), --| 1 X01 | + (('U', 'U', 'U', 'U'), --| U X0H | + ('U', 'X', 'X', 'X'), --| X X0H | + ('U', 'X', '0', 'H'), --| 0 X0H | + ('Z', 'Z', 'Z', 'Z')), --| 1 X0H | + (('U', 'U', 'U', 'U'), --| U XL1 | + ('U', 'X', 'X', 'X'), --| X XL1 | + ('U', 'X', 'L', '1'), --| 0 XL1 | + ('Z', 'Z', 'Z', 'Z')), --| 1 XL1 | + (('U', 'U', 'U', 'Z'), --| U X0Z | + ('U', 'X', 'X', 'Z'), --| X X0Z | + ('U', 'X', '0', 'Z'), --| 0 X0Z | + ('Z', 'Z', 'Z', 'Z')), --| 1 X0Z | + (('U', 'U', 'U', 'U'), --| U XZ1 | + ('U', 'X', 'X', 'X'), --| X XZ1 | + ('U', 'X', 'Z', '1'), --| 0 XZ1 | + ('Z', 'Z', 'Z', 'Z')), --| 1 XZ1 | + (('U', 'U', 'U', 'U'), --| U WLH | + ('U', 'W', 'W', 'W'), --| X WLH | + ('U', 'W', 'L', 'H'), --| 0 WLH | + ('Z', 'Z', 'Z', 'Z')), --| 1 WLH | + (('U', 'U', 'U', 'U'), --| U WLZ | + ('U', 'W', 'W', 'Z'), --| X WLZ | + ('U', 'W', 'L', 'Z'), --| 0 WLZ | + ('Z', 'Z', 'Z', 'Z')), --| 1 WLZ | + (('U', 'U', 'U', 'U'), --| U WZH | + ('U', 'W', 'W', 'W'), --| X WZH | + ('U', 'W', 'Z', 'H'), --| 0 WZH | + ('Z', 'Z', 'Z', 'Z')), --| 1 WZH | + (('U', 'U', 'U', 'U'), --| U W0H | + ('U', 'W', 'W', 'W'), --| X W0H | + ('U', 'W', '0', 'H'), --| 0 W0H | + ('Z', 'Z', 'Z', 'Z')), --| 1 W0H | + (('U', 'U', 'U', 'U'), --| U WL1 | + ('U', 'W', 'W', 'W'), --| X WL1 | + ('U', 'W', 'L', '1'), --| 0 WL1 | + ('Z', 'Z', 'Z', 'Z')));--| 1 WL1 | + begin + return tbl_BUF3SL(Strn, Enable, Input); + end fun_BUF3SL; + + + function fun_MUX2x1(Input0, Input1, Sel: UX01) return UX01 is + -- pragma subpgm_id 413 + type MUX_TABLE is array (UX01, UX01, UX01) of UX01; + + -- truth table for "MUX2x1" function + constant tbl_MUX2x1: MUX_TABLE := + -------------------------------------------- + --| In0 'U' 'X' '0' '1' | Sel In1 | + -------------------------------------------- + ((('U', 'U', 'U', 'U'), --| 'U' 'U' | + ('U', 'U', 'U', 'U'), --| 'X' 'U' | + ('U', 'X', '0', '1'), --| '0' 'U' | + ('U', 'U', 'U', 'U')), --| '1' 'U' | + (('U', 'X', 'U', 'U'), --| 'U' 'X' | + ('U', 'X', 'X', 'X'), --| 'X' 'X' | + ('U', 'X', '0', '1'), --| '0' 'X' | + ('X', 'X', 'X', 'X')), --| '1' 'X' | + (('U', 'U', '0', 'U'), --| 'U' '0' | + ('U', 'X', '0', 'X'), --| 'X' '0' | + ('U', 'X', '0', '1'), --| '0' '0' | + ('0', '0', '0', '0')), --| '1' '0' | + (('U', 'U', 'U', '1'), --| 'U' '1' | + ('U', 'X', 'X', '1'), --| 'X' '1' | + ('U', 'X', '0', '1'), --| '0' '1' | + ('1', '1', '1', '1')));--| '1' '1' | + begin + return tbl_MUX2x1(Input1, Sel, Input0); + end fun_MUX2x1; + + + function fun_MAJ23(Input0, Input1, Input2: UX01) return UX01 is + -- pragma subpgm_id 414 + type MAJ23_TABLE is array (UX01, UX01, UX01) of UX01; + + ---------------------------------------------------------------------------- + -- The "tbl_MAJ23" truth table return 1 if the majority of three + -- inputs is 1, a 0 if the majority is 0, a X if unknown, and a U if + -- uninitialized. + ---------------------------------------------------------------------------- + constant tbl_MAJ23: MAJ23_TABLE := + -------------------------------------------- + --| In0 'U' 'X' '0' '1' | In1 In2 | + -------------------------------------------- + ((('U', 'U', 'U', 'U'), --| 'U' 'U' | + ('U', 'U', 'U', 'U'), --| 'X' 'U' | + ('U', 'U', '0', 'U'), --| '0' 'U' | + ('U', 'U', 'U', '1')), --| '1' 'U' | + (('U', 'U', 'U', 'U'), --| 'U' 'X' | + ('U', 'X', 'X', 'X'), --| 'X' 'X' | + ('U', 'X', '0', 'X'), --| '0' 'X' | + ('U', 'X', 'X', '1')), --| '1' 'X' | + (('U', 'U', '0', 'U'), --| 'U' '0' | + ('U', 'X', '0', 'X'), --| 'X' '0' | + ('0', '0', '0', '0'), --| '0' '0' | + ('U', 'X', '0', '1')), --| '1' '0' | + (('U', 'U', 'U', '1'), --| 'U' '1' | + ('U', 'X', 'X', '1'), --| 'X' '1' | + ('U', 'X', '0', '1'), --| '0' '1' | + ('1', '1', '1', '1')));--| '1' '1' | + + begin + return tbl_MAJ23(Input0, Input1, Input2); + end fun_MAJ23; + + + function fun_WiredX(Input0, Input1: STD_ULOGIC) return STD_LOGIC is + -- pragma subpgm_id 415 + TYPE stdlogic_table IS ARRAY(STD_ULOGIC, STD_ULOGIC) OF STD_LOGIC; + + -- truth table for "WiredX" function + ------------------------------------------------------------------- + -- resolution function + ------------------------------------------------------------------- + CONSTANT resolution_table : stdlogic_table := ( + -- --------------------------------------------------------- + -- | U X 0 1 Z W L H - | | + -- --------------------------------------------------------- + ( 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U', 'U' ), -- | U | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ), -- | X | + ( 'U', 'X', '0', 'X', '0', '0', '0', '0', 'X' ), -- | 0 | + ( 'U', 'X', 'X', '1', '1', '1', '1', '1', 'X' ), -- | 1 | + ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', 'X' ), -- | Z | + ( 'U', 'X', '0', '1', 'W', 'W', 'W', 'W', 'X' ), -- | W | + ( 'U', 'X', '0', '1', 'L', 'W', 'L', 'W', 'X' ), -- | L | + ( 'U', 'X', '0', '1', 'H', 'W', 'W', 'H', 'X' ), -- | H | + ( 'U', 'X', 'X', 'X', 'X', 'X', 'X', 'X', 'X' ));-- | - | + begin + return resolution_table(Input0, Input1); + end fun_WiredX; + +--synopsys synthesis_on + +end; diff --git a/libraries/synopsys/std_logic_misc.vhdl b/libraries/synopsys/std_logic_misc.vhdl new file mode 100644 index 000000000..999aa8391 --- /dev/null +++ b/libraries/synopsys/std_logic_misc.vhdl @@ -0,0 +1,170 @@ +-------------------------------------------------------------------------- +-- +-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc. All rights reserved. +-- +-- This source file may be used and distributed without restriction +-- provided that this copyright statement is not removed from the file +-- and that any derivative work contains this copyright notice. +-- +-- Package name: std_logic_misc +-- +-- Purpose: This package defines supplemental types, subtypes, +-- constants, and functions for the Std_logic_1164 Package. +-- +-- Author: GWH +-- +-------------------------------------------------------------------------- + +library IEEE; +use IEEE.STD_LOGIC_1164.all; +--library SYNOPSYS; +--use SYNOPSYS.attributes.all; + + +package std_logic_misc is + + -- output-strength types + + type STRENGTH is (strn_X01, strn_X0H, strn_XL1, strn_X0Z, strn_XZ1, + strn_WLH, strn_WLZ, strn_WZH, strn_W0H, strn_WL1); + + +--synopsys synthesis_off + + type MINOMAX is array (1 to 3) of TIME; + + + --------------------------------------------------------------------- + -- + -- functions for mapping the STD_(U)LOGIC according to STRENGTH + -- + --------------------------------------------------------------------- + + function strength_map(input: STD_ULOGIC; strn: STRENGTH) return STD_LOGIC; + + function strength_map_z(input:STD_ULOGIC; strn:STRENGTH) return STD_LOGIC; + + --------------------------------------------------------------------- + -- + -- conversion functions for STD_ULOGIC_VECTOR and STD_LOGIC_VECTOR + -- + --------------------------------------------------------------------- + +--synopsys synthesis_on + function Drive (V: STD_ULOGIC_VECTOR) return STD_LOGIC_VECTOR; + + function Drive (V: STD_LOGIC_VECTOR) return STD_ULOGIC_VECTOR; +--synopsys synthesis_off + + --attribute CLOSELY_RELATED_TCF of Drive: function is TRUE; + + --------------------------------------------------------------------- + -- + -- conversion functions for sensing various types + -- (the second argument allows the user to specify the value to + -- be returned when the network is undriven) + -- + --------------------------------------------------------------------- + + function Sense (V: STD_ULOGIC; vZ, vU, vDC: STD_ULOGIC) return STD_LOGIC; + + function Sense (V: STD_ULOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) + return STD_LOGIC_VECTOR; + function Sense (V: STD_ULOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) + return STD_ULOGIC_VECTOR; + + function Sense (V: STD_LOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) + return STD_LOGIC_VECTOR; + function Sense (V: STD_LOGIC_VECTOR; vZ, vU, vDC: STD_ULOGIC) + return STD_ULOGIC_VECTOR; + +--synopsys synthesis_on + + + --------------------------------------------------------------------- + -- + -- Function: STD_LOGIC_VECTORtoBIT_VECTOR STD_ULOGIC_VECTORtoBIT_VECTOR + -- + -- Purpose: Conversion fun. from STD_(U)LOGIC_VECTOR to BIT_VECTOR + -- + -- Mapping: 0, L --> 0 + -- 1, H --> 1 + -- X, W --> vX if Xflag is TRUE + -- X, W --> 0 if Xflag is FALSE + -- Z --> vZ if Zflag is TRUE + -- Z --> 0 if Zflag is FALSE + -- U --> vU if Uflag is TRUE + -- U --> 0 if Uflag is FALSE + -- - --> vDC if DCflag is TRUE + -- - --> 0 if DCflag is FALSE + -- + --------------------------------------------------------------------- + + function STD_LOGIC_VECTORtoBIT_VECTOR (V: STD_LOGIC_VECTOR +--synopsys synthesis_off + ; vX, vZ, vU, vDC: BIT := '0'; + Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE +--synopsys synthesis_on + ) return BIT_VECTOR; + + function STD_ULOGIC_VECTORtoBIT_VECTOR (V: STD_ULOGIC_VECTOR +--synopsys synthesis_off + ; vX, vZ, vU, vDC: BIT := '0'; + Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE +--synopsys synthesis_on + ) return BIT_VECTOR; + + + --------------------------------------------------------------------- + -- + -- Function: STD_ULOGICtoBIT + -- + -- Purpose: Conversion function from STD_(U)LOGIC to BIT + -- + -- Mapping: 0, L --> 0 + -- 1, H --> 1 + -- X, W --> vX if Xflag is TRUE + -- X, W --> 0 if Xflag is FALSE + -- Z --> vZ if Zflag is TRUE + -- Z --> 0 if Zflag is FALSE + -- U --> vU if Uflag is TRUE + -- U --> 0 if Uflag is FALSE + -- - --> vDC if DCflag is TRUE + -- - --> 0 if DCflag is FALSE + -- + --------------------------------------------------------------------- + + function STD_ULOGICtoBIT (V: STD_ULOGIC +--synopsys synthesis_off + ; vX, vZ, vU, vDC: BIT := '0'; + Xflag, Zflag, Uflag, DCflag: BOOLEAN := FALSE +--synopsys synthesis_on + ) return BIT; + + -------------------------------------------------------------------- + function AND_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01; + function NAND_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01; + function OR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01; + function NOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01; + function XOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01; + function XNOR_REDUCE(ARG: STD_LOGIC_VECTOR) return UX01; + + function AND_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01; + function NAND_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01; + function OR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01; + function NOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01; + function XOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01; + function XNOR_REDUCE(ARG: STD_ULOGIC_VECTOR) return UX01; + +--synopsys synthesis_off + + function fun_BUF3S(Input, Enable: UX01; Strn: STRENGTH) return STD_LOGIC; + function fun_BUF3SL(Input, Enable: UX01; Strn: STRENGTH) return STD_LOGIC; + function fun_MUX2x1(Input0, Input1, Sel: UX01) return UX01; + + function fun_MAJ23(Input0, Input1, Input2: UX01) return UX01; + function fun_WiredX(Input0, Input1: std_ulogic) return STD_LOGIC; + +--synopsys synthesis_on + +end; diff --git a/libraries/synopsys/std_logic_signed.vhdl b/libraries/synopsys/std_logic_signed.vhdl new file mode 100644 index 000000000..27d211be5 --- /dev/null +++ b/libraries/synopsys/std_logic_signed.vhdl @@ -0,0 +1,343 @@ +-------------------------------------------------------------------------- +-- -- +-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc. -- +-- All rights reserved. -- +-- -- +-- This source file may be used and distributed without restriction -- +-- provided that this copyright statement is not removed from the file -- +-- and that any derivative work contains this copyright notice. -- +-- -- +-- Package name: STD_LOGIC_SIGNED -- +-- -- +-- -- +-- Date: 09/11/91 KN -- +-- 10/08/92 AMT change std_ulogic to signed std_logic -- +-- 10/28/92 AMT added signed functions, -, ABS -- +-- -- +-- Purpose: -- +-- A set of signed arithemtic, conversion, -- +-- and comparision functions for STD_LOGIC_VECTOR. -- +-- -- +-- Note: Comparision of same length std_logic_vector is defined -- +-- in the LRM. The interpretation is for unsigned vectors -- +-- This package will "overload" that definition. -- +-- -- +-------------------------------------------------------------------------- + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.std_logic_arith.all; + +package STD_LOGIC_SIGNED is + + function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function "+"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR; + function "+"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR; + function "+"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + + function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function "-"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR; + function "-"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR; + function "-"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + + function "+"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function "-"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function "ABS"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + + + function "*"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + + function "<"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function "<"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function "<"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + + function "<="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function "<="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function "<="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + + function ">"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function ">"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function ">"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + + function ">="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function ">="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function ">="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + + function "="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function "="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function "="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + + function "/="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function "/="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function "/="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + function SHL(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function SHR(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + + function CONV_INTEGER(ARG: STD_LOGIC_VECTOR) return INTEGER; + +-- remove this since it is already in std_logic_arith +-- function CONV_STD_LOGIC_VECTOR(ARG: INTEGER; SIZE: INTEGER) return STD_LOGIC_VECTOR; + +end STD_LOGIC_SIGNED; + + + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.std_logic_arith.all; + +package body STD_LOGIC_SIGNED is + + + function maximum(L, R: INTEGER) return INTEGER is + begin + if L > R then + return L; + else + return R; + end if; + end; + + + function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + constant length: INTEGER := maximum(L'length, R'length); + variable result : STD_LOGIC_VECTOR (length-1 downto 0); + begin + result := SIGNED(L) + SIGNED(R); -- pragma label plus + return std_logic_vector(result); + end; + + function "+"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := SIGNED(L) + R; -- pragma label plus + return std_logic_vector(result); + end; + + function "+"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + variable result : STD_LOGIC_VECTOR (R'range); + begin + result := L + SIGNED(R); -- pragma label plus + return std_logic_vector(result); + end; + + function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := SIGNED(L) + R; -- pragma label plus + return std_logic_vector(result); + end; + + function "+"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + variable result : STD_LOGIC_VECTOR (R'range); + begin + result := L + SIGNED(R); -- pragma label plus + return std_logic_vector(result); + end; + + function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + constant length: INTEGER := maximum(L'length, R'length); + variable result : STD_LOGIC_VECTOR (length-1 downto 0); + begin + result := SIGNED(L) - SIGNED(R); -- pragma label minus + return std_logic_vector(result); + end; + + function "-"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := SIGNED(L) - R; -- pragma label minus + return std_logic_vector(result); + end; + + function "-"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + variable result : STD_LOGIC_VECTOR (R'range); + begin + result := L - SIGNED(R); -- pragma label minus + return std_logic_vector(result); + end; + + function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := SIGNED(L) - R; -- pragma label minus + return std_logic_vector(result); + end; + + function "-"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + variable result : STD_LOGIC_VECTOR (R'range); + begin + result := L - SIGNED(R); -- pragma label minus + return std_logic_vector(result); + end; + + function "+"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := + SIGNED(L); -- pragma label plus + return std_logic_vector(result); + end; + + function "-"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := - SIGNED(L); -- pragma label minus + return std_logic_vector(result); + end; + + function "ABS"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := ABS( SIGNED(L)); + return std_logic_vector(result); + end; + + function "*"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to mult + constant length: INTEGER := maximum(L'length, R'length); + variable result : STD_LOGIC_VECTOR ((L'length+R'length-1) downto 0); + begin + result := SIGNED(L) * SIGNED(R); -- pragma label mult + return std_logic_vector(result); + end; + + function "<"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to lt + constant length: INTEGER := maximum(L'length, R'length); + begin + return SIGNED(L) < SIGNED(R); -- pragma label lt + end; + + function "<"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to lt + begin + return SIGNED(L) < R; -- pragma label lt + end; + + function "<"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to lt + begin + return L < SIGNED(R); -- pragma label lt + end; + + function "<="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to leq + begin + return SIGNED(L) <= SIGNED(R); -- pragma label leq + end; + + function "<="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to leq + begin + return SIGNED(L) <= R; -- pragma label leq + end; + + function "<="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to leq + begin + return L <= SIGNED(R); -- pragma label leq + end; + + function ">"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to gt + begin + return SIGNED(L) > SIGNED(R); -- pragma label gt + end; + + function ">"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to gt + begin + return SIGNED(L) > R; -- pragma label gt + end; + + function ">"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to gt + begin + return L > SIGNED(R); -- pragma label gt + end; + + function ">="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to geq + begin + return SIGNED(L) >= SIGNED(R); -- pragma label geq + end; + + function ">="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to geq + begin + return SIGNED(L) >= R; -- pragma label geq + end; + + function ">="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to geq + begin + return L >= SIGNED(R); -- pragma label geq + end; + + function "="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + begin + return SIGNED(L) = SIGNED(R); + end; + + function "="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + begin + return SIGNED(L) = R; + end; + + function "="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + begin + return L = SIGNED(R); + end; + + function "/="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + begin + return SIGNED(L) /= SIGNED(R); + end; + + function "/="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + begin + return SIGNED(L) /= R; + end; + + function "/="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + begin + return L /= SIGNED(R); + end; + + function SHL(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + begin + return STD_LOGIC_VECTOR(SHL(SIGNED(ARG),UNSIGNED(COUNT))); + end; + + function SHR(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + begin + return STD_LOGIC_VECTOR(SHR(SIGNED(ARG),UNSIGNED(COUNT))); + end; + + + +-- This function converts std_logic_vector to a signed integer value +-- using a conversion function in std_logic_arith + function CONV_INTEGER(ARG: STD_LOGIC_VECTOR) return INTEGER is + variable result : SIGNED(ARG'range); + begin + result := SIGNED(ARG); + return CONV_INTEGER(result); + end; +end STD_LOGIC_SIGNED; + + diff --git a/libraries/synopsys/std_logic_textio.vhdl b/libraries/synopsys/std_logic_textio.vhdl new file mode 100644 index 000000000..d69a87e37 --- /dev/null +++ b/libraries/synopsys/std_logic_textio.vhdl @@ -0,0 +1,634 @@ +---------------------------------------------------------------------------- +-- +-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc. All rights reserved. +-- +-- This source file may be used and distributed without restriction +-- provided that this copyright statement is not removed from the file +-- and that any derivative work contains this copyright notice. +-- +-- Package name: STD_LOGIC_TEXTIO +-- +-- Purpose: This package overloads the standard TEXTIO procedures +-- READ and WRITE. +-- +-- Author: CRC, TS +-- +---------------------------------------------------------------------------- + +use STD.textio.all; +library IEEE; +use IEEE.std_logic_1164.all; + +package STD_LOGIC_TEXTIO is +--synopsys synthesis_off + -- Read and Write procedures for STD_ULOGIC and STD_ULOGIC_VECTOR + procedure READ(L:inout LINE; VALUE:out STD_ULOGIC); + procedure READ(L:inout LINE; VALUE:out STD_ULOGIC; GOOD: out BOOLEAN); + procedure READ(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR); + procedure READ(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR; GOOD: out BOOLEAN); + procedure WRITE(L:inout LINE; VALUE:in STD_ULOGIC; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0); + procedure WRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0); + + -- Read and Write procedures for STD_LOGIC_VECTOR + procedure READ(L:inout LINE; VALUE:out STD_LOGIC_VECTOR); + procedure READ(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN); + procedure WRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0); + + -- + -- Read and Write procedures for Hex and Octal values. + -- The values appear in the file as a series of characters + -- between 0-F (Hex), or 0-7 (Octal) respectively. + -- + + -- Hex + procedure HREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR); + procedure HREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR; GOOD: out BOOLEAN); + procedure HWRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0); + procedure HREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR); + procedure HREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN); + procedure HWRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0); + + -- Octal + procedure OREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR); + procedure OREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR; GOOD: out BOOLEAN); + procedure OWRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0); + procedure OREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR); + procedure OREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN); + procedure OWRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0); + + +--synopsys synthesis_on +end STD_LOGIC_TEXTIO; + +package body STD_LOGIC_TEXTIO is +--synopsys synthesis_off + + -- Type and constant definitions used to map STD_ULOGIC values + -- into/from character values. + + type MVL9plus is ('U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-', ERROR); + type char_indexed_by_MVL9 is array (STD_ULOGIC) of character; + type MVL9_indexed_by_char is array (character) of STD_ULOGIC; + type MVL9plus_indexed_by_char is array (character) of MVL9plus; + + constant MVL9_to_char: char_indexed_by_MVL9 := "UX01ZWLH-"; + constant char_to_MVL9: MVL9_indexed_by_char := + ('U' => 'U', 'X' => 'X', '0' => '0', '1' => '1', 'Z' => 'Z', + 'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => 'U'); + constant char_to_MVL9plus: MVL9plus_indexed_by_char := + ('U' => 'U', 'X' => 'X', '0' => '0', '1' => '1', 'Z' => 'Z', + 'W' => 'W', 'L' => 'L', 'H' => 'H', '-' => '-', others => ERROR); + + + -- Overloaded procedures. + + procedure READ(L:inout LINE; VALUE:out STD_ULOGIC; GOOD:out BOOLEAN) is + variable c: character; + begin + loop -- skip white space + read(l,c); + exit when ((c /= ' ') and (c /= CR) and (c /= HT)); + end loop; + + if (char_to_MVL9plus(c) = ERROR) then + value := 'U'; + good := FALSE; + else + value := char_to_MVL9(c); + good := TRUE; + end if; + end READ; + + procedure READ(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR; GOOD:out BOOLEAN) is + variable m: STD_ULOGIC; + variable c: character; + variable s: string(1 to value'length-1); + variable mv: STD_ULOGIC_VECTOR(0 to value'length-1); + constant allU: STD_ULOGIC_VECTOR(0 to value'length-1) + := (others => 'U'); + begin + loop -- skip white space + read(l,c); + exit when ((c /= ' ') and (c /= CR) and (c /= HT)); + end loop; + + if (char_to_MVL9plus(c) = ERROR) then + value := allU; + good := FALSE; + return; + end if; + + read(l, s); + for i in integer range 1 to value'length-1 loop + if (char_to_MVL9plus(s(i)) = ERROR) then + value := allU; + good := FALSE; + return; + end if; + end loop; + + mv(0) := char_to_MVL9(c); + for i in integer range 1 to value'length-1 loop + mv(i) := char_to_MVL9(s(i)); + end loop; + value := mv; + good := TRUE; + end READ; + + procedure READ(L:inout LINE; VALUE:out STD_ULOGIC) is + variable c: character; + begin + loop -- skip white space + read(l,c); + exit when ((c /= ' ') and (c /= CR) and (c /= HT)); + end loop; + + if (char_to_MVL9plus(c) = ERROR) then + value := 'U'; + assert FALSE report "READ(STD_ULOGIC) Error: Character '" & + c & "' read, expected STD_ULOGIC literal."; + else + value := char_to_MVL9(c); + end if; + end READ; + + procedure READ(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR) is + variable m: STD_ULOGIC; + variable c: character; + variable s: string(1 to value'length-1); + variable mv: STD_ULOGIC_VECTOR(0 to value'length-1); + constant allU: STD_ULOGIC_VECTOR(0 to value'length-1) + := (others => 'U'); + begin + loop -- skip white space + read(l,c); + exit when ((c /= ' ') and (c /= CR) and (c /= HT)); + end loop; + + if (char_to_MVL9plus(c) = ERROR) then + value := allU; + assert FALSE report + "READ(STD_ULOGIC_VECTOR) Error: Character '" & + c & "' read, expected STD_ULOGIC literal."; + return; + end if; + + read(l, s); + for i in integer range 1 to value'length-1 loop + if (char_to_MVL9plus(s(i)) = ERROR) then + value := allU; + assert FALSE report + "READ(STD_ULOGIC_VECTOR) Error: Character '" & + s(i) & "' read, expected STD_ULOGIC literal."; + return; + end if; + end loop; + + mv(0) := char_to_MVL9(c); + for i in integer range 1 to value'length-1 loop + mv(i) := char_to_MVL9(s(i)); + end loop; + value := mv; + end READ; + + procedure WRITE(L:inout LINE; VALUE:in STD_ULOGIC; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is + begin + write(l, MVL9_to_char(value), justified, field); + end WRITE; + + + procedure WRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is + variable s: string(1 to value'length); + variable m: STD_ULOGIC_VECTOR(1 to value'length) := value; + begin + for i in 1 to value'length loop + s(i) := MVL9_to_char(m(i)); + end loop; + write(l, s, justified, field); + end WRITE; + + -- Read and Write procedures for STD_LOGIC_VECTOR + procedure READ(L:inout LINE; VALUE:out STD_LOGIC_VECTOR) is + variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0); + begin + READ(L, tmp); + VALUE := STD_LOGIC_VECTOR(tmp); + end READ; + + procedure READ(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN) is + variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0); + begin + READ(L, tmp, GOOD); + VALUE := STD_LOGIC_VECTOR(tmp); + end READ; + + procedure WRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is + begin + WRITE(L, STD_ULOGIC_VECTOR(VALUE), JUSTIFIED, FIELD); + end WRITE; + + + -- + -- Hex Read and Write procedures. + -- + + -- + -- Hex, and Octal Read and Write procedures for BIT_VECTOR + -- (these procedures are not exported, they are only used + -- by the STD_ULOGIC hex/octal reads and writes below. + -- + -- + + procedure Char2QuadBits(C: Character; + RESULT: out Bit_Vector(3 downto 0); + GOOD: out Boolean; + ISSUE_ERROR: in Boolean) is + begin + case c is + when '0' => result := x"0"; good := TRUE; + when '1' => result := x"1"; good := TRUE; + when '2' => result := x"2"; good := TRUE; + when '3' => result := x"3"; good := TRUE; + when '4' => result := x"4"; good := TRUE; + when '5' => result := x"5"; good := TRUE; + when '6' => result := x"6"; good := TRUE; + when '7' => result := x"7"; good := TRUE; + when '8' => result := x"8"; good := TRUE; + when '9' => result := x"9"; good := TRUE; + when 'A' => result := x"A"; good := TRUE; + when 'B' => result := x"B"; good := TRUE; + when 'C' => result := x"C"; good := TRUE; + when 'D' => result := x"D"; good := TRUE; + when 'E' => result := x"E"; good := TRUE; + when 'F' => result := x"F"; good := TRUE; + + when 'a' => result := x"A"; good := TRUE; + when 'b' => result := x"B"; good := TRUE; + when 'c' => result := x"C"; good := TRUE; + when 'd' => result := x"D"; good := TRUE; + when 'e' => result := x"E"; good := TRUE; + when 'f' => result := x"F"; good := TRUE; + when others => + if ISSUE_ERROR then + assert FALSE report + "HREAD Error: Read a '" & c & + "', expected a Hex character (0-F)."; + end if; + good := FALSE; + end case; + end; + + procedure HREAD(L:inout LINE; VALUE:out BIT_VECTOR) is + variable ok: boolean; + variable c: character; + constant ne: integer := value'length/4; + variable bv: bit_vector(0 to value'length-1); + variable s: string(1 to ne-1); + begin + if value'length mod 4 /= 0 then + assert FALSE report + "HREAD Error: Trying to read vector " & + "with an odd (non multiple of 4) length"; + return; + end if; + + loop -- skip white space + read(l,c); + exit when ((c /= ' ') and (c /= CR) and (c /= HT)); + end loop; + + Char2QuadBits(c, bv(0 to 3), ok, TRUE); + if not ok then + return; + end if; + + read(L, s, ok); + if not ok then + assert FALSE + report "HREAD Error: Failed to read the STRING"; + return; + end if; + + for i in 1 to ne-1 loop + Char2QuadBits(s(i), bv(4*i to 4*i+3), ok, TRUE); + if not ok then + return; + end if; + end loop; + value := bv; + end HREAD; + + procedure HREAD(L:inout LINE; VALUE:out BIT_VECTOR;GOOD: out BOOLEAN) is + variable ok: boolean; + variable c: character; + constant ne: integer := value'length/4; + variable bv: bit_vector(0 to value'length-1); + variable s: string(1 to ne-1); + begin + if value'length mod 4 /= 0 then + good := FALSE; + return; + end if; + + loop -- skip white space + read(l,c); + exit when ((c /= ' ') and (c /= CR) and (c /= HT)); + end loop; + + Char2QuadBits(c, bv(0 to 3), ok, FALSE); + if not ok then + good := FALSE; + return; + end if; + + read(L, s, ok); + if not ok then + good := FALSE; + return; + end if; + + for i in 1 to ne-1 loop + Char2QuadBits(s(i), bv(4*i to 4*i+3), ok, FALSE); + if not ok then + good := FALSE; + return; + end if; + end loop; + good := TRUE; + value := bv; + end HREAD; + + + procedure HWRITE(L:inout LINE; VALUE:in BIT_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is + variable quad: bit_vector(0 to 3); + constant ne: integer := value'length/4; + variable bv: bit_vector(0 to value'length-1) := value; + variable s: string(1 to ne); + begin + if value'length mod 4 /= 0 then + assert FALSE report + "HWRITE Error: Trying to read vector " & + "with an odd (non multiple of 4) length"; + return; + end if; + + for i in 0 to ne-1 loop + quad := bv(4*i to 4*i+3); + case quad is + when x"0" => s(i+1) := '0'; + when x"1" => s(i+1) := '1'; + when x"2" => s(i+1) := '2'; + when x"3" => s(i+1) := '3'; + when x"4" => s(i+1) := '4'; + when x"5" => s(i+1) := '5'; + when x"6" => s(i+1) := '6'; + when x"7" => s(i+1) := '7'; + when x"8" => s(i+1) := '8'; + when x"9" => s(i+1) := '9'; + when x"A" => s(i+1) := 'A'; + when x"B" => s(i+1) := 'B'; + when x"C" => s(i+1) := 'C'; + when x"D" => s(i+1) := 'D'; + when x"E" => s(i+1) := 'E'; + when x"F" => s(i+1) := 'F'; + end case; + end loop; + write(L, s, JUSTIFIED, FIELD); + end HWRITE; + + procedure Char2TriBits(C: Character; + RESULT: out bit_vector(2 downto 0); + GOOD: out Boolean; + ISSUE_ERROR: in Boolean) is + begin + case c is + when '0' => result := o"0"; good := TRUE; + when '1' => result := o"1"; good := TRUE; + when '2' => result := o"2"; good := TRUE; + when '3' => result := o"3"; good := TRUE; + when '4' => result := o"4"; good := TRUE; + when '5' => result := o"5"; good := TRUE; + when '6' => result := o"6"; good := TRUE; + when '7' => result := o"7"; good := TRUE; + when others => + if ISSUE_ERROR then + assert FALSE report + "OREAD Error: Read a '" & c & + "', expected an Octal character (0-7)."; + end if; + good := FALSE; + end case; + end; + + procedure OREAD(L:inout LINE; VALUE:out BIT_VECTOR) is + variable c: character; + variable ok: boolean; + constant ne: integer := value'length/3; + variable bv: bit_vector(0 to value'length-1); + variable s: string(1 to ne-1); + begin + if value'length mod 3 /= 0 then + assert FALSE report + "OREAD Error: Trying to read vector " & + "with an odd (non multiple of 3) length"; + return; + end if; + + loop -- skip white space + read(l,c); + exit when ((c /= ' ') and (c /= CR) and (c /= HT)); + end loop; + + Char2TriBits(c, bv(0 to 2), ok, TRUE); + if not ok then + return; + end if; + + read(L, s, ok); + if not ok then + assert FALSE + report "OREAD Error: Failed to read the STRING"; + return; + end if; + + for i in 1 to ne-1 loop + Char2TriBits(s(i), bv(3*i to 3*i+2), ok, TRUE); + if not ok then + return; + end if; + end loop; + value := bv; + end OREAD; + + procedure OREAD(L:inout LINE; VALUE:out BIT_VECTOR;GOOD: out BOOLEAN) is + variable ok: boolean; + variable c: character; + constant ne: integer := value'length/3; + variable bv: bit_vector(0 to value'length-1); + variable s: string(1 to ne-1); + begin + if value'length mod 3 /= 0 then + good := FALSE; + return; + end if; + + loop -- skip white space + read(l,c); + exit when ((c /= ' ') and (c /= CR) and (c /= HT)); + end loop; + + Char2TriBits(c, bv(0 to 2), ok, FALSE); + if not ok then + good := FALSE; + return; + end if; + + read(L, s, ok); + if not ok then + good := FALSE; + return; + end if; + + for i in 1 to ne-1 loop + Char2TriBits(s(i), bv(3*i to 3*i+2), ok, FALSE); + if not ok then + good := FALSE; + return; + end if; + end loop; + good := TRUE; + value := bv; + end OREAD; + + + procedure OWRITE(L:inout LINE; VALUE:in BIT_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is + variable tri: bit_vector(0 to 2); + constant ne: integer := value'length/3; + variable bv: bit_vector(0 to value'length-1) := value; + variable s: string(1 to ne); + begin + if value'length mod 3 /= 0 then + assert FALSE report + "OWRITE Error: Trying to read vector " & + "with an odd (non multiple of 3) length"; + return; + end if; + + for i in 0 to ne-1 loop + tri := bv(3*i to 3*i+2); + case tri is + when o"0" => s(i+1) := '0'; + when o"1" => s(i+1) := '1'; + when o"2" => s(i+1) := '2'; + when o"3" => s(i+1) := '3'; + when o"4" => s(i+1) := '4'; + when o"5" => s(i+1) := '5'; + when o"6" => s(i+1) := '6'; + when o"7" => s(i+1) := '7'; + end case; + end loop; + write(L, s, JUSTIFIED, FIELD); + end OWRITE; + + -- Hex Read and Write procedures for STD_LOGIC_VECTOR + procedure HREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR;GOOD:out BOOLEAN) is + variable tmp: bit_vector(VALUE'length-1 downto 0); + begin + HREAD(L, tmp, GOOD); + VALUE := To_X01(tmp); + end HREAD; + + procedure HREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR) is + variable tmp: bit_vector(VALUE'length-1 downto 0); + begin + HREAD(L, tmp); + VALUE := To_X01(tmp); + end HREAD; + + procedure HWRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is + begin + HWRITE(L, To_bitvector(VALUE),JUSTIFIED, FIELD); + end HWRITE; + + -- Hex Read and Write procedures for STD_LOGIC_VECTOR + + procedure HREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR) is + variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0); + begin + HREAD(L, tmp); + VALUE := STD_LOGIC_VECTOR(tmp); + end HREAD; + + procedure HREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN) is + variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0); + begin + HREAD(L, tmp, GOOD); + VALUE := STD_LOGIC_VECTOR(tmp); + end HREAD; + + procedure HWRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is + begin + HWRITE(L, To_bitvector(VALUE), JUSTIFIED, FIELD); + end HWRITE; + + + -- Octal Read and Write procedures for STD_ULOGIC_VECTOR + procedure OREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR;GOOD:out BOOLEAN) is + variable tmp: bit_vector(VALUE'length-1 downto 0); + begin + OREAD(L, tmp, GOOD); + VALUE := To_X01(tmp); + end OREAD; + + procedure OREAD(L:inout LINE; VALUE:out STD_ULOGIC_VECTOR) is + variable tmp: bit_vector(VALUE'length-1 downto 0); + begin + OREAD(L, tmp); + VALUE := To_X01(tmp); + end OREAD; + + procedure OWRITE(L:inout LINE; VALUE:in STD_ULOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is + begin + OWRITE(L, To_bitvector(VALUE),JUSTIFIED, FIELD); + end OWRITE; + + -- Octal Read and Write procedures for STD_LOGIC_VECTOR + + procedure OREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR) is + variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0); + begin + OREAD(L, tmp); + VALUE := STD_LOGIC_VECTOR(tmp); + end OREAD; + + procedure OREAD(L:inout LINE; VALUE:out STD_LOGIC_VECTOR; GOOD: out BOOLEAN) is + variable tmp: STD_ULOGIC_VECTOR(VALUE'length-1 downto 0); + begin + OREAD(L, tmp, GOOD); + VALUE := STD_LOGIC_VECTOR(tmp); + end OREAD; + + procedure OWRITE(L:inout LINE; VALUE:in STD_LOGIC_VECTOR; + JUSTIFIED:in SIDE := RIGHT; FIELD:in WIDTH := 0) is + begin + OWRITE(L, STD_ULOGIC_VECTOR(VALUE), JUSTIFIED, FIELD); + end OWRITE; + + +--synopsys synthesis_on +end STD_LOGIC_TEXTIO; diff --git a/libraries/synopsys/std_logic_unsigned.vhdl b/libraries/synopsys/std_logic_unsigned.vhdl new file mode 100644 index 000000000..3e29847a8 --- /dev/null +++ b/libraries/synopsys/std_logic_unsigned.vhdl @@ -0,0 +1,329 @@ +-------------------------------------------------------------------------- +-- -- +-- Copyright (c) 1990, 1991, 1992 by Synopsys, Inc. -- +-- All rights reserved. -- +-- -- +-- This source file may be used and distributed without restriction -- +-- provided that this copyright statement is not removed from the file -- +-- and that any derivative work contains this copyright notice. -- +-- -- +-- Package name: STD_LOGIC_UNSIGNED -- +-- -- +-- -- +-- Date: 09/11/92 KN -- +-- 10/08/92 AMT -- +-- -- +-- Purpose: -- +-- A set of unsigned arithemtic, conversion, -- +-- and comparision functions for STD_LOGIC_VECTOR. -- +-- -- +-- Note: comparision of same length discrete arrays is defined -- +-- by the LRM. This package will "overload" those -- +-- definitions -- +-- -- +-------------------------------------------------------------------------- + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.std_logic_arith.all; + +package STD_LOGIC_UNSIGNED is + + function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function "+"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR; + function "+"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR; + function "+"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + + function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function "-"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR; + function "-"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR; + function "-"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + + function "+"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + + function "*"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + + function "<"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function "<"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function "<"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + + function "<="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function "<="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function "<="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + + function ">"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function ">"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function ">"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + + function ">="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function ">="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function ">="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + + function "="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function "="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function "="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + + function "/="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN; + function "/="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN; + function "/="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN; + function SHL(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + function SHR(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR; + + function CONV_INTEGER(ARG: STD_LOGIC_VECTOR) return INTEGER; + +-- remove this since it is already in std_logic_arith +-- function CONV_STD_LOGIC_VECTOR(ARG: INTEGER; SIZE: INTEGER) return STD_LOGIC_VECTOR; + +end STD_LOGIC_UNSIGNED; + + + +library IEEE; +use IEEE.std_logic_1164.all; +use IEEE.std_logic_arith.all; + +package body STD_LOGIC_UNSIGNED is + + + function maximum(L, R: INTEGER) return INTEGER is + begin + if L > R then + return L; + else + return R; + end if; + end; + + + function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + constant length: INTEGER := maximum(L'length, R'length); + variable result : STD_LOGIC_VECTOR (length-1 downto 0); + begin + result := UNSIGNED(L) + UNSIGNED(R);-- pragma label plus + return std_logic_vector(result); + end; + + function "+"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := UNSIGNED(L) + R;-- pragma label plus + return std_logic_vector(result); + end; + + function "+"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + variable result : STD_LOGIC_VECTOR (R'range); + begin + result := L + UNSIGNED(R);-- pragma label plus + return std_logic_vector(result); + end; + + function "+"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := UNSIGNED(L) + R;-- pragma label plus + return std_logic_vector(result); + end; + + function "+"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to plus + variable result : STD_LOGIC_VECTOR (R'range); + begin + result := L + UNSIGNED(R);-- pragma label plus + return std_logic_vector(result); + end; + + function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + constant length: INTEGER := maximum(L'length, R'length); + variable result : STD_LOGIC_VECTOR (length-1 downto 0); + begin + result := UNSIGNED(L) - UNSIGNED(R); -- pragma label minus + return std_logic_vector(result); + end; + + function "-"(L: STD_LOGIC_VECTOR; R: INTEGER) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := UNSIGNED(L) - R; -- pragma label minus + return std_logic_vector(result); + end; + + function "-"(L: INTEGER; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + variable result : STD_LOGIC_VECTOR (R'range); + begin + result := L - UNSIGNED(R); -- pragma label minus + return std_logic_vector(result); + end; + + function "-"(L: STD_LOGIC_VECTOR; R: STD_LOGIC) return STD_LOGIC_VECTOR is + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := UNSIGNED(L) - R; + return std_logic_vector(result); + end; + + function "-"(L: STD_LOGIC; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to minus + variable result : STD_LOGIC_VECTOR (R'range); + begin + result := L - UNSIGNED(R); -- pragma label minus + return std_logic_vector(result); + end; + + function "+"(L: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + variable result : STD_LOGIC_VECTOR (L'range); + begin + result := + UNSIGNED(L); + return std_logic_vector(result); + end; + + function "*"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + -- pragma label_applies_to mult + constant length: INTEGER := maximum(L'length, R'length); + variable result : STD_LOGIC_VECTOR ((L'length+R'length-1) downto 0); + begin + result := UNSIGNED(L) * UNSIGNED(R); -- pragma label mult + return std_logic_vector(result); + end; + + function "<"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to lt + constant length: INTEGER := maximum(L'length, R'length); + begin + return UNSIGNED(L) < UNSIGNED(R); -- pragma label lt + end; + + function "<"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to lt + begin + return UNSIGNED(L) < R; -- pragma label lt + end; + + function "<"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to lt + begin + return L < UNSIGNED(R); -- pragma label lt + end; + + function "<="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to leq + begin + return UNSIGNED(L) <= UNSIGNED(R); -- pragma label leq + end; + + function "<="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to leq + begin + return UNSIGNED(L) <= R; -- pragma label leq + end; + + function "<="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to leq + begin + return L <= UNSIGNED(R); -- pragma label leq + end; + + function ">"(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to gt + begin + return UNSIGNED(L) > UNSIGNED(R); -- pragma label gt + end; + + function ">"(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to gt + begin + return UNSIGNED(L) > R; -- pragma label gt + end; + + function ">"(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to gt + begin + return L > UNSIGNED(R); -- pragma label gt + end; + + function ">="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to geq + begin + return UNSIGNED(L) >= UNSIGNED(R); -- pragma label geq + end; + + function ">="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + -- pragma label_applies_to geq + begin + return UNSIGNED(L) >= R; -- pragma label geq + end; + + function ">="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + -- pragma label_applies_to geq + begin + return L >= UNSIGNED(R); -- pragma label geq + end; + + function "="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + begin + return UNSIGNED(L) = UNSIGNED(R); + end; + + function "="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + begin + return UNSIGNED(L) = R; + end; + + function "="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + begin + return L = UNSIGNED(R); + end; + + function "/="(L: STD_LOGIC_VECTOR; R: STD_LOGIC_VECTOR) return BOOLEAN is + begin + return UNSIGNED(L) /= UNSIGNED(R); + end; + + function "/="(L: STD_LOGIC_VECTOR; R: INTEGER) return BOOLEAN is + begin + return UNSIGNED(L) /= R; + end; + + function "/="(L: INTEGER; R: STD_LOGIC_VECTOR) return BOOLEAN is + begin + return L /= UNSIGNED(R); + end; + + function CONV_INTEGER(ARG: STD_LOGIC_VECTOR) return INTEGER is + variable result : UNSIGNED(ARG'range); + begin + result := UNSIGNED(ARG); + return CONV_INTEGER(result); + end; + function SHL(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + begin + return STD_LOGIC_VECTOR(SHL(UNSIGNED(ARG),UNSIGNED(COUNT))); + end; + + function SHR(ARG:STD_LOGIC_VECTOR;COUNT: STD_LOGIC_VECTOR) return STD_LOGIC_VECTOR is + begin + return STD_LOGIC_VECTOR(SHR(UNSIGNED(ARG),UNSIGNED(COUNT))); + end; + + +-- remove this since it is already in std_logic_arith + --function CONV_STD_LOGIC_VECTOR(ARG: INTEGER; SIZE: INTEGER) return STD_LOGIC_VECTOR is + --variable result1 : UNSIGNED (SIZE-1 downto 0); + --variable result2 : STD_LOGIC_VECTOR (SIZE-1 downto 0); + --begin + --result1 := CONV_UNSIGNED(ARG,SIZE); + --return std_logic_vector(result1); + --end; + + +end STD_LOGIC_UNSIGNED; + + diff --git a/libraries/vital2000/memory_b.vhdl b/libraries/vital2000/memory_b.vhdl new file mode 100644 index 000000000..0376ee4d3 --- /dev/null +++ b/libraries/vital2000/memory_b.vhdl @@ -0,0 +1,7151 @@ +-- ---------------------------------------------------------------------------- +-- Title : Standard VITAL Memory Package +-- : +-- Library : Vital_Memory +-- : +-- Developers : IEEE DASC Timing Working Group (TWG), PAR 1076.4 +-- : Ekambaram Balaji, LSI Logic Corporation +-- : Jose De Castro, Consultant +-- : Prakash Bare, GDA Technologies +-- : William Yam, LSI Logic Corporation +-- : Dennis Brophy, Model Technology +-- : +-- Purpose : This packages defines standard types, constants, functions +-- : and procedures for use in developing ASIC memory models. +-- : +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Modification History : +-- ---------------------------------------------------------------------------- +-- Ver:|Auth:| Date:| Changes Made: +-- 0.1 | eb |071796| First prototye as part of VITAL memory proposal +-- 0.2 | jdc |012897| Initial prototyping with proposed MTM scheme +-- 0.3 | jdc |090297| Extensive updates for TAG review (functional) +-- 0.4 | eb |091597| Changed naming conventions for VitalMemoryTable +-- | | | Added interface of VitalMemoryCrossPorts() & +-- | | | VitalMemoryViolation(). +-- 0.5 | jdc |092997| Completed naming changes thoughout package body. +-- | | | Testing with simgle port test model looks ok. +-- 0.6 | jdc |121797| Major updates to the packages: +-- | | | - Implement VitalMemoryCrossPorts() +-- | | | - Use new VitalAddressValueType +-- | | | - Use new VitalCrossPortModeType enum +-- | | | - Overloading without SamePort args +-- | | | - Honor erroneous address values +-- | | | - Honor ports disabled with 'Z' +-- | | | - Implement implicit read 'M' table symbol +-- | | | - Cleanup buses to use (H DOWNTO L) +-- | | | - Message control via MsgOn,HeaderMsg,PortName +-- | | | - Tested with 1P1RW,2P2RW,4P2R2W,4P4RW cases +-- 0.7 | jdc |052698| Bug fixes to the packages: +-- | | | - Fix failure with negative Address values +-- | | | - Added debug messages for VMT table search +-- | | | - Remove 'S' for action column (only 's') +-- | | | - Remove 's' for response column (only 'S') +-- | | | - Remove 'X' for action and response columns +-- 0.8 | jdc |061298| Implemented VitalMemoryViolation() +-- | | | - Minimal functionality violation tables +-- | | | - Missing: +-- | | | - Cannot handle wide violation variables +-- | | | - Cannot handle sub-word cases +-- | | | Fixed IIC version of MemoryMatch +-- | | | Fixed 'M' vs 'm' switched on debug output +-- | | | TO BE DONE: +-- | | | - Implement 'd' corrupting a single bit +-- | | | - Implement 'D' corrupting a single bit +-- 0.9 |eb/sc|080498| Added UNDEF value for VitalPortFlagType +-- 0.10|eb/sc|080798| Added CORRUPT value for VitalPortFlagType +-- 0.11|eb/sc|081798| Added overloaded function interface for +-- | | | VitalDeclareMemory +-- 0.14| jdc |113198| Merging of memory functionality and version +-- | | | 1.4 9/17/98 of timing package from Prakash +-- 0.15| jdc |120198| Major development of VMV functionality +-- 0.16| jdc |120298| Complete VMV functionlality for initial testing +-- | | | - New ViolationTableCorruptMask() procedure +-- | | | - New MemoryTableCorruptMask() procedure +-- | | | - HandleMemoryAction(): +-- | | | - Removed DataOutBus bogus output +-- | | | - Replaced DataOutTmp with DataInTmp +-- | | | - Added CorruptMask input handling +-- | | | - Implemented 'd','D' using CorruptMask +-- | | | - CorruptMask on 'd','C','L','D','E' +-- | | | - CorruptMask ignored on 'c','l','e' +-- | | | - Changed 'l','d','e' to set PortFlag to CORRUPT +-- | | | - Changed 'L','D','E' to set PortFlag to CORRUPT +-- | | | - Changed 'c','l','d','e' to ignore HighBit, LowBit +-- | | | - Changed 'C','L','D','E' to use HighBit, LowBit +-- | | | - HandleDataAction(): +-- | | | - Added CorruptMask input handling +-- | | | - Implemented 'd','D' using CorruptMask +-- | | | - CorruptMask on 'd','C','L','D','E' +-- | | | - CorruptMask ignored on 'l','e' +-- | | | - Changed 'l','d','e' to set PortFlag to CORRUPT +-- | | | - Changed 'L','D','E' to set PortFlag to CORRUPT +-- | | | - Changed 'l','d','e' to ignore HighBit, LowBit +-- | | | - Changed 'L','D','E' to use HighBit, LowBit +-- | | | - MemoryTableLookUp(): +-- | | | - Added MsgOn table debug output +-- | | | - Uses new MemoryTableCorruptMask() +-- | | | - ViolationTableLookUp(): +-- | | | - Uses new ViolationTableCorruptMask() +-- 0.17| jdc |120898| - Added VitalMemoryViolationSymbolType, +-- | | | VitalMemoryViolationTableType data +-- | | | types but not used yet (need to discuss) +-- | | | - Added overload for VitalMemoryViolation() +-- | | | which does not have array flags +-- | | | - Bug fixes for VMV functionality: +-- | | | - ViolationTableLookUp() not handling '-' in +-- | | | scalar violation matching +-- | | | - VitalMemoryViolation() now normalizes +-- | | | VFlagArrayTmp'LEFT as LSB before calling +-- | | | ViolationTableLookUp() for proper scanning +-- | | | - ViolationTableCorruptMask() had to remove +-- | | | normalization of CorruptMaskTmp and +-- | | | ViolMaskTmp for proper MSB:LSB corruption +-- | | | - HandleMemoryAction(), HandleDataAction() +-- | | | - Removed 'D','E' since not being used +-- | | | - Use XOR instead of OR for corrupt masks +-- | | | - Now 'd' is sensitive to HighBit, LowBit +-- | | | - Fixed LowBit overflow in bit writeable case +-- | | | - MemoryTableCorruptMask() +-- | | | - ViolationTableCorruptMask() +-- | | | - VitalMemoryTable() +-- | | | - VitalMemoryCrossPorts() +-- | | | - Fixed VitalMemoryViolation() failing on +-- | | | error AddressValue from earlier VMT() +-- | | | - Minor cleanup of code formatting +-- 0.18| jdc |032599| - In VitalDeclareMemory() +-- | | | - Added BinaryLoadFile formal arg and +-- | | | modified LoadMemory() to handle bin +-- | | | - Added NOCHANGE to VitalPortFlagType +-- | | | - For VitalCrossPortModeType +-- | | | - Added CpContention enum +-- | | | - In HandleDataAction() +-- | | | - Set PortFlag := NOCHANGE for 'S' +-- | | | - In HandleMemoryAction() +-- | | | - Set PortFlag := NOCHANGE for 's' +-- | | | - In VitalMemoryTable() and +-- | | | VitalMemoryViolation() +-- | | | - Honor PortFlag = NOCHANGE returned +-- | | | from HandleMemoryAction() +-- | | | - In VitalMemoryCrossPorts() +-- | | | - Fixed Address = AddressJ for all +-- | | | conditions of DoWrCont & DoCpRead +-- | | | - Handle CpContention like WrContOnly +-- | | | under CpReadOnly conditions, with +-- | | | associated memory message changes +-- | | | - Handle PortFlag = NOCHANGE like +-- | | | PortFlag = READ for actions +-- | | | - Modeling change: +-- | | | - Need to init PortFlag every delta +-- | | | PortFlag_A := (OTHES => UNDEF); +-- | | | - Updated InternalTimingCheck code +-- 0.19| jdc |042599| - Fixes for bit-writeable cases +-- | | | - Check PortFlag after HandleDataAction +-- | | | in VitalMemoryViolation() +-- 0.20| jdc |042599| - Merge PortFlag changes from Prakash +-- | | | and Willian: +-- | | | VitalMemorySchedulePathDelay() +-- | | | VitalMemoryExpandPortFlag() +-- 0.21| jdc |072199| - Changed VitalCrossPortModeType enums, +-- | | | added new CpReadAndReadContention. +-- | | | - Fixed VitalMemoryCrossPorts() parameter +-- | | | SamePortFlag to INOUT so that it can +-- | | | set CORRUPT or READ value. +-- | | | - Fixed VitalMemoryTable() where PortFlag +-- | | | setting by HandleDataAction() is being +-- | | | ignored when HandleMemoryAction() sets +-- | | | PortFlagTmp to NOCHANGE. +-- | | | - Fixed VitalMemoryViolation() to set +-- | | | all bits of PortFlag when violating. +-- 0.22| jdc |072399| - Added HIGHZ to PortFlagType. HandleData +-- | | | checks whether the previous state is HIGHZ. +-- | | | If yes then portFlag should be NOCHANGE +-- | | | for VMPD to ignore IORetain corruption. +-- | | | The idea is that the first Z should be +-- | | | propagated but later ones should be ignored. +-- | | | +-- 0.23| jdc |100499| - Took code checked in by Dennis 09/28/99 +-- | | | - Changed VitalPortFlagType to record of +-- | | | new VitalPortStateType to hold current, +-- | | | previous values and separate disable. +-- | | | Also created VitalDefaultPortFlag const. +-- | | | Removed usage of PortFlag NOCHANGE +-- | | | - VitalMemoryTable() changes: +-- | | | Optimized return when all curr = prev +-- | | | AddressValue is now INOUT to optimize +-- | | | Transfer PF.MemoryCurrent to MemoryPrevious +-- | | | Transfer PF.DataCurrent to DataPrevious +-- | | | Reset PF.OutputDisable to FALSE +-- | | | Expects PortFlag init in declaration +-- | | | No need to init PortFlag every delta +-- | | | - VitalMemorySchedulePathDelay() changes: +-- | | | Initialize with VitalDefaultPortFlag +-- | | | Check PortFlag.OutputDisable +-- | | | - HandleMemoryAction() changes: +-- | | | Set value of PortFlag.MemoryCurrent +-- | | | Never set PortFlag.OutputDisable +-- | | | - HandleDataAction() changes: +-- | | | Set value of PortFlag.DataCurrent +-- | | | Set PortFlag.DataCurrent for HIGHZ +-- | | | - VitalMemoryCrossPorts() changes: +-- | | | Check/set value of PF.MemoryCurrent +-- | | | Check value of PF.OutputDisable +-- | | | - VitalMemoryViolation() changes: +-- | | | Fixed bug - not reading inout PF value +-- | | | Clean up setting of PortFlag +-- 0.24| jdc |100899| - Modified update of PF.OutputDisable +-- | | | to correctly accomodate 2P1W1R case: +-- | | | the read port should not exhibit +-- | | | IO retain corrupt when reading +-- | | | addr unrelated to addr being written. +-- 0.25| jdc |100999| - VitalMemoryViolation() change: +-- | | | Fixed bug with RDNWR mode incorrectly +-- | | | updating the PF.OutputDisable +-- 0.26| jdc |100999| - VitalMemoryCrossPorts() change: +-- | | | Fixed bugs with update of PF +-- 0.27| jdc |101499| - VitalMemoryCrossPorts() change: +-- | | | Added DoRdWrCont message (ErrMcpRdWrCo, +-- | | | Memory cross port read/write data only +-- | | | contention) +-- | | | - VitalMemoryTable() change: +-- | | | Set PF.OutputDisable := TRUE for the +-- | | | optimized cases. +-- 0.28| pb |112399| - Added 8 VMPD procedures for vector +-- | | | PathCondition support. Now the total +-- | | | number of overloadings for VMPD is 24. +-- | | | - Number of overloadings for SetupHold +-- | | | procedures increased to 5. Scalar violations +-- | | | are not supported anymore. Vector checkEnabled +-- | | | support is provided through the new overloading +-- 0.29| jdc |120999| - HandleMemoryAction() HandleDataAction() +-- | | | Reinstated 'D' and 'E' actions but +-- | | | with new PortFlagType +-- | | | - Updated file handling syntax, must compile +-- | | | with -93 syntax now. +-- 0.30| jdc |022300| - Formated for 80 column max width +-- ---------------------------------------------------------------------------- + +LIBRARY IEEE; +USE IEEE.STD_LOGIC_1164.ALL; +USE IEEE.Vital_Timing.all; +USE IEEE.Vital_Primitives.all; + +LIBRARY STD; +USE STD.TEXTIO.ALL; + +-- ---------------------------------------------------------------------------- +PACKAGE BODY Vital_Memory IS + +-- ---------------------------------------------------------------------------- +-- Timing Section +-- ---------------------------------------------------------------------------- + +FILE LogFile : TEXT OPEN write_mode IS "delayLog"; +FILE Output : TEXT OPEN write_mode IS "STD_OUTPUT"; + +-- Added for turning off the debug msg.. +CONSTANT PrintDebugMsg : STD_ULOGIC := '0'; + -- '0' - don't print in STD OUTPUT + -- '1' - print in STD OUTPUT + +-- Type and constant definitions for type conversion. +TYPE MVL9_TO_CHAR_TBL IS ARRAY (STD_ULOGIC) OF character; + +--constant MVL9_to_char: MVL9_TO_CHAR_TBL := "UX01ZWLH-"; +CONSTANT MVL9_to_char: MVL9_TO_CHAR_TBL := "XX01ZX010"; + +-- ---------------------------------------------------------------------------- +-- STD_LOGIC WRITE UTILITIES +-- ---------------------------------------------------------------------------- +PROCEDURE WRITE( + l : INOUT line; + val : IN std_logic_vector; + justify : IN side := right; + field : IN width := 0 +) IS + VARIABLE invect : std_logic_vector(val'LENGTH DOWNTO 1); + VARIABLE ins : STRING(val'LENGTH DOWNTO 1); +BEGIN + invect := val; + FOR I IN invect'length DOWNTO 1 LOOP + ins(I) := MVL9_to_char(invect(I)); + END LOOP; + WRITE(L, ins, justify, field); +END; + +PROCEDURE WRITE( + l : INOUT line; + val : IN std_ulogic; + justify : IN side := right; + field : in width := 0 +) IS + VARIABLE ins : CHARACTER; +BEGIN + ins := MVL9_to_char(val); + WRITE(L, ins, justify, field); +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE DelayValue( + InputTime : IN TIME ; + outline : INOUT LINE +) IS + CONSTANT header : STRING := "TIME'HIGH"; +BEGIN + IF(InputTime = TIME'HIGH) THEN + WRITE(outline, header); + ELSE + WRITE(outline, InputTime); + END IF; +END DelayValue; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintScheduleDataArray ( + ScheduleDataArray : IN VitalMemoryScheduleDataVectorType +) IS + VARIABLE outline1 : LINE; + VARIABLE outline2 : LINE; + VARIABLE value : TIME; + CONSTANT empty : STRING := " "; + CONSTANT header1 : STRING := "i Age PropDly RetainDly"; + CONSTANT header2 : STRING := "i Sc.Value Output Lastvalue Sc.Time"; +BEGIN + WRITE (outline1, empty); + WRITE (outline1, NOW); + outline2 := outline1; + WRITELINE (LogFile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + WRITE (outline1, header1); + outline2 := outline1; + WRITELINE (LogFile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + FOR i IN ScheduleDataArray'RANGE LOOP + WRITE (outline1, i ); + WRITE (outline1, empty); + DelayValue(ScheduleDataArray(i).InputAge, outline1); + WRITE (outline1, empty); + DelayValue(ScheduleDataArray(i).PropDelay, outline1); + WRITE (outline1, empty); + DelayValue(ScheduleDataArray(i).OutputRetainDelay, outline1); + outline2 := outline1; + WRITELINE (LogFile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + END LOOP; + WRITE (outline1, header2); + outline2 := outline1; + WRITELINE (LogFile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + FOR i IN ScheduleDataArray'RANGE LOOP + WRITE (outline1, i ); + WRITE (outline1, empty); + WRITE (outline1, ScheduleDataArray(i).ScheduleValue); + WRITE (outline1, empty); + WRITE (outline1, ScheduleDataArray(i).OutputData); + WRITE (outline1, empty); + WRITE (outline1, ScheduleDataArray(i).LastOutputValue ); + WRITE (outline1, empty); + DelayValue(ScheduleDataArray(i).ScheduleTime, outline1); + outline2 := outline1; + WRITELINE (LogFile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + END LOOP; + WRITE (outline1, empty); + WRITE (outline2, empty); + WRITELINE (LogFile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE (Output, outline2); + END IF; +END PrintScheduleDataArray; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintArcType ( + ArcType : IN VitalMemoryArcType +) IS + VARIABLE outline1, outline2 : LINE; + CONSTANT empty : STRING := " "; + CONSTANT cross : STRING := "CrossArc"; + CONSTANT para : STRING := "ParallelArc"; + CONSTANT sub : STRING := "SubWordArc"; + CONSTANT Header1 : STRING := "Path considered @ "; + CONSTANT Header2 : STRING := " is "; +BEGIN + WRITELINE (LogFile, outline1); + WRITE (outline1, header1); + WRITE (outline1, NOW); + WRITE (outline1, empty); + WRITE (outline1, header2); + WRITE (outline1, empty); + case ArcType is + WHEN CrossArc => + WRITE (outline1, cross); + WHEN ParallelArc => + WRITE (outline1, para); + WHEN SubwordArc => + WRITE (outline1, sub); + END CASE; + outline2 := outline1 ; + -- Appears on STD OUT + IF (PrintDebugMsg = '1') THEN + WRITELINE (Output, outline1); + END IF; + WRITELINE (LogFile, outline2); +END PrintArcType; + +-- ---------------------------------------------------------------------------- +-- This returns the value picked from the delay array +-- ---------------------------------------------------------------------------- +PROCEDURE PrintDelay ( + outbitpos : IN INTEGER; + InputArrayLow : IN INTEGER; + InputArrayHigh : IN INTEGER; + debugprop : IN VitalTimeArrayT; + debugretain : IN VitalTimeArrayT +) IS + VARIABLE outline1 : LINE; + VARIABLE outline2 : LINE; + VARIABLE outline3 : LINE; + VARIABLE outline4 : LINE; + VARIABLE outline5 : LINE; + VARIABLE outline6 : LINE; + CONSTANT empty : STRING := " "; + CONSTANT empty5 : STRING := " "; + CONSTANT header1 : STRING := "Prop. delays : "; + CONSTANT header2 : STRING := "Retain delays : "; + CONSTANT header3 : STRING := "output bit : "; +BEGIN + WRITE(outline1, header3); + WRITE(outline1, outbitpos); + outline2 := outline1; + WRITELINE(LogFile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE(output, outline2); + END IF; + WRITE(outline1, header1); + WRITE (outline1, empty5); + FOR i IN InputArrayHigh DOWNTO InputArrayLow LOOP + DelayValue(debugprop(i), outline1); + WRITE(outline1, empty); + END LOOP; + outline2 := outline1; + WRITELINE(LogFile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE(output, outline2); + END IF; + WRITE(outline1, header2); + WRITE (outline1, empty5); + FOR i in InputArrayHigh DOWNTO InputArrayLow LOOP + DelayValue(debugretain(i), outline1); + WRITE(outline1, empty); + END LOOP; + outline2 := outline1; + WRITELINE(LogFile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE(output, outline2); + END IF; +END PrintDelay; + +-- ---------------------------------------------------------------------------- +PROCEDURE DebugMsg1 IS + CONSTANT header1:STRING:= "******************************************"; + CONSTANT header2 :STRING:="Entering the process because of an i/p change"; + variable outline1, outline2 : LINE; +BEGIN + WRITE(outline1, header1); + outline2 := outline1; + WRITELINE (Logfile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + WRITE(outline1, header2); + outline2 := outline1; + WRITELINE (Logfile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + WRITE(outline1, header1); + outline2 := outline1; + WRITELINE (Logfile, outline1); + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; +END DebugMsg1; + +-- ---------------------------------------------------------------------------- +PROCEDURE ScheduleDebugMsg IS + CONSTANT header1 : STRING := "******************************************"; + CONSTANT header2 : STRING := "Finished executing all the procedures"; + VARIABLE outline1 : LINE; + VARIABLE outline2 : LINE; +BEGIN + WRITE(outline1, header1); + outline2 := outline1; + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + WRITELINE (Logfile, outline1); + WRITE(outline1, header2); + outline2 := outline1; + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + WRITELINE (Logfile, outline1); + WRITE(outline1, header1); + outline2 := outline1; + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + WRITELINE (Logfile, outline1); +END ScheduleDebugMsg; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintInputName( + InputSignalName : IN STRING +) IS + VARIABLE outline1 : LINE; + VARIABLE outline2 : LINE; + CONSTANT header1 : STRING := "***Changing input is "; + CONSTANT header2 : STRING := "("; + CONSTANT header3 : STRING := ")"; + CONSTANT header4 : STRING := "****"; + CONSTANT header5 : STRING := "******************************************"; + CONSTANT header6 : STRING:="Entering the process because of an i/p change"; + CONSTANT empty : STRING := " "; +BEGIN + WRITE(outline1, header5); + outline2 := outline1; + WRITELINE (output, outline1); + WRITELINE (Logfile, outline2); + WRITE(outline1, header6); + outline2 := outline1; + WRITELINE (output, outline1); + WRITELINE (Logfile, outline2); + WRITE(outline1, header5); + outline2 := outline1; + WRITELINE (output, outline1); + WRITELINE (Logfile, outline2); + WRITE(outline1, header1); + WRITE(outline1, InputSignalName); + WRITE(outline1, empty); + WRITE(outline1, now); + WRITE(outline1, empty); + WRITE(outline1, header4); + WRITELINE (output, outline1); + WRITELINE (Logfile, outline2); +END PrintInputName; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintInputChangeTime( + ChangeTimeArray : IN VitalTimeArrayT +) IS + VARIABLE outline1 : LINE; + VARIABLE outline2 : LINE; + CONSTANT header5 : STRING := "*************************************"; + CONSTANT header6 : STRING:="ChangeTime Array : "; + CONSTANT empty : STRING := " "; +BEGIN + WRITE(outline1, header5); + outline2 := outline1; + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + WRITELINE (Logfile, outline1); + WRITE(outline1, header6); + FOR i in ChangeTimeArray'range LOOP + WRITE(outline1, ChangeTimeArray(i)); + WRITE(outline1, empty); + END LOOP; + outline2 := outline1; + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + WRITELINE (Logfile, outline1); + WRITE(outline1, header5); + outline2 := outline1; + IF (PrintDebugMsg = '1') THEN + WRITELINE (output, outline2); + END IF; + WRITELINE (Logfile, outline1); +END PrintInputChangeTime; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintInputChangeTime( + ChangeTime : IN Time +) IS + VARIABLE ChangeTimeArray : VitalTimeArrayT(0 DOWNTO 0); +BEGIN + ChangeTimeArray(0) := ChangeTime; + PrintInputChangeTime(ChangeTimeArray); +END PrintInputChangeTime; + +-- ---------------------------------------------------------------------------- +-- for debug purpose +CONSTANT MaxNoInputBits : INTEGER := 1000; + +TYPE VitalMemoryDelayType IS RECORD + PropDelay : TIME; + OutputRetainDelay : TIME; +END RECORD; + +-- ---------------------------------------------------------------------------- +-- PROCEDURE: IntToStr +-- +-- PARAMETERS: InputInt - Integer to be converted to String. +-- ResultStr - String buffer for converted Integer +-- AppendPos - Position in buffer to place result +-- +-- DESCRIPTION: This procedure is used to convert an input integer +-- into a string representation. The converted string +-- may be placed at a specific position in the result +-- buffer. +-- +-- ---------------------------------------------------------------------------- + +PROCEDURE IntToStr ( + InputInt : IN INTEGER ; + ResultStr : INOUT STRING ( 1 TO 256) ; + AppendPos : INOUT NATURAL +) IS + -- Look-up table. Given an int, we can get the character. + TYPE integer_table_type IS ARRAY (0 TO 9) OF CHARACTER ; + CONSTANT integer_table : integer_table_type := + ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9') ; + -- Local variables used in this function. + VARIABLE inpVal : INTEGER := inputInt ; + VARIABLE divisor : INTEGER := 10 ; + VARIABLE tmpStrIndex : INTEGER := 1 ; + VARIABLE tmpStr : STRING ( 1 TO 256 ) ; +BEGIN + IF ( inpVal = 0 ) THEN + tmpStr(tmpStrIndex) := integer_table ( 0 ) ; + tmpStrIndex := tmpStrIndex + 1 ; + ELSE + WHILE ( inpVal > 0 ) LOOP + tmpStr(tmpStrIndex) := integer_table (inpVal mod divisor); + tmpStrIndex := tmpStrIndex + 1 ; + inpVal := inpVal / divisor ; + END LOOP ; + END IF ; + IF (appendPos /= 1 ) THEN + resultStr(appendPos) := ',' ; + appendPos := appendPos + 1 ; + END IF ; + + FOR i IN tmpStrIndex-1 DOWNTO 1 LOOP + resultStr(appendPos) := tmpStr(i) ; + appendPos := appendPos + 1 ; + END LOOP ; +END IntToStr ; + +-- ---------------------------------------------------------------------------- +TYPE CheckType IS ( + SetupCheck, + HoldCheck, + RecoveryCheck, + RemovalCheck, + PulseWidCheck, + PeriodCheck +); + +TYPE CheckInfoType IS RECORD + Violation : BOOLEAN; + CheckKind : CheckType; + ObsTime : TIME; + ExpTime : TIME; + DetTime : TIME; + State : X01; +END RECORD; + +TYPE LogicCvtTableType IS ARRAY (std_ulogic) OF CHARACTER; +TYPE HiLoStrType IS ARRAY (std_ulogic RANGE 'X' TO '1') OF STRING(1 TO 4); + +CONSTANT LogicCvtTable : LogicCvtTableType + := ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-'); +CONSTANT HiLoStr : HiLoStrType := (" X ", " Low", "High" ); + +TYPE EdgeSymbolMatchType IS ARRAY (X01,X01,VitalEdgeSymbolType) OF BOOLEAN; + +-- last value, present value, edge symbol +CONSTANT EdgeSymbolMatch : EdgeSymbolMatchType := + ( + 'X' => + ( 'X'=>( OTHERS => FALSE), + '0'=>('N'|'F'|'v'|'E'|'D'|'*' => TRUE, OTHERS => FALSE ), + '1'=>('P'|'R'|'^'|'E'|'A'|'*' => TRUE, OTHERS => FALSE ) + ), + '0' => + ( 'X'=>( 'r'|'p'|'R'|'A'|'*' => TRUE, OTHERS => FALSE ), + '0'=>( OTHERS => FALSE ), + '1'=>( '/'|'P'|'p'|'R'|'*' => TRUE, OTHERS => FALSE ) + ), + '1' => + ( 'X'=>( 'f'|'n'|'F'|'D'|'*' => TRUE, OTHERS => FALSE ), + '0'=>( '\'|'N'|'n'|'F'|'*' => TRUE, OTHERS => FALSE ), + '1'=>( OTHERS => FALSE ) + ) + ); + +-- ---------------------------------------------------------------------------- +FUNCTION Minimum ( + CONSTANT t1, t2 : IN TIME +) RETURN TIME IS +BEGIN + IF (t1 < t2) THEN RETURN (t1); ELSE RETURN (t2); END IF; +END Minimum; + +-- ---------------------------------------------------------------------------- +FUNCTION Maximum ( + CONSTANT t1, t2 : IN TIME +) RETURN TIME IS +BEGIN + IF (t1 < t2) THEN RETURN (t2); ELSE RETURN (t1); END IF; +END Maximum; + +-- ---------------------------------------------------------------------------- +-- FUNCTION: VitalMemoryCalcDelay +-- Description: Select Transition dependent Delay. +-- Used internally by VitalMemorySelectDelay. +-- ---------------------------------------------------------------------------- +FUNCTION VitalMemoryCalcDelay ( + CONSTANT NewVal : IN STD_ULOGIC := 'X'; + CONSTANT OldVal : IN STD_ULOGIC := 'X'; + CONSTANT Delay : IN VitalDelayType01ZX +) RETURN VitalMemoryDelayType IS + VARIABLE Result : VitalMemoryDelayType; +BEGIN + CASE Oldval IS + WHEN '0' | 'L' => + CASE Newval IS + WHEN '0' | 'L' => + Result.PropDelay := Delay(tr10); + WHEN '1' | 'H' => + Result.PropDelay := Delay(tr01); + WHEN 'Z' => + Result.PropDelay := Delay(tr0Z); + WHEN OTHERS => + Result.PropDelay := Minimum(Delay(tr01), Delay(tr0Z)); + END CASE; + Result.OutputRetainDelay := Delay(tr0X); + WHEN '1' | 'H' => + CASE Newval IS + WHEN '0' | 'L' => + Result.PropDelay := Delay(tr10); + WHEN '1' | 'H' => + Result.PropDelay := Delay(tr01); + WHEN 'Z' => + Result.PropDelay := Delay(tr1Z); + WHEN OTHERS => + Result.PropDelay := Minimum(Delay(tr10), Delay(tr1Z)); + END CASE; + Result.OutputRetainDelay := Delay(tr1X); + WHEN 'Z' => + CASE Newval IS + WHEN '0' | 'L' => + Result.PropDelay := Delay(trZ0); + WHEN '1' | 'H' => + Result.PropDelay := Delay(trZ1); + WHEN 'Z' => + Result.PropDelay := Maximum(Delay(tr1Z), Delay(tr0Z)); + WHEN OTHERS => + Result.PropDelay := Minimum(Delay(trZ1), Delay(trZ0)); + END CASE; + Result.OutputRetainDelay := Delay(trZX); + WHEN OTHERS => + CASE Newval IS + WHEN '0' | 'L' => + Result.PropDelay := Maximum(Delay(tr10), Delay(trZ0)); + WHEN '1' | 'H' => + Result.PropDelay := Maximum(Delay(tr01), Delay(trZ1)); + WHEN 'Z' => + Result.PropDelay := Maximum(Delay(tr1Z), Delay(tr0Z)); + WHEN OTHERS => + Result.PropDelay := Maximum(Delay(tr10), Delay(tr01)); + END CASE; + Result.OutputRetainDelay := Minimum(Delay(tr1X), Delay(tr0X)); + END CASE; + RETURN Result; +END VitalMemoryCalcDelay; + +-- ---------------------------------------------------------------------------- +FUNCTION VitalMemoryCalcDelay ( + CONSTANT NewVal : IN STD_ULOGIC := 'X'; + CONSTANT OldVal : IN STD_ULOGIC := 'X'; + CONSTANT Delay : IN VitalDelayType01Z +) RETURN VitalMemoryDelayType IS + VARIABLE Result : VitalMemoryDelayType; +BEGIN +CASE Oldval IS + WHEN '0' | 'L' => + CASE Newval IS + WHEN '0' | 'L' => Result.PropDelay := Delay(tr10); + WHEN '1' | 'H' => Result.PropDelay := Delay(tr01); + WHEN OTHERS => + Result.PropDelay := Minimum(Delay(tr01), Delay(tr10)); + END CASE; + Result.OutputRetainDelay := Delay(tr0Z); + WHEN '1' | 'H' => + CASE Newval IS + WHEN '0' | 'L' => Result.PropDelay := Delay(tr10); + WHEN '1' | 'H' => Result.PropDelay := Delay(tr01); + WHEN OTHERS => + Result.PropDelay := Minimum(Delay(tr10), Delay(tr01)); + END CASE; + Result.OutputRetainDelay := Delay(tr1Z); + WHEN OTHERS => + Result.PropDelay := Maximum(Delay(tr10),Delay(tr01)); + Result.OutputRetainDelay := Minimum(Delay(tr1Z),Delay(tr0Z)); + END CASE; + RETURN Result; +END VitalMemoryCalcDelay; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryUpdateInputChangeTime ( + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + VARIABLE NumBitsPerSubword : INTEGER +) IS + VARIABLE LastInputValue : STD_LOGIC_VECTOR(InputSignal'LENGTH-1 downto 0); + VARIABLE InSignalNorm : STD_LOGIC_VECTOR(InputSignal'LENGTH-1 downto 0); + VARIABLE ChangeTimeNorm : VitalTimeArrayT(InputSignal'LENGTH-1 downto 0); + VARIABLE BitsPerWord : INTEGER; +BEGIN + LastInputValue := InputSignal'LAST_VALUE; + IF NumBitsPerSubword = DefaultNumBitsPerSubword THEN + BitsPerWord := InputSignal'LENGTH; + ELSE + BitsPerWord := NumBitsPerSubword; + END IF; + + FOR i IN InSignalNorm'RANGE LOOP + IF (InSignalNorm(i) /= LastInputValue(i)) THEN + ChangeTimeNorm(i/BitsPerWord) := NOW - InputSignal'LAST_EVENT; + ELSE + ChangeTimeNorm(i/BitsPerWord) := InputChangeTimeArray(i); + END IF; + END LOOP; + + FOR i IN ChangeTimeNorm'RANGE LOOP + ChangeTimeNorm(i) := ChangeTimeNorm(i/BitsPerword); + END LOOP; + + InputChangeTimeArray := ChangeTimeNorm; + + -- for debug purpose only + PrintInputChangeTime(InputChangeTimeArray); +END VitalMemoryUpdateInputChangeTime; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemoryUpdateInputChangeTime +-- Description: Time since previous event for each bit of the input +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryUpdateInputChangeTime ( + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR +) IS + VARIABLE LastInputValue : STD_LOGIC_VECTOR(InputSignal'RANGE) ; +BEGIN + LastInputValue := InputSignal'LAST_VALUE; + FOR i IN InputSignal'RANGE LOOP + IF (InputSignal(i) /= LastInputValue(i)) THEN + InputChangeTimeArray(i) := NOW - InputSignal'LAST_EVENT; + END IF; + END LOOP; + -- for debug purpose only + PrintInputChangeTime(InputChangeTimeArray); +END VitalMemoryUpdateInputChangeTime; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryUpdateInputChangeTime ( + VARIABLE InputChangeTime : INOUT TIME; + SIGNAL InputSignal : IN STD_ULOGIC +) IS +BEGIN + InputChangeTime := NOW - InputSignal'LAST_EVENT; + -- for debug purpose only + PrintInputChangeTime(InputChangeTime); +END VitalMemoryUpdateInputChangeTime; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryExpandPortFlag ( + CONSTANT PortFlag : IN VitalPortFlagVectorType; + CONSTANT NumBitsPerSubword : IN INTEGER; + VARIABLE ExpandedPortFlag : OUT VitalPortFlagVectorType +) IS + VARIABLE PortFlagNorm : VitalPortFlagVectorType( + PortFlag'LENGTH-1 downto 0) := PortFlag; + VARIABLE ExpandedPortFlagNorm : VitalPortFlagVectorType( + ExpandedPortFlag'LENGTH-1 downto 0); + VARIABLE SubwordIndex : INTEGER; +BEGIN + FOR Index IN INTEGER RANGE 0 to ExpandedPortFlag'LENGTH-1 LOOP + IF NumBitsPerSubword = DefaultNumBitsPerSubword THEN + SubwordIndex := 0; + ELSE + SubwordIndex := Index / NumBitsPerSubword; + END IF; + ExpandedPortFlagNorm(Index) := PortFlagNorm(SubWordIndex); + END LOOP; + ExpandedPortFlag := ExpandedPortFlagNorm; +END VitalMemoryExpandPortFlag; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemorySelectDelay +-- Description : Select Propagation Delay. Used internally by +-- VitalMemoryAddPathDelay. +-- ---------------------------------------------------------------------------- + +-- ---------------------------------------------------------------------------- +-- VitalDelayArrayType01ZX +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySelectDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + VARIABLE InputChangeTimeArray : IN VitalTimeArrayT; + CONSTANT OutputSignalName : IN STRING :=""; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType; + CONSTANT PathConditionArray : IN VitalBoolArrayT; + CONSTANT OutputRetainFlag : IN BOOLEAN +) IS + VARIABLE InputArrayLow : INTEGER := 0; + VARIABLE InputArrayHigh : INTEGER := 0; + VARIABLE DelayArrayIndex : INTEGER := 0; + VARIABLE NumBitsPerSubWord : INTEGER := DefaultNumBitsPerSubword; + VARIABLE NewValue : STD_ULOGIC; + VARIABLE OldValue : STD_ULOGIC; + VARIABLE OutputLength : INTEGER := 0; + VARIABLE OutArrayIndex : INTEGER; + VARIABLE PropDelay : TIME; + VARIABLE RetainDelay : TIME; + VARIABLE CurPropDelay : TIME; + VARIABLE CurRetainDelay : TIME; + VARIABLE InputAge : TIME; + VARIABLE CurInputAge : TIME; + VARIABLE InputChangeTimeNorm : VitalTimeArrayT( + InputChangeTimeArray'LENGTH-1 downto 0):=InputChangeTimeArray; + VARIABLE DelayArrayNorm : VitalDelayArrayType01ZX( + PathDelayArray'LENGTH-1 downto 0):= PathDelayArray; + VARIABLE ScheduleDataArrayNorm : VitalMemoryScheduleDatavectorType + (ScheduleDataArray'LENGTH-1 downto 0):= ScheduleDataArray; + + -- for debug purpose + VARIABLE debugprop : VitalTimeArrayT(MaxNoInputBits-1 downto 0); + VARIABLE debugretain : VitalTimeArrayT(MaxNoInputBits-1 downto 0); + +BEGIN + + -- for debug purpose + PrintArcType(ArcType); + + OutputLength := ScheduleDataArray'LENGTH; + FOR OutBitPos IN 0 to (OutputLength -1) LOOP + NEXT WHEN PathConditionArray(OutBitPos) = FALSE; + + NEXT WHEN ((ScheduleDataArrayNorm(OutBitPos).ScheduleValue + = ScheduleDataArrayNorm(OutBitPos).OutputData) AND + (ScheduleDataArrayNorm(OutBitPos).ScheduleTime <= NOW) AND + (OutputRetainFlag = FALSE )); + + NewValue := ScheduleDataArrayNorm(OutBitPos).OutputData; + OldValue := ScheduleDataArrayNorm(OutBitPos).LastOutputValue; + PropDelay :=ScheduleDataArrayNorm(OutBitPos).PropDelay; + InputAge := ScheduleDataArrayNorm(OutBitPos).InputAge; + RetainDelay:=ScheduleDataArrayNorm(OutBitPos).OutputRetainDelay; + NumBitsPerSubWord:=ScheduleDataArrayNorm(OutBitPos).NumBitsPerSubWord; + + CASE ArcType IS + WHEN ParallelArc => + InputArrayLow := OutBitPos; + InputArrayHigh := OutBitPos; + DelayArrayIndex := OutBitPos; + WHEN CrossArc => + InputArrayLow := 0; + InputArrayHigh := InputChangeTimeArray'LENGTH - 1 ; + DelayArrayIndex := OutBitPos; + WHEN SubwordArc => + InputArrayLow := OutBitPos / NumBitsPerSubWord; + InputArrayHigh := OutBitPos / NumBitsPerSubWord; + DelayArrayIndex := OutBitPos + + (OutputLength * (OutBitPos / NumBitsPerSubWord)); + END CASE; + + FOR i IN InputArrayLow TO InputArrayHigh LOOP + (CurPropDelay,CurRetainDelay) := + VitalMemoryCalcDelay ( + NewValue, OldValue, DelayArrayNorm(DelayArrayIndex) + ); + IF (OutputRetainFlag = FALSE) THEN + CurRetainDelay := TIME'HIGH; + END IF; + + -- for debug purpose + debugprop(i) := CurPropDelay; + debugretain(i) := CurRetainDelay; + + IF ArcType = CrossArc THEN + DelayArrayIndex := DelayArrayIndex + OutputLength; + END IF; + + -- If there is one input change at a time, then choose the + -- delay from that input. If there is simultaneous input + -- change, then choose the minimum of propagation delays + + IF (InputChangeTimeNorm(i) < 0 ns)THEN + CurInputAge := TIME'HIGH; + ELSE + CurInputAge := NOW - InputChangeTimeNorm(i); + END IF; + + IF (CurInputAge < InputAge)THEN + PropDelay := CurPropDelay; + RetainDelay := CurRetainDelay; + InputAge := CurInputAge; + ELSIF (CurInputAge = InputAge)THEN + IF (CurPropDelay < PropDelay) THEN + PropDelay := CurPropDelay; + END IF; + IF (OutputRetainFlag = TRUE) THEN + IF (CurRetainDelay < RetainDelay) THEN + RetainDelay := CurRetainDelay; + END IF; + END IF; + END IF; + END LOOP; + + -- Store it back to data strucutre + ScheduleDataArrayNorm(OutBitPos).PropDelay := PropDelay; + ScheduleDataArrayNorm(OutBitPos).OutputRetainDelay:= RetainDelay; + ScheduleDataArrayNorm(OutBitPos).InputAge := InputAge; + + -- for debug purpose + PrintDelay(outbitPos,InputArrayLow, InputArrayHigh, + debugprop, debugretain); + END LOOP; + + ScheduleDataArray := ScheduleDataArrayNorm; + +END VitalMemorySelectDelay; + +-- ---------------------------------------------------------------------------- +-- VitalDelayArrayType01Z +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySelectDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + VARIABLE InputChangeTimeArray : IN VitalTimeArrayT; + CONSTANT OutputSignalName : IN STRING :=""; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType; + CONSTANT PathConditionArray : IN VitalBoolArrayT; + CONSTANT OutputRetainFlag : IN BOOLEAN +) IS + VARIABLE InputArrayLow : INTEGER := 0; + VARIABLE InputArrayHigh : INTEGER := 0; + VARIABLE DelayArrayIndex : INTEGER := 0; + VARIABLE NumBitsPerSubWord : INTEGER := DefaultNumBitsPerSubword; + VARIABLE NewValue : STD_ULOGIC; + VARIABLE OldValue : STD_ULOGIC; + VARIABLE OutputLength : INTEGER := 0; + VARIABLE OutArrayIndex : INTEGER; + VARIABLE PropDelay : TIME; + VARIABLE RetainDelay : TIME; + VARIABLE CurPropDelay : TIME; + VARIABLE CurRetainDelay : TIME; + VARIABLE InputAge : TIME; + VARIABLE CurInputAge : TIME; + VARIABLE InputChangeTimeNorm : VitalTimeArrayT( + InputChangeTimeArray'LENGTH-1 downto 0):=InputChangeTimeArray; + VARIABLE DelayArrayNorm : VitalDelayArrayType01Z( + PathDelayArray'LENGTH-1 downto 0):= PathDelayArray; + VARIABLE ScheduleDataArrayNorm : VitalMemoryScheduleDatavectorType + (ScheduleDataArray'LENGTH-1 downto 0):=ScheduleDataArray; + + -- for debug purpose + VARIABLE debugprop : VitalTimeArrayT(MaxNoInputBits-1 downto 0); + VARIABLE debugretain : VitalTimeArrayT(MaxNoInputBits-1 downto 0); +BEGIN + + -- for debug purpose + PrintArcType(ArcType); + + OutputLength := ScheduleDataArray'LENGTH; + FOR OutBitPos IN 0 to (OutputLength -1) LOOP + NEXT WHEN PathConditionArray(OutBitPos) = FALSE; + + NEXT WHEN ((ScheduleDataArrayNorm(OutBitPos).ScheduleValue + = ScheduleDataArrayNorm(OutBitPos).OutputData) AND + (ScheduleDataArrayNorm(OutBitPos).ScheduleTime <= NOW) AND + (OutputRetainFlag = FALSE)); + + NewValue := ScheduleDataArrayNorm(OutBitPos).OutputData; + OldValue := ScheduleDataArrayNorm(OutBitPos).LastOutputValue; + PropDelay :=ScheduleDataArrayNorm(OutBitPos).PropDelay; + InputAge := ScheduleDataArrayNorm(OutBitPos).InputAge; + RetainDelay:=ScheduleDataArrayNorm(OutBitPos).OutputRetainDelay; + NumBitsPerSubWord:=ScheduleDataArrayNorm(OutBitPos).NumBitsPerSubWord; + + CASE ArcType IS + WHEN ParallelArc => + InputArrayLow := OutBitPos; + InputArrayHigh := OutBitPos; + DelayArrayIndex := OutBitPos; + WHEN CrossArc => + InputArrayLow := 0; + InputArrayHigh := InputChangeTimeArray'LENGTH-1; + DelayArrayIndex := OutBitPos; + WHEN SubwordArc => + InputArrayLow := OutBitPos / NumBitsPerSubWord; + InputArrayHigh := OutBitPos / NumBitsPerSubWord; + DelayArrayIndex := OutBitPos + + (OutputLength * (OutBitPos / NumBitsPerSubWord)); + END CASE; + + FOR i IN InputArrayLow TO InputArrayHigh LOOP + (CurPropDelay, CurRetainDelay) := + VitalMemoryCalcDelay ( + NewValue, OldValue, DelayArrayNorm(DelayArrayIndex) + ); + IF (OutputRetainFlag = FALSE) THEN + CurRetainDelay := TIME'HIGH; + END IF; + + -- for debug purpose + debugprop(i) := CurPropDelay; + debugretain(i) := CurRetainDelay; + + IF (ArcType = CrossArc) THEN + DelayArrayIndex := DelayArrayIndex + OutputLength; + END IF; + + -- If there is one input change at a time, then choose the + -- delay from that input. If there is simultaneous input + -- change, then choose the minimum of propagation delays + + IF (InputChangeTimeNorm(i) < 0 ns) THEN + CurInputAge := TIME'HIGH; + ELSE + CurInputAge := NOW - InputChangeTimeNorm(i); + END IF; + + IF (CurInputAge < InputAge) THEN + PropDelay := CurPropDelay; + RetainDelay := CurRetainDelay; + InputAge := CurInputAge; + ELSIF (CurInputAge = InputAge) THEN + IF (CurPropDelay < PropDelay) THEN + PropDelay := CurPropDelay; + END IF; + IF (OutputRetainFlag = TRUE) THEN + IF (CurRetainDelay < RetainDelay) THEN + RetainDelay := CurRetainDelay; + END IF; + END IF; + END IF; + END LOOP; + + -- Store it back to data strucutre + ScheduleDataArrayNorm(OutBitPos).PropDelay := PropDelay; + ScheduleDataArrayNorm(OutBitPos).OutputRetainDelay:= RetainDelay; + ScheduleDataArrayNorm(OutBitPos).InputAge := InputAge; + + -- for debug purpose + PrintDelay(outbitPos, InputArrayLow, InputArrayHigh, + debugprop, debugretain); + END LOOP; + + ScheduleDataArray := ScheduleDataArrayNorm; + +END VitalMemorySelectDelay; + +-- ---------------------------------------------------------------------------- +-- VitalDelayArrayType01 +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySelectDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + VARIABLE InputChangeTimeArray : IN VitalTimeArrayT; + CONSTANT OutputSignalName : IN STRING :=""; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType; + CONSTANT PathConditionArray : IN VitalBoolArrayT +) IS + VARIABLE CurPathDelay : VitalMemoryDelayType; + VARIABLE InputArrayLow : INTEGER := 0; + VARIABLE InputArrayHigh : INTEGER := 0; + VARIABLE DelayArrayIndex : INTEGER := 0; + VARIABLE NumBitsPerSubWord : INTEGER := DefaultNumBitsPerSubword; + VARIABLE NewValue : STD_ULOGIC; + VARIABLE OldValue : STD_ULOGIC; + VARIABLE OutputLength : INTEGER := 0; + VARIABLE OutArrayIndex : INTEGER; + VARIABLE PropDelay : TIME; + VARIABLE CurPropDelay : TIME; + VARIABLE InputAge : TIME; + VARIABLE CurInputAge : TIME; + VARIABLE InputChangeTimeNorm : VitalTimeArrayT( + InputChangeTimeArray'LENGTH-1 downto 0):= InputChangeTimeArray; + VARIABLE DelayArrayNorm : VitalDelayArrayType01( + PathDelayArray'LENGTH-1 downto 0):= PathDelayArray; + VARIABLE ScheduleDataArrayNorm : VitalMemoryScheduleDatavectorType + (ScheduleDataArray'LENGTH-1 downto 0):=ScheduleDataArray; + + -- for debug purpose + VARIABLE debugprop : VitalTimeArrayT(MaxNoInputBits-1 downto 0); + VARIABLE debugretain : VitalTimeArrayT(MaxNoInputBits-1 downto 0); +BEGIN + + -- for debug purpose + PrintArcType(ArcType); + + OutputLength := ScheduleDataArray'LENGTH; + FOR OutBitPos IN 0 to (OutputLength -1) LOOP + NEXT WHEN PathConditionArray(OutBitPos) = FALSE; + + NEXT WHEN ((ScheduleDataArrayNorm(OutBitPos).ScheduleValue + = ScheduleDataArrayNorm(OutBitPos).OutputData) AND + (ScheduleDataArrayNorm(OutBitPos).ScheduleTime <= NOW)); + + NewValue := ScheduleDataArrayNorm(OutBitPos).OutputData; + OldValue := ScheduleDataArrayNorm(OutBitPos).LastOutputValue; + PropDelay :=ScheduleDataArrayNorm(OutBitPos).PropDelay; + InputAge := ScheduleDataArrayNorm(OutBitPos).InputAge; + NumBitsPerSubWord:=ScheduleDataArrayNorm(OutBitPos).NumBitsPerSubWord; + + CASE ArcType IS + WHEN ParallelArc => + InputArrayLow := OutBitPos; + InputArrayHigh := OutBitPos; + DelayArrayIndex := OutBitPos; + WHEN CrossArc => + InputArrayLow := 0; + InputArrayHigh := InputChangeTimeArray'LENGTH-1; + DelayArrayIndex := OutBitPos; + WHEN SubwordArc => + InputArrayLow := OutBitPos / NumBitsPerSubWord; + InputArrayHigh := OutBitPos / NumBitsPerSubWord; + DelayArrayIndex := OutBitPos + + (OutputLength * (OutBitPos / NumBitsPerSubWord)); + END CASE; + + FOR i IN InputArrayLow TO InputArrayHigh LOOP + CurPropDelay:= VitalCalcDelay (NewValue, + OldValue, DelayArrayNorm(DelayArrayIndex)); + + -- for debug purpose + debugprop(i) := CurPropDelay; + debugretain(i) := TIME'HIGH; + + IF (ArcType = CrossArc) THEN + DelayArrayIndex := DelayArrayIndex + OutputLength; + END IF; + + -- If there is one input change at a time, then choose the + -- delay from that input. If there is simultaneous input + -- change, then choose the minimum of propagation delays + + IF (InputChangeTimeNorm(i) < 0 ns) THEN + CurInputAge := TIME'HIGH; + ELSE + CurInputAge := NOW - InputChangeTimeNorm(i); + END IF; + IF (CurInputAge < InputAge) THEN + PropDelay := CurPropDelay; + InputAge := CurInputAge; + ELSIF (CurInputAge = InputAge) THEN + IF (CurPropDelay < PropDelay) THEN + PropDelay := CurPropDelay; + END IF; + END IF; + END LOOP; + + -- Store it back to data strucutre + ScheduleDataArrayNorm(OutBitPos).PropDelay := PropDelay; + ScheduleDataArrayNorm(OutBitPos).InputAge := InputAge; + + -- for debug purpose + PrintDelay(outbitPos, InputArrayLow, InputArrayHigh, + debugprop, debugretain); + END LOOP; + + ScheduleDataArray := ScheduleDataArrayNorm; + +END VitalMemorySelectDelay; + +-- ---------------------------------------------------------------------------- +-- VitalDelayArrayType +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySelectDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + VARIABLE InputChangeTimeArray : IN VitalTimeArrayT; + CONSTANT OutputSignalName : IN STRING :=""; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType; + CONSTANT PathConditionArray : IN VitalBoolArrayT +) IS + VARIABLE InputArrayLow : INTEGER := 0; + VARIABLE InputArrayHigh : INTEGER := 0; + VARIABLE DelayArrayIndex : INTEGER := 0; + VARIABLE NumBitsPerSubWord : INTEGER := DefaultNumBitsPerSubword; + VARIABLE NewValue : STD_ULOGIC; + VARIABLE OldValue : STD_ULOGIC; + VARIABLE OutputLength : INTEGER := 0; + VARIABLE OutArrayIndex : INTEGER; + VARIABLE PropDelay : TIME; + VARIABLE CurPropDelay : TIME; + VARIABLE InputAge : TIME; + VARIABLE CurInputAge : TIME; + VARIABLE InputChangeTimeNorm : VitalTimeArrayT( + InputChangeTimeArray'LENGTH-1 downto 0) := InputChangeTimeArray; + VARIABLE DelayArrayNorm : VitalDelayArrayType( + PathDelayArray'LENGTH-1 downto 0) := PathDelayArray; + VARIABLE ScheduleDataArrayNorm : VitalMemoryScheduleDatavectorType + (ScheduleDataArray'LENGTH-1 downto 0) := ScheduleDataArray; + + -- for debug purpose + VARIABLE debugprop : VitalTimeArrayT(MaxNoInputBits-1 downto 0); + VARIABLE debugretain : VitalTimeArrayT(MaxNoInputBits-1 downto 0); +BEGIN + + -- for debug purpose + PrintArcType(ArcType); + + OutputLength := ScheduleDataArray'LENGTH; + FOR OutBitPos IN 0 to (OutputLength -1) LOOP + NEXT WHEN PathConditionArray(OutBitPos) = FALSE; + + NEXT WHEN ((ScheduleDataArrayNorm(OutBitPos).ScheduleValue + = ScheduleDataArrayNorm(OutBitPos).OutputData) AND + (ScheduleDataArrayNorm(OutBitPos).ScheduleTime <= NOW)); + + NewValue := ScheduleDataArrayNorm(OutBitPos).OutputData; + OldValue := ScheduleDataArrayNorm(OutBitPos).LastOutputValue; + PropDelay :=ScheduleDataArrayNorm(OutBitPos).PropDelay; + InputAge := ScheduleDataArrayNorm(OutBitPos).InputAge; + NumBitsPerSubWord:=ScheduleDataArrayNorm(OutBitPos).NumBitsPerSubWord; + + CASE ArcType IS + WHEN ParallelArc => + InputArrayLow := OutBitPos; + InputArrayHigh := OutBitPos; + DelayArrayIndex := OutBitPos; + WHEN CrossArc => + InputArrayLow := 0; + InputArrayHigh := InputChangeTimeArray'LENGTH-1; + DelayArrayIndex := OutBitPos; + WHEN SubwordArc => + InputArrayLow := OutBitPos / NumBitsPerSubWord; + InputArrayHigh := OutBitPos / NumBitsPerSubWord; + DelayArrayIndex := OutBitPos + + (OutputLength * (OutBitPos / NumBitsPerSubWord)); + END CASE; + + FOR i IN InputArrayLow TO InputArrayHigh LOOP + CurPropDelay := VitalCalcDelay (NewValue, + OldValue, DelayArrayNorm(DelayArrayIndex)); + + -- for debug purpose + debugprop(i) := CurPropDelay; + debugretain(i) := TIME'HIGH; + + IF (ArcType = CrossArc) THEN + DelayArrayIndex := DelayArrayIndex + OutputLength; + END IF; + + -- If there is one input change at a time, then choose the + -- delay from that input. If there is simultaneous input + -- change, then choose the minimum of propagation delays + + IF (InputChangeTimeNorm(i) < 0 ns) THEN + CurInputAge := TIME'HIGH; + ELSE + CurInputAge := NOW - InputChangeTimeNorm(i); + END IF; + + IF (CurInputAge < InputAge) THEN + PropDelay := CurPropDelay; + InputAge := CurInputAge; + ELSIF (CurInputAge = InputAge) THEN + IF (CurPropDelay < PropDelay) THEN + PropDelay := CurPropDelay; + END IF; + END IF; + END LOOP; + + -- Store it back to data strucutre + ScheduleDataArrayNorm(OutBitPos).PropDelay := PropDelay; + ScheduleDataArrayNorm(OutBitPos).InputAge := InputAge; + + -- for debug purpose + PrintDelay(outbitPos, InputArrayLow, InputArrayHigh, + debugprop, debugretain); + END LOOP; + + ScheduleDataArray := ScheduleDataArrayNorm; + +END VitalMemorySelectDelay; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemoryInitPathDelay +-- Description: To initialize Schedule Data structure for an +-- output. +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryInitPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + VARIABLE OutputDataArray : IN STD_LOGIC_VECTOR; + CONSTANT NumBitsPerSubWord : IN INTEGER := DefaultNumBitsPerSubword +) IS +BEGIN + -- Initialize the ScheduleData Structure. + FOR i IN OutputDataArray'RANGE LOOP + ScheduleDataArray(i).OutputData := OutputDataArray(i); + ScheduleDataArray(i).PropDelay := TIME'HIGH; + ScheduleDataArray(i).OutputRetainDelay := TIME'HIGH; + ScheduleDataArray(i).InputAge := TIME'HIGH; + ScheduleDataArray(i).NumBitsPerSubWord := NumBitsPerSubWord; + + -- Update LastOutputValue of Output if the Output has + -- already been scheduled. + IF ((ScheduleDataArray(i).ScheduleValue /= OutputDataArray(i)) AND + (ScheduleDataArray(i).ScheduleTime <= NOW)) THEN + ScheduleDataArray(i).LastOutputValue + := ScheduleDataArray(i).ScheduleValue; + END IF; + END LOOP; + + -- for debug purpose + DebugMsg1; + PrintScheduleDataArray(ScheduleDataArray); + +END VitalMemoryInitPathDelay; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryInitPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + VARIABLE OutputData : IN STD_ULOGIC +) IS + VARIABLE ScheduledataArray: VitalMemoryScheduleDataVectorType + (0 downto 0); + VARIABLE OutputDataArray : STD_LOGIC_VECTOR(0 downto 0); +BEGIN + ScheduledataArray(0) := ScheduleData; + OutputDataArray(0) := OutputData; + VitalMemoryInitPathDelay ( + ScheduleDataArray => ScheduleDataArray, + OutputDataArray => OutputDataArray, + NumBitsPerSubWord => DefaultNumBitsPerSubword + ); + + -- for debug purpose + DebugMsg1; + PrintScheduleDataArray( ScheduleDataArray); + +END VitalMemoryInitPathDelay; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemoryAddPathDelay +-- Description: Declare a path for one scalar/vector input to +-- the output for which Schedule Data has been +-- initialized previously. +-- ---------------------------------------------------------------------------- + +-- ---------------------------------------------------------------------------- +-- #1 +-- DelayType - VitalMemoryDelayType +-- Input - Scalar +-- Output - Scalar +-- Delay - Scalar +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelay : IN VitalDelayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +) IS + VARIABLE ScheduleDataArray : + VitalMemoryScheduleDataVectorType(0 downto 0); + VARIABLE PathDelayArray : VitalDelayArrayType(0 downto 0); + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); +BEGIN + PathConditionArray(0) := PathCondition; + ScheduleDataArray(0) := ScheduleData; + PathDelayArray(0) := PathDelay; + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #2 +-- DelayType - VitalMemoryDelayType +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +) IS + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE PathConditionArray : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + FOR i IN PathConditionArray'RANGE LOOP + PathConditionArray(i) := PathCondition; + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray + ); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #3 +-- DelayType - VitalMemoryDelayType +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Vector +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray : IN VitalBoolArrayT +) IS + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArrayNorm : + VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR Mem400 + VARIABLE PathConditionArrayExp : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + NumBitsPerSubword := + ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword; + FOR i IN PathConditionArrayExp'RANGE LOOP + PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword); + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArrayExp); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #4 +-- DelayType - VitalMemoryDelayType +-- Input - Vector +-- Output - Scalar +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +) IS + VARIABLE ScheduleDataArray : VitalMemoryScheduleDataVectorType(0 downto 0); + VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); +BEGIN + PathConditionArray(0) := PathCondition; + + ScheduleDataArray(0) := ScheduleData; + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #5 +-- DelayType - VitalMemoryDelayType +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +) IS + VARIABLE PathConditionArray : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + FOR i IN PathConditionArray'RANGE LOOP + PathConditionArray(i) := PathCondition; + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #6 +-- DelayType - VitalMemoryDelayType +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Vector +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray : IN VitalBoolArrayT +) IS + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArrayNorm : + VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR MEM400; + VARIABLE PathConditionArrayExp : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + NumBitsPerSubword := + ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword; + FOR i IN PathConditionArrayExp'RANGE LOOP + PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword); + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArrayExp); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #7 +-- DelayType - VitalMemoryDelayType01 +-- Input - Scalar +-- Output - Scalar +-- Delay - Scalar +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelay : IN VitalDelayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +) IS + VARIABLE ScheduleDataArray : + VitalMemoryScheduleDataVectorType(0 downto 0); + VARIABLE PathDelayArray : VitalDelayArrayType01(0 downto 0); + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); +BEGIN + PathConditionArray(0) := PathCondition; + ScheduleDataArray(0) := ScheduleData; + PathDelayArray(0) := PathDelay; + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #8 +-- DelayType - VitalMemoryDelayType01 +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +) IS + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE PathConditionArray : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + FOR i IN PathConditionArray'RANGE LOOP + PathConditionArray(i) := PathCondition; + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #9 +-- DelayType - VitalMemoryDelayType01 +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Vector +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray: IN VitalBoolArrayT +) IS + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArrayNorm : + VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR MEM400; + VARIABLE PathConditionArrayExp : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + NumBitsPerSubword := + ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword; + FOR i IN PathConditionArrayExp'RANGE LOOP + PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword); + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArrayExp); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #10 +-- DelayType - VitalMemoryDelayType01 +-- Input - Vector +-- Output - Scalar +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray: INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +)IS + VARIABLE ScheduleDataArray : + VitalMemoryScheduleDataVectorType(0 downto 0); + VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); +BEGIN + PathConditionArray(0) := PathCondition; + ScheduleDataArray(0) := ScheduleData; + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #11 +-- DelayType - VitalMemoryDelayType01 +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +) IS + VARIABLE PathConditionArray : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + FOR i IN PathConditionArray'RANGE LOOP + PathConditionArray(i) := PathCondition; + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #12 +-- DelayType - VitalMemoryDelayType01 +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Vector +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray : IN VitalBoolArrayT +) IS + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArrayNorm : + VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR MEM400; + VARIABLE PathConditionArrayExp : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + NumBitsPerSubword := + ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword; + FOR i IN PathConditionArrayExp'RANGE LOOP + PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword); + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArrayExp); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #13 +-- DelayType - VitalMemoryDelayType01Z +-- Input - Scalar +-- Output - Scalar +-- Delay - Scalar +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelay : IN VitalDelayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +) IS + VARIABLE ScheduleDataArray : + VitalMemoryScheduleDataVectorType(0 downto 0); + VARIABLE PathDelayArray : VitalDelayArrayType01Z(0 downto 0); + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); +BEGIN + PathConditionArray(0) := PathCondition; + ScheduleDataArray(0) := ScheduleData; + PathDelayArray(0) := PathDelay; + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #14 +-- DelayType - VitalMemoryDelayType01Z +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +) IS + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE PathConditionArray : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + FOR i IN PathConditionArray'RANGE LOOP + PathConditionArray(i) := PathCondition; + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray, OutputRetainFlag); + +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #15 +-- DelayType - VitalMemoryDelayType01Z +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Vector +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray: IN VitalBoolArrayT; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +) IS + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArrayNorm : VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0); + VARIABLE PathConditionArrayExp : VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + NumBitsPerSubword := ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword; + FOR i IN PathConditionArrayExp'RANGE LOOP + PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword); + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArrayExp, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #16 +-- DelayType - VitalMemoryDelayType01Z +-- Input - Vector +-- Output - Scalar +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +) IS + VARIABLE ScheduleDataArray : + VitalMemoryScheduleDataVectorType(0 downto 0); + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); +BEGIN + PathConditionArray(0) := PathCondition; + ScheduleDataArray(0) := ScheduleData; + NumBitsPerSubword := ScheduleDataArray(0).NumBitsPerSubword; + IF (OutputRetainBehavior = WordCorrupt AND + ArcType = ParallelArc AND + OutputRetainFlag = TRUE) THEN + VitalMemoryUpdateInputChangeTime( + InputChangeTimeArray, + InputSignal, + NumBitsPerSubword + ); + ELSE + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + END IF; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #17 +-- DelayType - VitalMemoryDelayType01Z +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +) IS + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArray : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + FOR i IN PathConditionArray'RANGE LOOP + PathConditionArray(i) := PathCondition; + END LOOP; + + NumBitsPerSubword := + ScheduleDataArray(ScheduleDataArray'LEFT).NumBitsPerSubword; + IF (OutputRetainBehavior = WordCorrupt AND + ArcType = ParallelArc AND + OutputRetainFlag = TRUE) THEN + VitalMemoryUpdateInputChangeTime( + InputChangeTimeArray, + InputSignal, + NumBitsPerSubword + ); + ELSE + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + END IF; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #18 +-- DelayType - VitalMemoryDelayType01Z +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Vector +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray : IN VitalBoolArrayT; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +) IS +VARIABLE NumBitsPerSubword : INTEGER; +VARIABLE PathConditionArrayNorm : + VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0); +VARIABLE PathConditionArrayExp : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + NumBitsPerSubword := ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword; + FOR i IN PathConditionArrayExp'RANGE LOOP + PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword); + END LOOP; + + IF (OutputRetainBehavior = WordCorrupt AND + ArcType = ParallelArc AND + OutputRetainFlag = TRUE) THEN + VitalMemoryUpdateInputChangeTime( + InputChangeTimeArray, InputSignal, + NumBitsPerSubword); + ELSE + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + END IF; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArrayExp, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #19 +-- DelayType - VitalMemoryDelayType01XZ +-- Input - Scalar +-- Output - Scalar +-- Delay - Scalar +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelay : IN VitalDelayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +) IS + VARIABLE ScheduleDataArray : + VitalMemoryScheduleDataVectorType(0 downto 0); + VARIABLE PathDelayArray : VitalDelayArrayType01ZX(0 downto 0); + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); +BEGIN + PathConditionArray(0) := PathCondition; + ScheduleDataArray(0) := ScheduleData; + PathDelayArray(0) := PathDelay; + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #20 +-- DelayType - VitalMemoryDelayType01XZ +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray :INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +) IS + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE PathConditionArray : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + FOR i IN PathConditionArray'RANGE LOOP + PathConditionArray(i) := PathCondition; + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #21 +-- DelayType - VitalMemoryDelayType01XZ +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Vector +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray :INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTime : INOUT TIME; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray: IN VitalBoolArrayT; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +) IS + VARIABLE InputChangeTimeArray : VitalTimeArrayT(0 downto 0); + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArrayNorm : + VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR MEM400; + VARIABLE PathConditionArrayExp : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + NumBitsPerSubword := + ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword; + FOR i IN PathConditionArrayExp'RANGE LOOP + PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword); + END LOOP; + + VitalMemoryUpdateInputChangeTime(InputChangeTime, InputSignal); + InputChangeTimeArray(0) := InputChangeTime; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArrayExp, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #22 +-- DelayType - VitalMemoryDelayType01XZ +-- Input - Vector +-- Output - Scalar +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +) IS + VARIABLE ScheduleDataArray : + VitalMemoryScheduleDataVectorType(0 downto 0); + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArray : VitalBoolArrayT(0 downto 0); +BEGIN + PathConditionArray(0) := PathCondition; + ScheduleDataArray(0) := ScheduleData; + NumBitsPerSubword := + ScheduleDataArray(ScheduleDataArray'LEFT).NumBitsPerSubword; + IF (OutputRetainBehavior = WordCorrupt AND + ArcType = ParallelArc AND + OutputRetainFlag = TRUE) THEN + VitalMemoryUpdateInputChangeTime( + InputChangeTimeArray, InputSignal, + NumBitsPerSubword); + ELSE + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + END IF; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #23 +-- DelayType - VitalMemoryDelayType01XZ +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +) IS + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArray : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + FOR i IN PathConditionArray'RANGE LOOP + PathConditionArray(i) := PathCondition; + END LOOP; + + NumBitsPerSubword := + ScheduleDataArray(ScheduleDataArray'LEFT).NumBitsPerSubword; + IF (OutputRetainBehavior = WordCorrupt AND + ArcType = ParallelArc AND + OutputRetainFlag = TRUE) THEN + VitalMemoryUpdateInputChangeTime( + InputChangeTimeArray, InputSignal, + NumBitsPerSubword); + ELSE + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + END IF; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArray, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- #24 +-- DelayType - VitalMemoryDelayType01XZ +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Vector +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray : IN VitalBoolArrayT; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +) IS + VARIABLE NumBitsPerSubword : INTEGER; + VARIABLE PathConditionArrayNorm : + VitalBoolArrayT(PathConditionArray'LENGTH-1 downto 0) := PathConditionArray; -- IR MEM400; + VARIABLE PathConditionArrayExp : + VitalBoolArrayT(ScheduleDataArray'LENGTH-1 downto 0); +BEGIN + NumBitsPerSubword := + ScheduleDataArray(ScheduleDataArray'RIGHT).NumBitsPerSubword; + FOR i IN PathConditionArrayExp'RANGE LOOP + PathConditionArrayExp(i) := PathConditionArrayNorm(i/NumBitsPerSubword); + END LOOP; + + IF (OutputRetainBehavior = WordCorrupt AND + ArcType = ParallelArc AND + OutputRetainFlag = TRUE) THEN + VitalMemoryUpdateInputChangeTime( + InputChangeTimeArray, InputSignal, + NumBitsPerSubword); + ELSE + VitalMemoryUpdateInputChangeTime(InputChangeTimeArray, InputSignal); + END IF; + + VitalMemorySelectDelay( + ScheduleDataArray, InputChangeTimeArray, + OutputSignalName, PathDelayArray, + ArcType, PathConditionArrayExp, OutputRetainFlag); +END VitalMemoryAddPathDelay; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemorySchedulePathDelay +-- Description: Schedule Output after Propagation Delay selected +-- by checking all the paths added thru' +-- VitalMemoryAddPathDelay. +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySchedulePathDelay ( + SIGNAL OutSignal : OUT STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + CONSTANT PortFlag : IN VitalPortFlagType := VitalDefaultPortFlag; + CONSTANT OutputMap : IN VitalOutputMapType:= VitalDefaultOutputMap; + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType +) IS + VARIABLE Age : TIME; + VARIABLE PropDelay : TIME; + VARIABLE RetainDelay : TIME; + VARIABLE Data : STD_ULOGIC; +BEGIN + IF (PortFlag.OutputDisable /= TRUE) THEN + FOR i IN ScheduleDataArray'RANGE LOOP + PropDelay := ScheduleDataArray(i).PropDelay; + RetainDelay := ScheduleDataArray(i).OutputRetainDelay; + + NEXT WHEN PropDelay = TIME'HIGH; + + Age := ScheduleDataArray(i).InputAge; + Data := ScheduleDataArray(i).OutputData; + + IF (Age < RetainDelay and RetainDelay < PropDelay) THEN + OutSignal(i) <= TRANSPORT 'X' AFTER (RetainDelay - Age); + END IF; + + IF (Age <= PropDelay) THEN + OutSignal(i)<= TRANSPORT OutputMap(Data)AFTER (PropDelay-Age); + ScheduleDataArray(i).ScheduleValue := Data; + ScheduleDataArray(i).ScheduleTime := NOW + PropDelay - Age; + END IF; + END LOOP; + END IF; + + -- for debug purpose + PrintScheduleDataArray(ScheduleDataArray); + + -- for debug purpose + ScheduleDebugMsg; +END VitalMemorySchedulePathDelay; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemorySchedulePathDelay +-- Description: Schedule Output after Propagation Delay selected +-- by checking all the paths added thru' +-- VitalMemoryAddPathDelay. +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySchedulePathDelay ( + SIGNAL OutSignal : OUT STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING :=""; + CONSTANT PortFlag : IN VitalPortFlagVectorType; + CONSTANT OutputMap : IN VitalOutputMapType:= VitalDefaultOutputMap; + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType +) IS + VARIABLE Age : TIME; + VARIABLE PropDelay : TIME; + VARIABLE RetainDelay : TIME; + VARIABLE Data : STD_ULOGIC; + VARIABLE ExpandedPortFlag : + VitalPortFlagVectorType(ScheduleDataArray'RANGE); + VARIABLE NumBitsPerSubword : INTEGER; +BEGIN + NumBitsPerSubword := + ScheduleDataArray(ScheduleDataArray'LEFT).NumBitsPerSubword; + VitalMemoryExpandPortFlag( PortFlag, NumBitsPerSubword, ExpandedPortFlag ); + FOR i IN ScheduleDataArray'RANGE LOOP + NEXT WHEN ExpandedPortFlag(i).OutputDisable = TRUE; + + PropDelay := ScheduleDataArray(i).PropDelay; + RetainDelay := ScheduleDataArray(i).OutputRetainDelay; + + NEXT WHEN PropDelay = TIME'HIGH; + + Age := ScheduleDataArray(i).InputAge; + Data := ScheduleDataArray(i).OutputData; + + IF (Age < RetainDelay and RetainDelay < PropDelay) THEN + OutSignal(i) <= TRANSPORT 'X' AFTER (RetainDelay - Age); + END IF; + + IF (Age <= PropDelay) THEN + OutSignal(i)<= TRANSPORT OutputMap(Data)AFTER (PropDelay-Age); + ScheduleDataArray(i).ScheduleValue := Data; + ScheduleDataArray(i).ScheduleTime := NOW + PropDelay - Age; + END IF; + END LOOP; + + -- for debug purpose + PrintScheduleDataArray(ScheduleDataArray); + + -- for debug purpose + ScheduleDebugMsg; +END VitalMemorySchedulePathDelay; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySchedulePathDelay ( + SIGNAL OutSignal : OUT STD_ULOGIC; + CONSTANT OutputSignalName: IN STRING :=""; + CONSTANT PortFlag : IN VitalPortFlagType := VitalDefaultPortFlag; + CONSTANT OutputMap : IN VitalOutputMapType := VitalDefaultOutputMap; + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType +) IS + VARIABLE Age : TIME; + VARIABLE PropDelay : TIME; + VARIABLE RetainDelay : TIME; + VARIABLE Data : STD_ULOGIC; + VARIABLE ScheduleDataArray : VitalMemoryScheduleDataVectorType (0 downto 0); +BEGIN + IF (PortFlag.OutputDisable /= TRUE) THEN + ScheduledataArray(0) := ScheduleData; + PropDelay := ScheduleDataArray(0).PropDelay; + RetainDelay := ScheduleDataArray(0).OutputRetainDelay; + Age := ScheduleDataArray(0).InputAge; + Data := ScheduleDataArray(0).OutputData; + + IF (Age < RetainDelay and RetainDelay < PropDelay) THEN + OutSignal <= TRANSPORT 'X' AFTER (RetainDelay - Age); + END IF; + + IF (Age <= PropDelay and PropDelay /= TIME'HIGH) THEN + OutSignal <= TRANSPORT OutputMap(Data) AFTER (PropDelay - Age); + ScheduleDataArray(0).ScheduleValue := Data; + ScheduleDataArray(0).ScheduleTime := NOW + PropDelay - Age; + END IF; + END IF; + + -- for debug purpose + PrintScheduleDataArray(ScheduleDataArray); + + -- for debug purpose + ScheduleDebugMsg; + +END VitalMemorySchedulePathDelay; + +-- ---------------------------------------------------------------------------- +-- Procedure : InternalTimingCheck +-- ---------------------------------------------------------------------------- +PROCEDURE InternalTimingCheck ( + CONSTANT TestSignal : IN std_ulogic; + CONSTANT RefSignal : IN std_ulogic; + CONSTANT TestDelay : IN TIME := 0 ns; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + VARIABLE RefTime : IN TIME; + VARIABLE RefEdge : IN BOOLEAN; + VARIABLE TestTime : IN TIME; + VARIABLE TestEvent : IN BOOLEAN; + VARIABLE SetupEn : INOUT BOOLEAN; + VARIABLE HoldEn : INOUT BOOLEAN; + VARIABLE CheckInfo : INOUT CheckInfoType; + CONSTANT MsgOn : IN BOOLEAN +) IS + VARIABLE bias : TIME; + VARIABLE actualObsTime : TIME; + VARIABLE BC : TIME; + VARIABLE Message :LINE; +BEGIN + -- Check SETUP constraint + IF (RefEdge) THEN + IF (SetupEn) THEN + CheckInfo.ObsTime := RefTime - TestTime; + CheckInfo.State := To_X01(TestSignal); + CASE CheckInfo.State IS + WHEN '0' => + CheckInfo.ExpTime := SetupLow; + -- start of new code IR245-246 + BC := HoldHigh; + -- end of new code IR245-246 + WHEN '1' => + CheckInfo.ExpTime := SetupHigh; + -- start of new code IR245-246 + BC := HoldLow; + -- end of new code IR245-246 + WHEN 'X' => + CheckInfo.ExpTime := Maximum(SetupHigh,SetupLow); + -- start of new code IR245-246 + BC := Maximum(HoldHigh,HoldLow); + -- end of new code IR245-246 + END CASE; + -- added the second condition for IR 245-246 + CheckInfo.Violation := + ((CheckInfo.ObsTime < CheckInfo.ExpTime) + AND ( NOT ((CheckInfo.ObsTime = BC) and (BC = 0 ns)))); + -- start of new code IR245-246 + IF (CheckInfo.ExpTime = 0 ns) THEN + CheckInfo.CheckKind := HoldCheck; + ELSE + CheckInfo.CheckKind := SetupCheck; + END IF; + -- end of new code IR245-246 + SetupEn := FALSE; + ELSE + CheckInfo.Violation := FALSE; + END IF; + + -- Check HOLD constraint + ELSIF (TestEvent) THEN + IF HoldEn THEN + CheckInfo.ObsTime := TestTime - RefTime; + CheckInfo.State := To_X01(TestSignal); + CASE CheckInfo.State IS + WHEN '0' => + CheckInfo.ExpTime := HoldHigh; + -- new code for unnamed IR + CheckInfo.State := '1'; + -- start of new code IR245-246 + BC := SetupLow; + -- end of new code IR245-246 + WHEN '1' => + CheckInfo.ExpTime := HoldLow; + -- new code for unnamed IR + CheckInfo.State := '0'; + -- start of new code IR245-246 + BC := SetupHigh; + -- end of new code IR245-246 + WHEN 'X' => + CheckInfo.ExpTime := Maximum(HoldHigh,HoldLow); + -- start of new code IR245-246 + BC := Maximum(SetupHigh,SetupLow); + -- end of new code IR245-246 + END CASE; + -- added the second condition for IR 245-246 + CheckInfo.Violation := + ((CheckInfo.ObsTime < CheckInfo.ExpTime) + AND ( NOT ((CheckInfo.ObsTime = BC) and (BC = 0 ns)))); + -- start of new code IR245-246 + IF (CheckInfo.ExpTime = 0 ns) THEN + CheckInfo.CheckKind := SetupCheck; + ELSE + CheckInfo.CheckKind := HoldCheck; + END IF; + -- end of new code IR245-246 + HoldEn := NOT CheckInfo.Violation; + ELSE + CheckInfo.Violation := FALSE; + END IF; + ELSE + CheckInfo.Violation := FALSE; + END IF; + + -- Adjust report values to account for internal model delays + -- Note: TestDelay, RefDelay, TestTime, RefTime are non-negative + -- Note: bias may be negative or positive + IF MsgOn AND CheckInfo.Violation THEN + -- modified the code for correct reporting of violation in case of + -- order of signals being reversed because of internal delays + -- new variable + actualObsTime := (TestTime-TestDelay)-(RefTime-RefDelay); + bias := TestDelay - RefDelay; + IF (actualObsTime < 0 ns) THEN -- It should be a setup check + IF ( CheckInfo.CheckKind = HoldCheck) THEN + CheckInfo.CheckKind := SetupCheck; + CASE CheckInfo.State IS + WHEN '0' => CheckInfo.ExpTime := SetupLow; + WHEN '1' => CheckInfo.ExpTime := SetupHigh; + WHEN 'X' => CheckInfo.ExpTime := Maximum(SetupHigh,SetupLow); + END CASE; + END IF; + CheckInfo.ObsTime := -actualObsTime; + CheckInfo.ExpTime := CheckInfo.ExpTime + bias; + CheckInfo.DetTime := RefTime - RefDelay; + ELSE -- It should be a hold check + IF (CheckInfo.CheckKind = SetupCheck) THEN + CheckInfo.CheckKind := HoldCheck; + CASE CheckInfo.State IS + WHEN '0' => + CheckInfo.ExpTime := HoldHigh; + CheckInfo.State := '1'; + WHEN '1' => + CheckInfo.ExpTime := HoldLow; + CheckInfo.State := '0'; + WHEN 'X' => + CheckInfo.ExpTime := Maximum(HoldHigh,HoldLow); + END CASE; + END IF; + CheckInfo.ObsTime := actualObsTime; + CheckInfo.ExpTime := CheckInfo.ExpTime - bias; + CheckInfo.DetTime := TestTime - TestDelay; + END IF; + END IF; +END InternalTimingCheck; + + +-- ---------------------------------------------------------------------------- +-- Setup and Hold Time Check Routine +-- ---------------------------------------------------------------------------- +PROCEDURE TimingArrayIndex ( + SIGNAL InputSignal : IN Std_logic_vector; + CONSTANT ArrayIndexNorm : IN INTEGER; + VARIABLE Index : OUT INTEGER +) IS +BEGIN + IF (InputSignal'LEFT > InputSignal'RIGHT) THEN + Index := ArrayIndexNorm + InputSignal'RIGHT; + ELSE + Index := InputSignal'RIGHT - ArrayIndexNorm; + END IF; +END TimingArrayIndex; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryReportViolation ( + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT CheckInfo : IN CheckInfoType; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +) IS + VARIABLE Message : LINE; +BEGIN + IF (NOT CheckInfo.Violation) THEN + RETURN; + END IF; + Write ( Message, HeaderMsg ); + CASE CheckInfo.CheckKind IS + WHEN SetupCheck => Write ( Message, STRING'(" SETUP ") ); + WHEN HoldCheck => Write ( Message, STRING'(" HOLD ") ); + WHEN RecoveryCheck => Write ( Message, STRING'(" RECOVERY ") ); + WHEN RemovalCheck => Write ( Message, STRING'(" REMOVAL ") ); + WHEN PulseWidCheck => Write ( Message, STRING'(" PULSE WIDTH ")); + WHEN PeriodCheck => Write ( Message, STRING'(" PERIOD ") ); + END CASE; + Write ( Message, HiLoStr(CheckInfo.State) ); + Write ( Message, STRING'(" VIOLATION ON ") ); + Write ( Message, TestSignalName ); + IF (RefSignalName'LENGTH > 0) THEN + Write ( Message, STRING'(" WITH RESPECT TO ") ); + Write ( Message, RefSignalName ); + END IF; + Write ( Message, ';' & LF ); + Write ( Message, STRING'(" Expected := ") ); + Write ( Message, CheckInfo.ExpTime); + Write ( Message, STRING'("; Observed := ") ); + Write ( Message, CheckInfo.ObsTime); + Write ( Message, STRING'("; At : ") ); + Write ( Message, CheckInfo.DetTime); + ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity; + DEALLOCATE (Message); +END VitalMemoryReportViolation; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryReportViolation ( + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT TestArrayIndex : IN INTEGER; + CONSTANT RefArrayIndex : IN INTEGER; + SIGNAL TestSignal : IN std_logic_vector; + SIGNAL RefSignal : IN std_logic_vector; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT CheckInfo : IN CheckInfoType; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +) IS + VARIABLE Message : LINE; + VARIABLE i, j : INTEGER; +BEGIN + IF (NOT CheckInfo.Violation) THEN + RETURN; + END IF; + + Write ( Message, HeaderMsg ); + CASE CheckInfo.CheckKind IS + WHEN SetupCheck => Write ( Message, STRING'(" SETUP ") ); + WHEN HoldCheck => Write ( Message, STRING'(" HOLD ") ); + WHEN PulseWidCheck => Write ( Message, STRING'(" PULSE WIDTH ")); + WHEN PeriodCheck => Write ( Message, STRING'(" PERIOD ") ); + WHEN OTHERS => Write ( Message, STRING'(" UNKNOWN ") ); + END CASE; + Write ( Message, HiLoStr(CheckInfo.State) ); + Write ( Message, STRING'(" VIOLATION ON ") ); + Write ( Message, TestSignalName ); + TimingArrayIndex(TestSignal, TestArrayIndex, i); + CASE MsgFormat IS + WHEN Scalar => + NULL; + WHEN VectorEnum => + Write ( Message, '_'); + Write ( Message, i); + WHEN Vector => + Write ( Message, '('); + Write ( Message, i); + Write ( Message, ')'); + END CASE; + + IF (RefSignalName'LENGTH > 0) THEN + Write ( Message, STRING'(" WITH RESPECT TO ") ); + Write ( Message, RefSignalName ); + END IF; + + IF(RefSignal'LENGTH > 0) THEN + TimingArrayIndex(RefSignal, RefArrayIndex, j); + CASE MsgFormat IS + WHEN Scalar => + NULL; + WHEN VectorEnum => + Write ( Message, '_'); + Write ( Message, j); + WHEN Vector => + Write ( Message, '('); + Write ( Message, j); + Write ( Message, ')'); + END CASE; + END IF; + + Write ( Message, ';' & LF ); + Write ( Message, STRING'(" Expected := ") ); + Write ( Message, CheckInfo.ExpTime); + Write ( Message, STRING'("; Observed := ") ); + Write ( Message, CheckInfo.ObsTime); + Write ( Message, STRING'("; At : ") ); + Write ( Message, CheckInfo.DetTime); + + ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity; + + DEALLOCATE (Message); +END VitalMemoryReportViolation; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryReportViolation ( + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT TestArrayIndex : IN INTEGER; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT CheckInfo : IN CheckInfoType; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +) IS + VARIABLE Message : LINE; +BEGIN + IF (NOT CheckInfo.Violation) THEN + RETURN; + END IF; + + Write ( Message, HeaderMsg ); + CASE CheckInfo.CheckKind IS + WHEN SetupCheck => Write ( Message, STRING'(" SETUP ") ); + WHEN HoldCheck => Write ( Message, STRING'(" HOLD ") ); + WHEN PulseWidCheck => Write ( Message, STRING'(" PULSE WIDTH ")); + WHEN PeriodCheck => Write ( Message, STRING'(" PERIOD ") ); + WHEN OTHERS => Write ( Message, STRING'(" UNKNOWN ") ); + END CASE; + + Write ( Message, HiLoStr(CheckInfo.State) ); + Write ( Message, STRING'(" VIOLATION ON ") ); + Write ( Message, TestSignalName ); + + CASE MsgFormat IS + WHEN Scalar => + NULL; + WHEN VectorEnum => + Write ( Message, '_'); + Write ( Message, TestArrayIndex); + WHEN Vector => + Write ( Message, '('); + Write ( Message, TestArrayIndex); + Write ( Message, ')'); + END CASE; + + IF (RefSignalName'LENGTH > 0) THEN + Write ( Message, STRING'(" WITH RESPECT TO ") ); + Write ( Message, RefSignalName ); + END IF; + + Write ( Message, ';' & LF ); + Write ( Message, STRING'(" Expected := ") ); + Write ( Message, CheckInfo.ExpTime); + Write ( Message, STRING'("; Observed := ") ); + Write ( Message, CheckInfo.ObsTime); + Write ( Message, STRING'("; At : ") ); + Write ( Message, CheckInfo.DetTime); + + ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity; + + DEALLOCATE (Message); +END VitalMemoryReportViolation; + +-- ---------------------------------------------------------------------------- +FUNCTION VitalMemoryTimingDataInit +RETURN VitalMemoryTimingDataType IS +BEGIN + RETURN (FALSE, 'X', 0 ns, FALSE, 'X', 0 ns, FALSE, + NULL, NULL, NULL, NULL, NULL, NULL); +END; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalSetupHoldCheck +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN VitalDelayType; + CONSTANT SetupLow : IN VitalDelayType; + CONSTANT HoldHigh : IN VitalDelayType; + CONSTANT HoldLow : IN VitalDelayType; + CONSTANT CheckEnabled : IN VitalBoolArrayT; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + --IR252 3/23/98 + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +) IS + VARIABLE CheckInfo : CheckInfoType; + VARIABLE CheckEnScalar : BOOLEAN := FALSE; + VARIABLE ViolationInt : X01ArrayT(CheckEnabled'RANGE); + VARIABLE RefEdge : BOOLEAN; + VARIABLE TestEvent : BOOLEAN; + VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay); + VARIABLE RefDly : TIME := Maximum(0 ns, RefDelay); + VARIABLE bias : TIME; +BEGIN + + -- Initialization of working area. + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLast := To_X01(TestSignal); + TimingData.RefLast := To_X01(RefSignal); + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal), + RefTransition); + TimingData.RefLast := To_X01(RefSignal); + IF (RefEdge) THEN + TimingData.RefTime := NOW; + --TimingData.HoldEnA.all := (TestSignal'RANGE=>TRUE); + --IR252 3/23/98 + TimingData.SetupEn := TimingData.SetupEn AND EnableSetupOnRef; + TimingData.HoldEn := EnableHoldOnRef; + END IF; + + -- Detect test (data) changes and record the time of the last change + TestEvent := TimingData.TestLast /= To_X01Z(TestSignal); + TimingData.TestLast := To_X01Z(TestSignal); + IF TestEvent THEN + TimingData.SetupEn := EnableSetupOnTest ; --IR252 3/23/98 + TimingData.HoldEn := TimingData.HoldEn AND EnableHoldOnTest ; + --IR252 3/23/98 + TimingData.TestTime := NOW; + END IF; + + FOR i IN CheckEnabled'RANGE LOOP + IF CheckEnabled(i) = TRUE THEN + CheckEnScalar := TRUE; + END IF; + ViolationInt(i) := '0'; + END LOOP; + + IF (CheckEnScalar) THEN + InternalTimingCheck ( + TestSignal => TestSignal, + RefSignal => RefSignal, + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHigh, + SetupLow => SetupLow, + HoldHigh => HoldHigh, + HoldLow => HoldLow, + RefTime => TimingData.RefTime, + RefEdge => RefEdge, + TestTime => TimingData.TestTime, + TestEvent => TestEvent, + SetupEn => TimingData.SetupEn, + HoldEn => TimingData.HoldEn, + CheckInfo => CheckInfo, + MsgOn => MsgOn + ); + + -- Report any detected violations and set return violation flag + IF CheckInfo.Violation THEN + IF (MsgOn) THEN + VitalMemoryReportViolation (TestSignalName, RefSignalName, + HeaderMsg, CheckInfo, MsgSeverity ); + END IF; + IF (XOn) THEN + FOR i IN CheckEnabled'RANGE LOOP + IF CheckEnabled(i) = TRUE THEN + ViolationInt(i) := 'X'; + END IF; + END LOOP; + END IF; + END IF; + END IF; + Violation := ViolationInt; +END VitalMemorySetupHoldCheck; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArraytype; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN VitalDelayArraytype; + CONSTANT SetupLow : IN VitalDelayArraytype; + CONSTANT HoldHigh : IN VitalDelayArraytype; + CONSTANT HoldLow : IN VitalDelayArraytype; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + --IR252 3/23/98 + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +) IS + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge : BOOLEAN; + VARIABLE TestEvent : VitalBoolArrayT(TestSignal'RANGE); + VARIABLE TestDly : TIME; + VARIABLE RefDly : TIME := Maximum(0 ns, RefDelay); + VARIABLE bias : TIME; +BEGIN + + -- Initialization of working area. + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLastA := NEW std_logic_vector(TestSignal'RANGE); + TimingData.TestTimeA := NEW VitalTimeArrayT(TestSignal'RANGE); + TimingData.HoldEnA := NEW VitalBoolArrayT(TestSignal'RANGE); + TimingData.SetupEnA := NEW VitalBoolArrayT(TestSignal'RANGE); + FOR i IN TestSignal'RANGE LOOP + TimingData.TestLastA(i) := To_X01(TestSignal(i)); + END LOOP; + TimingData.RefLast := To_X01(RefSignal); + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal), + RefTransition); + TimingData.RefLast := To_X01(RefSignal); + IF (RefEdge) THEN + TimingData.RefTime := NOW; + --TimingData.HoldEnA.all := (TestSignal'RANGE=>TRUE); + --IR252 3/23/98 + FOR i IN TestSignal'RANGE LOOP + TimingData.SetupEnA(i) + := TimingData.SetupEnA(i) AND EnableSetupOnRef; + TimingData.HoldEnA(i) := EnableHoldOnRef; + END LOOP; + END IF; + + -- Detect test (data) changes and record the time of the last change + FOR i IN TestSignal'RANGE LOOP + TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignal(i)); + TimingData.TestLastA(i) := To_X01Z(TestSignal(i)); + IF TestEvent(i) THEN + TimingData.SetupEnA(i) := EnableSetupOnTest ; --IR252 3/23/98 + TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest ; + --IR252 3/23/98 + TimingData.TestTimeA(i) := NOW; + --TimingData.SetupEnA(i) := TRUE; + TimingData.TestTime := NOW; + END IF; + END LOOP; + + FOR i IN TestSignal'RANGE LOOP + Violation(i) := '0'; + + IF (CheckEnabled) THEN + TestDly := Maximum(0 ns, TestDelay(i)); + InternalTimingCheck ( + TestSignal => TestSignal(i), + RefSignal => RefSignal, + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHigh(i), + SetupLow => SetupLow(i), + HoldHigh => HoldHigh(i), + HoldLow => HoldLow(i), + RefTime => TimingData.RefTime, + RefEdge => RefEdge, + TestTime => TimingData.TestTimeA(i), + TestEvent => TestEvent(i), + SetupEn => TimingData.SetupEnA(i), + HoldEn => TimingData.HoldEnA(i), + CheckInfo => CheckInfo, + MsgOn => MsgOn + ); + + -- Report any detected violations and set return violation flag + IF CheckInfo.Violation THEN + IF (MsgOn) THEN + VitalMemoryReportViolation (TestSignalName, RefSignalName, i , + HeaderMsg, CheckInfo, MsgFormat, MsgSeverity ); + END IF; + IF (XOn) THEN + Violation(i) := 'X'; + END IF; + END IF; + END IF; + END LOOP; + +END VitalMemorySetupHoldCheck; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArraytype; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN VitalDelayArraytype; + CONSTANT SetupLow : IN VitalDelayArraytype; + CONSTANT HoldHigh : IN VitalDelayArraytype; + CONSTANT HoldLow : IN VitalDelayArraytype; + CONSTANT CheckEnabled : IN VitalBoolArrayT; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT NumBitsPerSubWord : IN INTEGER := 1; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + --IR252 3/23/98 + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +) IS + VARIABLE CheckInfo : CheckInfoType; + VARIABLE ViolationInt : X01ArrayT(TestSignal'RANGE); + VARIABLE ViolationIntNorm: X01ArrayT(TestSignal'LENGTH-1 downto 0); + VARIABLE ViolationNorm : X01ArrayT(Violation'LENGTH-1 downto 0); + VARIABLE CheckEnInt : VitalBoolArrayT(TestSignal'RANGE); + VARIABLE CheckEnIntNorm : VitalBoolArrayT(TestSignal'LENGTH-1 downto 0); + VARIABLE CheckEnScalar : BOOLEAN := FALSE; --Mem IR 401 + VARIABLE CheckEnabledNorm: VitalBoolArrayT(CheckEnabled'LENGTH-1 downto 0); + VARIABLE RefEdge : BOOLEAN; + VARIABLE TestEvent : VitalBoolArrayT(TestSignal'RANGE); + VARIABLE TestDly : TIME; + VARIABLE RefDly : TIME := Maximum(0 ns, RefDelay); + VARIABLE bias : TIME; +BEGIN + + -- Initialization of working area. + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLastA := NEW std_logic_vector(TestSignal'RANGE); + TimingData.TestTimeA := NEW VitalTimeArrayT(TestSignal'RANGE); + TimingData.HoldEnA := NEW VitalBoolArrayT(TestSignal'RANGE); + TimingData.SetupEnA := NEW VitalBoolArrayT(TestSignal'RANGE); + FOR i IN TestSignal'RANGE LOOP + TimingData.TestLastA(i) := To_X01(TestSignal(i)); + END LOOP; + TimingData.RefLast := To_X01(RefSignal); + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal), + RefTransition); + TimingData.RefLast := To_X01(RefSignal); + IF RefEdge THEN + TimingData.RefTime := NOW; + --TimingData.HoldEnA.all := (TestSignal'RANGE=>TRUE); + --IR252 3/23/98 + FOR i IN TestSignal'RANGE LOOP + TimingData.SetupEnA(i) + := TimingData.SetupEnA(i) AND EnableSetupOnRef; + TimingData.HoldEnA(i) := EnableHoldOnRef; + END LOOP; + END IF; + + -- Detect test (data) changes and record the time of the last change + FOR i IN TestSignal'RANGE LOOP + TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignal(i)); + TimingData.TestLastA(i) := To_X01Z(TestSignal(i)); + IF TestEvent(i) THEN + TimingData.SetupEnA(i) := EnableSetupOnTest ; --IR252 3/23/98 + TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest ; + --IR252 3/23/98 + TimingData.TestTimeA(i) := NOW; + --TimingData.SetupEnA(i) := TRUE; + TimingData.TestTime := NOW; + END IF; + END LOOP; + + IF ArcType = CrossArc THEN + CheckEnScalar := FALSE; + FOR i IN CheckEnabled'RANGE LOOP + IF CheckEnabled(i) = TRUE THEN + CheckEnScalar := TRUE; + END IF; + END LOOP; + FOR i IN CheckEnInt'RANGE LOOP + CheckEnInt(i) := CheckEnScalar; + END LOOP; + ELSE + FOR i IN CheckEnIntNorm'RANGE LOOP + CheckEnIntNorm(i) := CheckEnabledNorm(i / NumBitsPerSubWord ); + END LOOP; + CheckEnInt := CheckEnIntNorm; + END IF; + + FOR i IN TestSignal'RANGE LOOP + ViolationInt(i) := '0'; + + IF (CheckEnInt(i)) THEN + TestDly := Maximum(0 ns, TestDelay(i)); + InternalTimingCheck ( + TestSignal => TestSignal(i), + RefSignal => RefSignal, + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHigh(i), + SetupLow => SetupLow(i), + HoldHigh => HoldHigh(i), + HoldLow => HoldLow(i), + RefTime => TimingData.RefTime, + RefEdge => RefEdge, + TestTime => TimingData.TestTimeA(i), + TestEvent => TestEvent(i), + SetupEn => TimingData.SetupEnA(i), + HoldEn => TimingData.HoldEnA(i), + CheckInfo => CheckInfo, + MsgOn => MsgOn + ); + + -- Report any detected violations and set return violation flag + IF CheckInfo.Violation THEN + IF (MsgOn) THEN + VitalMemoryReportViolation (TestSignalName, RefSignalName, i , + HeaderMsg, CheckInfo, MsgFormat, MsgSeverity ); + END IF; + IF (XOn) THEN + ViolationInt(i) := 'X'; + END IF; + END IF; + END IF; + END LOOP; + + IF (ViolationInt'LENGTH = Violation'LENGTH) THEN + Violation := ViolationInt; + ELSE + ViolationIntNorm := ViolationInt; + FOR i IN ViolationNorm'RANGE LOOP + ViolationNorm(i) := '0'; + END LOOP; + FOR i IN ViolationIntNorm'RANGE LOOP + IF (ViolationIntNorm(i) = 'X') THEN + ViolationNorm(i / NumBitsPerSubWord) := 'X'; + END IF; + END LOOP; + Violation := ViolationNorm; + END IF; + +END VitalMemorySetupHoldCheck; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArraytype; + SIGNAL RefSignal : IN std_logic_vector; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN VitalDelayArraytype; + CONSTANT SetupHigh : IN VitalDelayArraytype; + CONSTANT SetupLow : IN VitalDelayArraytype; + CONSTANT HoldHigh : IN VitalDelayArraytype; + CONSTANT HoldLow : IN VitalDelayArraytype; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT NumBitsPerSubWord : IN INTEGER := 1; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + --IR252 3/23/98 + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +) IS + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge : VitalBoolArrayT(RefSignal'LENGTH-1 downto 0); + VARIABLE TestEvent : VitalBoolArrayT(TestSignal'LENGTH-1 downto 0); + VARIABLE TestDly : TIME; + VARIABLE RefDly : TIME; + VARIABLE bias : TIME; + VARIABLE NumTestBits : NATURAL := TestSignal'LENGTH; + VARIABLE NumRefBits : NATURAL := RefSignal'LENGTH; + VARIABLE NumChecks : NATURAL; + + VARIABLE ViolationTest : X01ArrayT(NumTestBits-1 downto 0); + VARIABLE ViolationRef : X01ArrayT(NumRefBits-1 downto 0); + + VARIABLE TestSignalNorm : std_logic_vector(NumTestBits-1 downto 0) + := TestSignal; + VARIABLE TestDelayNorm : VitalDelayArraytype(NumTestBits-1 downto 0) + := TestDelay; + VARIABLE RefSignalNorm : std_logic_vector(NumRefBits-1 downto 0) + := RefSignal; + VARIABLE RefDelayNorm : VitalDelayArraytype(NumRefBits-1 downto 0) + := RefDelay; + VARIABLE SetupHighNorm : VitalDelayArraytype(SetupHigh'LENGTH-1 downto 0) + := SetupHigh; + VARIABLE SetupLowNorm : VitalDelayArraytype(SetupLow'LENGTH-1 downto 0) + := SetupLow; + VARIABLE HoldHighNorm : VitalDelayArraytype(HoldHigh'LENGTH-1 downto 0) + := HoldHigh; + VARIABLE HoldLowNorm : VitalDelayArraytype(HoldLow'LENGTH-1 downto 0) + := HoldLow; + + VARIABLE RefBitLow : NATURAL; + VARIABLE RefBitHigh : NATURAL; + VARIABLE EnArrayIndex : NATURAL; + VARIABLE TimingArrayIndex: NATURAL; +BEGIN + + -- Initialization of working area. + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLastA := NEW std_logic_vector(NumTestBits-1 downto 0); + TimingData.TestTimeA := NEW VitalTimeArrayT(NumTestBits-1 downto 0); + TimingData.RefTimeA := NEW VitalTimeArrayT(NumRefBits-1 downto 0); + TimingData.RefLastA := NEW X01ArrayT(NumRefBits-1 downto 0); + IF (ArcType = CrossArc) THEN + NumChecks := RefSignal'LENGTH * TestSignal'LENGTH; + ELSE + NumChecks := TestSignal'LENGTH; + END IF; + TimingData.HoldEnA := NEW VitalBoolArrayT(NumChecks-1 downto 0); + TimingData.SetupEnA := NEW VitalBoolArrayT(NumChecks-1 downto 0); + + FOR i IN TestSignalNorm'RANGE LOOP + TimingData.TestLastA(i) := To_X01(TestSignalNorm(i)); + END LOOP; + + FOR i IN RefSignalNorm'RANGE LOOP + TimingData.RefLastA(i) := To_X01(RefSignalNorm(i)); + END LOOP; + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + FOR i IN RefSignalNorm'RANGE LOOP + RefEdge(i) := EdgeSymbolMatch(TimingData.RefLastA(i), + To_X01(RefSignalNorm(i)), RefTransition); + TimingData.RefLastA(i) := To_X01(RefSignalNorm(i)); + IF (RefEdge(i)) THEN + TimingData.RefTimeA(i) := NOW; + END IF; + END LOOP; + + -- Detect test (data) changes and record the time of the last change + FOR i IN TestSignalNorm'RANGE LOOP + TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignalNorm(i)); + TimingData.TestLastA(i) := To_X01Z(TestSignalNorm(i)); + IF (TestEvent(i)) THEN + TimingData.TestTimeA(i) := NOW; + END IF; + END LOOP; + + FOR i IN ViolationTest'RANGE LOOP + ViolationTest(i) := '0'; + END LOOP; + FOR i IN ViolationRef'RANGE LOOP + ViolationRef(i) := '0'; + END LOOP; + + FOR i IN TestSignalNorm'RANGE LOOP + IF (ArcType = CrossArc) THEN + FOR j IN RefSignalNorm'RANGE LOOP + IF (TestEvent(i)) THEN + --TimingData.SetupEnA(i*NumRefBits+j) := TRUE; + --IR252 + TimingData.SetupEnA(i*NumRefBits+j) := EnableSetupOnTest; + TimingData.HoldEnA(i*NumRefBits+j) + := TimingData.HoldEnA(i*NumRefBits+j) AND EnableHoldOnTest; + END IF; + IF (RefEdge(j)) THEN + --TimingData.HoldEnA(i*NumRefBits+j) := TRUE; + --IR252 + TimingData.HoldEnA(i*NumRefBits+j) := EnableHoldOnRef; + TimingData.SetupEnA(i*NumRefBits+j) + := TimingData.SetupEnA(i*NumRefBits+j) AND EnableSetupOnRef; + END IF; + END LOOP; + RefBitLow := 0; + RefBitHigh := NumRefBits-1; + TimingArrayIndex := i; + ELSE + IF ArcType = SubwordArc THEN + RefBitLow := i / NumBitsPerSubWord; + TimingArrayIndex := i + NumTestBits * RefBitLow; + ELSE + RefBitLow := i; + TimingArrayIndex := i; + END IF; + RefBitHigh := RefBitLow; + IF TestEvent(i) THEN + --TimingData.SetupEnA(i) := TRUE; + --IR252 + TimingData.SetupEnA(i) := EnableSetupOnTest; + TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest; + END IF; + IF RefEdge(RefBitLow) THEN + --TimingData.HoldEnA(i) := TRUE; + --IR252 + TimingData.HoldEnA(i) := EnableHoldOnRef; + TimingData.SetupEnA(i) := TimingData.SetupEnA(i) AND EnableSetupOnRef; + END IF; + END IF; + + EnArrayIndex := i; + FOR j IN RefBitLow to RefBitHigh LOOP + + IF (CheckEnabled) THEN + TestDly := Maximum(0 ns, TestDelayNorm(i)); + RefDly := Maximum(0 ns, RefDelayNorm(j)); + + InternalTimingCheck ( + TestSignal => TestSignalNorm(i), + RefSignal => RefSignalNorm(j), + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHighNorm(TimingArrayIndex), + SetupLow => SetupLowNorm(TimingArrayIndex), + HoldHigh => HoldHighNorm(TimingArrayIndex), + HoldLow => HoldLowNorm(TimingArrayIndex), + RefTime => TimingData.RefTimeA(j), + RefEdge => RefEdge(j), + TestTime => TimingData.TestTimeA(i), + TestEvent => TestEvent(i), + SetupEn => TimingData.SetupEnA(EnArrayIndex), + HoldEn => TimingData.HoldEnA(EnArrayIndex), + CheckInfo => CheckInfo, + MsgOn => MsgOn + ); + + -- Report any detected violations and set return violation flag + IF (CheckInfo.Violation) THEN + IF (MsgOn) THEN + VitalMemoryReportViolation (TestSignalName, RefSignalName, i, j, + TestSignal, RefSignal, HeaderMsg, CheckInfo, + MsgFormat, MsgSeverity ); + END IF; + IF (XOn) THEN + ViolationTest(i) := 'X'; + ViolationRef(j) := 'X'; + END IF; + END IF; + END IF; + + TimingArrayIndex := TimingArrayIndex + NumRefBits; + EnArrayIndex := EnArrayIndex + NumRefBits; + + END LOOP; + END LOOP; + + IF (ArcType = CrossArc) THEN + Violation := ViolationRef; + ELSE + IF (Violation'LENGTH = ViolationRef'LENGTH) THEN + Violation := ViolationRef; + ELSE + Violation := ViolationTest; + END IF; + END IF; + +END VitalMemorySetupHoldCheck; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArraytype; + SIGNAL RefSignal : IN std_logic_vector; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN VitalDelayArraytype; + CONSTANT SetupHigh : IN VitalDelayArraytype; + CONSTANT SetupLow : IN VitalDelayArraytype; + CONSTANT HoldHigh : IN VitalDelayArraytype; + CONSTANT HoldLow : IN VitalDelayArraytype; + CONSTANT CheckEnabled : IN VitalBoolArrayT; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT NumBitsPerSubWord : IN INTEGER := 1; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + --IR252 3/23/98 + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +) IS + + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge : VitalBoolArrayT(RefSignal'LENGTH-1 downto 0); + VARIABLE TestEvent : VitalBoolArrayT(TestSignal'LENGTH-1 downto 0); + VARIABLE TestDly : TIME; + VARIABLE RefDly : TIME; + VARIABLE bias : TIME; + VARIABLE NumTestBits : NATURAL := TestSignal'LENGTH; + VARIABLE NumRefBits : NATURAL := RefSignal'LENGTH; + VARIABLE NumChecks : NATURAL; + + VARIABLE ViolationTest : X01ArrayT(NumTestBits-1 downto 0); + VARIABLE ViolationRef : X01ArrayT(NumRefBits-1 downto 0); + + VARIABLE TestSignalNorm : std_logic_vector(NumTestBits-1 downto 0) + := TestSignal; + VARIABLE TestDelayNorm : VitalDelayArraytype(NumTestBits-1 downto 0) + := TestDelay; + VARIABLE RefSignalNorm : std_logic_vector(NumRefBits-1 downto 0) + := RefSignal; + VARIABLE RefDelayNorm : VitalDelayArraytype(NumRefBits-1 downto 0) + := RefDelay; + VARIABLE CheckEnNorm : VitalBoolArrayT(NumRefBits-1 downto 0) + := CheckEnabled; + VARIABLE SetupHighNorm : VitalDelayArraytype(SetupHigh'LENGTH-1 downto 0) + := SetupHigh; + VARIABLE SetupLowNorm : VitalDelayArraytype(SetupLow'LENGTH-1 downto 0) + := SetupLow; + VARIABLE HoldHighNorm : VitalDelayArraytype(HoldHigh'LENGTH-1 downto 0) + := HoldHigh; + VARIABLE HoldLowNorm : VitalDelayArraytype(HoldLow'LENGTH-1 downto 0) + := HoldLow; + + VARIABLE RefBitLow : NATURAL; + VARIABLE RefBitHigh : NATURAL; + VARIABLE EnArrayIndex : NATURAL; + VARIABLE TimingArrayIndex: NATURAL; +BEGIN + + -- Initialization of working area. + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLastA := NEW std_logic_vector(NumTestBits-1 downto 0); + TimingData.TestTimeA := NEW VitalTimeArrayT(NumTestBits-1 downto 0); + TimingData.RefTimeA := NEW VitalTimeArrayT(NumRefBits-1 downto 0); + TimingData.RefLastA := NEW X01ArrayT(NumRefBits-1 downto 0); + IF ArcType = CrossArc THEN + NumChecks := RefSignal'LENGTH * TestSignal'LENGTH; + ELSE + NumChecks := TestSignal'LENGTH; + END IF; + TimingData.HoldEnA := NEW VitalBoolArrayT(NumChecks-1 downto 0); + TimingData.SetupEnA := NEW VitalBoolArrayT(NumChecks-1 downto 0); + + FOR i IN TestSignalNorm'RANGE LOOP + TimingData.TestLastA(i) := To_X01(TestSignalNorm(i)); + END LOOP; + + FOR i IN RefSignalNorm'RANGE LOOP + TimingData.RefLastA(i) := To_X01(RefSignalNorm(i)); + END LOOP; + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + FOR i IN RefSignalNorm'RANGE LOOP + RefEdge(i) := EdgeSymbolMatch(TimingData.RefLastA(i), + To_X01(RefSignalNorm(i)), RefTransition); + TimingData.RefLastA(i) := To_X01(RefSignalNorm(i)); + IF RefEdge(i) THEN + TimingData.RefTimeA(i) := NOW; + END IF; + END LOOP; + + -- Detect test (data) changes and record the time of the last change + FOR i IN TestSignalNorm'RANGE LOOP + TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignalNorm(i)); + TimingData.TestLastA(i) := To_X01Z(TestSignalNorm(i)); + IF TestEvent(i) THEN + TimingData.TestTimeA(i) := NOW; + END IF; + END LOOP; + + FOR i IN ViolationTest'RANGE LOOP + ViolationTest(i) := '0'; + END LOOP; + FOR i IN ViolationRef'RANGE LOOP + ViolationRef(i) := '0'; + END LOOP; + + FOR i IN TestSignalNorm'RANGE LOOP + IF (ArcType = CrossArc) THEN + FOR j IN RefSignalNorm'RANGE LOOP + IF (TestEvent(i)) THEN + --TimingData.SetupEnA(i*NumRefBits+j) := TRUE; + --IR252 + TimingData.SetupEnA(i*NumRefBits+j) := EnableSetupOnTest; + TimingData.HoldEnA(i*NumRefBits+j) + := TimingData.HoldEnA(i*NumRefBits+j) AND EnableHoldOnTest; + END IF; + IF (RefEdge(j)) THEN + --TimingData.HoldEnA(i*NumRefBits+j) := TRUE; + --IR252 + TimingData.HoldEnA(i*NumRefBits+j) := EnableHoldOnRef; + TimingData.SetupEnA(i*NumRefBits+j) + := TimingData.SetupEnA(i*NumRefBits+j) AND EnableSetupOnRef; + END IF; + END LOOP; + RefBitLow := 0; + RefBitHigh := NumRefBits-1; + TimingArrayIndex := i; + ELSE + IF (ArcType = SubwordArc) THEN + RefBitLow := i / NumBitsPerSubWord; + TimingArrayIndex := i + NumTestBits * RefBitLow; + ELSE + RefBitLow := i; + TimingArrayIndex := i; + END IF; + RefBitHigh := RefBitLow; + IF (TestEvent(i)) THEN + --TimingData.SetupEnA(i) := TRUE; + --IR252 + TimingData.SetupEnA(i) := EnableSetupOnTest; + TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest; + END IF; + IF (RefEdge(RefBitLow)) THEN + --TimingData.HoldEnA(i) := TRUE; + --IR252 + TimingData.HoldEnA(i) := EnableHoldOnRef; + TimingData.SetupEnA(i) := TimingData.SetupEnA(i) AND EnableSetupOnRef; + END IF; + END IF; + + EnArrayIndex := i; + FOR j IN RefBitLow to RefBitHigh LOOP + IF (CheckEnNorm(j)) THEN + TestDly := Maximum(0 ns, TestDelayNorm(i)); + RefDly := Maximum(0 ns, RefDelayNorm(j)); + + InternalTimingCheck ( + TestSignal => TestSignalNorm(i), + RefSignal => RefSignalNorm(j), + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHighNorm(TimingArrayIndex), + SetupLow => SetupLowNorm(TimingArrayIndex), + HoldHigh => HoldHighNorm(TimingArrayIndex), + HoldLow => HoldLowNorm(TimingArrayIndex), + RefTime => TimingData.RefTimeA(j), + RefEdge => RefEdge(j), + TestTime => TimingData.TestTimeA(i), + TestEvent => TestEvent(i), + SetupEn => TimingData.SetupEnA(EnArrayIndex), + HoldEn => TimingData.HoldEnA(EnArrayIndex), + CheckInfo => CheckInfo, + MsgOn => MsgOn + ); + + -- Report any detected violations and set return violation flag + IF (CheckInfo.Violation) THEN + IF (MsgOn) THEN + VitalMemoryReportViolation (TestSignalName, RefSignalName, i, j, + TestSignal, RefSignal, HeaderMsg, CheckInfo, + MsgFormat, MsgSeverity ); + END IF; + + IF (XOn) THEN + ViolationTest(i) := 'X'; + ViolationRef(j) := 'X'; + END IF; + END IF; + END IF; + + TimingArrayIndex := TimingArrayIndex + NumRefBits; + EnArrayIndex := EnArrayIndex + NumRefBits; + END LOOP; + END LOOP; + + IF (ArcType = CrossArc) THEN + Violation := ViolationRef; + ELSE + IF (Violation'LENGTH = ViolationRef'LENGTH) THEN + Violation := ViolationRef; + ELSE + Violation := ViolationTest; + END IF; + END IF; + +END VitalMemorySetupHoldCheck; + +-- ---------------------------------------------------------------------------- +-- scalar violations not needed +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArraytype; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN VitalDelayArraytype; + CONSTANT SetupLow : IN VitalDelayArraytype; + CONSTANT HoldHigh : IN VitalDelayArraytype; + CONSTANT HoldLow : IN VitalDelayArraytype; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + --IR252 3/23/98 + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +) IS + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge : BOOLEAN; + VARIABLE TestEvent : VitalBoolArrayT(TestSignal'RANGE); + VARIABLE TestDly : TIME; + VARIABLE RefDly : TIME := Maximum(0 ns, RefDelay); + VARIABLE bias : TIME; + +BEGIN + + -- Initialization of working area. + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLastA := NEW std_logic_vector(TestSignal'RANGE); + TimingData.TestTimeA := NEW VitalTimeArrayT(TestSignal'RANGE); + TimingData.HoldEnA := NEW VitalBoolArrayT(TestSignal'RANGE); + TimingData.SetupEnA := NEW VitalBoolArrayT(TestSignal'RANGE); + FOR i IN TestSignal'RANGE LOOP + TimingData.TestLastA(i) := To_X01(TestSignal(i)); + END LOOP; + TimingData.RefLast := To_X01(RefSignal); + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal), + RefTransition); + TimingData.RefLast := To_X01(RefSignal); + IF (RefEdge) THEN + TimingData.RefTime := NOW; + --TimingData.HoldEnA.all := (TestSignal'RANGE=>TRUE); + --IR252 3/23/98 + FOR i IN TestSignal'RANGE LOOP + TimingData.SetupEnA(i) + := TimingData.SetupEnA(i) AND EnableSetupOnRef; + TimingData.HoldEnA(i) := EnableHoldOnRef; + END LOOP; + END IF; + + -- Detect test (data) changes and record the time of the last change + FOR i IN TestSignal'RANGE LOOP + TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignal(i)); + TimingData.TestLastA(i) := To_X01Z(TestSignal(i)); + IF TestEvent(i) THEN + TimingData.SetupEnA(i) := EnableSetupOnTest ; --IR252 3/23/98 + TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest ; + --IR252 3/23/98 + TimingData.TestTimeA(i) := NOW; + --TimingData.SetupEnA(i) := TRUE; + TimingData.TestTime := NOW; + END IF; + END LOOP; + + Violation := '0'; + FOR i IN TestSignal'RANGE LOOP + IF (CheckEnabled) THEN + TestDly := Maximum(0 ns, TestDelay(i)); + InternalTimingCheck ( + TestSignal => TestSignal(i), + RefSignal => RefSignal, + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHigh(i), + SetupLow => SetupLow(i), + HoldHigh => HoldHigh(i), + HoldLow => HoldLow(i), + RefTime => TimingData.RefTime, + RefEdge => RefEdge, + TestTime => TimingData.TestTimeA(i), + TestEvent => TestEvent(i), + SetupEn => TimingData.SetupEnA(i), + HoldEn => TimingData.HoldEnA(i), + CheckInfo => CheckInfo, + MsgOn => MsgOn + ); + + -- Report any detected violations and set return violation flag + IF CheckInfo.Violation THEN + IF (MsgOn) THEN + VitalMemoryReportViolation (TestSignalName, RefSignalName, i , + HeaderMsg, CheckInfo, MsgFormat, MsgSeverity ); + END IF; + IF (XOn) THEN + Violation := 'X'; + END IF; + END IF; + END IF; + END LOOP; + +END VitalMemorySetupHoldCheck; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArraytype; + SIGNAL RefSignal : IN std_logic_vector; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN VitalDelayArraytype; + CONSTANT SetupHigh : IN VitalDelayArraytype; + CONSTANT SetupLow : IN VitalDelayArraytype; + CONSTANT HoldHigh : IN VitalDelayArraytype; + CONSTANT HoldLow : IN VitalDelayArraytype; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT NumBitsPerSubWord : IN INTEGER := 1; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + --IR252 3/23/98 + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +) IS + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge : VitalBoolArrayT(RefSignal'LENGTH-1 downto 0); + VARIABLE TestEvent : VitalBoolArrayT(TestSignal'LENGTH-1 downto 0); + VARIABLE TestDly : TIME; + VARIABLE RefDly : TIME; + VARIABLE bias : TIME; + VARIABLE NumTestBits : NATURAL := TestSignal'LENGTH; + VARIABLE NumRefBits : NATURAL := RefSignal'LENGTH; + VARIABLE NumChecks : NATURAL; + + VARIABLE TestSignalNorm : std_logic_vector(NumTestBits-1 downto 0) + := TestSignal; + VARIABLE TestDelayNorm : VitalDelayArraytype(NumTestBits-1 downto 0) + := TestDelay; + VARIABLE RefSignalNorm : std_logic_vector(NumRefBits-1 downto 0) + := RefSignal; + VARIABLE RefDelayNorm : VitalDelayArraytype(NumRefBits-1 downto 0) + := RefDelay; + VARIABLE SetupHighNorm : VitalDelayArraytype(SetupHigh'LENGTH-1 downto 0) + := SetupHigh; + VARIABLE SetupLowNorm : VitalDelayArraytype(SetupLow'LENGTH-1 downto 0) + := SetupLow; + VARIABLE HoldHighNorm : VitalDelayArraytype(HoldHigh'LENGTH-1 downto 0) + := HoldHigh; + VARIABLE HoldLowNorm : VitalDelayArraytype(HoldLow'LENGTH-1 downto 0) + := HoldLow; + + VARIABLE RefBitLow : NATURAL; + VARIABLE RefBitHigh : NATURAL; + VARIABLE EnArrayIndex : NATURAL; + VARIABLE TimingArrayIndex: NATURAL; +BEGIN + + -- Initialization of working area. + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLastA := NEW std_logic_vector(NumTestBits-1 downto 0); + TimingData.TestTimeA := NEW VitalTimeArrayT(NumTestBits-1 downto 0); + TimingData.RefTimeA := NEW VitalTimeArrayT(NumRefBits-1 downto 0); + TimingData.RefLastA := NEW X01ArrayT(NumRefBits-1 downto 0); + IF (ArcType = CrossArc) THEN + NumChecks := RefSignal'LENGTH * TestSignal'LENGTH; + ELSE + NumChecks := TestSignal'LENGTH; + END IF; + TimingData.HoldEnA := NEW VitalBoolArrayT(NumChecks-1 downto 0); + TimingData.SetupEnA := NEW VitalBoolArrayT(NumChecks-1 downto 0); + + FOR i IN TestSignalNorm'RANGE LOOP + TimingData.TestLastA(i) := To_X01(TestSignalNorm(i)); + END LOOP; + + FOR i IN RefSignalNorm'RANGE LOOP + TimingData.RefLastA(i) := To_X01(RefSignalNorm(i)); + END LOOP; + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + FOR i IN RefSignalNorm'RANGE LOOP + RefEdge(i) := EdgeSymbolMatch(TimingData.RefLastA(i), + To_X01(RefSignalNorm(i)), RefTransition); + TimingData.RefLastA(i) := To_X01(RefSignalNorm(i)); + IF (RefEdge(i)) THEN + TimingData.RefTimeA(i) := NOW; + END IF; + END LOOP; + + -- Detect test (data) changes and record the time of the last change + FOR i IN TestSignalNorm'RANGE LOOP + TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignalNorm(i)); + TimingData.TestLastA(i) := To_X01Z(TestSignalNorm(i)); + IF (TestEvent(i)) THEN + TimingData.TestTimeA(i) := NOW; + END IF; + END LOOP; + + FOR i IN TestSignalNorm'RANGE LOOP + IF (ArcType = CrossArc) THEN + FOR j IN RefSignalNorm'RANGE LOOP + IF (TestEvent(i)) THEN + --TimingData.SetupEnA(i*NumRefBits+j) := TRUE; + --IR252 + TimingData.SetupEnA(i*NumRefBits+j) := EnableSetupOnTest; + TimingData.HoldEnA(i*NumRefBits+j) + := TimingData.HoldEnA(i*NumRefBits+j) AND EnableHoldOnTest; + END IF; + IF (RefEdge(j)) THEN + --TimingData.HoldEnA(i*NumRefBits+j) := TRUE; + --IR252 + TimingData.HoldEnA(i*NumRefBits+j) := EnableHoldOnRef; + TimingData.SetupEnA(i*NumRefBits+j) + := TimingData.SetupEnA(i*NumRefBits+j) AND EnableSetupOnRef; + END IF; + END LOOP; + RefBitLow := 0; + RefBitHigh := NumRefBits-1; + TimingArrayIndex := i; + ELSE + IF (ArcType = SubwordArc) THEN + RefBitLow := i / NumBitsPerSubWord; + TimingArrayIndex := i + NumTestBits * RefBitLow; + ELSE + RefBitLow := i; + TimingArrayIndex := i; + END IF; + RefBitHigh := RefBitLow; + IF (TestEvent(i)) THEN + --TimingData.SetupEnA(i) := TRUE; + --IR252 + TimingData.SetupEnA(i) := EnableSetupOnTest; + TimingData.HoldEnA(i) := TimingData.HoldEnA(i) AND EnableHoldOnTest; + END IF; + IF (RefEdge(RefBitLow)) THEN + --TimingData.HoldEnA(i) := TRUE; + --IR252 + TimingData.HoldEnA(i) := EnableHoldOnRef; + TimingData.SetupEnA(i) := TimingData.SetupEnA(i) AND EnableSetupOnRef; + END IF; + END IF; + + EnArrayIndex := i; + Violation := '0'; + FOR j IN RefBitLow to RefBitHigh LOOP + + IF (CheckEnabled) THEN + TestDly := Maximum(0 ns, TestDelayNorm(i)); + RefDly := Maximum(0 ns, RefDelayNorm(j)); + + InternalTimingCheck ( + TestSignal => TestSignalNorm(i), + RefSignal => RefSignalNorm(j), + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHighNorm(TimingArrayIndex), + SetupLow => SetupLowNorm(TimingArrayIndex), + HoldHigh => HoldHighNorm(TimingArrayIndex), + HoldLow => HoldLowNorm(TimingArrayIndex), + RefTime => TimingData.RefTimeA(j), + RefEdge => RefEdge(j), + TestTime => TimingData.TestTimeA(i), + TestEvent => TestEvent(i), + SetupEn => TimingData.SetupEnA(EnArrayIndex), + HoldEn => TimingData.HoldEnA(EnArrayIndex), + CheckInfo => CheckInfo, + MsgOn => MsgOn + ); + + -- Report any detected violations and set return violation flag + IF (CheckInfo.Violation) THEN + IF (MsgOn) THEN + VitalMemoryReportViolation (TestSignalName, RefSignalName, i, j, + TestSignal, RefSignal, HeaderMsg, CheckInfo, + MsgFormat, MsgSeverity ); + END IF; + + IF (XOn) THEN + Violation := 'X'; + END IF; + END IF; + END IF; + + TimingArrayIndex := TimingArrayIndex + NumRefBits; + EnArrayIndex := EnArrayIndex + NumRefBits; + + END LOOP; + END LOOP; + +END VitalMemorySetupHoldCheck; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryPeriodPulseCheck ( + VARIABLE Violation : OUT X01; + VARIABLE PeriodData : INOUT VitalPeriodDataArrayType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArraytype; + CONSTANT Period : IN VitalDelayArraytype; + CONSTANT PulseWidthHigh : IN VitalDelayArraytype; + CONSTANT PulseWidthLow : IN VitalDelayArraytype; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType +) IS + VARIABLE TestDly : VitalDelayType; + VARIABLE CheckInfo : CheckInfoType; + VARIABLE PeriodObs : VitalDelayType; + VARIABLE PulseTest : BOOLEAN; + VARIABLE PeriodTest: BOOLEAN; + VARIABLE TestValue : X01; +BEGIN + + -- Initialize for no violation + Violation := '0'; --MEM IR 402 + + FOR i IN TestSignal'RANGE LOOP + TestDly := Maximum(0 ns, TestDelay(i)); + TestValue := To_X01(TestSignal(i)); + + IF (PeriodData(i).NotFirstFlag = FALSE) THEN + PeriodData(i).Rise := -Maximum(Period(i), + Maximum(PulseWidthHigh(i),PulseWidthLow(i))); + PeriodData(i).Fall := -Maximum(Period(i), + Maximum(PulseWidthHigh(i),PulseWidthLow(i))); + PeriodData(i).Last := TestValue; + PeriodData(i).NotFirstFlag := TRUE; + END IF; + + -- Initialize for no violation + -- Violation := '0'; --Mem IR 402 + + -- No violation possible if no test signal change + NEXT WHEN (PeriodData(i).Last = TestValue); + + -- record starting pulse times + IF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'P')) THEN + -- Compute period times, then record the High Rise Time + PeriodObs := NOW - PeriodData(i).Rise; + PeriodData(i).Rise := NOW; + PeriodTest := TRUE; + ELSIF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'N')) THEN + -- Compute period times, then record the Low Fall Time + PeriodObs := NOW - PeriodData(i).Fall; + PeriodData(i).Fall := NOW; + PeriodTest := TRUE; + ELSE + PeriodTest := FALSE; + END IF; + + -- do checks on pulse ends + IF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'p')) THEN + -- Compute pulse times + CheckInfo.ObsTime := NOW - PeriodData(i).Fall; + CheckInfo.ExpTime := PulseWidthLow(i); + PulseTest := TRUE; + ELSIF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'n')) THEN + -- Compute pulse times + CheckInfo.ObsTime := NOW - PeriodData(i).Rise; + CheckInfo.ExpTime := PulseWidthHigh(i); + PulseTest := TRUE; + ELSE + PulseTest := FALSE; + END IF; + + IF (PulseTest AND CheckEnabled) THEN + -- Verify Pulse Width [ignore 1st edge] + IF (CheckInfo.ObsTime < CheckInfo.ExpTime) THEN + IF (XOn) THEN + Violation := 'X'; + END IF; + IF (MsgOn) THEN + CheckInfo.Violation := TRUE; + CheckInfo.CheckKind := PulseWidCheck; + CheckInfo.DetTime := NOW - TestDly; + CheckInfo.State := PeriodData(i).Last; + VitalMemoryReportViolation (TestSignalName, "", i, + HeaderMsg, CheckInfo, MsgFormat, MsgSeverity ); + END IF; -- MsgOn + END IF; + END IF; + + IF (PeriodTest AND CheckEnabled) THEN + -- Verify the Period [ignore 1st edge] + CheckInfo.ObsTime := PeriodObs; + CheckInfo.ExpTime := Period(i); + IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN + IF (XOn) THEN + Violation := 'X'; + END IF; + IF (MsgOn) THEN + CheckInfo.Violation := TRUE; + CheckInfo.CheckKind := PeriodCheck; + CheckInfo.DetTime := NOW - TestDly; + CheckInfo.State := TestValue; + VitalMemoryReportViolation (TestSignalName, "", i, + HeaderMsg, CheckInfo, MsgFormat, MsgSeverity ); + END IF; -- MsgOn + END IF; + END IF; + + PeriodData(i).Last := TestValue; + END LOOP; + +END VitalMemoryPeriodPulseCheck; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryPeriodPulseCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE PeriodData : INOUT VitalPeriodDataArrayType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArraytype; + CONSTANT Period : IN VitalDelayArraytype; + CONSTANT PulseWidthHigh : IN VitalDelayArraytype; + CONSTANT PulseWidthLow : IN VitalDelayArraytype; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType +)IS + VARIABLE TestDly : VitalDelayType; + VARIABLE CheckInfo : CheckInfoType; + VARIABLE PeriodObs : VitalDelayType; + VARIABLE PulseTest : BOOLEAN; + VARIABLE PeriodTest: BOOLEAN; + VARIABLE TestValue : X01; +BEGIN + + FOR i IN TestSignal'RANGE LOOP + TestDly := Maximum(0 ns, TestDelay(i)); + TestValue := To_X01(TestSignal(i)); + + IF (PeriodData(i).NotFirstFlag = FALSE) THEN + PeriodData(i).Rise := -Maximum(Period(i), + Maximum(PulseWidthHigh(i),PulseWidthLow(i))); + PeriodData(i).Fall := -Maximum(Period(i), + Maximum(PulseWidthHigh(i),PulseWidthLow(i))); + PeriodData(i).Last := TestValue; + PeriodData(i).NotFirstFlag := TRUE; + END IF; + + -- Initialize for no violation + Violation(i) := '0'; + + -- No violation possible if no test signal change + NEXT WHEN (PeriodData(i).Last = TestValue); + + -- record starting pulse times + IF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'P')) THEN + -- Compute period times, then record the High Rise Time + PeriodObs := NOW - PeriodData(i).Rise; + PeriodData(i).Rise := NOW; + PeriodTest := TRUE; + ELSIF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'N')) THEN + -- Compute period times, then record the Low Fall Time + PeriodObs := NOW - PeriodData(i).Fall; + PeriodData(i).Fall := NOW; + PeriodTest := TRUE; + ELSE + PeriodTest := FALSE; + END IF; + + -- do checks on pulse ends + IF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'p')) THEN + -- Compute pulse times + CheckInfo.ObsTime := NOW - PeriodData(i).Fall; + CheckInfo.ExpTime := PulseWidthLow(i); + PulseTest := TRUE; + ELSIF (EdgeSymbolMatch(PeriodData(i).Last, TestValue, 'n')) THEN + -- Compute pulse times + CheckInfo.ObsTime := NOW - PeriodData(i).Rise; + CheckInfo.ExpTime := PulseWidthHigh(i); + PulseTest := TRUE; + ELSE + PulseTest := FALSE; + END IF; + + IF (PulseTest AND CheckEnabled) THEN + -- Verify Pulse Width [ignore 1st edge] + IF (CheckInfo.ObsTime < CheckInfo.ExpTime) THEN + IF (XOn) THEN + Violation(i) := 'X'; + END IF; + IF (MsgOn) THEN + CheckInfo.Violation := TRUE; + CheckInfo.CheckKind := PulseWidCheck; + CheckInfo.DetTime := NOW - TestDly; + CheckInfo.State := PeriodData(i).Last; + VitalMemoryReportViolation (TestSignalName, "", i, + HeaderMsg, CheckInfo, MsgFormat, MsgSeverity ); + END IF; -- MsgOn + END IF; + END IF; + + IF (PeriodTest AND CheckEnabled) THEN + -- Verify the Period [ignore 1st edge] + CheckInfo.ObsTime := PeriodObs; + CheckInfo.ExpTime := Period(i); + IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN + IF (XOn) THEN + Violation(i) := 'X'; + END IF; + IF (MsgOn) THEN + CheckInfo.Violation := TRUE; + CheckInfo.CheckKind := PeriodCheck; + CheckInfo.DetTime := NOW - TestDly; + CheckInfo.State := TestValue; + VitalMemoryReportViolation (TestSignalName, "", i, + HeaderMsg, CheckInfo, MsgFOrmat, MsgSeverity ); + END IF; -- MsgOn + END IF; + END IF; + + PeriodData(i).Last := TestValue; + END LOOP; + +END VitalMemoryPeriodPulseCheck; + +-- ---------------------------------------------------------------------------- +-- Functionality Section +-- ---------------------------------------------------------------------------- + +-- Look-up table. Given an int, we can get the 4-bit bit_vector. +TYPE HexToBitvTableType IS ARRAY (NATURAL RANGE <>) OF + std_logic_vector(3 DOWNTO 0) ; + +CONSTANT HexToBitvTable : HexToBitvTableType (0 TO 15) := + ( + "0000", "0001", "0010", "0011", + "0100", "0101", "0110", "0111", + "1000", "1001", "1010", "1011", + "1100", "1101", "1110", "1111" + ) ; + +-- ---------------------------------------------------------------------------- +-- Misc Utilities Local Utilities +-- ---------------------------------------------------------------------------- + +-- ---------------------------------------------------------------------------- +-- Procedure: IsSpace +-- Parameters: ch -- input character +-- Description: Returns TRUE or FALSE depending on the input character +-- being white space or not. +-- ---------------------------------------------------------------------------- +FUNCTION IsSpace (ch : character) +RETURN boolean IS +BEGIN + RETURN ((ch = ' ') OR (ch = CR) OR (ch = HT) OR (ch = NUL)); +END IsSpace; + +-- ---------------------------------------------------------------------------- +-- Procedure: LenOfString +-- Parameters: Str -- input string +-- Description: Returns the NATURAL length of the input string. +-- as terminated by the first NUL character. +-- ---------------------------------------------------------------------------- +FUNCTION LenOfString (Str : STRING) +RETURN NATURAL IS + VARIABLE StrRight : NATURAL; +BEGIN + StrRight := Str'RIGHT; + FOR i IN Str'RANGE LOOP + IF (Str(i) = NUL) THEN + StrRight := i - 1; + EXIT; + END IF; + END LOOP; + RETURN (StrRight); +END LenOfString; + +-- ---------------------------------------------------------------------------- +-- Procedure: HexToInt +-- Parameters: Hex -- input character or string +-- Description: Converts input character or string interpreted as a +-- hexadecimal representation to integer value. +-- ---------------------------------------------------------------------------- +FUNCTION HexToInt(Hex : CHARACTER) RETURN INTEGER IS + CONSTANT HexChars : STRING := "0123456789ABCDEFabcdef"; + CONSTANT XHiChar : CHARACTER := 'X'; + CONSTANT XLoChar : CHARACTER := 'x'; +BEGIN + IF (Hex = XLoChar OR Hex = XHiChar) THEN + RETURN (23); + END IF; + FOR i IN 1 TO 16 LOOP + IF(Hex = HexChars(i)) THEN + RETURN (i-1); + END IF; + END LOOP; + FOR i IN 17 TO 22 LOOP + IF (Hex = HexChars(i)) THEN + RETURN (i-7); + END IF; + END LOOP; + ASSERT FALSE REPORT + "Invalid character received by HexToInt function" + SEVERITY WARNING; + RETURN (0); +END HexToInt; + +-- ---------------------------------------------------------------------------- +FUNCTION HexToInt (Hex : STRING) RETURN INTEGER IS + VARIABLE Value : INTEGER := 0; + VARIABLE Length : INTEGER; +BEGIN + Length := LenOfString(hex); + IF (Length > 8) THEN + ASSERT FALSE REPORT + "Invalid string length received by HexToInt function" + SEVERITY WARNING; + ELSE + FOR i IN 1 TO Length LOOP + Value := Value + HexToInt(Hex(i)) * 16 ** (Length - i); + END LOOP; + END IF; + RETURN (Value); +END HexToInt; + +-- ---------------------------------------------------------------------------- +-- Procedure: HexToBitv +-- Parameters: Hex -- Input hex string +-- Description: Converts input hex string to a std_logic_vector +-- ---------------------------------------------------------------------------- +FUNCTION HexToBitv( + Hex : STRING +) RETURN std_logic_vector is + VARIABLE Index : INTEGER := 0 ; + VARIABLE ValHexToInt : INTEGER ; + VARIABLE BitsPerHex : INTEGER := 4 ; -- Denotes no. of bits per hex char. + VARIABLE HexLen : NATURAL := (BitsPerHex * LenOfString(Hex)) ; + VARIABLE TableVal : std_logic_vector(3 DOWNTO 0) ; + VARIABLE Result : std_logic_vector(HexLen-1 DOWNTO 0) ; +BEGIN + -- Assign 4-bit wide bit vector to result directly from a look-up table. + Index := 0 ; + WHILE ( Index < HexLen ) LOOP + ValHexToInt := HexToInt( Hex((HexLen - Index)/BitsPerHex ) ); + IF ( ValHexToInt = 23 ) THEN + TableVal := "XXXX"; + ELSE + -- Look up from the table. + TableVal := HexToBitvTable( ValHexToInt ) ; + END IF; + -- Assign now. + Result(Index+3 DOWNTO Index) := TableVal ; + -- Get ready for next block of 4-bits. + Index := Index + 4 ; + END LOOP ; + RETURN Result ; +END HexToBitv ; + +-- ---------------------------------------------------------------------------- +-- Procedure: BinToBitv +-- Parameters: Bin -- Input bin string +-- Description: Converts input bin string to a std_logic_vector +-- ---------------------------------------------------------------------------- +FUNCTION BinToBitv( + Bin : STRING +) RETURN std_logic_vector is + VARIABLE Index : INTEGER := 0 ; + VARIABLE Length : NATURAL := LenOfString(Bin); + VARIABLE BitVal : std_ulogic; + VARIABLE Result : std_logic_vector(Length-1 DOWNTO 0) ; +BEGIN + Index := 0 ; + WHILE ( Index < Length ) LOOP + IF (Bin(Length-Index) = '0') THEN + BitVal := '0'; + ELSIF (Bin(Length-Index) = '1') THEN + BitVal := '1'; + ELSE + BitVal := 'X'; + END IF ; + -- Assign now. + Result(Index) := BitVal ; + Index := Index + 1 ; + END LOOP ; + RETURN Result ; +END BinToBitv ; + +-- ---------------------------------------------------------------------------- +-- For Memory Table Modeling +-- ---------------------------------------------------------------------------- + +TYPE To_MemoryCharType IS ARRAY (VitalMemorySymbolType) OF CHARACTER; +CONSTANT To_MemoryChar : To_MemoryCharType := + ( '/', '\', 'P', 'N', 'r', 'f', 'p', 'n', 'R', 'F', '^', 'v', + 'E', 'A', 'D', '*', 'X', '0', '1', '-', 'B', 'Z', 'S', + 'g', 'u', 'i', 'G', 'U', 'I', + 'w', 's', + 'c', 'l', 'd', 'e', 'C', 'L', + 'M', 'm', 't' ); + +TYPE ValidMemoryTableInputType IS ARRAY (VitalMemorySymbolType) OF BOOLEAN; +CONSTANT ValidMemoryTableInput : ValidMemoryTableInputType := + -- '/', '\', 'P', 'N', 'r', 'f', + ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, + -- 'p', 'n', 'R', 'F', '^', 'v', + TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, + -- 'E', 'A', 'D', '*', + TRUE, TRUE, TRUE, TRUE, + -- 'X', '0', '1', '-', 'B', 'Z', + TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, + -- 'S', + TRUE, + -- 'g', 'u', 'i', 'G', 'U', 'I', + FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + -- 'w', 's', + FALSE, FALSE, + -- 'c', 'l', 'd', 'e', 'C', 'L', + FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + -- 'M', 'm', 't' + FALSE, FALSE, FALSE); + +TYPE MemoryTableMatchType IS ARRAY (X01,X01,VitalMemorySymbolType) OF BOOLEAN; +-- last value, present value, table symbol +CONSTANT MemoryTableMatch : MemoryTableMatchType := ( + ( -- X (lastvalue) + -- / \ P N r f + -- p n R F ^ v + -- E A D * + -- X 0 1 - B Z S + -- g u i G U I + -- w s + -- c l d e, C L + -- m t + ( FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE, + TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE), + ( FALSE,FALSE,FALSE,TRUE, FALSE,FALSE, + FALSE,FALSE,FALSE,TRUE, FALSE,TRUE, + TRUE, FALSE,TRUE, TRUE, + FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE), + ( FALSE,FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,FALSE,TRUE, FALSE,TRUE, FALSE, + TRUE, TRUE, FALSE,TRUE, + FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE) + ), + + (-- 0 (lastvalue) + -- / \ P N r f + -- p n R F ^ v + -- E A D * + -- X 0 1 - B Z S + -- g u i G U I + -- w s + -- c l d e, C L + -- m t + ( FALSE,FALSE,FALSE,FALSE,TRUE, FALSE, + TRUE, FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,TRUE, FALSE,TRUE, + TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE), + ( FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE, + FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,TRUE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE), + ( TRUE, FALSE,TRUE, FALSE,FALSE,FALSE, + TRUE, FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,TRUE, + FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE) + ), + + (-- 1 (lastvalue) + -- / \ P N r f + -- p n R F ^ v + -- E A D * + -- X 0 1 - B Z S + -- g u i G U I + -- w s + -- c l d e, C L + -- m t + ( FALSE,FALSE,FALSE,FALSE,FALSE,TRUE , + FALSE,TRUE, FALSE,TRUE, FALSE,FALSE, + FALSE,FALSE,TRUE, TRUE, + TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE), + ( FALSE,TRUE, FALSE,TRUE, FALSE,FALSE, + FALSE,TRUE, FALSE,TRUE, FALSE,FALSE, + FALSE,FALSE,FALSE,TRUE, + FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE), + ( FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,TRUE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE) + ) + ); + + +-- ---------------------------------------------------------------------------- +-- Error Message Types and Tables +-- ---------------------------------------------------------------------------- + +TYPE VitalMemoryErrorType IS ( + ErrGoodAddr, -- 'g' Good address (no transition) + ErrUnknAddr, -- 'u' 'X' levels in address (no transition) + ErrInvaAddr, -- 'i' Invalid address (no transition) + ErrGoodTrAddr, -- 'G' Good address (with transition) + ErrUnknTrAddr, -- 'U' 'X' levels in address (with transition) + ErrInvaTrAddr, -- 'I' Invalid address (with transition) + ErrWrDatMem, -- 'w' Writing data to memory + ErrNoChgMem, -- 's' Retaining previous memory contents + ErrCrAllMem, -- 'c' Corrupting entire memory with 'X' + ErrCrWrdMem, -- 'l' Corrupting a word in memory with 'X' + ErrCrBitMem, -- 'd' Corrupting a single bit in memory with 'X' + ErrCrDatMem, -- 'e' Corrupting a word with 'X' based on data in + ErrCrAllSubMem,-- 'C' Corrupting a sub-word entire memory with 'X' + ErrCrWrdSubMem,-- 'L' Corrupting a sub-word in memory with 'X' + ErrCrBitSubMem,-- 'D' Corrupting a single bit of a memory sub-word with 'X' + ErrCrDatSubMem,-- 'E' Corrupting a sub-word with 'X' based on data in + ErrCrWrdOut, -- 'l' Corrupting data out with 'X' + ErrCrBitOut, -- 'd' Corrupting a single bit of data out with 'X' + ErrCrDatOut, -- 'e' Corrupting data out with 'X' based on data in + ErrCrWrdSubOut,-- 'L' Corrupting data out sub-word with 'X' + ErrCrBitSubOut,-- 'D' Corrupting a single bit of data out sub-word with 'X' + ErrCrDatSubOut,-- 'E' Corrupting data out sub-word with 'X' based on data in + ErrImplOut, -- 'M' Implicit read from memory to data out + ErrReadOut, -- 'm' Reading data from memory to data out + ErrAssgOut, -- 't' Transfering from data in to data out + ErrAsgXOut, -- 'X' Assigning unknown level to data out + ErrAsg0Out, -- '0' Assigning low level to data out + ErrAsg1Out, -- '1' Assigning high level to data out + ErrAsgZOut, -- 'Z' Assigning high impedence to data out + ErrAsgSOut, -- 'S' Keeping data out at steady value + ErrAsgXMem, -- 'X' Assigning unknown level to memory location + ErrAsg0Mem, -- '0' Assigning low level to memory location + ErrAsg1Mem, -- '1' Assigning high level to memory location + ErrAsgZMem, -- 'Z' Assigning high impedence to memory location + ErrDefMemAct, -- No memory table match, using default action + ErrInitMem, -- Initialize memory contents + ErrMcpWrCont, -- Memory cross port to same port write contention + ErrMcpCpCont, -- Memory cross port read/write data/memory contention + ErrMcpCpRead, -- Memory cross port read to same port + ErrMcpRdWrCo, -- Memory cross port read/write data only contention + ErrMcpCpWrCont,-- Memory cross port to cross port write contention + ErrUnknMemDo, -- Unknown memory action + ErrUnknDatDo, -- Unknown data action + ErrUnknSymbol, -- Illegal memory symbol + ErrLdIlgArg, + ErrLdAddrRng, + ErrLdMemInfo, + ErrLdFileEmpty, + ErrPrintString +); + +TYPE VitalMemoryErrorSeverityType IS +ARRAY (VitalMemoryErrorType) OF SEVERITY_LEVEL; +CONSTANT VitalMemoryErrorSeverity : + VitalMemoryErrorSeverityType := ( + ErrGoodAddr => NOTE, + ErrUnknAddr => WARNING, + ErrInvaAddr => WARNING, + ErrGoodTrAddr => NOTE, + ErrUnknTrAddr => WARNING, + ErrInvaTrAddr => WARNING, + ErrWrDatMem => NOTE, + ErrNoChgMem => NOTE, + ErrCrAllMem => WARNING, + ErrCrWrdMem => WARNING, + ErrCrBitMem => WARNING, + ErrCrDatMem => WARNING, + ErrCrAllSubMem => WARNING, + ErrCrWrdSubMem => WARNING, + ErrCrBitSubMem => WARNING, + ErrCrDatSubMem => WARNING, + ErrCrWrdOut => WARNING, + ErrCrBitOut => WARNING, + ErrCrDatOut => WARNING, + ErrCrWrdSubOut => WARNING, + ErrCrBitSubOut => WARNING, + ErrCrDatSubOut => WARNING, + ErrImplOut => NOTE, + ErrReadOut => NOTE, + ErrAssgOut => NOTE, + ErrAsgXOut => NOTE, + ErrAsg0Out => NOTE, + ErrAsg1Out => NOTE, + ErrAsgZOut => NOTE, + ErrAsgSOut => NOTE, + ErrAsgXMem => NOTE, + ErrAsg0Mem => NOTE, + ErrAsg1Mem => NOTE, + ErrAsgZMem => NOTE, + ErrDefMemAct => NOTE, + ErrInitMem => NOTE, + ErrMcpWrCont => WARNING, + ErrMcpCpCont => WARNING, + ErrMcpCpRead => WARNING, + ErrMcpRdWrCo => WARNING, + ErrMcpCpWrCont => WARNING, + ErrUnknMemDo => ERROR, + ErrUnknDatDo => ERROR, + ErrUnknSymbol => ERROR, + ErrLdIlgArg => ERROR, + ErrLdAddrRng => WARNING, + ErrLdMemInfo => NOTE, + ErrLdFileEmpty => ERROR, + ErrPrintString => WARNING + ); + +-- ---------------------------------------------------------------------------- +CONSTANT MsgGoodAddr : STRING + := "Good address (no transition)"; +CONSTANT MsgUnknAddr : STRING + := "Unknown address (no transition)"; +CONSTANT MsgInvaAddr : STRING + := "Invalid address (no transition)"; +CONSTANT MsgGoodTrAddr : STRING + := "Good address (with transition)"; +CONSTANT MsgUnknTrAddr : STRING + := "Unknown address (with transition)"; +CONSTANT MsgInvaTrAddr : STRING + := "Invalid address (with transition)"; +CONSTANT MsgNoChgMem : STRING + := "Retaining previous memory contents"; +CONSTANT MsgWrDatMem : STRING + := "Writing data to memory"; +CONSTANT MsgCrAllMem : STRING + := "Corrupting entire memory with 'X'"; +CONSTANT MsgCrWrdMem : STRING + := "Corrupting a word in memory with 'X'"; +CONSTANT MsgCrBitMem : STRING + := "Corrupting a single bit in memory with 'X'"; +CONSTANT MsgCrDatMem : STRING + := "Corrupting a word with 'X' based on data in"; +CONSTANT MsgCrAllSubMem : STRING + := "Corrupting a sub-word entire memory with 'X'"; +CONSTANT MsgCrWrdSubMem : STRING + := "Corrupting a sub-word in memory with 'X'"; +CONSTANT MsgCrBitSubMem : STRING + := "Corrupting a single bit of a sub-word with 'X'"; +CONSTANT MsgCrDatSubMem : STRING + := "Corrupting a sub-word with 'X' based on data in"; +CONSTANT MsgCrWrdOut : STRING + := "Corrupting data out with 'X'"; +CONSTANT MsgCrBitOut : STRING + := "Corrupting a single bit of data out with 'X'"; +CONSTANT MsgCrDatOut : STRING + := "Corrupting data out with 'X' based on data in"; +CONSTANT MsgCrWrdSubOut : STRING + := "Corrupting data out sub-word with 'X'"; +CONSTANT MsgCrBitSubOut : STRING + := "Corrupting a single bit of data out sub-word with 'X'"; +CONSTANT MsgCrDatSubOut : STRING + := "Corrupting data out sub-word with 'X' based on data in"; +CONSTANT MsgImplOut : STRING + := "Implicit read from memory to data out"; +CONSTANT MsgReadOut : STRING + := "Reading data from memory to data out"; +CONSTANT MsgAssgOut : STRING + := "Transfering from data in to data out"; +CONSTANT MsgAsgXOut : STRING + := "Assigning unknown level to data out"; +CONSTANT MsgAsg0Out : STRING + := "Assigning low level to data out"; +CONSTANT MsgAsg1Out : STRING + := "Assigning high level to data out"; +CONSTANT MsgAsgZOut : STRING + := "Assigning high impedance to data out"; +CONSTANT MsgAsgSOut : STRING + := "Keeping data out at steady value"; +CONSTANT MsgAsgXMem : STRING + := "Assigning unknown level to memory location"; +CONSTANT MsgAsg0Mem : STRING + := "Assigning low level to memory location"; +CONSTANT MsgAsg1Mem : STRING + := "Assigning high level to memory location"; +CONSTANT MsgAsgZMem : STRING + := "Assigning high impedance to memory location"; +CONSTANT MsgDefMemAct : STRING + := "No memory table match, using default action"; +CONSTANT MsgInitMem : STRING + := "Initializing memory contents"; +CONSTANT MsgMcpWrCont : STRING + := "Same port write contention"; +CONSTANT MsgMcpCpCont : STRING + := "Cross port read/write data/memory contention"; +CONSTANT MsgMcpCpRead : STRING + := "Cross port read to same port"; +CONSTANT MsgMcpRdWrCo : STRING + := "Cross port read/write data only contention"; +CONSTANT MsgMcpCpWrCont : STRING + := "Cross port write contention"; +CONSTANT MsgUnknMemDo : STRING + := "Unknown memory action"; +CONSTANT MsgUnknDatDo : STRING + := "Unknown data action"; +CONSTANT MsgUnknSymbol : STRING + := "Illegal memory symbol"; + +CONSTANT MsgLdIlgArg : STRING + := "Illegal bit arguments while loading memory."; +CONSTANT MsgLdMemInfo : STRING + := "Loading data from the file into memory."; +CONSTANT MsgLdAddrRng : STRING + := "Address out of range while loading memory."; +CONSTANT MsgLdFileEmpty : STRING + := "Memory load file is empty."; +CONSTANT MsgPrintString : STRING + := ""; + +CONSTANT MsgUnknown : STRING + := "Unknown error message."; + +CONSTANT MsgVMT : STRING + := "VitalMemoryTable"; +CONSTANT MsgVMV : STRING + := "VitalMemoryViolation"; +CONSTANT MsgVDM : STRING + := "VitalDeclareMemory"; +CONSTANT MsgVMCP : STRING + := "VitalMemoryCrossPorts"; + +-- ---------------------------------------------------------------------------- +-- LOCAL Utilities +-- ---------------------------------------------------------------------------- + +-- ---------------------------------------------------------------------------- +-- Procedure: MemoryMessage +-- Parameters: ErrorId -- Input error code +-- Description: This function looks up the input error code and returns +-- the string value of the associated message. +-- ---------------------------------------------------------------------------- + +FUNCTION MemoryMessage ( + CONSTANT ErrorId : IN VitalMemoryErrorType +) RETURN STRING IS +BEGIN + CASE ErrorId IS + WHEN ErrGoodAddr => RETURN MsgGoodAddr ; + WHEN ErrUnknAddr => RETURN MsgUnknAddr ; + WHEN ErrInvaAddr => RETURN MsgInvaAddr ; + WHEN ErrGoodTrAddr => RETURN MsgGoodTrAddr ; + WHEN ErrUnknTrAddr => RETURN MsgUnknTrAddr ; + WHEN ErrInvaTrAddr => RETURN MsgInvaTrAddr ; + WHEN ErrWrDatMem => RETURN MsgWrDatMem ; + WHEN ErrNoChgMem => RETURN MsgNoChgMem ; + WHEN ErrCrAllMem => RETURN MsgCrAllMem ; + WHEN ErrCrWrdMem => RETURN MsgCrWrdMem ; + WHEN ErrCrBitMem => RETURN MsgCrBitMem ; + WHEN ErrCrDatMem => RETURN MsgCrDatMem ; + WHEN ErrCrAllSubMem => RETURN MsgCrAllSubMem; + WHEN ErrCrWrdSubMem => RETURN MsgCrWrdSubMem; + WHEN ErrCrBitSubMem => RETURN MsgCrBitSubMem; + WHEN ErrCrDatSubMem => RETURN MsgCrDatSubMem; + WHEN ErrCrWrdOut => RETURN MsgCrWrdOut ; + WHEN ErrCrBitOut => RETURN MsgCrBitOut ; + WHEN ErrCrDatOut => RETURN MsgCrDatOut ; + WHEN ErrCrWrdSubOut => RETURN MsgCrWrdSubOut; + WHEN ErrCrBitSubOut => RETURN MsgCrBitSubOut; + WHEN ErrCrDatSubOut => RETURN MsgCrDatSubOut; + WHEN ErrImplOut => RETURN MsgImplOut ; + WHEN ErrReadOut => RETURN MsgReadOut ; + WHEN ErrAssgOut => RETURN MsgAssgOut ; + WHEN ErrAsgXOut => RETURN MsgAsgXOut ; + WHEN ErrAsg0Out => RETURN MsgAsg0Out ; + WHEN ErrAsg1Out => RETURN MsgAsg1Out ; + WHEN ErrAsgZOut => RETURN MsgAsgZOut ; + WHEN ErrAsgSOut => RETURN MsgAsgSOut ; + WHEN ErrAsgXMem => RETURN MsgAsgXMem ; + WHEN ErrAsg0Mem => RETURN MsgAsg0Mem ; + WHEN ErrAsg1Mem => RETURN MsgAsg1Mem ; + WHEN ErrAsgZMem => RETURN MsgAsgZMem ; + WHEN ErrDefMemAct => RETURN MsgDefMemAct ; + WHEN ErrInitMem => RETURN MsgInitMem ; + WHEN ErrMcpWrCont => RETURN MsgMcpWrCont ; + WHEN ErrMcpCpCont => RETURN MsgMcpCpCont ; + WHEN ErrMcpCpRead => RETURN MsgMcpCpRead ; + WHEN ErrMcpRdWrCo => RETURN MsgMcpRdWrCo ; + WHEN ErrMcpCpWrCont => RETURN MsgMcpCpWrCont; + WHEN ErrUnknMemDo => RETURN MsgUnknMemDo ; + WHEN ErrUnknDatDo => RETURN MsgUnknDatDo ; + WHEN ErrUnknSymbol => RETURN MsgUnknSymbol ; + WHEN ErrLdIlgArg => RETURN MsgLdIlgArg ; + WHEN ErrLdAddrRng => RETURN MsgLdAddrRng ; + WHEN ErrLdMemInfo => RETURN MsgLdMemInfo ; + WHEN ErrLdFileEmpty => RETURN MsgLdFileEmpty; + WHEN ErrPrintString => RETURN MsgPrintString; + WHEN OTHERS => RETURN MsgUnknown ; + END CASE; +END; + +-- ---------------------------------------------------------------------------- +-- Procedure: PrintMemoryMessage +-- Parameters: Routine -- String identifying the calling routine +-- ErrorId -- Input error code for message lookup +-- Info -- Output string or character +-- InfoStr -- Additional output string +-- Info1 -- Additional output integer +-- Info2 -- Additional output integer +-- Info3 -- Additional output integer +-- Description: This procedure prints out a memory status message +-- given the input error id and other status information. +-- ---------------------------------------------------------------------------- +PROCEDURE PrintMemoryMessage ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalMemoryErrorType +) IS +BEGIN + ASSERT FALSE + REPORT Routine & ": " & MemoryMessage(ErrorId) + SEVERITY VitalMemoryErrorSeverity(ErrorId); +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintMemoryMessage ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalMemoryErrorType; + CONSTANT Info : IN STRING +) IS +BEGIN + ASSERT FALSE + REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & Info + SEVERITY VitalMemoryErrorSeverity(ErrorId); +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintMemoryMessage ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalMemoryErrorType; + CONSTANT Info1 : IN STRING; + CONSTANT Info2 : IN STRING +) IS +BEGIN + ASSERT FALSE + REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & Info1 & " " & Info2 + SEVERITY VitalMemoryErrorSeverity(ErrorId); +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintMemoryMessage ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalMemoryErrorType; + CONSTANT Info : IN CHARACTER +) IS +BEGIN + ASSERT FALSE + REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & Info + SEVERITY VitalMemoryErrorSeverity(ErrorId); +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintMemoryMessage ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalMemoryErrorType; + CONSTANT InfoStr : IN STRING; + CONSTANT Info1 : IN NATURAL +) IS + VARIABLE TmpStr : STRING ( 1 TO 256 ) ; + VARIABLE TmpInt : INTEGER := 1; +BEGIN + IntToStr(Info1,TmpStr,TmpInt); + ASSERT FALSE + REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & InfoStr & " " & TmpStr + SEVERITY VitalMemoryErrorSeverity(ErrorId); +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintMemoryMessage ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalMemoryErrorType; + CONSTANT InfoStr : IN STRING; + CONSTANT Info1 : IN NATURAL; + CONSTANT Info2 : IN NATURAL +) IS + VARIABLE TmpStr : STRING ( 1 TO 256 ) ; + VARIABLE TmpInt : INTEGER := 1; +BEGIN + IntToStr(Info1,TmpStr,TmpInt); + IntToStr(Info2,TmpStr,TmpInt); + ASSERT FALSE + REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & InfoStr & " " & TmpStr + SEVERITY VitalMemoryErrorSeverity(ErrorId); +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintMemoryMessage ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalMemoryErrorType; + CONSTANT InfoStr : IN STRING; + CONSTANT Info1 : IN NATURAL; + CONSTANT Info2 : IN NATURAL; + CONSTANT Info3 : IN NATURAL +) IS + VARIABLE TmpStr : STRING ( 1 TO 256 ) ; + VARIABLE TmpInt : INTEGER := 1; +BEGIN + IntToStr(Info1,TmpStr,TmpInt); + IntToStr(Info2,TmpStr,TmpInt); + IntToStr(Info3,TmpStr,TmpInt); + ASSERT FALSE + REPORT Routine & ": " & MemoryMessage(ErrorId) & " " & InfoStr & " " & TmpStr + SEVERITY VitalMemoryErrorSeverity(ErrorId); +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE PrintMemoryMessage ( + CONSTANT Routine : IN STRING; + CONSTANT Table : IN VitalMemoryTableType; + CONSTANT Index : IN INTEGER; + CONSTANT InfoStr : IN STRING +) IS + CONSTANT TableEntries : INTEGER := Table'LENGTH(1); + CONSTANT TableWidth : INTEGER := Table'LENGTH(2); + VARIABLE TmpStr : STRING ( 1 TO 256 ) ; + VARIABLE TmpInt : INTEGER := 1; +BEGIN + IF (Index < 0 AND Index > TableEntries-1) THEN + ASSERT FALSE + REPORT Routine & ": Memory table search failure" + SEVERITY ERROR; + END IF; + ColLoop: + FOR i IN 0 TO TableWidth-1 LOOP + IF (i >= 64) THEN + TmpStr(TmpInt) := '.'; + TmpInt := TmpInt + 1; + TmpStr(TmpInt) := '.'; + TmpInt := TmpInt + 1; + TmpStr(TmpInt) := '.'; + TmpInt := TmpInt + 1; + EXIT ColLoop; + END IF; + TmpStr(TmpInt) := '''; + TmpInt := TmpInt + 1; + TmpStr(TmpInt) := To_MemoryChar(Table(Index,i)); + TmpInt := TmpInt + 1; + TmpStr(TmpInt) := '''; + TmpInt := TmpInt + 1; + IF (i < TableWidth-1) THEN + TmpStr(TmpInt) := ','; + TmpInt := TmpInt + 1; + END IF; + END LOOP; + ASSERT FALSE + REPORT Routine & ": Port=" & InfoStr & " TableRow=" & TmpStr + SEVERITY NOTE; +END; + +-- ---------------------------------------------------------------------------- +-- Procedure: DecodeAddress +-- Parameters: Address - Converted address. +-- AddrFlag - Flag to indicte address match +-- MemoryData - Information about memory characteristics +-- PrevAddressBus - Previous input address value +-- AddressBus - Input address value. +-- Description: This procedure is used for transforming a valid +-- address value to an integer in order to access memory. +-- It performs address bound checking as well. +-- Sets Address to -1 for unknowns +-- Sets Address to -2 for out of range +-- ---------------------------------------------------------------------------- + +PROCEDURE DecodeAddress ( + VARIABLE Address : INOUT INTEGER; + VARIABLE AddrFlag : INOUT VitalMemorySymbolType; + VARIABLE MemoryData : IN VitalMemoryDataType; + CONSTANT PrevAddressBus : IN std_logic_vector; + CONSTANT AddressBus : IN std_logic_vector +) IS + VARIABLE Power : NATURAL; + VARIABLE AddrUnkn : BOOLEAN; +BEGIN + Power := 0; + AddrUnkn := FALSE; + -- It is assumed that always Address'LEFT represents the Most significant bit. + FOR i IN AddressBus'RANGE LOOP + Power := Power * 2; + IF (AddressBus(i) /= '1' AND AddressBus(i) /= '0') THEN + AddrUnkn := TRUE; + Power := 0; + EXIT; + ELSIF (AddressBus(i) = '1') THEN + Power := Power + 1; + END IF; + END LOOP; + Address := Power; + AddrFlag := 'g'; + IF (AddrUnkn) THEN + AddrFlag := 'u'; -- unknown addr + Address := -1; + END IF; + IF ( Power > (MemoryData.NoOfWords - 1)) THEN + AddrFlag := 'i'; -- invalid addr + Address := -2; + END IF; + IF (PrevAddressBus /= AddressBus) THEN + CASE AddrFlag IS + WHEN 'g' => AddrFlag := 'G'; + WHEN 'u' => AddrFlag := 'U'; + WHEN 'i' => AddrFlag := 'I'; + WHEN OTHERS => + ASSERT FALSE REPORT + "DecodeAddress: Internal error. [AddrFlag]=" + & To_MemoryChar(AddrFlag) + SEVERITY ERROR; + END CASE; + END IF; +END DecodeAddress; + +-- ---------------------------------------------------------------------------- +-- Procedure: DecodeData +-- Parameters: DataFlag - Flag to indicte data match +-- PrevDataInBus - Previous input data value +-- DataInBus - Input data value. +-- HighBit - High bit offset value. +-- LowBit - Low bit offset value. +-- Description: This procedure is used for interpreting the input data +-- as a data flag for subsequent table matching. +-- ---------------------------------------------------------------------------- +PROCEDURE DecodeData ( + VARIABLE DataFlag : INOUT VitalMemorySymbolType; + CONSTANT PrevDataInBus : IN std_logic_vector; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT HighBit : IN NATURAL; + CONSTANT LowBit : IN NATURAL +) IS + VARIABLE DataUnkn : BOOLEAN := FALSE; +BEGIN + FOR i IN LowBit TO HighBit LOOP + IF DataInBus(i) /= '1' AND DataInBus(i) /= '0' THEN + DataUnkn := TRUE; + EXIT; + END IF; + END LOOP; + DataFlag := 'g'; + IF (DataUnkn) THEN + DataFlag := 'u'; -- unknown addr + END IF; + IF (PrevDataInBus(HighBit DOWNTO LowBit) /= + DataInBus(HighBit DOWNTO LowBit)) THEN + CASE DataFlag IS + WHEN 'g' => DataFlag := 'G'; + WHEN 'u' => DataFlag := 'U'; + WHEN OTHERS => + ASSERT FALSE REPORT + "DecodeData: Internal error. [DataFlag]=" + & To_MemoryChar(DataFlag) + SEVERITY ERROR; + END CASE; + END IF; +END DecodeData; + +-- ---------------------------------------------------------------------------- +-- Procedure: WriteMemory +-- Parameters: MemoryPtr - Pointer to the memory array. +-- DataInBus - Input Data to be written. +-- Address - Address of the memory location. +-- BitPosition - Position of bit in memory location. +-- HighBit - High bit offset value. +-- LowBit - Low bit offset value. +-- Description: This procedure is used to write to a memory location +-- on a bit/byte/word basis. +-- The high bit and low bit offset are used for byte write +-- operations.These parameters specify the data byte for write. +-- In the case of word write the complete memory word is used. +-- This procedure is overloaded for bit,byte and word write +-- memory operations.The number of parameters may vary. +-- ---------------------------------------------------------------------------- +PROCEDURE WriteMemory ( + VARIABLE MemoryPtr : INOUT VitalMemoryDataType; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT Address : IN INTEGER; + CONSTANT HighBit : IN NATURAL; + CONSTANT LowBit : IN NATURAL +) IS + VARIABLE TmpData : std_logic_vector(DataInBus'LENGTH - 1 DOWNTO 0); +BEGIN + -- Address bound checking. + IF ( Address < 0 OR Address > (MemoryPtr.NoOfWords - 1)) THEN + PrintMemoryMessage ( "WriteMemory", ErrPrintString, + "Aborting write operation as address is out of range.") ; + RETURN; + END IF; + TmpData := To_UX01(DataInBus); + FOR i in LowBit to HighBit LOOP + MemoryPtr.MemoryArrayPtr(Address).all(i) := TmpData(i); + END LOOP; +END WriteMemory; + +-- ---------------------------------------------------------------------------- +PROCEDURE WriteMemory ( + VARIABLE MemoryPtr : INOUT VitalMemoryDataType; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT Address : IN INTEGER; + CONSTANT BitPosition : IN NATURAL +) IS + VARIABLE HighBit : NATURAL; + VARIABLE LowBit : NATURAL; +BEGIN + HighBit := BitPosition; + LowBit := BitPosition; + WriteMemory (MemoryPtr, DataInBus, Address, HighBit, LowBit); +END WriteMemory; + +-- ---------------------------------------------------------------------------- +PROCEDURE WriteMemory ( + VARIABLE MemoryPtr : INOUT VitalMemoryDataType; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT Address : IN INTEGER +) IS + VARIABLE HighBit : NATURAL; + VARIABLE LowBit : NATURAL; +BEGIN + HighBit := MemoryPtr.NoOfBitsPerWord - 1; + LowBit := 0; + WriteMemory (MemoryPtr, DataInBus, Address, HighBit, LowBit); +END WriteMemory; + +-- ---------------------------------------------------------------------------- +-- Procedure: ReadMemory +-- Parameters: MemoryPtr - Pointer to the memory array. +-- DataOut - Output Data to be read in this. +-- Address - Address of the memory location. +-- BitPosition - Position of bit in memory location. +-- HighBit - High bit offset value. +-- LowBit - Low bit offset value. +-- Description: This procedure is used to read from a memory location +-- on a bit/byte/word basis. +-- The high bit and low bit offset are used for byte write +-- operations.These parameters specify the data byte for +-- read.In the case of word write the complete memory word +-- is used.This procedure is overloaded for bit,byte and +-- word write memory operations.The number of parameters +-- may vary. +-- ---------------------------------------------------------------------------- +PROCEDURE ReadMemory ( + VARIABLE MemoryPtr : INOUT VitalMemoryDataType; + VARIABLE DataOut : OUT std_logic_vector; + CONSTANT Address : IN INTEGER; + CONSTANT HighBit : IN NATURAL; + CONSTANT LowBit : IN NATURAL +) IS + VARIABLE DataOutTmp : std_logic_vector(MemoryPtr.NoOfBitsPerWord-1 DOWNTO 0); + VARIABLE length : NATURAL := (HighBit - LowBit + 1); +BEGIN + -- Address bound checking. + IF ( Address > (MemoryPtr.NoOfWords - 1)) THEN + PrintMemoryMessage ( + "ReadMemory",ErrInvaAddr, + "[Address,NoOfWords]=",Address,MemoryPtr.NoOfWords + ); + FOR i in LowBit to HighBit LOOP + DataOutTmp(i) := 'X'; + END LOOP; + ELSE + FOR i in LowBit to HighBit LOOP + DataOutTmp(i) := MemoryPtr.MemoryArrayPtr (Address).all(i); + END LOOP; + END IF; + DataOut := DataOutTmp; +END ReadMemory; + +-- ---------------------------------------------------------------------------- +PROCEDURE ReadMemory ( + VARIABLE MemoryPtr : INOUT VitalMemoryDataType; + VARIABLE DataOut : OUT std_logic_vector; + CONSTANT Address : IN INTEGER; + CONSTANT BitPosition : IN NATURAL +) IS + VARIABLE HighBit : NATURAL; + VARIABLE LowBit : NATURAL; +BEGIN + HighBit := BitPosition; + LowBit := BitPosition; + ReadMemory (MemoryPtr, DataOut, Address, HighBit, LowBit); +END ReadMemory; + +-- ---------------------------------------------------------------------------- +PROCEDURE ReadMemory ( + VARIABLE MemoryPtr : INOUT VitalMemoryDataType; + VARIABLE DataOut : OUT std_logic_vector; + CONSTANT Address : IN INTEGER +) IS + VARIABLE HighBit : NATURAL; + VARIABLE LowBit : NATURAL; +BEGIN + HighBit := MemoryPtr.NoOfBitsPerWord - 1; + LowBit := 0; + ReadMemory (MemoryPtr, DataOut, Address, HighBit, LowBit); +END ReadMemory; + + +-- ---------------------------------------------------------------------------- +-- Procedure: LoadMemory +-- Parameters: MemoryPtr - Pointer to the memory array. +-- FileName - Name of the output file. +-- HighBit - High bit offset value. +-- LowBit - Low bit offset value. +-- Description: This procedure is used to load the contents of the memory +-- from a specified input file. +-- The high bit and low bit offset are used so that same task +-- can be used for all bit/byte/word write operations. +-- In the case of a bit write RAM the HighBit and LowBit have +-- the same value. +-- This procedure is overloaded for word write operations. +-- ---------------------------------------------------------------------------- +PROCEDURE LoadMemory ( + VARIABLE MemoryPtr : INOUT VitalMemoryDataType; + CONSTANT FileName : IN STRING; + CONSTANT BinaryFile : IN BOOLEAN := FALSE +) IS + FILE Fptr : TEXT OPEN read_mode IS FileName; + VARIABLE OneLine : LINE; + VARIABLE Ignore : CHARACTER; + VARIABLE Index : NATURAL := 1; + VARIABLE LineNo : NATURAL := 0; + VARIABLE Address : INTEGER := 0; + VARIABLE DataInBus : std_logic_vector(MemoryPtr.NoOfBitsPerWord-1 DOWNTO 0); + VARIABLE AddrStr : STRING(1 TO 80) ; + VARIABLE DataInStr : STRING(1 TO 255) ; +BEGIN + IF (ENDFILE(fptr)) THEN + PrintMemoryMessage (MsgVDM, ErrLdFileEmpty, + "[FileName]="&FileName); + RETURN; + END IF ; + PrintMemoryMessage ( + MsgVDM,ErrLdMemInfo, "[FileName]="&FileName + ); + WHILE (NOT ENDFILE(fptr)) LOOP + ReadLine(Fptr, OneLine); + LineNo := LineNo + 1 ; + -- First ignoring leading spaces. + WHILE (OneLine'LENGTH /= 0 and IsSpace(OneLine(1))) LOOP + READ (OneLine, Ignore) ; -- Ignoring the space character. + END LOOP ; + -- Note that, by now oneline has been "stripped" of its leading spaces. + IF ( OneLine(1) = '@' ) THEN + READ (OneLine, Ignore); -- Ignore the '@' character and read the string. + -- Now strip off spaces, if any, between '@' and Address string. + WHILE (OneLine'LENGTH /= 0 and IsSpace(OneLine(1))) LOOP + READ (OneLine, Ignore) ; -- Ignoring the space character. + END LOOP ; + -- Now get the string which represents the address into string variable. + Index := 1; + WHILE (OneLine'LENGTH /= 0 AND (NOT(IsSpace(OneLine(1))))) LOOP + READ(OneLine, AddrStr(Index)); + Index := Index + 1; + END LOOP ; + AddrStr(Index) := NUL; + -- Now convert the hex string into a hex integer + Address := HexToInt(AddrStr) ; + ELSE + IF ( LineNo /= 1 ) THEN + Address := Address + 1; + END IF; + END IF ; + IF ( Address > (MemoryPtr.NoOfWords - 1) ) THEN + PrintMemoryMessage (MsgVDM, ErrLdAddrRng, + "[Address,lineno]=", Address, LineNo) ; + EXIT ; + END IF; + -- Now strip off spaces, between Address string and DataInBus string. + WHILE (OneLine'LENGTH /= 0 AND IsSpace(OneLine(1))) LOOP + READ (OneLine, Ignore) ; -- Ignoring the space character. + END LOOP ; + Index := 1; + WHILE (OneLine'LENGTH /= 0 AND (NOT(IsSpace(OneLine(1))))) LOOP + READ(OneLine, DataInStr(Index)); + Index := Index + 1; + END LOOP ; + DataInStr(Index) := NUL; + IF (BinaryFile) THEN + DataInBus := BinToBitv (DataInStr); + ELSE + DataInBus := HexToBitv (DataInStr); + END IF ; + WriteMemory (MemoryPtr, DataInBus, Address); + END LOOP ; +END LoadMemory; + +-- ---------------------------------------------------------------------------- +-- Procedure: MemoryMatch +-- Parameters: Symbol - Symbol from memory table +-- TestFlag - Interpreted data or address symbol +-- In2 - input from VitalMemoryTable procedure +-- to memory table +-- In2LastValue - Previous value of input +-- Err - TRUE if symbol is not a valid input symbol +-- ReturnValue - TRUE if match occurred +-- Description: This procedure sets ReturnValue to true if in2 matches +-- symbol (from the memory table). If symbol is an edge +-- value edge is set to true and in2 and in2LastValue are +-- checked against symbol. Err is set to true if symbol +-- is an invalid value for the input portion of the memory +-- table. +-- ---------------------------------------------------------------------------- +PROCEDURE MemoryMatch ( + CONSTANT Symbol : IN VitalMemorySymbolType; + CONSTANT In2 : IN std_ulogic; + CONSTANT In2LastValue : IN std_ulogic; + VARIABLE Err : OUT BOOLEAN; + VARIABLE ReturnValue : OUT BOOLEAN +) IS +BEGIN + IF (NOT ValidMemoryTableInput(Symbol) ) THEN + PrintMemoryMessage(MsgVMT,ErrUnknSymbol,To_MemoryChar(Symbol)); + Err := TRUE; + ReturnValue := FALSE; + ELSE + ReturnValue := MemoryTableMatch(To_X01(In2LastValue), To_X01(In2), Symbol); + Err := FALSE; + END IF; +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE MemoryMatch ( + CONSTANT Symbol : IN VitalMemorySymbolType; + CONSTANT TestFlag : IN VitalMemorySymbolType; + VARIABLE Err : OUT BOOLEAN; + VARIABLE ReturnValue : OUT BOOLEAN +) IS +BEGIN + Err := FALSE; + ReturnValue := FALSE; + CASE Symbol IS + WHEN 'g'|'u'|'i'|'G'|'U'|'I'|'-'|'*'|'S' => + IF (Symbol = TestFlag) THEN + ReturnValue := TRUE; + ELSE + CASE Symbol IS + WHEN '-' => + ReturnValue := TRUE; + Err := FALSE; + WHEN '*' => + IF (TestFlag = 'G' OR + TestFlag = 'U' OR + TestFlag = 'I') THEN + ReturnValue := TRUE; + Err := FALSE; + END IF; + WHEN 'S' => + IF (TestFlag = 'g' OR + TestFlag = 'u' OR + TestFlag = 'i') THEN + ReturnValue := TRUE; + Err := FALSE; + END IF; + WHEN OTHERS => + ReturnValue := FALSE; + END CASE; + END IF; + WHEN OTHERS => + Err := TRUE; + RETURN; + END CASE; +END; + +-- ---------------------------------------------------------------------------- +-- Procedure: MemoryTableCorruptMask +-- Description: Compute memory and data corruption masks for memory table +-- ---------------------------------------------------------------------------- +PROCEDURE MemoryTableCorruptMask ( + VARIABLE CorruptMask : OUT std_logic_vector; + CONSTANT Action : IN VitalMemorySymbolType; + CONSTANT EnableIndex : IN INTEGER; + CONSTANT BitsPerWord : IN INTEGER; + CONSTANT BitsPerSubWord : IN INTEGER; + CONSTANT BitsPerEnable : IN INTEGER +) IS + VARIABLE CorruptMaskTmp : std_logic_vector (CorruptMask'RANGE) + := (OTHERS => '0'); + VARIABLE ViolFlAryPosn : INTEGER; + VARIABLE HighBit : INTEGER; + VARIABLE LowBit : INTEGER; +BEGIN + CASE (Action) IS + WHEN 'c'|'l'|'e' => + -- Corrupt whole word + CorruptMaskTmp := (OTHERS => 'X'); + CorruptMask := CorruptMaskTmp; + RETURN; + WHEN 'd'|'C'|'L'|'D'|'E' => + -- Process corruption below + WHEN OTHERS => + -- No data or memory corruption + CorruptMaskTmp := (OTHERS => '0'); + CorruptMask := CorruptMaskTmp; + RETURN; + END CASE; + IF (Action = 'd') THEN + CorruptMaskTmp := (OTHERS => 'X'); + CorruptMask := CorruptMaskTmp; + RETURN; + END IF; + -- Remaining are subword cases 'C', 'L', 'D', 'E' + CorruptMaskTmp := (OTHERS => '0'); + LowBit := 0; + HighBit := BitsPerSubWord-1; + SubWordLoop: + FOR i IN 0 TO BitsPerEnable-1 LOOP + IF (i = EnableIndex) THEN + FOR j IN HighBit TO LowBit LOOP + CorruptMaskTmp(j) := 'X'; + END LOOP; + END IF; + -- Calculate HighBit and LowBit + LowBit := LowBit + BitsPerSubWord; + IF (LowBit > BitsPerWord) THEN + LowBit := BitsPerWord; + END IF; + HighBit := LowBit + BitsPerSubWord; + IF (HighBit > BitsPerWord) THEN + HighBit := BitsPerWord; + ELSE + HighBit := HighBit - 1; + END IF; + END LOOP; + CorruptMask := CorruptMaskTmp; + RETURN; +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE MemoryTableCorruptMask ( + VARIABLE CorruptMask : OUT std_logic_vector; + CONSTANT Action : IN VitalMemorySymbolType +) IS + VARIABLE CorruptMaskTmp : std_logic_vector (0 TO CorruptMask'LENGTH-1) + := (OTHERS => '0'); + VARIABLE ViolFlAryPosn : INTEGER; + VARIABLE HighBit : INTEGER; + VARIABLE LowBit : INTEGER; +BEGIN + CASE (Action) IS + WHEN 'c'|'l'|'d'|'e'|'C'|'L'|'D'|'E' => + -- Corrupt whole word + CorruptMaskTmp := (OTHERS => 'X'); + CorruptMask := CorruptMaskTmp; + RETURN; + WHEN OTHERS => + -- No data or memory corruption + CorruptMaskTmp := (OTHERS => '0'); + CorruptMask := CorruptMaskTmp; + RETURN; + END CASE; + RETURN; +END; + +-- ---------------------------------------------------------------------------- +-- Procedure: MemoryTableCorruptMask +-- Description: Compute memory and data corruption masks for violation table +-- ---------------------------------------------------------------------------- +PROCEDURE ViolationTableCorruptMask ( + VARIABLE CorruptMask : OUT std_logic_vector; + CONSTANT Action : IN VitalMemorySymbolType; + CONSTANT ViolationFlags : IN std_logic_vector; + CONSTANT ViolationFlagsArray : IN std_logic_vector; + CONSTANT ViolationSizesArray : IN VitalMemoryViolFlagSizeType; + CONSTANT ViolationTable : IN VitalMemoryTableType; + CONSTANT TableIndex : IN INTEGER; + CONSTANT BitsPerWord : IN INTEGER; + CONSTANT BitsPerSubWord : IN INTEGER; + CONSTANT BitsPerEnable : IN INTEGER +) IS + VARIABLE CorruptMaskTmp : std_logic_vector (CorruptMask'RANGE) + := (OTHERS => '0'); + VARIABLE ViolMaskTmp : std_logic_vector (CorruptMask'RANGE) + := (OTHERS => '0'); + VARIABLE ViolFlAryPosn : INTEGER; + VARIABLE HighBit : INTEGER; + VARIABLE LowBit : INTEGER; + CONSTANT ViolFlagsSize : INTEGER := ViolationFlags'LENGTH; + CONSTANT ViolFlArySize : INTEGER := ViolationFlagsArray'LENGTH; + CONSTANT TableEntries : INTEGER := ViolationTable'LENGTH(1); + CONSTANT TableWidth : INTEGER := ViolationTable'LENGTH(2); + CONSTANT DatActionNdx : INTEGER := TableWidth - 1; + CONSTANT MemActionNdx : INTEGER := TableWidth - 2; +BEGIN + CASE (Action) IS + WHEN 'c'|'l'|'e' => + -- Corrupt whole word + CorruptMaskTmp := (OTHERS => 'X'); + CorruptMask := CorruptMaskTmp; + RETURN; + WHEN 'd'|'C'|'L'|'D'|'E' => + -- Process corruption below + WHEN OTHERS => + -- No data or memory corruption + CorruptMaskTmp := (OTHERS => '0'); + CorruptMask := CorruptMaskTmp; + RETURN; + END CASE; + RowLoop: -- Check each element of the ViolationFlags + FOR j IN 0 TO ViolFlagsSize LOOP + IF (j = ViolFlagsSize) THEN + ViolFlAryPosn := 0; + RowLoop2: -- Check relevant elements of the ViolationFlagsArray + FOR k IN 0 TO MemActionNdx - ViolFlagsSize - 1 LOOP + IF (ViolationTable(TableIndex, k + ViolFlagsSize) = 'X') THEN + MaskLoop: -- Set the 'X' bits in the violation mask + FOR m IN INTEGER RANGE 0 TO CorruptMask'LENGTH-1 LOOP + IF (m <= ViolationSizesArray(k)-1) THEN + ViolMaskTmp(m) := ViolMaskTmp(m) XOR + ViolationFlagsArray(ViolFlAryPosn+m); + ELSE + EXIT MaskLoop; + END IF; + END LOOP; + END IF; + ViolFlAryPosn := ViolFlAryPosn + ViolationSizesArray(k); + END LOOP; + ELSE + IF (ViolationTable(TableIndex, j) = 'X') THEN + ViolMaskTmp(0) := ViolMaskTmp(0) XOR ViolationFlags(j); + END IF; + END IF; + END LOOP; + IF (Action = 'd') THEN + CorruptMask := ViolMaskTmp; + RETURN; + END IF; + -- Remaining are subword cases 'C', 'L', 'D', 'E' + CorruptMaskTmp := (OTHERS => '0'); + LowBit := 0; + HighBit := BitsPerSubWord-1; + SubWordLoop: + FOR i IN 0 TO BitsPerEnable-1 LOOP + IF (ViolMaskTmp(i) = 'X') THEN + FOR j IN HighBit TO LowBit LOOP + CorruptMaskTmp(j) := 'X'; + END LOOP; + END IF; + -- Calculate HighBit and LowBit + LowBit := LowBit + BitsPerSubWord; + IF (LowBit > BitsPerWord) THEN + LowBit := BitsPerWord; + END IF; + HighBit := LowBit + BitsPerSubWord; + IF (HighBit > BitsPerWord) THEN + HighBit := BitsPerWord; + ELSE + HighBit := HighBit - 1; + END IF; + END LOOP; + CorruptMask := CorruptMaskTmp; + RETURN; +END; + +-- ---------------------------------------------------------------------------- +-- Procedure: MemoryTableLookUp +-- Parameters: MemoryAction - Output memory action to be performed +-- DataAction - Output data action to be performed +-- PrevControls - Previous data in for edge detection +-- PrevEnableBus - Previous enables for edge detection +-- Controls - Agregate of scalar control lines +-- EnableBus - Concatenation of vector control lines +-- EnableIndex - Current slice of vector control lines +-- AddrFlag - Matching symbol from address decoding +-- DataFlag - Matching symbol from data decoding +-- MemoryTable - Input memory action table +-- PortName - Port name string for messages +-- HeaderMsg - Header string for messages +-- MsgOn - Control message output +-- +-- Description: This function is used to find the output of the +-- MemoryTable corresponding to a given set of inputs. +-- +-- ---------------------------------------------------------------------------- +PROCEDURE MemoryTableLookUp ( + VARIABLE MemoryAction : OUT VitalMemorySymbolType; + VARIABLE DataAction : OUT VitalMemorySymbolType; + VARIABLE MemoryCorruptMask : OUT std_logic_vector; + VARIABLE DataCorruptMask : OUT std_logic_vector; + CONSTANT PrevControls : IN std_logic_vector; + CONSTANT Controls : IN std_logic_vector; + CONSTANT AddrFlag : IN VitalMemorySymbolType; + CONSTANT DataFlag : IN VitalMemorySymbolType; + CONSTANT MemoryTable : IN VitalMemoryTableType; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE +) IS + CONSTANT ControlsSize : INTEGER := Controls'LENGTH; + CONSTANT TableEntries : INTEGER := MemoryTable'LENGTH(1); + CONSTANT TableWidth : INTEGER := MemoryTable'LENGTH(2); + CONSTANT DatActionNdx : INTEGER := TableWidth - 1; + CONSTANT MemActionNdx : INTEGER := TableWidth - 2; + CONSTANT DataInBusNdx : INTEGER := TableWidth - 3; + CONSTANT AddressBusNdx : INTEGER := TableWidth - 4; + VARIABLE AddrFlagTable : VitalMemorySymbolType; + VARIABLE Match : BOOLEAN; + VARIABLE Err : BOOLEAN := FALSE; + VARIABLE TableAlias : VitalMemoryTableType( + 0 TO TableEntries - 1, + 0 TO TableWidth - 1) + := MemoryTable; +BEGIN + ColLoop: -- Compare each entry in the table + FOR i IN TableAlias'RANGE(1) LOOP + RowLoop: -- Check each element of the Controls + FOR j IN 0 TO ControlsSize LOOP + IF (j = ControlsSize) THEN + -- a match occurred, now check AddrFlag, DataFlag + MemoryMatch(TableAlias(i,AddressBusNdx),AddrFlag,Err,Match); + IF (Match) THEN + MemoryMatch(TableAlias(i,DataInBusNdx),DataFlag,Err,Match); + IF (Match) THEN + MemoryTableCorruptMask ( + CorruptMask => MemoryCorruptMask , + Action => TableAlias(i, MemActionNdx) + ); + MemoryTableCorruptMask ( + CorruptMask => DataCorruptMask , + Action => TableAlias(i, DatActionNdx) + ); + -- get the return memory and data actions + MemoryAction := TableAlias(i, MemActionNdx); + DataAction := TableAlias(i, DatActionNdx); + -- DEBUG: The lines below report table search + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMT,TableAlias,i,PortName); + END IF; + -- DEBUG: The lines above report table search + RETURN; + END IF; + END IF; + ELSE + -- Match memory table inputs + MemoryMatch ( TableAlias(i,j), + Controls(j), PrevControls(j), + Err, Match); + END IF; + EXIT RowLoop WHEN NOT(Match); + EXIT ColLoop WHEN Err; + END LOOP RowLoop; + END LOOP ColLoop; + -- no match found, return default action + MemoryAction := 's'; -- no change to memory + DataAction := 'S'; -- no change to dataout + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMT,ErrDefMemAct,HeaderMsg,PortName); + END IF; + RETURN; +END; + +-- ---------------------------------------------------------------------------- +PROCEDURE MemoryTableLookUp ( + VARIABLE MemoryAction : OUT VitalMemorySymbolType; + VARIABLE DataAction : OUT VitalMemorySymbolType; + VARIABLE MemoryCorruptMask : OUT std_logic_vector; + VARIABLE DataCorruptMask : OUT std_logic_vector; + CONSTANT PrevControls : IN std_logic_vector; + CONSTANT PrevEnableBus : IN std_logic_vector; + CONSTANT Controls : IN std_logic_vector; + CONSTANT EnableBus : IN std_logic_vector; + CONSTANT EnableIndex : IN INTEGER; + CONSTANT BitsPerWord : IN INTEGER; + CONSTANT BitsPerSubWord : IN INTEGER; + CONSTANT BitsPerEnable : IN INTEGER; + CONSTANT AddrFlag : IN VitalMemorySymbolType; + CONSTANT DataFlag : IN VitalMemorySymbolType; + CONSTANT MemoryTable : IN VitalMemoryTableType; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE +) IS + CONSTANT ControlsSize : INTEGER := Controls'LENGTH; + CONSTANT TableEntries : INTEGER := MemoryTable'LENGTH(1); + CONSTANT TableWidth : INTEGER := MemoryTable'LENGTH(2); + CONSTANT DatActionNdx : INTEGER := TableWidth - 1; + CONSTANT MemActionNdx : INTEGER := TableWidth - 2; + CONSTANT DataInBusNdx : INTEGER := TableWidth - 3; + CONSTANT AddressBusNdx : INTEGER := TableWidth - 4; + VARIABLE AddrFlagTable : VitalMemorySymbolType; + VARIABLE Match : BOOLEAN; + VARIABLE Err : BOOLEAN := FALSE; + VARIABLE TableAlias : VitalMemoryTableType( + 0 TO TableEntries - 1, + 0 TO TableWidth - 1) + := MemoryTable; +BEGIN + ColLoop: -- Compare each entry in the table + FOR i IN TableAlias'RANGE(1) LOOP + RowLoop: -- Check each element of the Controls + FOR j IN 0 TO ControlsSize LOOP + IF (j = ControlsSize) THEN + -- a match occurred, now check EnableBus, AddrFlag, DataFlag + IF (EnableIndex >= 0) THEN + RowLoop2: -- Check relevant elements of the EnableBus + FOR k IN 0 TO AddressBusNdx - ControlsSize - 1 LOOP + MemoryMatch ( TableAlias(i,k + ControlsSize), + EnableBus(k * BitsPerEnable + EnableIndex), + PrevEnableBus(k * BitsPerEnable + EnableIndex), + Err, Match); + EXIT RowLoop2 WHEN NOT(Match); + END LOOP; + END IF; + IF (Match) THEN + MemoryMatch(TableAlias(i,AddressBusNdx),AddrFlag,Err,Match); + IF (Match) THEN + MemoryMatch(TableAlias(i,DataInBusNdx),DataFlag,Err,Match); + IF (Match) THEN + MemoryTableCorruptMask ( + CorruptMask => MemoryCorruptMask , + Action => TableAlias(i, MemActionNdx), + EnableIndex => EnableIndex , + BitsPerWord => BitsPerWord , + BitsPerSubWord => BitsPerSubWord , + BitsPerEnable => BitsPerEnable + ); + MemoryTableCorruptMask ( + CorruptMask => DataCorruptMask , + Action => TableAlias(i, DatActionNdx), + EnableIndex => EnableIndex , + BitsPerWord => BitsPerWord , + BitsPerSubWord => BitsPerSubWord , + BitsPerEnable => BitsPerEnable + ); + -- get the return memory and data actions + MemoryAction := TableAlias(i, MemActionNdx); + DataAction := TableAlias(i, DatActionNdx); + -- DEBUG: The lines below report table search + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMT,TableAlias,i,PortName); + END IF; + -- DEBUG: The lines above report table search + RETURN; + END IF; + END IF; + END IF; + ELSE + -- Match memory table inputs + MemoryMatch ( TableAlias(i,j), + Controls(j), PrevControls(j), + Err, Match); + END IF; + EXIT RowLoop WHEN NOT(Match); + EXIT ColLoop WHEN Err; + END LOOP RowLoop; + END LOOP ColLoop; + -- no match found, return default action + MemoryAction := 's'; -- no change to memory + DataAction := 'S'; -- no change to dataout + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMT,ErrDefMemAct,HeaderMsg,PortName); + END IF; + RETURN; +END; + +-- ---------------------------------------------------------------------------- +-- Procedure: ViolationTableLookUp +-- Parameters: MemoryAction - Output memory action to be performed +-- DataAction - Output data action to be performed +-- TimingDataArray - This is currently not used (comment out) +-- ViolationArray - Aggregation of violation variables +-- ViolationTable - Input memory violation table +-- PortName - Port name string for messages +-- HeaderMsg - Header string for messages +-- MsgOn - Control message output +-- Description: This function is used to find the output of the +-- ViolationTable corresponding to a given set of inputs. +-- ---------------------------------------------------------------------------- +PROCEDURE ViolationTableLookUp ( + VARIABLE MemoryAction : OUT VitalMemorySymbolType; + VARIABLE DataAction : OUT VitalMemorySymbolType; + VARIABLE MemoryCorruptMask : OUT std_logic_vector; + VARIABLE DataCorruptMask : OUT std_logic_vector; + CONSTANT ViolationFlags : IN std_logic_vector; + CONSTANT ViolationFlagsArray : IN std_logic_vector; + CONSTANT ViolationSizesArray : IN VitalMemoryViolFlagSizeType; + CONSTANT ViolationTable : IN VitalMemoryTableType; + CONSTANT BitsPerWord : IN INTEGER; + CONSTANT BitsPerSubWord : IN INTEGER; + CONSTANT BitsPerEnable : IN INTEGER; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE +) IS + CONSTANT ViolFlagsSize : INTEGER := ViolationFlags'LENGTH; + CONSTANT ViolFlArySize : INTEGER := ViolationFlagsArray'LENGTH; + VARIABLE ViolFlAryPosn : INTEGER; + VARIABLE ViolFlAryItem : std_ulogic; + CONSTANT ViolSzArySize : INTEGER := ViolationSizesArray'LENGTH; + CONSTANT TableEntries : INTEGER := ViolationTable'LENGTH(1); + CONSTANT TableWidth : INTEGER := ViolationTable'LENGTH(2); + CONSTANT DatActionNdx : INTEGER := TableWidth - 1; + CONSTANT MemActionNdx : INTEGER := TableWidth - 2; + VARIABLE HighBit : NATURAL := 0; + VARIABLE LowBit : NATURAL := 0; + VARIABLE Match : BOOLEAN; + VARIABLE Err : BOOLEAN := FALSE; + VARIABLE TableAlias : VitalMemoryTableType( + 0 TO TableEntries - 1, + 0 TO TableWidth - 1) + := ViolationTable; +BEGIN + ColLoop: -- Compare each entry in the table + FOR i IN TableAlias'RANGE(1) LOOP + RowLoop: -- Check each element of the ViolationFlags + FOR j IN 0 TO ViolFlagsSize LOOP + IF (j = ViolFlagsSize) THEN + ViolFlAryPosn := 0; + RowLoop2: -- Check relevant elements of the ViolationFlagsArray + FOR k IN 0 TO MemActionNdx - ViolFlagsSize - 1 LOOP + ViolFlAryItem := '0'; + SubwordLoop: -- Check for 'X' in ViolationFlagsArray chunk + FOR s IN ViolFlAryPosn TO ViolFlAryPosn+ViolationSizesArray(k)-1 LOOP + IF (ViolationFlagsArray(s) = 'X') THEN + ViolFlAryItem := 'X'; + EXIT SubwordLoop; + END IF; + END LOOP; + MemoryMatch ( TableAlias(i,k + ViolFlagsSize), + ViolFlAryItem,ViolFlAryItem, + Err, Match); + ViolFlAryPosn := ViolFlAryPosn + ViolationSizesArray(k); + EXIT RowLoop2 WHEN NOT(Match); + END LOOP; + IF (Match) THEN + -- Compute memory and data corruption masks + ViolationTableCorruptMask( + CorruptMask => MemoryCorruptMask , + Action => TableAlias(i, MemActionNdx), + ViolationFlags => ViolationFlags , + ViolationFlagsArray => ViolationFlagsArray , + ViolationSizesArray => ViolationSizesArray , + ViolationTable => ViolationTable , + TableIndex => i , + BitsPerWord => BitsPerWord , + BitsPerSubWord => BitsPerSubWord , + BitsPerEnable => BitsPerEnable + ); + ViolationTableCorruptMask( + CorruptMask => DataCorruptMask , + Action => TableAlias(i, DatActionNdx), + ViolationFlags => ViolationFlags , + ViolationFlagsArray => ViolationFlagsArray , + ViolationSizesArray => ViolationSizesArray , + ViolationTable => ViolationTable , + TableIndex => i , + BitsPerWord => BitsPerWord , + BitsPerSubWord => BitsPerSubWord , + BitsPerEnable => BitsPerEnable + ); + -- get the return memory and data actions + MemoryAction := TableAlias(i, MemActionNdx); + DataAction := TableAlias(i, DatActionNdx); + -- DEBUG: The lines below report table search + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMV,TableAlias,i,PortName); + END IF; + -- DEBUG: The lines above report table search + RETURN; + END IF; + ELSE + -- Match violation table inputs + Err := FALSE; + Match := FALSE; + IF (TableAlias(i,j) /= 'X' AND + TableAlias(i,j) /= '0' AND + TableAlias(i,j) /= '-') THEN + Err := TRUE; + ELSIF (TableAlias(i,j) = '-' OR + (TableAlias(i,j) = 'X' AND ViolationFlags(j) = 'X') OR + (TableAlias(i,j) = '0' AND ViolationFlags(j) = '0')) THEN + Match := TRUE; + END IF; + END IF; + EXIT RowLoop WHEN NOT(Match); + EXIT ColLoop WHEN Err; + END LOOP RowLoop; + END LOOP ColLoop; + -- no match found, return default action + MemoryAction := 's'; -- no change to memory + DataAction := 'S'; -- no change to dataout + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMV,ErrDefMemAct,HeaderMsg,PortName); + END IF; + RETURN; +END; + +-- ---------------------------------------------------------------------------- +-- Procedure: HandleMemoryAction +-- Parameters: MemoryData - Pointer to memory data structure +-- PortFlag - Indicates read/write mode of port +-- CorruptMask - XOR'ed with DataInBus when corrupting +-- DataInBus - Current data bus in +-- Address - Current address integer +-- HighBit - Current address high bit +-- LowBit - Current address low bit +-- MemoryTable - Input memory action table +-- MemoryAction - Memory action to be performed +-- PortName - Port name string for messages +-- HeaderMsg - Header string for messages +-- MsgOn - Control message output +-- Description: This procedure performs the specified memory action on +-- the input memory data structure. +-- ---------------------------------------------------------------------------- +PROCEDURE HandleMemoryAction ( + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE PortFlag : INOUT VitalPortFlagType; + CONSTANT CorruptMask : IN std_logic_vector; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT Address : IN INTEGER; + CONSTANT HighBit : IN NATURAL; + CONSTANT LowBit : IN NATURAL; + CONSTANT MemoryTable : IN VitalMemoryTableType; + CONSTANT MemoryAction : IN VitalMemorySymbolType; + CONSTANT CallerName : IN STRING; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE +) IS + VARIABLE DataInTmp : std_logic_vector(DataInBus'RANGE) + := DataInBus; + BEGIN + + -- Handle the memory action + CASE MemoryAction IS + + WHEN 'w' => + -- Writing data to memory + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrWrDatMem,HeaderMsg,PortName); + END IF; + WriteMemory(MemoryData,DataInBus,Address,HighBit,LowBit); + PortFlag.MemoryCurrent := WRITE; + + WHEN 's' => + -- Retaining previous memory contents + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrNoChgMem,HeaderMsg,PortName); + END IF; + -- Set memory current to quiet state + PortFlag.MemoryCurrent := READ; + + WHEN 'c' => + -- Corrupting entire memory with 'X' + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrAllMem,HeaderMsg,PortName); + END IF; + DataInTmp := (OTHERS => 'X'); + -- No need to CorruptMask + FOR i IN 0 TO MemoryData.NoOfWords-1 LOOP + WriteMemory(MemoryData,DataInTmp,i); + END LOOP; + PortFlag.MemoryCurrent := CORRUPT; + + WHEN 'l' => + -- Corrupting a word in memory with 'X' + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrWrdMem,HeaderMsg,PortName); + END IF; + DataInTmp := (OTHERS => 'X'); + -- No need to CorruptMask + WriteMemory(MemoryData,DataInTmp,Address); + PortFlag.MemoryCurrent := CORRUPT; + + WHEN 'd' => + -- Corrupting a single bit in memory with 'X' + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrBitMem,HeaderMsg,PortName); + END IF; + ReadMemory(MemoryData,DataInTmp,Address); + DataInTmp := DataInTmp XOR CorruptMask; + WriteMemory(MemoryData,DataInTmp,Address,HighBit,LowBit); + PortFlag.MemoryCurrent := CORRUPT; + + WHEN 'e' => + -- Corrupting a word with 'X' based on data in + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrDatMem,HeaderMsg,PortName); + END IF; + ReadMemory(MemoryData,DataInTmp,Address); + IF (DataInTmp /= DataInBus) THEN + DataInTmp := (OTHERS => 'X'); + -- No need to CorruptMask + WriteMemory(MemoryData,DataInTmp,Address); + END IF; + PortFlag.MemoryCurrent := CORRUPT; + + WHEN 'C' => + -- Corrupting a sub-word entire memory with 'X' + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrAllSubMem,HeaderMsg,PortName); + END IF; + FOR i IN 0 TO MemoryData.NoOfWords-1 LOOP + ReadMemory(MemoryData,DataInTmp,i); + DataInTmp := DataInTmp XOR CorruptMask; + WriteMemory(MemoryData,DataInTmp,i,HighBit,LowBit); + END LOOP; + PortFlag.MemoryCurrent := CORRUPT; + + WHEN 'L' => + -- Corrupting a sub-word in memory with 'X' + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrWrdSubMem,HeaderMsg,PortName); + END IF; + ReadMemory(MemoryData,DataInTmp,Address); + DataInTmp := DataInTmp XOR CorruptMask; + WriteMemory(MemoryData,DataInTmp,Address,HighBit,LowBit); + PortFlag.MemoryCurrent := CORRUPT; + + WHEN 'D' => + -- Corrupting a single bit of a memory sub-word with 'X' + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrBitSubMem,HeaderMsg,PortName); + END IF; + ReadMemory(MemoryData,DataInTmp,Address); + DataInTmp := DataInTmp XOR CorruptMask; + WriteMemory(MemoryData,DataInTmp,Address,HighBit,LowBit); + PortFlag.MemoryCurrent := CORRUPT; + + WHEN 'E' => + -- Corrupting a sub-word with 'X' based on data in + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrDatSubMem,HeaderMsg,PortName); + END IF; + ReadMemory(MemoryData,DataInTmp,Address); + IF (DataInBus(HighBit DOWNTO LowBit) /= + DataInTmp(HighBit DOWNTO LowBit)) THEN + DataInTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X'); + WriteMemory(MemoryData,DataInTmp,Address,HighBit,LowBit); + END IF; + --PortFlag := WRITE; + PortFlag.MemoryCurrent := CORRUPT; + + WHEN '0' => + -- Assigning low level to memory location + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrAsg0Mem,HeaderMsg,PortName); + END IF; + DataInTmp := (OTHERS => '0'); + WriteMemory(MemoryData,DataInTmp,Address, HighBit, LowBit); + PortFlag.MemoryCurrent := WRITE; + + WHEN '1' => + -- Assigning high level to memory location + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrAsg1Mem,HeaderMsg,PortName); + END IF; + DataInTmp := (OTHERS => '1'); + WriteMemory(MemoryData,DataInTmp,Address, HighBit, LowBit); + PortFlag.MemoryCurrent := WRITE; + + WHEN 'Z' => + -- Assigning high impedence to memory location + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrAsgZMem,HeaderMsg,PortName); + END IF; + DataInTmp := (OTHERS => 'Z'); + WriteMemory(MemoryData,DataInTmp,Address, HighBit, LowBit); + PortFlag.MemoryCurrent := WRITE; + + WHEN OTHERS => + -- Unknown memory action + PortFlag.MemoryCurrent := UNDEF; + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrUnknMemDo,HeaderMsg,PortName); + END IF; + + END CASE; + + -- Note: HandleMemoryAction does not change the PortFlag.OutputDisable +END; + +-- ---------------------------------------------------------------------------- +-- Procedure: HandleDataAction +-- Parameters: DataOutBus - Output result of the data action +-- MemoryData - Input pointer to memory data structure +-- PortFlag - Indicates read/write mode of port +-- CorruptMask - XOR'ed with DataInBus when corrupting +-- DataInBus - Current data bus in +-- Address - Current address integer +-- HighBit - Current address high bit +-- LowBit - Current address low bit +-- MemoryTable - Input memory action table +-- DataAction - Data action to be performed +-- PortName - Port name string for messages +-- HeaderMsg - Header string for messages +-- MsgOn - Control message output +-- Description: This procedure performs the specified data action based +-- on the input memory data structure. Checks whether +-- the previous state is HighZ. If yes then portFlag +-- should be NOCHANGE for VMPD to ignore IORetain +-- corruption. The idea is that the first Z should be +-- propagated but later ones should be ignored. +-- ---------------------------------------------------------------------------- +PROCEDURE HandleDataAction ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE PortFlag : INOUT VitalPortFlagType; + CONSTANT CorruptMask : IN std_logic_vector; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT Address : IN INTEGER; + CONSTANT HighBit : IN NATURAL; + CONSTANT LowBit : IN NATURAL; + CONSTANT MemoryTable : IN VitalMemoryTableType; + CONSTANT DataAction : IN VitalMemorySymbolType; + CONSTANT CallerName : IN STRING; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE +) IS + + VARIABLE DataOutTmp : std_logic_vector(DataOutBus'RANGE) + := DataOutBus; + +BEGIN + + -- Handle the data action + CASE DataAction IS + + WHEN 'l' => + -- Corrupting data out with 'X' + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrWrdOut,HeaderMsg,PortName); + END IF; + DataOutTmp := (OTHERS => 'X'); + -- No need to CorruptMask + PortFlag.DataCurrent := CORRUPT; + + WHEN 'd' => + -- Corrupting a single bit of data out with 'X' + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrBitOut,HeaderMsg,PortName); + END IF; + DataOutTmp(HighBit DOWNTO LowBit) := + DataOutTmp(HighBit DOWNTO LowBit) XOR + CorruptMask(HighBit DOWNTO LowBit); + PortFlag.DataCurrent := CORRUPT; + + WHEN 'e' => + -- Corrupting data out with 'X' based on data in + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrDatOut,HeaderMsg,PortName); + END IF; + ReadMemory(MemoryData,DataOutTmp,Address); + IF (DataOutTmp /= DataInBus) THEN + DataOutTmp := (OTHERS => 'X'); + -- No need to CorruptMask + END IF; + PortFlag.DataCurrent := CORRUPT; + + WHEN 'L' => + -- Corrupting data out sub-word with 'X' + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrWrdSubOut,HeaderMsg,PortName); + END IF; + ReadMemory(MemoryData,DataOutTmp,Address); + DataOutTmp(HighBit DOWNTO LowBit) := + DataOutTmp(HighBit DOWNTO LowBit) XOR + CorruptMask(HighBit DOWNTO LowBit); + PortFlag.DataCurrent := CORRUPT; + + WHEN 'D' => + -- Corrupting a single bit of data out sub-word with 'X' + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrBitSubOut,HeaderMsg,PortName); + END IF; + DataOutTmp(HighBit DOWNTO LowBit) := + DataOutTmp(HighBit DOWNTO LowBit) XOR + CorruptMask(HighBit DOWNTO LowBit); + PortFlag.DataCurrent := CORRUPT; + + WHEN 'E' => + -- Corrupting data out sub-word with 'X' based on data in + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrCrDatSubOut,HeaderMsg,PortName); + END IF; + ReadMemory(MemoryData,DataOutTmp,Address); + IF (DataInBus(HighBit DOWNTO LowBit) /= + DataOutTmp(HighBit DOWNTO LowBit)) THEN + DataOutTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X'); + -- No need to CorruptMask + END IF; + PortFlag.DataCurrent := CORRUPT; + + WHEN 'M' => + -- Implicit read from memory to data out + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrImplOut,HeaderMsg,PortName); + END IF; + PortFlag.DataCurrent := READ; + + WHEN 'm' => + -- Reading data from memory to data out + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrReadOut,HeaderMsg,PortName); + END IF; + ReadMemory(MemoryData,DataOutTmp,Address); + PortFlag.DataCurrent := READ; + + WHEN 't' => + -- Transfering from data in to data out + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrAssgOut,HeaderMsg,PortName); + END IF; + DataOutTmp := DataInBus; + PortFlag.DataCurrent := READ; + + WHEN '0' => + -- Assigning low level to data out + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrAsg0Out,HeaderMsg,PortName); + END IF; + DataOutTmp := (OTHERS => '0'); + PortFlag.DataCurrent := READ; + + WHEN '1' => + -- Assigning high level to data out + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrAsg1Out,HeaderMsg,PortName); + END IF; + DataOutTmp := (OTHERS => '1'); + PortFlag.DataCurrent := READ; + + WHEN 'Z' => + -- Assigning high impedence to data out + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrAsgZOut,HeaderMsg,PortName); + END IF; + DataOutTmp := (OTHERS => 'Z'); + PortFlag.DataCurrent := HIGHZ; + + WHEN 'S' => + -- Keeping data out at steady value + PortFlag.OutputDisable := TRUE; + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrAsgSOut,HeaderMsg,PortName); + END IF; + + WHEN OTHERS => + -- Unknown data action + PortFlag.DataCurrent := UNDEF; + IF (MsgOn) THEN + PrintMemoryMessage(CallerName,ErrUnknDatDo,HeaderMsg,PortName); + END IF; + + END CASE; + + DataOutBus(HighBit DOWNTO LowBit) := DataOutTmp(HighBit DOWNTO LowBit); + +END; + + +-- ---------------------------------------------------------------------------- +-- Memory Table Modeling Primitives +-- ---------------------------------------------------------------------------- + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalDeclareMemory +-- Parameters: NoOfWords - Number of words in the memory +-- NoOfBitsPerWord - Number of bits per word in memory +-- NoOfBitsPerSubWord - Number of bits per sub word +-- MemoryLoadFile - Name of data file to load +-- Description: This function is intended to be used to initialize +-- memory data declarations, i.e. to be executed duing +-- simulation elaboration time. Handles the allocation +-- and initialization of memory for the memory data. +-- Default NoOfBitsPerSubWord is NoOfBitsPerWord. +-- ---------------------------------------------------------------------------- +IMPURE FUNCTION VitalDeclareMemory ( + CONSTANT NoOfWords : IN POSITIVE; + CONSTANT NoOfBitsPerWord : IN POSITIVE; + CONSTANT MemoryLoadFile : IN string := ""; + CONSTANT BinaryLoadFile : IN BOOLEAN := FALSE +) RETURN VitalMemoryDataType IS + VARIABLE MemoryPtr : VitalMemoryDataType; +BEGIN + MemoryPtr := VitalDeclareMemory( + NoOfWords => NoOfWords, + NoOfBitsPerWord => NoOfBitsPerWord, + NoOfBitsPerSubWord => NoOfBitsPerWord, + MemoryLoadFile => MemoryLoadFile, + BinaryLoadFile => BinaryLoadFile + ); + RETURN MemoryPtr; +END; + +-- ---------------------------------------------------------------------------- +IMPURE FUNCTION VitalDeclareMemory ( + CONSTANT NoOfWords : IN POSITIVE; + CONSTANT NoOfBitsPerWord : IN POSITIVE; + CONSTANT NoOfBitsPerSubWord : IN POSITIVE; + CONSTANT MemoryLoadFile : IN string := ""; + CONSTANT BinaryLoadFile : IN BOOLEAN := FALSE +) RETURN VitalMemoryDataType IS + VARIABLE MemoryPtr : VitalMemoryDataType; + VARIABLE BitsPerEnable : NATURAL + := ((NoOfBitsPerWord-1) + /NoOfBitsPerSubWord)+1; +BEGIN + PrintMemoryMessage(MsgVDM,ErrInitMem); + MemoryPtr := new VitalMemoryArrayRecType '( + NoOfWords => NoOfWords, + NoOfBitsPerWord => NoOfBitsPerWord, + NoOfBitsPerSubWord => NoOfBitsPerSubWord, + NoOfBitsPerEnable => BitsPerEnable, + MemoryArrayPtr => NULL + ); + MemoryPtr.MemoryArrayPtr + := new MemoryArrayType (0 to MemoryPtr.NoOfWords - 1); + FOR i IN 0 TO MemoryPtr.NoOfWords - 1 LOOP + MemoryPtr.MemoryArrayPtr(i) + := new MemoryWordType (MemoryPtr.NoOfBitsPerWord - 1 DOWNTO 0); + END LOOP; + IF (MemoryLoadFile /= "") THEN + LoadMemory (MemoryPtr, MemoryLoadFile, BinaryLoadFile); + END IF; + RETURN MemoryPtr; +END; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemoryTable +-- Parameters: DataOutBus - Output candidate zero delay data bus out +-- MemoryData - Pointer to memory data structure +-- PrevControls - Previous data in for edge detection +-- PrevEnableBus - Previous enables for edge detection +-- PrevDataInBus - Previous data bus for edge detection +-- PrevAddressBus - Previous address bus for edge detection +-- PortFlag - Indicates port operating mode +-- PortFlagArray - Vector form of PortFlag for sub-word +-- Controls - Agregate of scalar control lines +-- EnableBus - Concatenation of vector control lines +-- DataInBus - Input value of data bus in +-- AddressBus - Input value of address bus in +-- AddressValue - Decoded value of the AddressBus +-- MemoryTable - Input memory action table +-- PortType - The type of port (currently not used) +-- PortName - Port name string for messages +-- HeaderMsg - Header string for messages +-- MsgOn - Control the generation of messages +-- MsgSeverity - Control level of message generation +-- Description: This procedure implements the majority of the memory +-- modeling functionality via lookup of the memory action +-- tables and performing the specified actions if matches +-- are found, or the default actions otherwise. The +-- overloadings are provided for the word and sub-word +-- (using the EnableBus and PortFlagArray arguments) addressing +-- cases. +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryTable ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE PrevControls : INOUT std_logic_vector; + VARIABLE PrevDataInBus : INOUT std_logic_vector; + VARIABLE PrevAddressBus : INOUT std_logic_vector; + VARIABLE PortFlag : INOUT VitalPortFlagVectorType; + CONSTANT Controls : IN std_logic_vector; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT AddressBus : IN std_logic_vector; + VARIABLE AddressValue : INOUT VitalAddressValueType; + CONSTANT MemoryTable : IN VitalMemoryTableType; + CONSTANT PortType : IN VitalPortType := UNDEF; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +) IS + + VARIABLE DataOutTmp : std_logic_vector(DataOutBus'RANGE) + := DataOutBus; + VARIABLE MemoryAction : VitalMemorySymbolType; + VARIABLE DataAction : VitalMemorySymbolType; + VARIABLE HighBit : NATURAL := MemoryData.NoOfBitsPerWord-1; + VARIABLE LowBit : NATURAL := 0; + VARIABLE Address : INTEGER := 0; + VARIABLE PortFlagTmp : VitalPortFlagType; + VARIABLE AddrFlag : VitalMemorySymbolType := 'g'; -- good addr + VARIABLE DataFlag : VitalMemorySymbolType := 'g'; -- good data + VARIABLE MemCorruptMask : std_logic_vector (DataOutBus'RANGE); + VARIABLE DatCorruptMask : std_logic_vector (DataOutBus'RANGE); + +BEGIN + + -- Optimize for case when all current inputs are same as previous + IF (PrevDataInBus = DataInBus + AND PrevAddressBus = AddressBus + AND PrevControls = Controls + AND PortFlag(0).MemoryCurrent = PortFlag(0).MemoryPrevious + AND PortFlag(0).DataCurrent = PortFlag(0).DataPrevious) THEN + PortFlag(0).OutputDisable := TRUE; + RETURN; + END IF; + + PortFlag(0).DataPrevious := PortFlag(0).DataCurrent; + PortFlag(0).MemoryPrevious := PortFlag(0).MemoryCurrent; + PortFlag(0).OutputDisable := FALSE; + PortFlagTmp := PortFlag(0); + + -- Convert address bus to integer value and table lookup flag + DecodeAddress( + Address => Address , + AddrFlag => AddrFlag , + MemoryData => MemoryData , + PrevAddressBus => PrevAddressBus , + AddressBus => AddressBus + ); + + -- Interpret data bus as a table lookup flag + DecodeData ( + DataFlag => DataFlag , + PrevDataInBus => PrevDataInBus , + DataInBus => DataInBus , + HighBit => HighBit , + LowBit => LowBit + ); + + -- Lookup memory and data actions + MemoryTableLookUp( + MemoryAction => MemoryAction , + DataAction => DataAction , + MemoryCorruptMask => MemCorruptMask , + DataCorruptMask => DatCorruptMask , + PrevControls => PrevControls , + Controls => Controls , + AddrFlag => AddrFlag , + DataFlag => DataFlag , + MemoryTable => MemoryTable , + PortName => PortName , + HeaderMsg => HeaderMsg , + MsgOn => MsgOn + ); + + -- Handle data action before memory action + -- This allows reading previous memory contents + HandleDataAction( + DataOutBus => DataOutTmp , + MemoryData => MemoryData , + PortFlag => PortFlagTmp , + CorruptMask => DatCorruptMask , + DataInBus => DataInBus , + Address => Address , + HighBit => HighBit , + LowBit => LowBit , + MemoryTable => MemoryTable , + DataAction => DataAction , + CallerName => MsgVMT , + PortName => PortName , + HeaderMsg => HeaderMsg , + MsgOn => MsgOn + ); + + HandleMemoryAction( + MemoryData => MemoryData , + PortFlag => PortFlagTmp , + CorruptMask => MemCorruptMask , + DataInBus => DataInBus , + Address => Address , + HighBit => HighBit , + LowBit => LowBit , + MemoryTable => MemoryTable , + MemoryAction => MemoryAction , + CallerName => MsgVMT , + PortName => PortName , + HeaderMsg => HeaderMsg , + MsgOn => MsgOn + ); + + -- Set the output PortFlag(0) value + IF (DataAction = 'S') THEN + PortFlagTmp.OutputDisable := TRUE; + END IF; + IF (PortFlagTmp.DataCurrent = PortFlagTmp.DataPrevious + AND PortFlagTmp.DataCurrent = HIGHZ) THEN + PortFlagTmp.OutputDisable := TRUE; + END IF; + PortFlag(0) := PortFlagTmp; + + -- Set previous values for subsequent edge detection + PrevControls := Controls; + PrevDataInBus := DataInBus; + PrevAddressBus := AddressBus; + + -- Set the candidate zero delay return value + DataOutBus := DataOutTmp; + + -- Set the output AddressValue for VitalMemoryCrossPorts + AddressValue := Address; + +END VitalMemoryTable; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryTable ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE PrevControls : INOUT std_logic_vector; + VARIABLE PrevEnableBus : INOUT std_logic_vector; + VARIABLE PrevDataInBus : INOUT std_logic_vector; + VARIABLE PrevAddressBus : INOUT std_logic_vector; + VARIABLE PortFlagArray : INOUT VitalPortFlagVectorType; + CONSTANT Controls : IN std_logic_vector; + CONSTANT EnableBus : IN std_logic_vector; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT AddressBus : IN std_logic_vector; + VARIABLE AddressValue : INOUT VitalAddressValueType; + CONSTANT MemoryTable : IN VitalMemoryTableType; + CONSTANT PortType : IN VitalPortType := UNDEF; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +) IS + + VARIABLE BitsPerWord : NATURAL := MemoryData.NoOfBitsPerWord; + VARIABLE BitsPerSubWord : NATURAL := MemoryData.NoOfBitsPerSubWord; + VARIABLE BitsPerEnable : NATURAL := MemoryData.NoOfBitsPerEnable; + VARIABLE DataOutTmp : std_logic_vector(DataOutBus'RANGE) + := DataOutBus; + VARIABLE MemoryAction : VitalMemorySymbolType; + VARIABLE DataAction : VitalMemorySymbolType; + VARIABLE HighBit : NATURAL := BitsPerSubWord-1; + VARIABLE LowBit : NATURAL := 0; + VARIABLE Address : INTEGER := 0; + VARIABLE PortFlagTmp : VitalPortFlagType; + VARIABLE AddrFlag : VitalMemorySymbolType := 'g'; -- good addr + VARIABLE DataFlag : VitalMemorySymbolType := 'g'; -- good data + VARIABLE MemCorruptMask : std_logic_vector (DataOutBus'RANGE); + VARIABLE DatCorruptMask : std_logic_vector (DataOutBus'RANGE); + +BEGIN + + -- Optimize for case when all current inputs are same as previous + IF (PrevDataInBus = DataInBus + AND PrevAddressBus = AddressBus + AND PrevControls = Controls) THEN + CheckFlags: + FOR i IN 0 TO BitsPerEnable-1 LOOP + IF (PortFlagArray(i).MemoryCurrent /= PortFlagArray(i).MemoryPrevious + OR PortFlagArray(i).DataCurrent /= PortFlagArray(i).DataPrevious) THEN + EXIT CheckFlags; + END IF; + IF (i = BitsPerEnable-1) THEN + FOR j IN 0 TO BitsPerEnable-1 LOOP + PortFlagArray(j).OutputDisable := TRUE; + END LOOP; + RETURN; + END IF; + END LOOP; + END IF; + + -- Convert address bus to integer value and table lookup flag + DecodeAddress( + Address => Address, + AddrFlag => AddrFlag, + MemoryData => MemoryData, + PrevAddressBus => PrevAddressBus, + AddressBus => AddressBus + ); + + -- Perform independent operations for each sub-word + FOR i IN 0 TO BitsPerEnable-1 LOOP + + -- Set the output PortFlag(i) value + PortFlagArray(i).DataPrevious := PortFlagArray(i).DataCurrent; + PortFlagArray(i).MemoryPrevious := PortFlagArray(i).MemoryCurrent; + PortFlagArray(i).OutputDisable := FALSE; + PortFlagTmp := PortFlagArray(i); + + -- Interpret data bus as a table lookup flag + DecodeData ( + DataFlag => DataFlag , + PrevDataInBus => PrevDataInBus , + DataInBus => DataInBus , + HighBit => HighBit , + LowBit => LowBit + ); + + -- Lookup memory and data actions + MemoryTableLookUp( + MemoryAction => MemoryAction , + DataAction => DataAction , + MemoryCorruptMask => MemCorruptMask , + DataCorruptMask => DatCorruptMask , + PrevControls => PrevControls , + PrevEnableBus => PrevEnableBus , + Controls => Controls , + EnableBus => EnableBus , + EnableIndex => i , + BitsPerWord => BitsPerWord , + BitsPerSubWord => BitsPerSubWord , + BitsPerEnable => BitsPerEnable , + AddrFlag => AddrFlag , + DataFlag => DataFlag , + MemoryTable => MemoryTable , + PortName => PortName , + HeaderMsg => HeaderMsg , + MsgOn => MsgOn + ); + + -- Handle data action before memory action + -- This allows reading previous memory contents + HandleDataAction( + DataOutBus => DataOutTmp , + MemoryData => MemoryData , + PortFlag => PortFlagTmp , + CorruptMask => DatCorruptMask , + DataInBus => DataInBus , + Address => Address , + HighBit => HighBit , + LowBit => LowBit , + MemoryTable => MemoryTable , + DataAction => DataAction , + CallerName => MsgVMT , + PortName => PortName , + HeaderMsg => HeaderMsg , + MsgOn => MsgOn + ); + + HandleMemoryAction( + MemoryData => MemoryData , + PortFlag => PortFlagTmp , + CorruptMask => MemCorruptMask , + DataInBus => DataInBus , + Address => Address , + HighBit => HighBit , + LowBit => LowBit , + MemoryTable => MemoryTable , + MemoryAction => MemoryAction , + CallerName => MsgVMT , + PortName => PortName , + HeaderMsg => HeaderMsg , + MsgOn => MsgOn + ); + + -- Set the output PortFlag(i) value + IF (DataAction = 'S') THEN + PortFlagTmp.OutputDisable := TRUE; + END IF; + IF (PortFlagTmp.DataCurrent = PortFlagTmp.DataPrevious + AND PortFlagTmp.DataCurrent = HIGHZ) THEN + PortFlagTmp.OutputDisable := TRUE; + END IF; + PortFlagArray(i) := PortFlagTmp; + + IF (i < BitsPerEnable-1) THEN + -- Calculate HighBit and LowBit + LowBit := LowBit + BitsPerSubWord; + IF (LowBit > BitsPerWord) THEN + LowBit := BitsPerWord; + END IF; + HighBit := LowBit + BitsPerSubWord; + IF (HighBit > BitsPerWord) THEN + HighBit := BitsPerWord; + ELSE + HighBit := HighBit - 1; + END IF; + END IF; + + END LOOP; + + -- Set previous values for subsequent edge detection + PrevControls := Controls; + PrevEnableBus := EnableBus; + PrevDataInBus := DataInBus; + PrevAddressBus := AddressBus; + + -- Set the candidate zero delay return value + DataOutBus := DataOutTmp; + + -- Set the output AddressValue for VitalMemoryCrossPorts + AddressValue := Address; + +END VitalMemoryTable; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemoryCrossPorts +-- Parameters: DataOutBus - Output candidate zero delay data bus out +-- MemoryData - Pointer to memory data structure +-- SamePortFlag - Operating mode for same port +-- SamePortAddressValue - Operating modes for cross ports +-- CrossPortAddressArray - Decoded AddressBus for cross ports +-- CrossPortMode - Write contention and crossport read control +-- PortName - Port name string for messages +-- HeaderMsg - Header string for messages +-- MsgOn - Control the generation of messages +-- Description: These procedures control the effect of memory operations +-- on a given port due to operations on other ports in a +-- multi-port memory. +-- This includes data write through when reading and writing +-- to the same address, as well as write contention when +-- there are multiple write to the same address. +-- If addresses do not match then data bus is unchanged. +-- The DataOutBus can be diabled with 'Z' value. +-- If the WritePortFlag is 'CORRUPT', that would mean +-- that the whole memory is corrupted. So, for corrupting +-- the Read port, the Addresses need not be compared. +-- +-- CrossPortMode Enum Description +-- 1. CpRead Allows Cross Port Read Only +-- No contention checking. +-- 2. WriteContention Allows for write contention checks +-- only between multiple write ports +-- 3. ReadWriteContention Allows contention between read and +-- write ports. The action is to corrupt +-- the memory and the output bus. +-- 4. CpReadAndWriteContention Is a combination of 1 & 2 +-- 5. CpReadAndReadContention Allows contention between read and +-- write ports. The action is to corrupt +-- the dataout bus only. The cp read is +-- performed if not contending. +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryCrossPorts ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE SamePortFlag : INOUT VitalPortFlagVectorType; + CONSTANT SamePortAddressValue : IN VitalAddressValueType; + CONSTANT CrossPortFlagArray : IN VitalPortFlagVectorType; + CONSTANT CrossPortAddressArray : IN VitalAddressValueVectorType; + CONSTANT CrossPortMode : IN VitalCrossPortModeType + := CpReadAndWriteContention; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE +) IS + + VARIABLE BitsPerWord : NATURAL := MemoryData.NoOfBitsPerWord; + VARIABLE BitsPerSubWord : NATURAL := MemoryData.NoOfBitsPerSubWord; + VARIABLE BitsPerEnable : NATURAL := MemoryData.NoOfBitsPerEnable; + VARIABLE DataOutTmp : std_logic_vector(DataOutBus'RANGE) := (OTHERS => 'Z'); + VARIABLE MemoryTmp : std_logic_vector(DataOutBus'RANGE); + VARIABLE CrossPorts : NATURAL := CrossPortAddressArray'LENGTH; + VARIABLE LowBit : NATURAL := 0; + VARIABLE HighBit : NATURAL := BitsPerSubWord-1; + VARIABLE Address : VitalAddressValueType := SamePortAddressValue; + VARIABLE AddressJ : VitalAddressValueType; + VARIABLE AddressK : VitalAddressValueType; + VARIABLE PortFlagI : VitalPortFlagType; + VARIABLE PortFlagIJ : VitalPortFlagType; + VARIABLE PortFlagIK : VitalPortFlagType; + VARIABLE DoCpRead : BOOLEAN := FALSE; + VARIABLE DoWrCont : BOOLEAN := FALSE; + VARIABLE DoCpCont : BOOLEAN := FALSE; + VARIABLE DoRdWrCont : BOOLEAN := FALSE; + VARIABLE CpWrCont : BOOLEAN := FALSE; + VARIABLE ModeWrCont : BOOLEAN := + (CrossPortMode=WriteContention) OR + (CrossPortMode=CpReadAndWriteContention); + VARIABLE ModeCpRead : BOOLEAN := + (CrossPortMode=CpRead) OR + (CrossPortMode=CpReadAndWriteContention); + VARIABLE ModeCpCont : BOOLEAN := (CrossPortMode=ReadWriteContention); + VARIABLE ModeRdWrCont : BOOLEAN := (CrossPortMode=CpReadAndReadContention); + +BEGIN + + -- Check for disabled port (i.e. OTHERS => 'Z') + IF (DataOutBus = DataOutTmp) THEN + RETURN; + ELSE + DataOutTmp := DataOutBus; + END IF; + + -- Check for error in address + IF (Address < 0) THEN + RETURN; + END IF; + + ReadMemory(MemoryData,MemoryTmp,Address); + + SubWordLoop: -- For each slice of the sub-word I + FOR i IN 0 TO BitsPerEnable-1 LOOP + PortFlagI := SamePortFlag(i); + + -- For each cross port J: check with same port address + FOR j IN 0 TO CrossPorts-1 LOOP + PortFlagIJ := CrossPortFlagArray(i+j*BitsPerEnable); + AddressJ := CrossPortAddressArray(j); + IF (AddressJ < 0) THEN + NEXT; + END IF; + DoWrCont := (Address = AddressJ) AND + (ModeWrCont = TRUE) AND + ((PortFlagI.MemoryCurrent = WRITE) OR + (PortFlagI.MemoryCurrent = CORRUPT)) AND + ((PortFlagIJ.MemoryCurrent = WRITE) OR + (PortFlagIJ.MemoryCurrent = CORRUPT)) ; + DoCpRead := (Address = AddressJ) AND + (ModeCpRead = TRUE) AND + ((PortFlagI.MemoryCurrent = READ) OR + (PortFlagI.OutputDisable = TRUE)) AND + ((PortFlagIJ.MemoryCurrent = WRITE) OR + (PortFlagIJ.MemoryCurrent = CORRUPT)) ; + DoCpCont := (Address = AddressJ) AND + (ModeCpCont = TRUE) AND + ((PortFlagI.MemoryCurrent = READ) OR + (PortFlagI.OutputDisable = TRUE)) AND + ((PortFlagIJ.MemoryCurrent = WRITE) OR + (PortFlagIJ.MemoryCurrent = CORRUPT)) ; + DoRdWrCont:= (Address = AddressJ) AND + (ModeRdWrCont = TRUE) AND + ((PortFlagI.MemoryCurrent = READ) OR + (PortFlagI.OutputDisable = TRUE)) AND + ((PortFlagIJ.MemoryCurrent = WRITE) OR + (PortFlagIJ.MemoryCurrent = CORRUPT)) ; + IF (DoWrCont OR DoCpCont) THEN + -- Corrupt dataout and memory + MemoryTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X'); + DataOutTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X'); + SamePortFlag(i).MemoryCurrent := CORRUPT; + SamePortFlag(i).DataCurrent := CORRUPT; + SamePortFlag(i).OutputDisable := FALSE; + EXIT; + END IF; + IF (DoCpRead) THEN + -- Update dataout with memory + DataOutTmp(HighBit DOWNTO LowBit) := + MemoryTmp(HighBit DOWNTO LowBit); + SamePortFlag(i).MemoryCurrent := READ; + SamePortFlag(i).DataCurrent := READ; + SamePortFlag(i).OutputDisable := FALSE; + EXIT; + END IF; + IF (DoRdWrCont) THEN + -- Corrupt dataout only + DataOutTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X'); + SamePortFlag(i).DataCurrent := CORRUPT; + SamePortFlag(i).OutputDisable := FALSE; + EXIT; + END IF; + END LOOP; + + IF (i < BitsPerEnable-1) THEN + -- Calculate HighBit and LowBit + LowBit := LowBit + BitsPerSubWord; + IF (LowBit > BitsPerWord) THEN + LowBit := BitsPerWord; + END IF; + HighBit := LowBit + BitsPerSubWord; + IF (HighBit > BitsPerWord) THEN + HighBit := BitsPerWord; + ELSE + HighBit := HighBit - 1; + END IF; + END IF; + + END LOOP; -- SubWordLoop + + DataOutBus := DataOutTmp; + + IF (DoWrCont) THEN + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMCP,ErrMcpWrCont,HeaderMsg,PortName); + END IF; + WriteMemory(MemoryData,MemoryTmp,Address); + END IF; + + IF (DoCpCont) THEN + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMCP,ErrMcpCpCont,HeaderMsg,PortName); + END IF; + WriteMemory(MemoryData,MemoryTmp,Address); + END IF; + + IF (DoCpRead) THEN + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMCP,ErrMcpCpRead,HeaderMsg,PortName); + END IF; + END IF; + + IF (DoRdWrCont) THEN + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMCP,ErrMcpRdWrCo,HeaderMsg,PortName); + END IF; + END IF; + +END VitalMemoryCrossPorts; + +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryCrossPorts ( + VARIABLE MemoryData : INOUT VitalMemoryDataType; + CONSTANT CrossPortFlagArray : IN VitalPortFlagVectorType; + CONSTANT CrossPortAddressArray : IN VitalAddressValueVectorType; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE +) IS + + VARIABLE BitsPerWord : NATURAL := MemoryData.NoOfBitsPerWord; + VARIABLE BitsPerSubWord : NATURAL := MemoryData.NoOfBitsPerSubWord; + VARIABLE BitsPerEnable : NATURAL := MemoryData.NoOfBitsPerEnable; + VARIABLE MemoryTmp : std_logic_vector(BitsPerWord-1 DOWNTO 0); + VARIABLE CrossPorts : NATURAL := CrossPortAddressArray'LENGTH; + VARIABLE LowBit : NATURAL := 0; + VARIABLE HighBit : NATURAL := BitsPerSubWord-1; + VARIABLE AddressJ : VitalAddressValueType; + VARIABLE AddressK : VitalAddressValueType; + VARIABLE PortFlagIJ : VitalPortFlagType; + VARIABLE PortFlagIK : VitalPortFlagType; + VARIABLE CpWrCont : BOOLEAN := FALSE; + +BEGIN + + SubWordLoop: -- For each slice of the sub-word I + FOR i IN 0 TO BitsPerEnable-1 LOOP + + -- For each cross port J: check with each cross port K + FOR j IN 0 TO CrossPorts-1 LOOP + PortFlagIJ := CrossPortFlagArray(i+j*BitsPerEnable); + AddressJ := CrossPortAddressArray(j); + -- Check for error in address + IF (AddressJ < 0) THEN + NEXT; + END IF; + ReadMemory(MemoryData,MemoryTmp,AddressJ); + -- For each cross port K + FOR k IN 0 TO CrossPorts-1 LOOP + IF (k <= j) THEN + NEXT; + END IF; + PortFlagIK := CrossPortFlagArray(i+k*BitsPerEnable); + AddressK := CrossPortAddressArray(k); + -- Check for error in address + IF (AddressK < 0) THEN + NEXT; + END IF; + CpWrCont := ( (AddressJ = AddressK) AND + (PortFlagIJ.MemoryCurrent = WRITE) AND + (PortFlagIK.MemoryCurrent = WRITE) ) OR + ( (PortFlagIJ.MemoryCurrent = WRITE) AND + (PortFlagIK.MemoryCurrent = CORRUPT) ) OR + ( (PortFlagIJ.MemoryCurrent = CORRUPT) AND + (PortFlagIK.MemoryCurrent = WRITE) ) OR + ( (PortFlagIJ.MemoryCurrent = CORRUPT) AND + (PortFlagIK.MemoryCurrent = CORRUPT) ) ; + IF (CpWrCont) THEN + -- Corrupt memory only + MemoryTmp(HighBit DOWNTO LowBit) := (OTHERS => 'X'); + EXIT; + END IF; + END LOOP; -- FOR k IN 0 TO CrossPorts-1 LOOP + IF (CpWrCont = TRUE) THEN + IF (MsgOn) THEN + PrintMemoryMessage(MsgVMCP,ErrMcpCpWrCont,HeaderMsg); + END IF; + WriteMemory(MemoryData,MemoryTmp,AddressJ); + END IF; + END LOOP; -- FOR j IN 0 TO CrossPorts-1 LOOP + + IF (i < BitsPerEnable-1) THEN + -- Calculate HighBit and LowBit + LowBit := LowBit + BitsPerSubWord; + IF (LowBit > BitsPerWord) THEN + LowBit := BitsPerWord; + END IF; + HighBit := LowBit + BitsPerSubWord; + IF (HighBit > BitsPerWord) THEN + HighBit := BitsPerWord; + ELSE + HighBit := HighBit - 1; + END IF; + END IF; + END LOOP; -- SubWordLoop + +END VitalMemoryCrossPorts; + + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemoryViolation +-- Parameters: DataOutBus - Output zero delay data bus out +-- MemoryData - Pointer to memory data structure +-- PortFlag - Indicates port operating mode +-- TimingDataArray - This is currently not used (comment out) +-- ViolationArray - Aggregation of violation variables +-- DataInBus - Input value of data bus in +-- AddressBus - Input value of address bus in +-- AddressValue - Decoded value of the AddressBus +-- ViolationTable - Input memory violation table +-- PortName - Port name string for messages +-- HeaderMsg - Header string for messages +-- MsgOn - Control the generation of messages +-- MsgSeverity - Control level of message generation +-- Description: This procedure is intended to implement all actions on the +-- memory contents and data out bus as a result of timing viols. +-- It uses the memory action table to perform various corruption +-- policies specified by the user. +-- ---------------------------------------------------------------------------- + +PROCEDURE VitalMemoryViolation ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE PortFlag : INOUT VitalPortFlagVectorType; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT AddressValue : IN VitalAddressValueType; + CONSTANT ViolationFlags : IN std_logic_vector; + CONSTANT ViolationFlagsArray : IN X01ArrayT; + CONSTANT ViolationSizesArray : IN VitalMemoryViolFlagSizeType; + CONSTANT ViolationTable : IN VitalMemoryTableType; + CONSTANT PortType : IN VitalPortType; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +) IS + + VARIABLE BitsPerWord : NATURAL := MemoryData.NoOfBitsPerWord; + VARIABLE BitsPerSubWord : NATURAL := MemoryData.NoOfBitsPerSubWord; + VARIABLE BitsPerEnable : NATURAL := MemoryData.NoOfBitsPerEnable; + VARIABLE DataOutTmp : std_logic_vector(DataOutBus'RANGE) + := DataOutBus; + VARIABLE MemoryAction : VitalMemorySymbolType; + VARIABLE DataAction : VitalMemorySymbolType; + -- VMT relies on the corrupt masks so HighBit/LowBit are full word + VARIABLE HighBit : NATURAL := BitsPerWord-1; + VARIABLE LowBit : NATURAL := 0; + VARIABLE PortFlagTmp : VitalPortFlagType; + VARIABLE VFlagArrayTmp : std_logic_vector + (0 TO ViolationFlagsArray'LENGTH-1); + VARIABLE MemCorruptMask : std_logic_vector (DataOutBus'RANGE); + VARIABLE DatCorruptMask : std_logic_vector (DataOutBus'RANGE); + +BEGIN + + -- Don't do anything if given an error address + IF (AddressValue < 0) THEN + RETURN; + END IF; + + FOR i IN ViolationFlagsArray'RANGE LOOP + VFlagArrayTmp(i) := ViolationFlagsArray(i); + END LOOP; + + -- Lookup memory and data actions + ViolationTableLookUp( + MemoryAction => MemoryAction , + DataAction => DataAction , + MemoryCorruptMask => MemCorruptMask , + DataCorruptMask => DatCorruptMask , + ViolationFlags => ViolationFlags , + ViolationFlagsArray => VFlagArrayTmp , + ViolationSizesArray => ViolationSizesArray , + ViolationTable => ViolationTable , + BitsPerWord => BitsPerWord , + BitsPerSubWord => BitsPerSubWord , + BitsPerEnable => BitsPerEnable , + PortName => PortName , + HeaderMsg => HeaderMsg , + MsgOn => MsgOn + ); + + -- Need to read incoming PF value (was not before) + PortFlagTmp := PortFlag(0); + + IF (PortType = READ OR PortType = RDNWR) THEN + -- Handle data action before memory action + -- This allows reading previous memory contents + HandleDataAction( + DataOutBus => DataOutTmp , + MemoryData => MemoryData , + PortFlag => PortFlagTmp , + CorruptMask => DatCorruptMask , + DataInBus => DataInBus , + Address => AddressValue , + HighBit => HighBit , + LowBit => LowBit , + MemoryTable => ViolationTable , + DataAction => DataAction , + CallerName => MsgVMV , + PortName => PortName , + HeaderMsg => HeaderMsg , + MsgOn => MsgOn + ); + END IF; + + IF (PortType = WRITE OR PortType = RDNWR) THEN + HandleMemoryAction( + MemoryData => MemoryData , + PortFlag => PortFlagTmp , + CorruptMask => MemCorruptMask , + DataInBus => DataInBus , + Address => AddressValue , + HighBit => HighBit , + LowBit => LowBit , + MemoryTable => ViolationTable , + MemoryAction => MemoryAction , + CallerName => MsgVMV , + PortName => PortName , + HeaderMsg => HeaderMsg , + MsgOn => MsgOn + ); + END IF; + + -- Check if we need to turn off PF.OutputDisable + IF (DataAction /= 'S') THEN + PortFlagTmp.OutputDisable := FALSE; + -- Set the output PortFlag(0) value + -- Note that all bits of PortFlag get PortFlagTmp + FOR i IN PortFlag'RANGE LOOP + PortFlag(i) := PortFlagTmp; + END LOOP; + END IF; + + -- Set the candidate zero delay return value + DataOutBus := DataOutTmp; + +END; + +PROCEDURE VitalMemoryViolation ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE PortFlag : INOUT VitalPortFlagVectorType; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT AddressValue : IN VitalAddressValueType; + CONSTANT ViolationFlags : IN std_logic_vector; + CONSTANT ViolationTable : IN VitalMemoryTableType; + CONSTANT PortType : IN VitalPortType; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +) IS + + VARIABLE VFlagArrayTmp : X01ArrayT (0 TO 0); + +BEGIN + + VitalMemoryViolation ( + DataOutBus => DataOutBus , + MemoryData => MemoryData , + PortFlag => PortFlag , + DataInBus => DataInBus , + AddressValue => AddressValue , + ViolationFlags => ViolationFlags , + ViolationFlagsArray => VFlagArrayTmp , + ViolationSizesArray => ( 0 => 0 ) , + ViolationTable => ViolationTable , + PortType => PortType , + PortName => PortName , + HeaderMsg => HeaderMsg , + MsgOn => MsgOn , + MsgSeverity => MsgSeverity + ); + +END; + +END Vital_Memory ; diff --git a/libraries/vital2000/memory_p.vhdl b/libraries/vital2000/memory_p.vhdl new file mode 100644 index 000000000..83874f45e --- /dev/null +++ b/libraries/vital2000/memory_p.vhdl @@ -0,0 +1,1729 @@ +-- ---------------------------------------------------------------------------- +-- Title : Standard VITAL Memory Package +-- : +-- Library : Vital_Memory +-- : +-- Developers : IEEE DASC Timing Working Group (TWG), PAR 1076.4 +-- : Ekambaram Balaji, LSI Logic Corporation +-- : Jose De Castro, Consultant +-- : Prakash Bare, GDA Technologies +-- : William Yam, LSI Logic Corporation +-- : Dennis Brophy, Model Technology +-- : +-- Purpose : This packages defines standard types, constants, functions +-- : and procedures for use in developing ASIC memory models. +-- : +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Modification History : +-- ---------------------------------------------------------------------------- +-- Ver:|Auth:| Date:| Changes Made: +-- 0.1 | eb |071796| First prototye as part of VITAL memory proposal +-- 0.2 | jdc |012897| Initial prototyping with proposed MTM scheme +-- 0.3 | jdc |090297| Extensive updates for TAG review (functional) +-- 0.4 | eb |091597| Changed naming conventions for VitalMemoryTable +-- | | | Added interface of VitalMemoryCrossPorts() & +-- | | | VitalMemoryViolation(). +-- 0.5 | jdc |092997| Completed naming changes thoughout package body. +-- | | | Testing with simgle port test model looks ok. +-- 0.6 | jdc |121797| Major updates to the packages: +-- | | | - Implement VitalMemoryCrossPorts() +-- | | | - Use new VitalAddressValueType +-- | | | - Use new VitalCrossPortModeType enum +-- | | | - Overloading without SamePort args +-- | | | - Honor erroneous address values +-- | | | - Honor ports disabled with 'Z' +-- | | | - Implement implicit read 'M' table symbol +-- | | | - Cleanup buses to use (H DOWNTO L) +-- | | | - Message control via MsgOn,HeaderMsg,PortName +-- | | | - Tested with 1P1RW,2P2RW,4P2R2W,4P4RW cases +-- 0.7 | jdc |052698| Bug fixes to the packages: +-- | | | - Fix failure with negative Address values +-- | | | - Added debug messages for VMT table search +-- | | | - Remove 'S' for action column (only 's') +-- | | | - Remove 's' for response column (only 'S') +-- | | | - Remove 'X' for action and response columns +-- 0.8 | jdc |061298| Implemented VitalMemoryViolation() +-- | | | - Minimal functionality violation tables +-- | | | - Missing: +-- | | | - Cannot handle wide violation variables +-- | | | - Cannot handle sub-word cases +-- | | | Fixed IIC version of MemoryMatch +-- | | | Fixed 'M' vs 'm' switched on debug output +-- | | | TO BE DONE: +-- | | | - Implement 'd' corrupting a single bit +-- | | | - Implement 'D' corrupting a single bit +-- 0.9 |eb/sc|080498| Added UNDEF value for VitalPortFlagType +-- 0.10|eb/sc|080798| Added CORRUPT value for VitalPortFlagType +-- 0.11|eb/sc|081798| Added overloaded function interface for +-- | | | VitalDeclareMemory +-- 0.14| jdc |113198| Merging of memory functionality and version +-- | | | 1.4 9/17/98 of timing package from Prakash +-- 0.15| jdc |120198| Major development of VMV functionality +-- 0.16| jdc |120298| Complete VMV functionlality for initial testing +-- | | | - New ViolationTableCorruptMask() procedure +-- | | | - New MemoryTableCorruptMask() procedure +-- | | | - HandleMemoryAction(): +-- | | | - Removed DataOutBus bogus output +-- | | | - Replaced DataOutTmp with DataInTmp +-- | | | - Added CorruptMask input handling +-- | | | - Implemented 'd','D' using CorruptMask +-- | | | - CorruptMask on 'd','C','L','D','E' +-- | | | - CorruptMask ignored on 'c','l','e' +-- | | | - Changed 'l','d','e' to set PortFlag to CORRUPT +-- | | | - Changed 'L','D','E' to set PortFlag to CORRUPT +-- | | | - Changed 'c','l','d','e' to ignore HighBit, LowBit +-- | | | - Changed 'C','L','D','E' to use HighBit, LowBit +-- | | | - HandleDataAction(): +-- | | | - Added CorruptMask input handling +-- | | | - Implemented 'd','D' using CorruptMask +-- | | | - CorruptMask on 'd','C','L','D','E' +-- | | | - CorruptMask ignored on 'l','e' +-- | | | - Changed 'l','d','e' to set PortFlag to CORRUPT +-- | | | - Changed 'L','D','E' to set PortFlag to CORRUPT +-- | | | - Changed 'l','d','e' to ignore HighBit, LowBit +-- | | | - Changed 'L','D','E' to use HighBit, LowBit +-- | | | - MemoryTableLookUp(): +-- | | | - Added MsgOn table debug output +-- | | | - Uses new MemoryTableCorruptMask() +-- | | | - ViolationTableLookUp(): +-- | | | - Uses new ViolationTableCorruptMask() +-- 0.17| jdc |120898| - Added VitalMemoryViolationSymbolType, +-- | | | VitalMemoryViolationTableType data +-- | | | types but not used yet (need to discuss) +-- | | | - Added overload for VitalMemoryViolation() +-- | | | which does not have array flags +-- | | | - Bug fixes for VMV functionality: +-- | | | - ViolationTableLookUp() not handling '-' in +-- | | | scalar violation matching +-- | | | - VitalMemoryViolation() now normalizes +-- | | | VFlagArrayTmp'LEFT as LSB before calling +-- | | | ViolationTableLookUp() for proper scanning +-- | | | - ViolationTableCorruptMask() had to remove +-- | | | normalization of CorruptMaskTmp and +-- | | | ViolMaskTmp for proper MSB:LSB corruption +-- | | | - HandleMemoryAction(), HandleDataAction() +-- | | | - Removed 'D','E' since not being used +-- | | | - Use XOR instead of OR for corrupt masks +-- | | | - Now 'd' is sensitive to HighBit, LowBit +-- | | | - Fixed LowBit overflow in bit writeable case +-- | | | - MemoryTableCorruptMask() +-- | | | - ViolationTableCorruptMask() +-- | | | - VitalMemoryTable() +-- | | | - VitalMemoryCrossPorts() +-- | | | - Fixed VitalMemoryViolation() failing on +-- | | | error AddressValue from earlier VMT() +-- | | | - Minor cleanup of code formatting +-- 0.18| jdc |032599| - In VitalDeclareMemory() +-- | | | - Added BinaryLoadFile formal arg and +-- | | | modified LoadMemory() to handle bin +-- | | | - Added NOCHANGE to VitalPortFlagType +-- | | | - For VitalCrossPortModeType +-- | | | - Added CpContention enum +-- | | | - In HandleDataAction() +-- | | | - Set PortFlag := NOCHANGE for 'S' +-- | | | - In HandleMemoryAction() +-- | | | - Set PortFlag := NOCHANGE for 's' +-- | | | - In VitalMemoryTable() and +-- | | | VitalMemoryViolation() +-- | | | - Honor PortFlag = NOCHANGE returned +-- | | | from HandleMemoryAction() +-- | | | - In VitalMemoryCrossPorts() +-- | | | - Fixed Address = AddressJ for all +-- | | | conditions of DoWrCont & DoCpRead +-- | | | - Handle CpContention like WrContOnly +-- | | | under CpReadOnly conditions, with +-- | | | associated memory message changes +-- | | | - Handle PortFlag = NOCHANGE like +-- | | | PortFlag = READ for actions +-- | | | - Modeling change: +-- | | | - Need to init PortFlag every delta +-- | | | PortFlag_A := (OTHES => UNDEF); +-- | | | - Updated InternalTimingCheck code +-- 0.19| jdc |042599| - Fixes for bit-writeable cases +-- | | | - Check PortFlag after HandleDataAction +-- | | | in VitalMemoryViolation() +-- 0.20| jdc |042599| - Merge PortFlag changes from Prakash +-- | | | and Willian: +-- | | | VitalMemorySchedulePathDelay() +-- | | | VitalMemoryExpandPortFlag() +-- 0.21| jdc |072199| - Changed VitalCrossPortModeType enums, +-- | | | added new CpReadAndReadContention. +-- | | | - Fixed VitalMemoryCrossPorts() parameter +-- | | | SamePortFlag to INOUT so that it can +-- | | | set CORRUPT or READ value. +-- | | | - Fixed VitalMemoryTable() where PortFlag +-- | | | setting by HandleDataAction() is being +-- | | | ignored when HandleMemoryAction() sets +-- | | | PortFlagTmp to NOCHANGE. +-- | | | - Fixed VitalMemoryViolation() to set +-- | | | all bits of PortFlag when violating. +-- 0.22| jdc |072399| - Added HIGHZ to PortFlagType. HandleData +-- | | | checks whether the previous state is HIGHZ. +-- | | | If yes then portFlag should be NOCHANGE +-- | | | for VMPD to ignore IORetain corruption. +-- | | | The idea is that the first Z should be +-- | | | propagated but later ones should be ignored. +-- | | | +-- 0.23| jdc |100499| - Took code checked in by Dennis 09/28/99 +-- | | | - Changed VitalPortFlagType to record of +-- | | | new VitalPortStateType to hold current, +-- | | | previous values and separate disable. +-- | | | Also created VitalDefaultPortFlag const. +-- | | | Removed usage of PortFlag NOCHANGE +-- | | | - VitalMemoryTable() changes: +-- | | | Optimized return when all curr = prev +-- | | | AddressValue is now INOUT to optimize +-- | | | Transfer PF.MemoryCurrent to MemoryPrevious +-- | | | Transfer PF.DataCurrent to DataPrevious +-- | | | Reset PF.OutputDisable to FALSE +-- | | | Expects PortFlag init in declaration +-- | | | No need to init PortFlag every delta +-- | | | - VitalMemorySchedulePathDelay() changes: +-- | | | Initialize with VitalDefaultPortFlag +-- | | | Check PortFlag.OutputDisable +-- | | | - HandleMemoryAction() changes: +-- | | | Set value of PortFlag.MemoryCurrent +-- | | | Never set PortFlag.OutputDisable +-- | | | - HandleDataAction() changes: +-- | | | Set value of PortFlag.DataCurrent +-- | | | Set PortFlag.DataCurrent for HIGHZ +-- | | | - VitalMemoryCrossPorts() changes: +-- | | | Check/set value of PF.MemoryCurrent +-- | | | Check value of PF.OutputDisable +-- | | | - VitalMemoryViolation() changes: +-- | | | Fixed bug - not reading inout PF value +-- | | | Clean up setting of PortFlag +-- 0.24| jdc |100899| - Modified update of PF.OutputDisable +-- | | | to correctly accomodate 2P1W1R case: +-- | | | the read port should not exhibit +-- | | | IO retain corrupt when reading +-- | | | addr unrelated to addr being written. +-- 0.25| jdc |100999| - VitalMemoryViolation() change: +-- | | | Fixed bug with RDNWR mode incorrectly +-- | | | updating the PF.OutputDisable +-- 0.26| jdc |100999| - VitalMemoryCrossPorts() change: +-- | | | Fixed bugs with update of PF +-- 0.27| jdc |101499| - VitalMemoryCrossPorts() change: +-- | | | Added DoRdWrCont message (ErrMcpRdWrCo, +-- | | | Memory cross port read/write data only +-- | | | contention) +-- | | | - VitalMemoryTable() change: +-- | | | Set PF.OutputDisable := TRUE for the +-- | | | optimized cases. +-- 0.28| pb |112399| - Added 8 VMPD procedures for vector +-- | | | PathCondition support. Now the total +-- | | | number of overloadings for VMPD is 24. +-- | | | - Number of overloadings for SetupHold +-- | | | procedures increased to 5. Scalar violations +-- | | | are not supported anymore. Vector checkEnabled +-- | | | support is provided through the new overloading +-- 0.29| jdc |120999| - HandleMemoryAction() HandleDataAction() +-- | | | Reinstated 'D' and 'E' actions but +-- | | | with new PortFlagType +-- | | | - Updated file handling syntax, must compile +-- | | | with -93 syntax now. +-- 0.30| jdc |022300| - Formated for 80 column max width +-- ---------------------------------------------------------------------------- + +LIBRARY IEEE; +USE IEEE.STD_LOGIC_1164.ALL; +USE IEEE.Vital_Timing.ALL; +USE IEEE.Vital_Primitives.ALL; + +LIBRARY STD; +USE STD.TEXTIO.ALL; + +PACKAGE Vital_Memory IS + +-- ---------------------------------------------------------------------------- +-- Timing Section +-- ---------------------------------------------------------------------------- + +-- ---------------------------------------------------------------------------- +-- Types and constants for Memory timing procedures +-- ---------------------------------------------------------------------------- +TYPE VitalMemoryArcType IS (ParallelArc, CrossArc, SubwordArc); +TYPE OutputRetainBehaviorType IS (BitCorrupt, WordCorrupt); +TYPE VitalMemoryMsgFormatType IS (Vector, Scalar, VectorEnum); +TYPE X01ArrayT IS ARRAY (NATURAL RANGE <> ) OF X01; +TYPE X01ArrayPT IS ACCESS X01ArrayT; +TYPE VitalMemoryViolationType IS ACCESS X01ArrayT; +CONSTANT DefaultNumBitsPerSubword : INTEGER := -1; + + +-- Data type storing path delay and schedule information for output bits +TYPE VitalMemoryScheduleDataType IS RECORD + OutputData : std_ulogic; + NumBitsPerSubWord : INTEGER; + ScheduleTime : TIME; + ScheduleValue : std_ulogic; + LastOutputValue : std_ulogic; + PropDelay : TIME; + OutputRetainDelay : TIME; + InputAge : TIME; +END RECORD; + +TYPE VitalMemoryTimingDataType IS RECORD + NotFirstFlag : BOOLEAN; + RefLast : X01; + RefTime : TIME; + HoldEn : BOOLEAN; + TestLast : std_ulogic; + TestTime : TIME; + SetupEn : BOOLEAN; + TestLastA : VitalLogicArrayPT; + TestTimeA : VitalTimeArrayPT; + RefLastA : X01ArrayPT; + RefTimeA : VitalTimeArrayPT; + HoldEnA : VitalBoolArrayPT; + SetupEnA : VitalBoolArrayPT; +END RECORD; + +TYPE VitalPeriodDataArrayType IS ARRAY (NATURAL RANGE <>) OF + VitalPeriodDataType; + +-- Data type storing path delay and schedule information for output +-- vectors +TYPE VitalMemoryScheduleDataVectorType IS ARRAY (NATURAL RANGE <> ) OF + VitalMemoryScheduleDataType; + +-- VitalPortFlagType records runtime mode of port sub-word slices +-- TYPE VitalPortFlagType IS ( +-- UNDEF, +-- READ, +-- WRITE, +-- CORRUPT, +-- HIGHZ, +-- NOCHANGE +-- ); + +-- VitalPortFlagType records runtime mode of port sub-word slices +TYPE VitalPortStateType IS ( + UNDEF, + READ, + WRITE, + CORRUPT, + HIGHZ +); + +TYPE VitalPortFlagType IS RECORD + MemoryCurrent : VitalPortStateType; + MemoryPrevious : VitalPortStateType; + DataCurrent : VitalPortStateType; + DataPrevious : VitalPortStateType; + OutputDisable : BOOLEAN; +END RECORD; + +CONSTANT VitalDefaultPortFlag : VitalPortFlagType := ( + MemoryCurrent => READ, + MemoryPrevious => UNDEF, + DataCurrent => READ, + DataPrevious => UNDEF, + OutputDisable => FALSE +); + +-- VitalPortFlagVectorType to be same width i as enables of a port +-- or j multiples thereof, where j is the number of cross ports +TYPE VitalPortFlagVectorType IS + ARRAY (NATURAL RANGE <>) OF VitalPortFlagType; + +-- ---------------------------------------------------------------------------- +-- Functions : VitalMemory path delay procedures +-- - VitalMemoryInitPathDelay +-- - VitalMemoryAddPathDelay +-- - VitalMemorySchedulePathDelay +-- +-- Description: VitalMemoryInitPathDelay, VitalMemoryAddPathDelay and +-- VitalMemorySchedulePathDelay are Level 1 routines used +-- for selecting the propagation delay paths based on +-- path condition, transition type and delay values and +-- schedule a new output value. +-- +-- Following features are implemented in these procedures: +-- o condition dependent path selection +-- o Transition dependent delay selection +-- o shortest delay path selection from multiple +-- candidate paths +-- o Scheduling of the computed values on the specified +-- signal. +-- o output retain behavior if outputRetain flag is set +-- o output mapping to alternate strengths to model +-- pull-up, pull-down etc. +-- +-- +-- +-- Following is information on overloading of the procedures. +-- +-- VitalMemoryInitPathDelay is overloaded for ScheduleDataArray and +-- OutputDataArray +-- +-- ---------------------------------------------------------------------------- +-- ScheduleDataArray OutputDataArray +-- ---------------------------------------------------------------------------- +-- Scalar Scalar +-- Vector Vector +-- ---------------------------------------------------------------------------- +-- +-- +-- VitalMemoryAddPathDelay is overloaded for ScheduleDataArray, +-- PathDelayArray, InputSignal and delaytype. +-- +-- ---------------------------------------------------------------------------- +-- DelayType InputSignal ScheduleData PathDelay +-- Array Array +-- ---------------------------------------------------------------------------- +-- VitalDelayType Scalar Scalar Scalar +-- VitalDelayType Scalar Vector Vector +-- VitalDelayType Vector Scalar Vector +-- VitalDelayType Vector Vector Vector +-- VitalDelayType01 Scalar Scalar Scalar +-- VitalDelayType01 Scalar Vector Vector +-- VitalDelayType01 Vector Scalar Vector +-- VitalDelayType01 Vector Vector Vector +-- VitalDelayType01Z Scalar Scalar Scalar +-- VitalDelayType01Z Scalar Vector Vector +-- VitalDelayType01Z Vector Scalar Vector +-- VitalDelayType01Z Vector Vector Vector +-- VitalDelayType01XZ Scalar Scalar Scalar +-- VitalDelayType01XZ Scalar Vector Vector +-- VitalDelayType01XZ Vector Scalar Vector +-- VitalDelayType01XZ Vector Vector Vector +-- ---------------------------------------------------------------------------- +-- +-- +-- VitalMemorySchedulePathDelay is overloaded for ScheduleDataArray, +-- and OutSignal +-- +-- ---------------------------------------------------------------------------- +-- OutSignal ScheduleDataArray +-- ---------------------------------------------------------------------------- +-- Scalar Scalar +-- Vector Vector +-- ---------------------------------------------------------------------------- +-- +-- Procedure Declarations: +-- +-- +-- Function : VitalMemoryInitPathDelay +-- +-- Arguments: +-- +-- INOUT Type Description +-- +-- ScheduleDataArray/ VitalMemoryScheduleDataVectorType/ +-- ScheduleData VitalMemoryScheduleDataType +-- Internal data variable for +-- storing delay and schedule +-- information for each output bit +-- +-- +-- IN +-- +-- OutputDataArray/ STD_LOGIC_VECTOR/Array containing current output +-- OutputData STD_ULOGIC value +-- +-- +-- NumBitsPerSubWord INTEGER Number of bits per subword. +-- Default value of this argument +-- is DefaultNumBitsPerSubword +-- which is interpreted as no +-- subwords +-- +-- ---------------------------------------------------------------------------- +-- +-- +-- ScheduleDataArray - Vector +-- OutputDataArray - Vector +-- +PROCEDURE VitalMemoryInitPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + VARIABLE OutputDataArray : IN STD_LOGIC_VECTOR; + CONSTANT NumBitsPerSubWord : IN INTEGER := DefaultNumBitsPerSubword +); +-- +-- ScheduleDataArray - Scalar +-- OutputDataArray - Scalar +-- +PROCEDURE VitalMemoryInitPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + VARIABLE OutputData : IN STD_ULOGIC +); + +-- ---------------------------------------------------------------------------- +-- +-- Function : VitalMemoryAddPathDelay +-- +-- Arguments +-- +-- INOUT Type Description +-- +-- ScheduleDataArray/ VitalMemoryScheduleDataVectorType/ +-- ScheduleData VitalMemoryScheduleDataType +-- Internal data variable for +-- storing delay and schedule +-- information for each output bit +-- +-- InputChangeTimeArray/ VitaltimeArrayT/Time +-- InputChangeTime Holds the time since the last +-- input change +-- +-- IN +-- +-- InputSignal STD_LOGIC_VECTOR +-- STD_ULOGIC/ Array holding the input value +-- +-- OutputSignalName STRING The output signal name +-- +-- PathDelayArray/ VitalDelayArrayType01ZX, +-- PathDelay VitalDelayArrayType01Z, +-- VitalDelayArrayType01, +-- VitalDelayArrayType/ +-- VitalDelayType01ZX, +-- VitalDelayType01Z, +-- VitalDelayType01, +-- VitalDelayType Array of delay values +-- +-- ArcType VitalMemoryArcType +-- Indicates the Path type. This +-- can be SubwordArc, CrossArc or +-- ParallelArc +-- +-- PathCondition BOOLEAN If True, the transition in +-- the corresponding input signal +-- is considered while +-- caluculating the prop. delay +-- else the transition is ignored. +-- +-- OutputRetainFlag BOOLEAN If specified TRUE,output retain +-- (hold) behavior is implemented. +-- +-- ---------------------------------------------------------------------------- +-- +-- #1 +-- DelayType - VitalDelayType +-- Input - Scalar +-- Output - Scalar +-- Delay - Scalar +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelay : IN VitalDelayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +); + +-- #2 +-- DelayType - VitalDelayType +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +); + +-- #3 +-- DelayType - VitalDelayType +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Vector + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray: IN VitalBoolArrayT +); + +-- #4 +-- DelayType - VitalDelayType +-- Input - Vector +-- Output - Scalar +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +); + +-- #5 +-- DelayType - VitalDelayType +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +); + +-- #6 +-- DelayType - VitalDelayType +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Vector + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray : IN VitalBoolArrayT +); + +-- #7 +-- DelayType - VitalDelayType01 +-- Input - Scalar +-- Output - Scalar +-- Delay - Scalar +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelay : IN VitalDelayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +); + +-- #8 +-- DelayType - VitalDelayType01 +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +); + +-- #9 +-- DelayType - VitalDelayType01 +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Vector + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray: IN VitalBoolArrayT +); + +-- #10 +-- DelayType - VitalDelayType01 +-- Input - Vector +-- Output - Scalar +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +); + +-- #11 +-- DelayType - VitalDelayType01 +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE +); + +-- #12 +-- DelayType - VitalDelayType01 +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Vector + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray : IN VitalBoolArrayT +); + +-- #13 +-- DelayType - VitalDelayType01Z +-- Input - Scalar +-- Output - Scalar +-- Delay - Scalar +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelay : IN VitalDelayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +); + +-- #14 +-- DelayType - VitalDelayType01Z +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +); + +-- #15 +-- DelayType - VitalDelayType01Z +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Vector + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray: IN VitalBoolArrayT; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +); + +-- #16 +-- DelayType - VitalDelayType01Z +-- Input - Vector +-- Output - Scalar +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +); + +-- #17 +-- DelayType - VitalDelayType01Z +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +); + +-- #18 +-- DelayType - VitalDelayType01Z +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Vector + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01Z; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray : IN VitalBoolArrayT; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +); + +-- #19 +-- DelayType - VitalDelayType01ZX +-- Input - Scalar +-- Output - Scalar +-- Delay - Scalar +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelay : IN VitalDelayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +); + +-- #20 +-- DelayType - VitalDelayType01ZX +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +); + +-- #21 +-- DelayType - VitalDelayType01ZX +-- Input - Scalar +-- Output - Vector +-- Delay - Vector +-- Condition - Vector + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_ULOGIC; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTime : INOUT Time; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray: IN VitalBoolArrayT; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE +); + +-- #22 +-- DelayType - VitalDelayType01ZX +-- Input - Vector +-- Output - Scalar +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +); + +-- #23 +-- DelayType - VitalDelayType01ZX +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Scalar + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathCondition : IN BOOLEAN := TRUE; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +); + +-- #24 +-- DelayType - VitalDelayType01ZX +-- Input - Vector +-- Output - Vector +-- Delay - Vector +-- Condition - Vector + +PROCEDURE VitalMemoryAddPathDelay ( + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType; + SIGNAL InputSignal : IN STD_LOGIC_VECTOR; + CONSTANT OutputSignalName : IN STRING := ""; + VARIABLE InputChangeTimeArray : INOUT VitalTimeArrayT; + CONSTANT PathDelayArray : IN VitalDelayArrayType01ZX; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT PathConditionArray : IN VitalBoolArrayT; + CONSTANT OutputRetainFlag : IN BOOLEAN := FALSE; + CONSTANT OutputRetainBehavior : IN OutputRetainBehaviorType := BitCorrupt +); + +-- ---------------------------------------------------------------------------- +-- +-- Function : VitalMemorySchedulePathDelay +-- +-- Arguments: +-- +-- OUT Type Description +-- OutSignal STD_LOGIC_VECTOR/ The output signal for +-- STD_ULOGIC scheduling +-- +-- IN +-- OutputSignalName STRING The name of the output signal +-- +-- IN +-- PortFlag VitalPortFlagType Port flag variable from +-- functional procedures +-- +-- IN +-- OutputMap VitalOutputMapType For VitalPathDelay01Z, the +-- output can be mapped to +-- alternate strengths to model +-- tri-state devices, pull-ups +-- and pull-downs. +-- +-- INOUT +-- ScheduleDataArray/ VitalMemoryScheduleDataVectorType/ +-- ScheduleData VitalMemoryScheduleDataType +-- Internal data variable for +-- storing delay and schedule +-- information for each +-- output bit +-- +-- ---------------------------------------------------------------------------- +-- +-- ScheduleDataArray - Vector +-- OutputSignal - Vector +-- +PROCEDURE VitalMemorySchedulePathDelay ( + SIGNAL OutSignal : OUT std_logic_vector; + CONSTANT OutputSignalName : IN STRING := ""; + CONSTANT PortFlag : IN VitalPortFlagType := VitalDefaultPortFlag; + CONSTANT OutputMap : IN VitalOutputMapType := VitalDefaultOutputMap; + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType +); +-- +-- ScheduleDataArray - Vector +-- OutputSignal - Vector +-- +PROCEDURE VitalMemorySchedulePathDelay ( + SIGNAL OutSignal : OUT std_logic_vector; + CONSTANT OutputSignalName : IN STRING := ""; + CONSTANT PortFlag : IN VitalPortFlagVectorType; + CONSTANT OutputMap : IN VitalOutputMapType := VitalDefaultOutputMap; + VARIABLE ScheduleDataArray : INOUT VitalMemoryScheduleDataVectorType +); +-- +-- ScheduleDataArray - Scalar +-- OutputSignal - Scalar +-- +PROCEDURE VitalMemorySchedulePathDelay ( + SIGNAL OutSignal : OUT std_ulogic; + CONSTANT OutputSignalName : IN STRING := ""; + CONSTANT PortFlag : IN VitalPortFlagType := VitalDefaultPortFlag; + CONSTANT OutputMap : IN VitalOutputMapType := VitalDefaultOutputMap; + VARIABLE ScheduleData : INOUT VitalMemoryScheduleDataType +); + +-- ---------------------------------------------------------------------------- +FUNCTION VitalMemoryTimingDataInit RETURN VitalMemoryTimingDataType; + +-- ---------------------------------------------------------------------------- +-- +-- Function Name: VitalMemorySetupHoldCheck +-- +-- Description: The VitalMemorySetupHoldCheck procedure detects a setup or a +-- hold violation on the input test signal with respect +-- to the corresponding input reference signal. The timing +-- constraints are specified through parameters +-- representing the high and low values for the setup and +-- hold values for the setup and hold times. This +-- procedure assumes non-negative values for setup and hold +-- timing constraints. +-- +-- It is assumed that negative timing constraints +-- are handled by internally delaying the test or +-- reference signals. Negative setup times result in +-- a delayed reference signal. Negative hold times +-- result in a delayed test signal. Furthermore, the +-- delays and constraints associated with these and +-- other signals may need to be appropriately +-- adjusted so that all constraint intervals overlap +-- the delayed reference signals and all constraint +-- values (with respect to the delayed signals) are +-- non-negative. +-- +-- This function is overloaded based on the input +-- TestSignal and reference signals. Parallel, Subword and +-- Cross Arc relationships between test and reference +-- signals are supported. +-- +-- TestSignal XXXXXXXXXXXX____________________________XXXXXXXXXXXXXXXXXXXXXX +-- : +-- : -->| error region |<-- +-- : +-- _______________________________ +-- RefSignal \______________________________ +-- : | | | +-- : | -->| |<-- thold +-- : -->| tsetup |<-- +-- +-- Arguments: +-- +-- IN Type Description +-- TestSignal std_logic_vector Value of test signal +-- TestSignalName STRING Name of test signal +-- TestDelay VitalDelayArrayType Model's internal delay associated +-- with TestSignal +-- RefSignal std_ulogic Value of reference signal +-- std_logic_vector +-- RefSignalName STRING Name of reference signal +-- RefDelay TIME Model's internal delay associated +-- VitalDelayArrayType with RefSignal +-- SetupHigh VitalDelayArrayType Absolute minimum time duration +-- before the transition of RefSignal +-- for which transitions of +-- TestSignal are allowed to proceed +-- to the "1" state without causing +-- a setup violation. +-- SetupLow VitalDelayArrayType Absolute minimum time duration +-- before the transition of RefSignal +-- for which transitions of +-- TestSignal are allowed to proceed +-- to the "0" state without causing +-- a setup violation. +-- HoldHigh VitalDelayArrayType Absolute minimum time duration +-- after the transition of RefSignal +-- for which transitions of +-- TestSignal are allowed to +-- proceed to the "1" state without +-- causing a hold violation. +-- HoldLow VitalDelayArrayType Absolute minimum time duration +-- after the transition of RefSignal +-- for which transitions of +-- TestSignal are allowed to +-- proceed to the "0" state without +-- causing a hold violation. +-- CheckEnabled BOOLEAN Check performed if TRUE. +-- RefTransition VitalEdgeSymbolType +-- Reference edge specified. Events +-- on the RefSignal which match the +-- edge spec. are used as reference +-- edges. +-- ArcType VitalMemoryArcType +-- NumBitsPerSubWord INTEGER +-- HeaderMsg STRING String that will accompany any +-- assertion messages produced. +-- XOn BOOLEAN If TRUE, Violation output +-- parameter is set to "X". +-- Otherwise, Violation is always +-- set to "0." +-- MsgOn BOOLEAN If TRUE, set and hold violation +-- message will be generated. +-- Otherwise, no messages are +-- generated, even upon violations. +-- MsgSeverity SEVERITY_LEVEL Severity level for the assertion. +-- MsgFormat VitalMemoryMsgFormatType +-- Format of the Test/Reference +-- signals in violation messages. +-- +-- INOUT +-- TimingData VitalMemoryTimingDataType +-- VitalMemorySetupHoldCheck information +-- storage area. This is used +-- internally to detect reference +-- edges and record the time of the +-- last edge. +-- +-- OUT +-- Violation X01 This is the violation flag returned. +-- X01ArrayT Overloaded for array type. +-- +-- +-- ---------------------------------------------------------------------------- + +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN VitalDelayType; + CONSTANT SetupLow : IN VitalDelayType; + CONSTANT HoldHigh : IN VitalDelayType; + CONSTANT HoldLow : IN VitalDelayType; + CONSTANT CheckEnabled : IN VitalBoolArrayT; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +); + +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArrayType; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN VitalDelayArrayType; + CONSTANT SetupLow : IN VitalDelayArrayType; + CONSTANT HoldHigh : IN VitalDelayArrayType; + CONSTANT HoldLow : IN VitalDelayArrayType; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +); + +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArrayType; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN VitalDelayArrayType; + CONSTANT SetupLow : IN VitalDelayArrayType; + CONSTANT HoldHigh : IN VitalDelayArrayType; + CONSTANT HoldLow : IN VitalDelayArrayType; + CONSTANT CheckEnabled : IN VitalBoolArrayT; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT NumBitsPerSubWord : IN INTEGER := 1; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +); + +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArrayType; + SIGNAL RefSignal : IN std_logic_vector; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN VitalDelayArrayType; + CONSTANT SetupHigh : IN VitalDelayArrayType; + CONSTANT SetupLow : IN VitalDelayArrayType; + CONSTANT HoldHigh : IN VitalDelayArrayType; + CONSTANT HoldLow : IN VitalDelayArrayType; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT NumBitsPerSubWord : IN INTEGER := 1; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +); + +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArrayType; + SIGNAL RefSignal : IN std_logic_vector; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN VitalDelayArrayType; + CONSTANT SetupHigh : IN VitalDelayArrayType; + CONSTANT SetupLow : IN VitalDelayArrayType; + CONSTANT HoldHigh : IN VitalDelayArrayType; + CONSTANT HoldLow : IN VitalDelayArrayType; + CONSTANT CheckEnabled : IN VitalBoolArrayT; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT NumBitsPerSubWord : IN INTEGER := 1; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +); + +--------------- following are not needed -------------------------- + +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArrayType; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN VitalDelayArrayType; + CONSTANT SetupLow : IN VitalDelayArrayType; + CONSTANT HoldHigh : IN VitalDelayArrayType; + CONSTANT HoldLow : IN VitalDelayArrayType; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +); + +PROCEDURE VitalMemorySetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalMemoryTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArrayType; + SIGNAL RefSignal : IN std_logic_vector; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN VitalDelayArrayType; + CONSTANT SetupHigh : IN VitalDelayArrayType; + CONSTANT SetupLow : IN VitalDelayArrayType; + CONSTANT HoldHigh : IN VitalDelayArrayType; + CONSTANT HoldLow : IN VitalDelayArrayType; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT ArcType : IN VitalMemoryArcType := CrossArc; + CONSTANT NumBitsPerSubWord : IN INTEGER := 1; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE +); + + +-- ---------------------------------------------------------------------------- +-- +-- Function Name: VitalPeriodPulseCheck +-- +-- Description: VitalPeriodPulseCheck checks for minimum and maximum +-- periodicity and pulse width for "1" and "0" values of +-- the input test signal. The timing constraint is +-- specified through parameters representing the minimal +-- period between successive rising and falling edges of +-- the input test signal and the minimum pulse widths +-- associated with high and low values. +-- +-- VitalPeriodCheck's accepts rising and falling edges +-- from 1 and 0 as well as transitions to and from 'X.' +-- +-- _______________ __________ +-- ____________| |_______| +-- +-- |<--- pw_hi --->| +-- |<-------- period ----->| +-- -->| pw_lo |<-- +-- +-- Arguments: +-- IN Type Description +-- TestSignal std_logic_vector Value of test signal +-- TestSignalName STRING Name of the test signal +-- TestDelay VitalDelayArrayType +-- Model's internal delay associated +-- with TestSignal +-- Period VitalDelayArrayType +-- Minimum period allowed between +-- consecutive rising ('P') or +-- falling ('F') transitions. +-- PulseWidthHigh VitalDelayArrayType +-- Minimum time allowed for a high +-- pulse ('1' or 'H') +-- PulseWidthLow VitalDelayArrayType +-- Minimum time allowed for a low +-- pulse ('0' or 'L') +-- CheckEnabled BOOLEAN Check performed if TRUE. +-- HeaderMsg STRING String that will accompany any +-- assertion messages produced. +-- XOn BOOLEAN If TRUE, Violation output parameter +-- is set to "X". Otherwise, Violation +-- is always set to "0." +-- MsgOn BOOLEAN If TRUE, period/pulse violation +-- message will be generated. +-- Otherwise, no messages are generated, +-- even though a violation is detected. +-- MsgSeverity SEVERITY_LEVEL Severity level for the assertion. +-- MsgFormat VitalMemoryMsgFormatType +-- Format of the Test/Reference signals +-- in violation messages. +-- +-- INOUT +-- PeriodData VitalPeriodDataArrayType +-- VitalPeriodPulseCheck information +-- storage area. This is used +-- internally to detect reference edges +-- and record the pulse and period +-- times. +-- OUT +-- Violation X01 This is the violation flag returned. +-- X01ArrayT Overloaded for array type. +-- +-- ---------------------------------------------------------------------------- +PROCEDURE VitalMemoryPeriodPulseCheck ( + VARIABLE Violation : OUT X01ArrayT; + VARIABLE PeriodData : INOUT VitalPeriodDataArrayType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArrayType; + CONSTANT Period : IN VitalDelayArrayType; + CONSTANT PulseWidthHigh : IN VitalDelayArrayType; + CONSTANT PulseWidthLow : IN VitalDelayArrayType; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType +); + +PROCEDURE VitalMemoryPeriodPulseCheck ( + VARIABLE Violation : OUT X01; + VARIABLE PeriodData : INOUT VitalPeriodDataArrayType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN VitalDelayArrayType; + CONSTANT Period : IN VitalDelayArrayType; + CONSTANT PulseWidthHigh : IN VitalDelayArrayType; + CONSTANT PulseWidthLow : IN VitalDelayArrayType; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT MsgFormat : IN VitalMemoryMsgFormatType +); + +-- ---------------------------------------------------------------------------- +-- Functionality Section +-- ---------------------------------------------------------------------------- + +-- ---------------------------------------------------------------------------- +-- All Memory Types and Record definitions. +-- ---------------------------------------------------------------------------- +TYPE MemoryWordType IS ARRAY (NATURAL RANGE <>) OF UX01; +TYPE MemoryWordPtr IS ACCESS MemoryWordType; + +TYPE MemoryArrayType IS ARRAY (NATURAL RANGE <>) OF MemoryWordPtr; +TYPE MemoryArrayPtrType IS ACCESS MemoryArrayType; + +TYPE VitalMemoryArrayRecType IS +RECORD +NoOfWords : POSITIVE; +NoOfBitsPerWord : POSITIVE; +NoOfBitsPerSubWord : POSITIVE; +NoOfBitsPerEnable : POSITIVE; +MemoryArrayPtr : MemoryArrayPtrType; +END RECORD; + +TYPE VitalMemoryDataType IS ACCESS VitalMemoryArrayRecType; + +TYPE VitalTimingDataVectorType IS +ARRAY (NATURAL RANGE <>) OF VitalTimingDataType; + +TYPE VitalMemoryViolFlagSizeType IS ARRAY (NATURAL RANGE <>) OF INTEGER; + +-- ---------------------------------------------------------------------------- +-- Symbol Literals used for Memory Table Modeling +-- ---------------------------------------------------------------------------- + +-- Symbol literals from '/' to 'S' are closely related to MemoryTableMatch +-- lookup matching and the order cannot be arbitrarily changed. +-- The remaining symbol literals are interpreted directly and matchting is +-- handled in the MemoryMatch procedure itself. + +TYPE VitalMemorySymbolType IS ( + '/', -- 0 -> 1 + '\', -- 1 -> 0 + 'P', -- Union of '/' and '^' (any edge to 1) + 'N', -- Union of '\' and 'v' (any edge to 0) + 'r', -- 0 -> X + 'f', -- 1 -> X + 'p', -- Union of '/' and 'r' (any edge from 0) + 'n', -- Union of '\' and 'f' (any edge from 1) + 'R', -- Union of '^' and 'p' (any possible rising edge) + 'F', -- Union of 'v' and 'n' (any possible falling edge) + '^', -- X -> 1 + 'v', -- X -> 0 + 'E', -- Union of 'v' and '^' (any edge from X) + 'A', -- Union of 'r' and '^' (rising edge to or from 'X') + + 'D', -- Union of 'f' and 'v' (falling edge to or from 'X') + + '*', -- Union of 'R' and 'F' (any edge) + 'X', -- Unknown level + '0', -- low level + '1', -- high level + '-', -- don't care + 'B', -- 0 or 1 + 'Z', -- High Impedance + 'S', -- steady value + + 'g', -- Good address (no transition) + 'u', -- Unknown address (no transition) + 'i', -- Invalid address (no transition) + 'G', -- Good address (with transition) + 'U', -- Unknown address (with transition) + 'I', -- Invalid address (with transition) + + 'w', -- Write data to memory + 's', -- Retain previous memory contents + + 'c', -- Corrupt entire memory with 'X' + 'l', -- Corrupt a word in memory with 'X' + 'd', -- Corrupt a single bit in memory with 'X' + 'e', -- Corrupt a word with 'X' based on data in + 'C', -- Corrupt a sub-word entire memory with 'X' + 'L', -- Corrupt a sub-word in memory with 'X' + + -- The following entries are commented since their + -- interpretation overlap with existing definitions. + + -- 'D', -- Corrupt a single bit of a sub-word with 'X' + -- 'E', -- Corrupt a sub-word with 'X' based on datain + + 'M', -- Implicit read data from memory + 'm', -- Read data from memory + 't' -- Immediate assign/transfer data in + +); + +TYPE VitalMemoryTableType IS ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> ) + OF VitalMemorySymbolType; + +TYPE VitalMemoryViolationSymbolType IS ( + 'X', -- Unknown level + '0', -- low level + '-' -- don't care +); + +TYPE VitalMemoryViolationTableType IS + ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> ) + OF VitalMemoryViolationSymbolType; + +TYPE VitalPortType IS ( + UNDEF, + READ, + WRITE, + RDNWR +); + +TYPE VitalCrossPortModeType IS ( + CpRead, -- CpReadOnly, + WriteContention, -- WrContOnly, + ReadWriteContention, -- CpContention + CpReadAndWriteContention, -- WrContAndCpRead, + CpReadAndReadContention +); + +SUBTYPE VitalAddressValueType IS INTEGER; +TYPE VitalAddressValueVectorType IS + ARRAY (NATURAL RANGE <>) OF VitalAddressValueType; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalDeclareMemory +-- Parameters: NoOfWords - Number of words in the memory +-- NoOfBitsPerWord - Number of bits per word in memory +-- NoOfBitsPerSubWord - Number of bits per sub word +-- MemoryLoadFile - Name of data file to load +-- Description: This function is intended to be used to initialize +-- memory data declarations, i.e. to be executed duing +-- simulation elaboration time. Handles the allocation +-- and initialization of memory for the memory data. +-- Default NoOfBitsPerSubWord is NoOfBits. +-- ---------------------------------------------------------------------------- + +IMPURE FUNCTION VitalDeclareMemory ( + CONSTANT NoOfWords : IN POSITIVE; + CONSTANT NoOfBitsPerWord : IN POSITIVE; + CONSTANT NoOfBitsPerSubWord : IN POSITIVE; + CONSTANT MemoryLoadFile : IN string := ""; + CONSTANT BinaryLoadFile : IN BOOLEAN := FALSE +) RETURN VitalMemoryDataType; + +IMPURE FUNCTION VitalDeclareMemory ( + CONSTANT NoOfWords : IN POSITIVE; + CONSTANT NoOfBitsPerWord : IN POSITIVE; + CONSTANT MemoryLoadFile : IN string := ""; + CONSTANT BinaryLoadFile : IN BOOLEAN := FALSE +) RETURN VitalMemoryDataType; + + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemoryTable +-- Parameters: DataOutBus - Output candidate zero delay data bus out +-- MemoryData - Pointer to memory data structure +-- PrevControls - Previous data in for edge detection +-- PrevEnableBus - Previous enables for edge detection +-- PrevDataInBus - Previous data bus for edge detection +-- PrevAddressBus - Previous address bus for edge detection +-- PortFlag - Indicates port operating mode +-- PortFlagArray - Vector form of PortFlag for sub-word +-- Controls - Agregate of scalar control lines +-- EnableBus - Concatenation of vector control lines +-- DataInBus - Input value of data bus in +-- AddressBus - Input value of address bus in +-- AddressValue - Decoded value of the AddressBus +-- MemoryTable - Input memory action table +-- PortType - The type of port (currently not used) +-- PortName - Port name string for messages +-- HeaderMsg - Header string for messages +-- MsgOn - Control the generation of messages +-- MsgSeverity - Control level of message generation +-- Description: This procedure implements the majority of the memory +-- modeling functionality via lookup of the memory action +-- tables and performing the specified actions if matches +-- are found, or the default actions otherwise. The +-- overloadings are provided for the word and sub-word +-- (using the EnableBus and PortFlagArray arguments) addressing +-- cases. +-- ---------------------------------------------------------------------------- + +PROCEDURE VitalMemoryTable ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE PrevControls : INOUT std_logic_vector; + VARIABLE PrevDataInBus : INOUT std_logic_vector; + VARIABLE PrevAddressBus : INOUT std_logic_vector; + VARIABLE PortFlag : INOUT VitalPortFlagVectorType; + CONSTANT Controls : IN std_logic_vector; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT AddressBus : IN std_logic_vector; + VARIABLE AddressValue : INOUT VitalAddressValueType; + CONSTANT MemoryTable : IN VitalMemoryTableType; + CONSTANT PortType : IN VitalPortType := UNDEF; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +); + +PROCEDURE VitalMemoryTable ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE PrevControls : INOUT std_logic_vector; + VARIABLE PrevEnableBus : INOUT std_logic_vector; + VARIABLE PrevDataInBus : INOUT std_logic_vector; + VARIABLE PrevAddressBus : INOUT std_logic_vector; + VARIABLE PortFlagArray : INOUT VitalPortFlagVectorType; + CONSTANT Controls : IN std_logic_vector; + CONSTANT EnableBus : IN std_logic_vector; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT AddressBus : IN std_logic_vector; + VARIABLE AddressValue : INOUT VitalAddressValueType; + CONSTANT MemoryTable : IN VitalMemoryTableType; + CONSTANT PortType : IN VitalPortType := UNDEF; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +); + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemoryCrossPorts +-- Parameters: DataOutBus - Output candidate zero delay data bus out +-- MemoryData - Pointer to memory data structure +-- SamePortFlag - Operating mode for same port +-- SamePortAddressValue - Decoded AddressBus for same port +-- CrossPortFlagArray - Operating modes for cross ports +-- CrossPortAddressArray - Decoded AddressBus for cross ports +-- CrossPortMode - Write contention and crossport read control +-- PortName - Port name string for messages +-- HeaderMsg - Header string for messages +-- MsgOn - Control the generation of messages +-- +-- Description: These procedures control the effect of memory operations +-- on a given port due to operations on other ports in a +-- multi-port memory. +-- This includes data write through when reading and writing +-- to the same address, as well as write contention when +-- there are multiple write to the same address. +-- If addresses do not match then data bus is unchanged. +-- The DataOutBus can be diabled with 'Z' value. +-- ---------------------------------------------------------------------------- + +PROCEDURE VitalMemoryCrossPorts ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE SamePortFlag : INOUT VitalPortFlagVectorType; + CONSTANT SamePortAddressValue : IN VitalAddressValueType; + CONSTANT CrossPortFlagArray : IN VitalPortFlagVectorType; + CONSTANT CrossPortAddressArray : IN VitalAddressValueVectorType; + CONSTANT CrossPortMode : IN VitalCrossPortModeType + := CpReadAndWriteContention; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE +) ; + +PROCEDURE VitalMemoryCrossPorts ( + VARIABLE MemoryData : INOUT VitalMemoryDataType; + CONSTANT CrossPortFlagArray : IN VitalPortFlagVectorType; + CONSTANT CrossPortAddressArray : IN VitalAddressValueVectorType; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE +) ; + +-- ---------------------------------------------------------------------------- +-- Procedure: VitalMemoryViolation +-- Parameters: DataOutBus - Output zero delay data bus out +-- MemoryData - Pointer to memory data structure +-- PortFlag - Indicates port operating mode +-- DataInBus - Input value of data bus in +-- AddressValue - Decoded value of the AddressBus +-- ViolationFlags - Aggregate of scalar violation vars +-- ViolationFlagsArray - Concatenation of vector violation vars +-- ViolationTable - Input memory violation table +-- PortType - The type of port (currently not used) +-- PortName - Port name string for messages +-- HeaderMsg - Header string for messages +-- MsgOn - Control the generation of messages +-- MsgSeverity - Control level of message generation +-- Description: This procedure is intended to implement all actions on the +-- memory contents and data out bus as a result of timing viols. +-- It uses the memory action table to perform various corruption +-- policies specified by the user. +-- ---------------------------------------------------------------------------- + +PROCEDURE VitalMemoryViolation ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE PortFlag : INOUT VitalPortFlagVectorType; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT AddressValue : IN VitalAddressValueType; + CONSTANT ViolationFlags : IN std_logic_vector; + CONSTANT ViolationFlagsArray : IN X01ArrayT; + CONSTANT ViolationSizesArray : IN VitalMemoryViolFlagSizeType; + CONSTANT ViolationTable : IN VitalMemoryTableType; + CONSTANT PortType : IN VitalPortType; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +) ; + +PROCEDURE VitalMemoryViolation ( + VARIABLE DataOutBus : INOUT std_logic_vector; + VARIABLE MemoryData : INOUT VitalMemoryDataType; + VARIABLE PortFlag : INOUT VitalPortFlagVectorType; + CONSTANT DataInBus : IN std_logic_vector; + CONSTANT AddressValue : IN VitalAddressValueType; + CONSTANT ViolationFlags : IN std_logic_vector; + CONSTANT ViolationTable : IN VitalMemoryTableType; + CONSTANT PortType : IN VitalPortType; + CONSTANT PortName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := ""; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING +) ; + +END Vital_Memory; diff --git a/libraries/vital2000/prmtvs_b.vhdl b/libraries/vital2000/prmtvs_b.vhdl new file mode 100644 index 000000000..c015e62d5 --- /dev/null +++ b/libraries/vital2000/prmtvs_b.vhdl @@ -0,0 +1,5622 @@ +------------------------------------------------------------------------------- +-- Title : Standard VITAL_Primitives Package +-- : $Revision: 600 $ +-- : +-- Library : VITAL +-- : +-- Developers : IEEE DASC Timing Working Group (TWG), PAR 1076.4 +-- : +-- Purpose : This packages defines standard types, constants, functions +-- : and procedures for use in developing ASIC models. +-- : Specifically a set of logic primitives are defined. +-- : +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Modification History : +-- ---------------------------------------------------------------------------- +-- Version No:|Auth:| Mod.Date:| Changes Made: +-- v95.0 A | | 06/02/95 | Initial ballot draft 1995 +-- v95.1 | | 08/31/95 | #204 - glitch detection prior to OutputMap +-- ---------------------------------------------------------------------------- +-- v95.2 | ddl | 09/14/96 | #223 - single input prmtvs use on-detect +-- | | | instead of glitch-on-event behavior +-- v95.3 | ddl | 09/24/96 | #236 - VitalTruthTable DataIn should be of +-- | | | of class SIGNAL +-- v95.4 | ddl | 01/16/97 | #243 - index constraint error in nbit xor/xnor +-- v99.1 | dbb | 03/31/99 | Updated for VHDL 93 +-- ---------------------------------------------------------------------------- + +LIBRARY STD; +USE STD.TEXTIO.ALL; + +PACKAGE BODY VITAL_Primitives IS + -- ------------------------------------------------------------------------ + -- Default values for Primitives + -- ------------------------------------------------------------------------ + -- default values for delay parameters + CONSTANT VitalDefDelay01 : VitalDelayType01 := VitalZeroDelay01; + CONSTANT VitalDefDelay01Z : VitalDelayType01Z := VitalZeroDelay01Z; + + TYPE VitalTimeArray IS ARRAY (NATURAL RANGE <>) OF TIME; + + -- default primitive model operation parameters + -- Glitch detection/reporting + TYPE VitalGlitchModeType IS ( MessagePlusX, MessageOnly, XOnly, NoGlitch); + CONSTANT PrimGlitchMode : VitalGlitchModeType := XOnly; + + -- ------------------------------------------------------------------------ + -- Local Type and Subtype Declarations + -- ------------------------------------------------------------------------ + --------------------------------------------------------------------------- + -- enumeration value representing the transition or level of the signal. + -- See function 'GetEdge' + --------------------------------------------------------------------------- + TYPE EdgeType IS ( 'U', -- Uninitialized level + 'X', -- Unknown level + '0', -- low level + '1', -- high level + '\', -- 1 to 0 falling edge + '/', -- 0 to 1 rising edge + 'F', -- * to 0 falling edge + 'R', -- * to 1 rising edge + 'f', -- rising to X edge + 'r', -- falling to X edge + 'x', -- Unknown edge (ie U->X) + 'V' -- Timing violation edge + ); + TYPE EdgeArray IS ARRAY ( NATURAL RANGE <> ) OF EdgeType; + + TYPE EdgeX1Table IS ARRAY ( EdgeType ) OF EdgeType; + TYPE EdgeX2Table IS ARRAY ( EdgeType, EdgeType ) OF EdgeType; + TYPE EdgeX3Table IS ARRAY ( EdgeType, EdgeType, EdgeType ) OF EdgeType; + TYPE EdgeX4Table IS ARRAY (EdgeType,EdgeType,EdgeType,EdgeType) OF EdgeType; + + TYPE LogicToEdgeT IS ARRAY(std_ulogic, std_ulogic) OF EdgeType; + TYPE LogicToLevelT IS ARRAY(std_ulogic ) OF EdgeType; + + TYPE GlitchDataType IS + RECORD + SchedTime : TIME; + GlitchTime : TIME; + SchedValue : std_ulogic; + CurrentValue : std_ulogic; + END RECORD; + TYPE GlitchDataArrayType IS ARRAY (NATURAL RANGE <>) + OF GlitchDataType; + + -- Enumerated type used in selection of output path delays + TYPE SchedType IS + RECORD + inp0 : TIME; -- time (abs) of output change due to input change to 0 + inp1 : TIME; -- time (abs) of output change due to input change to 1 + InpX : TIME; -- time (abs) of output change due to input change to X + Glch0 : TIME; -- time (abs) of output glitch due to input change to 0 + Glch1 : TIME; -- time (abs) of output glitch due to input change to 0 + END RECORD; + + TYPE SchedArray IS ARRAY ( NATURAL RANGE <> ) OF SchedType; + CONSTANT DefSchedType : SchedType := (TIME'HIGH, TIME'HIGH, 0 ns,0 ns,0 ns); + CONSTANT DefSchedAnd : SchedType := (TIME'HIGH, 0 ns,0 ns, TIME'HIGH,0 ns); + + -- Constrained array declarations (common sizes used by primitives) + SUBTYPE SchedArray2 IS SchedArray(1 DOWNTO 0); + SUBTYPE SchedArray3 IS SchedArray(2 DOWNTO 0); + SUBTYPE SchedArray4 IS SchedArray(3 DOWNTO 0); + SUBTYPE SchedArray8 IS SchedArray(7 DOWNTO 0); + + SUBTYPE TimeArray2 IS VitalTimeArray(1 DOWNTO 0); + SUBTYPE TimeArray3 IS VitalTimeArray(2 DOWNTO 0); + SUBTYPE TimeArray4 IS VitalTimeArray(3 DOWNTO 0); + SUBTYPE TimeArray8 IS VitalTimeArray(7 DOWNTO 0); + + SUBTYPE GlitchArray2 IS GlitchDataArrayType(1 DOWNTO 0); + SUBTYPE GlitchArray3 IS GlitchDataArrayType(2 DOWNTO 0); + SUBTYPE GlitchArray4 IS GlitchDataArrayType(3 DOWNTO 0); + SUBTYPE GlitchArray8 IS GlitchDataArrayType(7 DOWNTO 0); + + SUBTYPE EdgeArray2 IS EdgeArray(1 DOWNTO 0); + SUBTYPE EdgeArray3 IS EdgeArray(2 DOWNTO 0); + SUBTYPE EdgeArray4 IS EdgeArray(3 DOWNTO 0); + SUBTYPE EdgeArray8 IS EdgeArray(7 DOWNTO 0); + + CONSTANT DefSchedArray2 : SchedArray2 := + (OTHERS=> (0 ns, 0 ns, 0 ns, 0 ns, 0 ns)); + + TYPE stdlogic_table IS ARRAY(std_ulogic, std_ulogic) OF std_ulogic; + + CONSTANT InitialEdge : LogicToLevelT := ( + '1'|'H' => 'R', + '0'|'L' => 'F', + OTHERS => 'x' + ); + + CONSTANT LogicToEdge : LogicToEdgeT := ( -- previous, current + -- old \ new: U X 0 1 Z W L H - + 'U' => ( 'U', 'x', 'F', 'R', 'x', 'x', 'F', 'R', 'x' ), + 'X' => ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' ), + '0' => ( 'r', 'r', '0', '/', 'r', 'r', '0', '/', 'r' ), + '1' => ( 'f', 'f', '\', '1', 'f', 'f', '\', '1', 'f' ), + 'Z' => ( 'x', 'X', 'F', 'R', 'X', 'x', 'F', 'R', 'x' ), + 'W' => ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' ), + 'L' => ( 'r', 'r', '0', '/', 'r', 'r', '0', '/', 'r' ), + 'H' => ( 'f', 'f', '\', '1', 'f', 'f', '\', '1', 'f' ), + '-' => ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' ) + ); + CONSTANT LogicToLevel : LogicToLevelT := ( + '1'|'H' => '1', + '0'|'L' => '0', + 'U' => 'U', + OTHERS => 'X' + ); + + -- ----------------------------------- + -- 3-state logic tables + -- ----------------------------------- + CONSTANT BufIf0_Table : stdlogic_table := + -- enable data value + ( '1'|'H' => ( OTHERS => 'Z' ), + '0'|'L' => ( '1'|'H' => '1', + '0'|'L' => '0', + 'U' => 'U', + OTHERS => 'X' ), + 'U' => ( OTHERS => 'U' ), + OTHERS => ( OTHERS => 'X' ) ); + CONSTANT BufIf1_Table : stdlogic_table := + -- enable data value + ( '0'|'L' => ( OTHERS => 'Z' ), + '1'|'H' => ( '1'|'H' => '1', + '0'|'L' => '0', + 'U' => 'U', + OTHERS => 'X' ), + 'U' => ( OTHERS => 'U' ), + OTHERS => ( OTHERS => 'X' ) ); + CONSTANT InvIf0_Table : stdlogic_table := + -- enable data value + ( '1'|'H' => ( OTHERS => 'Z' ), + '0'|'L' => ( '1'|'H' => '0', + '0'|'L' => '1', + 'U' => 'U', + OTHERS => 'X' ), + 'U' => ( OTHERS => 'U' ), + OTHERS => ( OTHERS => 'X' ) ); + CONSTANT InvIf1_Table : stdlogic_table := + -- enable data value + ( '0'|'L' => ( OTHERS => 'Z' ), + '1'|'H' => ( '1'|'H' => '0', + '0'|'L' => '1', + 'U' => 'U', + OTHERS => 'X' ), + 'U' => ( OTHERS => 'U' ), + OTHERS => ( OTHERS => 'X' ) ); + + + TYPE To_StateCharType IS ARRAY (VitalStateSymbolType) OF CHARACTER; + CONSTANT To_StateChar : To_StateCharType := + ( '/', '\', 'P', 'N', 'r', 'f', 'p', 'n', 'R', 'F', '^', 'v', + 'E', 'A', 'D', '*', 'X', '0', '1', '-', 'B', 'Z', 'S' ); + TYPE To_TruthCharType IS ARRAY (VitalTruthSymbolType) OF CHARACTER; + CONSTANT To_TruthChar : To_TruthCharType := + ( 'X', '0', '1', '-', 'B', 'Z' ); + + TYPE TruthTableOutMapType IS ARRAY (VitalTruthSymbolType) OF std_ulogic; + CONSTANT TruthTableOutMap : TruthTableOutMapType := + -- 'X', '0', '1', '-', 'B', 'Z' + ( 'X', '0', '1', 'X', '-', 'Z' ); + + TYPE StateTableOutMapType IS ARRAY (VitalStateSymbolType) OF std_ulogic; + -- does conversion to X01Z or '-' if invalid + CONSTANT StateTableOutMap : StateTableOutMapType := + -- '/' '\' 'P' 'N' 'r' 'f' 'p' 'n' 'R' 'F' '^' 'v' + -- 'E' 'A' 'D' '*' 'X' '0' '1' '-' 'B' 'Z' 'S' + ( '-','-','-','-','-','-','-','-','-','-','-','-', + '-','-','-','-','X','0','1','X','-','Z','W'); + + -- ------------------------------------------------------------------------ + TYPE ValidTruthTableInputType IS ARRAY (VitalTruthSymbolType) OF BOOLEAN; + -- checks if a symbol IS valid for the stimulus portion of a truth table + CONSTANT ValidTruthTableInput : ValidTruthTableInputType := + -- 'X' '0' '1' '-' 'B' 'Z' + ( TRUE, TRUE, TRUE, TRUE, TRUE, FALSE ); + + TYPE TruthTableMatchType IS ARRAY (X01, VitalTruthSymbolType) OF BOOLEAN; + -- checks if an input matches th corresponding truth table symbol + -- use: TruthTableMatch(input_converted_to_X01, truth_table_stimulus_symbol) + CONSTANT TruthTableMatch : TruthTableMatchType := ( + -- X, 0, 1, - B Z + ( TRUE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- X + ( FALSE, TRUE, FALSE, TRUE, TRUE, FALSE ), -- 0 + ( FALSE, FALSE, TRUE, TRUE, TRUE, FALSE ) -- 1 + ); + + -- ------------------------------------------------------------------------ + TYPE ValidStateTableInputType IS ARRAY (VitalStateSymbolType) OF BOOLEAN; + CONSTANT ValidStateTableInput : ValidStateTableInputType := + -- '/', '\', 'P', 'N', 'r', 'f', + ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, + -- 'p', 'n', 'R', 'F', '^', 'v', + TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, + -- 'E', 'A', 'D', '*', + TRUE, TRUE, TRUE, TRUE, + -- 'X', '0', '1', '-', 'B', 'Z', + TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, + -- 'S' + TRUE ); + + CONSTANT ValidStateTableState : ValidStateTableInputType := + -- '/', '\', 'P', 'N', 'r', 'f', + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + -- 'p', 'n', 'R', 'F', '^', 'v', + FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + -- 'E', 'A', 'D', '*', + FALSE, FALSE, FALSE, FALSE, + -- 'X', '0', '1', '-', 'B', 'Z', + TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, + -- 'S' + FALSE ); + + TYPE StateTableMatchType IS ARRAY (X01,X01,VitalStateSymbolType) OF BOOLEAN; + -- last value, present value, table symbol + CONSTANT StateTableMatch : StateTableMatchType := ( + ( -- X (lastvalue) + -- / \ P N r f + -- p n R F ^ v + -- E A D * + -- X 0 1 - B Z S + (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE, + TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE), + (FALSE,FALSE,FALSE,TRUE, FALSE,FALSE, + FALSE,FALSE,FALSE,TRUE, FALSE,TRUE, + TRUE, FALSE,TRUE, TRUE, + FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE), + (FALSE,FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,FALSE,TRUE, FALSE,TRUE, FALSE, + TRUE, TRUE, FALSE,TRUE, + FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE) + ), + + (-- 0 (lastvalue) + -- / \ P N r f + -- p n R F ^ v + -- E A D * + -- X 0 1 - B Z S + (FALSE,FALSE,FALSE,FALSE,TRUE, FALSE, + TRUE, FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,TRUE, FALSE,TRUE, + TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE), + (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE, + FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,TRUE ), + (TRUE, FALSE,TRUE, FALSE,FALSE,FALSE, + TRUE, FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,TRUE, + FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE) + ), + + (-- 1 (lastvalue) + -- / \ P N r f + -- p n R F ^ v + -- E A D * + -- X 0 1 - B Z S + (FALSE,FALSE,FALSE,FALSE,FALSE,TRUE , + FALSE,TRUE, FALSE,TRUE, FALSE,FALSE, + FALSE,FALSE,TRUE, TRUE, + TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE), + (FALSE,TRUE, FALSE,TRUE, FALSE,FALSE, + FALSE,TRUE, FALSE,TRUE, FALSE,FALSE, + FALSE,FALSE,FALSE,TRUE, + FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE), + (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,TRUE ) + ) + ); + + TYPE Logic_UX01Z_Table IS ARRAY (std_ulogic) OF UX01Z; + ---------------------------------------------------------- + -- table name : cvt_to_x01z + -- parameters : std_ulogic -- some logic value + -- returns : UX01Z -- state value of logic value + -- purpose : to convert state-strength to state only + ---------------------------------------------------------- + CONSTANT cvt_to_ux01z : Logic_UX01Z_Table := + ('U','X','0','1','Z','X','0','1','X' ); + + TYPE LogicCvtTableType IS ARRAY (std_ulogic) OF CHARACTER; + CONSTANT LogicCvtTable : LogicCvtTableType + := ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-'); + + -------------------------------------------------------------------- + -- LOCAL Utilities + -------------------------------------------------------------------- + -- ------------------------------------------------------------------------ + -- FUNCTION NAME : MINIMUM + -- + -- PARAMETERS : in1, in2 - integer, time + -- + -- DESCRIPTION : return smaller of in1 and in2 + -- ------------------------------------------------------------------------ + FUNCTION Minimum ( + CONSTANT in1, in2 : INTEGER + ) RETURN INTEGER IS + BEGIN + IF (in1 < in2) THEN + RETURN in1; + END IF; + RETURN in2; + END; + -- ------------------------------------------------------------------------ + FUNCTION Minimum ( + CONSTANT t1,t2 : IN TIME + ) RETURN TIME IS + BEGIN + IF ( t1 < t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF; + END Minimum; + + -- ------------------------------------------------------------------------ + -- FUNCTION NAME : MAXIMUM + -- + -- PARAMETERS : in1, in2 - integer, time + -- + -- DESCRIPTION : return larger of in1 and in2 + -- ------------------------------------------------------------------------ + FUNCTION Maximum ( + CONSTANT in1, in2 : INTEGER + ) RETURN INTEGER IS + BEGIN + IF (in1 > in2) THEN + RETURN in1; + END IF; + RETURN in2; + END; + ----------------------------------------------------------------------- + FUNCTION Maximum ( + CONSTANT t1,t2 : IN TIME + ) RETURN TIME IS + BEGIN + IF ( t1 > t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF; + END Maximum; + + ----------------------------------------------------------------------- + FUNCTION GlitchMinTime ( + CONSTANT Time1, Time2 : IN TIME + ) RETURN TIME IS + BEGIN + IF ( Time1 >= NOW ) THEN + IF ( Time2 >= NOW ) THEN + RETURN Minimum ( Time1, Time2); + ELSE + RETURN Time1; + END IF; + ELSE + IF ( Time2 >= NOW ) THEN + RETURN Time2; + ELSE + RETURN 0 ns; + END IF; + END IF; + END; + + -------------------------------------------------------------------- + -- Error Message Types and Tables + -------------------------------------------------------------------- + TYPE VitalErrorType IS ( + ErrNegDel, + ErrInpSym, + ErrOutSym, + ErrStaSym, + ErrVctLng, + ErrTabWidSml, + ErrTabWidLrg, + ErrTabResSml, + ErrTabResLrg + ); + + TYPE VitalErrorSeverityType IS ARRAY (VitalErrorType) OF SEVERITY_LEVEL; + CONSTANT VitalErrorSeverity : VitalErrorSeverityType := ( + ErrNegDel => WARNING, + ErrInpSym => ERROR, + ErrOutSym => ERROR, + ErrStaSym => ERROR, + ErrVctLng => ERROR, + ErrTabWidSml => ERROR, + ErrTabWidLrg => WARNING, + ErrTabResSml => WARNING, + ErrTabResLrg => WARNING + ); + + CONSTANT MsgNegDel : STRING := + "Negative delay. New output value not scheduled. Output signal is: "; + CONSTANT MsgInpSym : STRING := + "Illegal symbol in the input portion of a Truth/State table."; + CONSTANT MsgOutSym : STRING := + "Illegal symbol in the output portion of a Truth/State table."; + CONSTANT MsgStaSym : STRING := + "Illegal symbol in the state portion of a State table."; + CONSTANT MsgVctLng : STRING := + "Vector (array) lengths not equal. "; + CONSTANT MsgTabWidSml : STRING := + "Width of the Truth/State table is too small."; + CONSTANT MsgTabWidLrg : STRING := + "Width of Truth/State table is too large. Extra elements are ignored."; + CONSTANT MsgTabResSml : STRING := + "Result of Truth/State table has too many elements."; + CONSTANT MsgTabResLrg : STRING := + "Result of Truth/State table has too few elements."; + + CONSTANT MsgUnknown : STRING := + "Unknown error message."; + + -------------------------------------------------------------------- + -- LOCAL Utilities + -------------------------------------------------------------------- + FUNCTION VitalMessage ( + CONSTANT ErrorId : IN VitalErrorType + ) RETURN STRING IS + BEGIN + CASE ErrorId IS + WHEN ErrNegDel => RETURN MsgNegDel; + WHEN ErrInpSym => RETURN MsgInpSym; + WHEN ErrOutSym => RETURN MsgOutSym; + WHEN ErrStaSym => RETURN MsgStaSym; + WHEN ErrVctLng => RETURN MsgVctLng; + WHEN ErrTabWidSml => RETURN MsgTabWidSml; + WHEN ErrTabWidLrg => RETURN MsgTabWidLrg; + WHEN ErrTabResSml => RETURN MsgTabResSml; + WHEN ErrTabResLrg => RETURN MsgTabResLrg; + WHEN OTHERS => RETURN MsgUnknown; + END CASE; + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) + SEVERITY VitalErrorSeverity(ErrorId); + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType; + CONSTANT Info : IN STRING + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) & Info + SEVERITY VitalErrorSeverity(ErrorId); + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType; + CONSTANT Info : IN CHARACTER + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) & Info + SEVERITY VitalErrorSeverity(ErrorId); + END; + + --------------------------------------------------------------------------- + PROCEDURE ReportGlitch ( + CONSTANT GlitchRoutine : IN STRING; + CONSTANT OutSignalName : IN STRING; + CONSTANT PreemptedTime : IN TIME; + CONSTANT PreemptedValue : IN std_ulogic; + CONSTANT NewTime : IN TIME; + CONSTANT NewValue : IN std_ulogic; + CONSTANT Index : IN INTEGER := 0; + CONSTANT IsArraySignal : IN BOOLEAN := FALSE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + VARIABLE StrPtr1, StrPtr2, StrPtr3, StrPtr4, StrPtr5 : LINE; + BEGIN + + Write (StrPtr1, PreemptedTime ); + Write (StrPtr2, NewTime); + Write (StrPtr3, LogicCvtTable(PreemptedValue)); + Write (StrPtr4, LogicCvtTable(NewValue)); + IF IsArraySignal THEN + Write (StrPtr5, STRING'( "(" ) ); + Write (StrPtr5, Index); + Write (StrPtr5, STRING'( ")" ) ); + ELSE + Write (StrPtr5, STRING'( " " ) ); + END IF; + + -- Issue Report only if Preemted value has not been + -- removed from event queue + ASSERT PreemptedTime > NewTime + REPORT GlitchRoutine & ": GLITCH Detected on port " & + OutSignalName & StrPtr5.ALL & + "; Preempted Future Value := " & StrPtr3.ALL & + " @ " & StrPtr1.ALL & + "; Newly Scheduled Value := " & StrPtr4.ALL & + " @ " & StrPtr2.ALL & + ";" + SEVERITY MsgSeverity; + + DEALLOCATE(StrPtr1); + DEALLOCATE(StrPtr2); + DEALLOCATE(StrPtr3); + DEALLOCATE(StrPtr4); + DEALLOCATE(StrPtr5); + RETURN; + END ReportGlitch; + + --------------------------------------------------------------------------- + -- Procedure : VitalGlitchOnEvent + -- : + -- Parameters : OutSignal ........ signal being driven + -- : OutSignalName..... name of the driven signal + -- : GlitchData........ internal data required by the procedure + -- : NewValue.......... new value being assigned + -- : NewDelay.......... Delay accompanying the assignment + -- : (Note: for vectors, this is an array) + -- : GlitchMode........ Glitch generation mode + -- : MessagePlusX, MessageOnly, + -- : XOnly, NoGlitch ) + -- : GlitchDelay....... if <= 0 ns , then there will be no Glitch + -- : if > NewDelay, then there is no Glitch, + -- : otherwise, this is the time when a FORCED + -- : generation of a glitch will occur. + ---------------------------------------------------------------------------- + PROCEDURE VitalGlitchOnEvent ( + SIGNAL OutSignal : OUT std_logic; + CONSTANT OutSignalName : IN STRING; + VARIABLE GlitchData : INOUT GlitchDataType; + CONSTANT NewValue : IN std_logic; + CONSTANT NewDelay : IN TIME := 0 ns; + CONSTANT GlitchMode : IN VitalGlitchModeType := MessagePlusX; + CONSTANT GlitchDelay : IN TIME := -1 ns; -- IR#223 + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + -- ------------------------------------------------------------------------ + VARIABLE NoGlitchDet : BOOLEAN := FALSE; + VARIABLE OldGlitch : BOOLEAN := FALSE; + VARIABLE Dly : TIME := NewDelay; + + BEGIN + -- If nothing to schedule, just return + IF NewDelay < 0 ns THEN + IF (NewValue /= GlitchData.SchedValue) THEN + VitalError ( "VitalGlitchOnEvent", ErrNegDel, OutSignalName ); + END IF; + + ELSE + -- If nothing currently scheduled + IF GlitchData.SchedTime <= NOW THEN + GlitchData.CurrentValue := GlitchData.SchedValue; + IF (GlitchDelay <= 0 ns) THEN + IF (NewValue = GlitchData.SchedValue) THEN RETURN; END IF; + NoGlitchDet := TRUE; + END IF; + + -- Transaction currently scheduled - if glitch already happened + ELSIF GlitchData.GlitchTime <= NOW THEN + GlitchData.CurrentValue := 'X'; + OldGlitch := TRUE; + IF (GlitchData.SchedValue = NewValue) THEN + dly := Minimum( GlitchData.SchedTime-NOW, NewDelay ); + END IF; + + -- Transaction currently scheduled (no glitch if same value) + ELSIF (GlitchData.SchedValue = NewValue) AND + (GlitchData.SchedTime = GlitchData.GlitchTime) AND + (GlitchDelay <= 0 ns) THEN + NoGlitchDet := TRUE; + Dly := Minimum( GlitchData.SchedTime-NOW, NewDelay ); + + END IF; + + GlitchData.SchedTime := NOW+Dly; + IF OldGlitch THEN + OutSignal <= NewValue AFTER Dly; + + ELSIF NoGlitchDet THEN + GlitchData.GlitchTime := NOW+Dly; + OutSignal <= NewValue AFTER Dly; + + ELSE -- new glitch + GlitchData.GlitchTime := GlitchMinTime ( GlitchData.GlitchTime, + NOW+GlitchDelay ); + + IF (GlitchMode = MessagePlusX) OR + (GlitchMode = MessageOnly) THEN + ReportGlitch ( "VitalGlitchOnEvent", OutSignalName, + GlitchData.GlitchTime, GlitchData.SchedValue, + (Dly + NOW), NewValue, + MsgSeverity=>MsgSeverity ); + END IF; + + IF (GlitchMode = MessagePlusX) OR (GlitchMode = XOnly) THEN + OutSignal <= 'X' AFTER GlitchData.GlitchTime-NOW; + OutSignal <= TRANSPORT NewValue AFTER Dly; + ELSE + OutSignal <= NewValue AFTER Dly; + END IF; + END IF; + + GlitchData.SchedValue := NewValue; + END IF; + + RETURN; + END; + + ---------------------------------------------------------------------------- + PROCEDURE VitalGlitchOnEvent ( + SIGNAL OutSignal : OUT std_logic_vector; + CONSTANT OutSignalName : IN STRING; + VARIABLE GlitchData : INOUT GlitchDataArrayType; + CONSTANT NewValue : IN std_logic_vector; + CONSTANT NewDelay : IN VitalTimeArray; + CONSTANT GlitchMode : IN VitalGlitchModeType := MessagePlusX; + CONSTANT GlitchDelay : IN VitalTimeArray; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + ALIAS GlDataAlias : GlitchDataArrayType(1 TO GlitchData'LENGTH) + IS GlitchData; + ALIAS NewValAlias : std_logic_vector(1 TO NewValue'LENGTH) IS NewValue; + ALIAS GlDelayAlias : VitalTimeArray(1 TO GlitchDelay'LENGTH) + IS GlitchDelay; + ALIAS NewDelAlias : VitalTimeArray(1 TO NewDelay'LENGTH) IS NewDelay; + + VARIABLE Index : INTEGER := OutSignal'LEFT; + VARIABLE Direction : INTEGER; + VARIABLE NoGlitchDet : BOOLEAN; + VARIABLE OldGlitch : BOOLEAN; + VARIABLE Dly, GlDly : TIME; + + BEGIN + IF (OutSignal'LEFT > OutSignal'RIGHT) THEN + Direction := -1; + ELSE + Direction := 1; + END IF; + + IF ( (OutSignal'LENGTH /= GlitchData'LENGTH) OR + (OutSignal'LENGTH /= NewValue'LENGTH) OR + (OutSignal'LENGTH /= NewDelay'LENGTH) OR + (OutSignal'LENGTH /= GlitchDelay'LENGTH) ) THEN + VitalError ( "VitalGlitchOnEvent", ErrVctLng, OutSignalName ); + RETURN; + END IF; + + -- a call to the scalar function cannot be made since the actual + -- name associated with a signal parameter must be locally static + FOR n IN 1 TO OutSignal'LENGTH LOOP + + NoGlitchDet := FALSE; + OldGlitch := FALSE; + Dly := NewDelAlias(n); + + -- If nothing to schedule, just skip to next loop iteration + IF NewDelAlias(n) < 0 ns THEN + IF (NewValAlias(n) /= GlDataAlias(n).SchedValue) THEN + VitalError ( "VitalGlitchOnEvent", ErrNegDel, OutSignalName ); + END IF; + ELSE + -- If nothing currently scheduled (i.e. last scheduled + -- transaction already occurred) + IF GlDataAlias(n).SchedTime <= NOW THEN + GlDataAlias(n).CurrentValue := GlDataAlias(n).SchedValue; + IF (GlDelayAlias(n) <= 0 ns) THEN + -- Next iteration if no change in value + IF (NewValAlias(n) = GlDataAlias(n).SchedValue) THEN + Index := Index + Direction; + NEXT; + END IF; + -- since last transaction already occurred there is no glitch + NoGlitchDet := TRUE; + END IF; + + -- Transaction currently scheduled - if glitch already happened + ELSIF GlDataAlias(n).GlitchTime <= NOW THEN + GlDataAlias(n).CurrentValue := 'X'; + OldGlitch := TRUE; + IF (GlDataAlias(n).SchedValue = NewValAlias(n)) THEN + dly := Minimum( GlDataAlias(n).SchedTime-NOW, + NewDelAlias(n) ); + END IF; + + -- Transaction currently scheduled + ELSIF (GlDataAlias(n).SchedValue = NewValAlias(n)) AND + (GlDataAlias(n).SchedTime = GlDataAlias(n).GlitchTime) AND + (GlDelayAlias(n) <= 0 ns) THEN + NoGlitchDet := TRUE; + Dly := Minimum( GlDataAlias(n).SchedTime-NOW, + NewDelAlias(n) ); + END IF; + + -- update last scheduled transaction + GlDataAlias(n).SchedTime := NOW+Dly; + + IF OldGlitch THEN + OutSignal(Index) <= NewValAlias(n) AFTER Dly; + ELSIF NoGlitchDet THEN + -- if no glitch then update last glitch time + -- and OutSignal(actual_index) + GlDataAlias(n).GlitchTime := NOW+Dly; + OutSignal(Index) <= NewValAlias(n) AFTER Dly; + ELSE -- new glitch + GlDataAlias(n).GlitchTime := GlitchMinTime ( + GlDataAlias(n).GlitchTime, + NOW+GlDelayAlias(n) ); + + IF (GlitchMode = MessagePlusX) OR + (GlitchMode = MessageOnly) THEN + ReportGlitch ( "VitalGlitchOnEvent", OutSignalName, + GlDataAlias(n).GlitchTime, + GlDataAlias(n).SchedValue, + (Dly + NOW), NewValAlias(n), + Index, TRUE, MsgSeverity ); + END IF; + + IF (GlitchMode = MessagePlusX) OR (GlitchMode = XOnly) THEN + GlDly := GlDataAlias(n).GlitchTime - NOW; + OutSignal(Index) <= 'X' AFTER GlDly; + OutSignal(Index) <= TRANSPORT NewValAlias(n) AFTER Dly; + ELSE + OutSignal(Index) <= NewValAlias(n) AFTER Dly; + END IF; + + END IF; -- glitch / no-glitch + GlDataAlias(n).SchedValue := NewValAlias(n); + + END IF; -- NewDelAlias(n) < 0 ns + Index := Index + Direction; + END LOOP; + + RETURN; + END; + + --------------------------------------------------------------------------- + -- ------------------------------------------------------------------------ + -- PROCEDURE NAME : TruthOutputX01Z + -- + -- PARAMETERS : table_out - output of table + -- X01Zout - output converted to X01Z + -- err - true if illegal character is encountered + -- + -- + -- DESCRIPTION : converts the output of a truth table to a valid + -- std_ulogic + -- ------------------------------------------------------------------------ + PROCEDURE TruthOutputX01Z ( + CONSTANT TableOut : IN VitalTruthSymbolType; + VARIABLE X01Zout : OUT std_ulogic; + VARIABLE Err : OUT BOOLEAN + ) IS + VARIABLE TempOut : std_ulogic; + BEGIN + Err := FALSE; + TempOut := TruthTableOutMap(TableOut); + IF (TempOut = '-') THEN + Err := TRUE; + TempOut := 'X'; + VitalError ( "VitalTruthTable", ErrOutSym, To_TruthChar(TableOut)); + END IF; + X01Zout := TempOut; + END; + + -- ------------------------------------------------------------------------ + -- PROCEDURE NAME : StateOutputX01Z + -- + -- PARAMETERS : table_out - output of table + -- prev_out - previous output value + -- X01Zout - output cojnverted to X01Z + -- err - true if illegal character is encountered + -- + -- DESCRIPTION : converts the output of a state table to a + -- valid std_ulogic + -- ------------------------------------------------------------------------ + PROCEDURE StateOutputX01Z ( + CONSTANT TableOut : IN VitalStateSymbolType; + CONSTANT PrevOut : IN std_ulogic; + VARIABLE X01Zout : OUT std_ulogic; + VARIABLE Err : OUT BOOLEAN + ) IS + VARIABLE TempOut : std_ulogic; + BEGIN + Err := FALSE; + TempOut := StateTableOutMap(TableOut); + IF (TempOut = '-') THEN + Err := TRUE; + TempOut := 'X'; + VitalError ( "VitalStateTable", ErrOutSym, To_StateChar(TableOut)); + ELSIF (TempOut = 'W') THEN + TempOut := To_X01Z(PrevOut); + END IF; + X01Zout := TempOut; + END; + + -- ------------------------------------------------------------------------ + -- PROCEDURE NAME: StateMatch + -- + -- PARAMETERS : symbol - symbol from state table + -- in2 - input from VitalStateTble procedure + -- to state table + -- in2LastValue - previous value of input + -- state - false if the symbol is from the input + -- portion of the table, + -- true if the symbol is from the state + -- portion of the table + -- Err - true if symbol is not a valid input symbol + -- ReturnValue - true if match occurred + -- + -- DESCRIPTION : This procedure sets ReturnValue to true if in2 matches + -- symbol (from the state table). If symbol is an edge + -- value edge is set to true and in2 and in2LastValue are + -- checked against symbol. Err is set to true if symbol + -- is an invalid value for the input portion of the state + -- table. + -- + -- ------------------------------------------------------------------------ + PROCEDURE StateMatch ( + CONSTANT Symbol : IN VitalStateSymbolType; + CONSTANT in2 : IN std_ulogic; + CONSTANT in2LastValue : IN std_ulogic; + CONSTANT State : IN BOOLEAN; + VARIABLE Err : OUT BOOLEAN; + VARIABLE ReturnValue : OUT BOOLEAN + ) IS + BEGIN + IF (State) THEN + IF (NOT ValidStateTableState(Symbol)) THEN + VitalError ( "VitalStateTable", ErrStaSym, To_StateChar(Symbol)); + Err := TRUE; + ReturnValue := FALSE; + ELSE + Err := FALSE; + ReturnValue := StateTableMatch(in2LastValue, in2, Symbol); + END IF; + ELSE + IF (NOT ValidStateTableInput(Symbol) ) THEN + VitalError ( "VitalStateTable", ErrInpSym, To_StateChar(Symbol)); + Err := TRUE; + ReturnValue := FALSE; + ELSE + ReturnValue := StateTableMatch(in2LastValue, in2, Symbol); + Err := FALSE; + END IF; + END IF; + END; + + -- ----------------------------------------------------------------------- + -- FUNCTION NAME: StateTableLookUp + -- + -- PARAMETERS : StateTable - state table + -- PresentDataIn - current inputs + -- PreviousDataIn - previous inputs and states + -- NumStates - number of state variables + -- PresentOutputs - current state and current outputs + -- + -- DESCRIPTION : This function is used to find the output of the + -- StateTable corresponding to a given set of inputs. + -- + -- ------------------------------------------------------------------------ + FUNCTION StateTableLookUp ( + CONSTANT StateTable : VitalStateTableType; + CONSTANT PresentDataIn : std_logic_vector; + CONSTANT PreviousDataIn : std_logic_vector; + CONSTANT NumStates : NATURAL; + CONSTANT PresentOutputs : std_logic_vector + ) RETURN std_logic_vector IS + + CONSTANT InputSize : INTEGER := PresentDataIn'LENGTH; + CONSTANT NumInputs : INTEGER := InputSize + NumStates - 1; + CONSTANT TableEntries : INTEGER := StateTable'LENGTH(1); + CONSTANT TableWidth : INTEGER := StateTable'LENGTH(2); + CONSTANT OutSize : INTEGER := TableWidth - InputSize - NumStates; + VARIABLE Inputs : std_logic_vector(0 TO NumInputs); + VARIABLE PrevInputs : std_logic_vector(0 TO NumInputs) + := (OTHERS => 'X'); + VARIABLE ReturnValue : std_logic_vector(0 TO (OutSize-1)) + := (OTHERS => 'X'); + VARIABLE Temp : std_ulogic; + VARIABLE Match : BOOLEAN; + VARIABLE Err : BOOLEAN := FALSE; + + -- This needs to be done since the TableLookup arrays must be + -- ascending starting with 0 + VARIABLE TableAlias : VitalStateTableType(0 TO TableEntries - 1, + 0 TO TableWidth - 1) + := StateTable; + + BEGIN + Inputs(0 TO InputSize-1) := PresentDataIn; + Inputs(InputSize TO NumInputs) := PresentOutputs(0 TO NumStates - 1); + PrevInputs(0 TO InputSize - 1) := PreviousDataIn(0 TO InputSize - 1); + + ColLoop: -- Compare each entry in the table + FOR i IN TableAlias'RANGE(1) LOOP + + RowLoop: -- Check each element of the entry + FOR j IN 0 TO InputSize + NumStates LOOP + + IF (j = InputSize + NumStates) THEN -- a match occurred + FOR k IN 0 TO Minimum(OutSize, PresentOutputs'LENGTH)-1 LOOP + StateOutputX01Z ( + TableAlias(i, TableWidth - k - 1), + PresentOutputs(PresentOutputs'LENGTH - k - 1), + Temp, Err); + ReturnValue(OutSize - k - 1) := Temp; + IF (Err) THEN + ReturnValue := (OTHERS => 'X'); + RETURN ReturnValue; + END IF; + END LOOP; + RETURN ReturnValue; + END IF; + + StateMatch ( TableAlias(i,j), + Inputs(j), PrevInputs(j), + j >= InputSize, Err, Match); + EXIT RowLoop WHEN NOT(Match); + EXIT ColLoop WHEN Err; + END LOOP RowLoop; + END LOOP ColLoop; + + ReturnValue := (OTHERS => 'X'); + RETURN ReturnValue; + END; + + -------------------------------------------------------------------- + -- to_ux01z + ------------------------------------------------------------------- + FUNCTION To_UX01Z ( s : std_ulogic + ) RETURN UX01Z IS + BEGIN + RETURN cvt_to_ux01z (s); + END; + + --------------------------------------------------------------------------- + -- Function : GetEdge + -- Purpose : Converts transitions on a given input signal into a + -- enumeration value representing the transition or level + -- of the signal. + -- + -- previous "value" current "value" := "edge" + -- --------------------------------------------------------- + -- '1' | 'H' '1' | 'H' '1' level, no edge + -- '0' | 'L' '1' | 'H' '/' rising edge + -- others '1' | 'H' 'R' rising from X + -- + -- '1' | 'H' '0' | 'L' '\' falling egde + -- '0' | 'L' '0' | 'L' '0' level, no edge + -- others '0' | 'L' 'F' falling from X + -- + -- 'X' | 'W' | '-' 'X' | 'W' | '-' 'X' unknown (X) level + -- 'Z' 'Z' 'X' unknown (X) level + -- 'U' 'U' 'U' 'U' level + -- + -- '1' | 'H' others 'f' falling to X + -- '0' | 'L' others 'r' rising to X + -- 'X' | 'W' | '-' 'U' | 'Z' 'x' unknown (X) edge + -- 'Z' 'X' | 'W' | '-' | 'U' 'x' unknown (X) edge + -- 'U' 'X' | 'W' | '-' | 'Z' 'x' unknown (X) edge + -- + --------------------------------------------------------------------------- + FUNCTION GetEdge ( + SIGNAL s : IN std_logic + ) RETURN EdgeType IS + BEGIN + IF (s'EVENT) + THEN RETURN LogicToEdge ( s'LAST_VALUE, s ); + ELSE RETURN LogicToLevel ( s ); + END IF; + END; + + --------------------------------------------------------------------------- + PROCEDURE GetEdge ( + SIGNAL s : IN std_logic_vector; + VARIABLE LastS : INOUT std_logic_vector; + VARIABLE Edge : OUT EdgeArray ) IS + + ALIAS sAlias : std_logic_vector ( 1 TO s'LENGTH ) IS s; + ALIAS LastSAlias : std_logic_vector ( 1 TO LastS'LENGTH ) IS LastS; + ALIAS EdgeAlias : EdgeArray ( 1 TO Edge'LENGTH ) IS Edge; + BEGIN + IF s'LENGTH /= LastS'LENGTH OR + s'LENGTH /= Edge'LENGTH THEN + VitalError ( "GetEdge", ErrVctLng, "s, LastS, Edge" ); + END IF; + + FOR n IN 1 TO s'LENGTH LOOP + EdgeAlias(n) := LogicToEdge( LastSAlias(n), sAlias(n) ); + LastSAlias(n) := sAlias(n); + END LOOP; + END; + + --------------------------------------------------------------------------- + FUNCTION ToEdge ( Value : IN std_logic + ) RETURN EdgeType IS + BEGIN + RETURN LogicToLevel( Value ); + END; + + -- Note: This function will likely be replaced by S'DRIVING_VALUE in VHDL'92 + ---------------------------------------------------------------------------- + IMPURE FUNCTION CurValue ( + CONSTANT GlitchData : IN GlitchDataType + ) RETURN std_logic IS + BEGIN + IF NOW >= GlitchData.SchedTime THEN + RETURN GlitchData.SchedValue; + ELSIF NOW >= GlitchData.GlitchTime THEN + RETURN 'X'; + ELSE + RETURN GlitchData.CurrentValue; + END IF; + END; + --------------------------------------------------------------------------- + IMPURE FUNCTION CurValue ( + CONSTANT GlitchData : IN GlitchDataArrayType + ) RETURN std_logic_vector IS + VARIABLE Result : std_logic_vector(GlitchData'RANGE); + BEGIN + FOR n IN GlitchData'RANGE LOOP + IF NOW >= GlitchData(n).SchedTime THEN + Result(n) := GlitchData(n).SchedValue; + ELSIF NOW >= GlitchData(n).GlitchTime THEN + Result(n) := 'X'; + ELSE + Result(n) := GlitchData(n).CurrentValue; + END IF; + END LOOP; + RETURN Result; + END; + + --------------------------------------------------------------------------- + -- function calculation utilities + --------------------------------------------------------------------------- + + --------------------------------------------------------------------------- + -- Function : VitalSame + -- Returns : VitalSame compares the state (UX01) of two logic value. A + -- value of 'X' is returned if the values are different. The + -- common value is returned if the values are equal. + -- Purpose : When the result of a logic model may be either of two + -- separate input values (eg. when the select on a MUX is 'X'), + -- VitalSame may be used to determine if the result needs to + -- be 'X'. + -- Arguments : See the declarations below... + --------------------------------------------------------------------------- + FUNCTION VitalSame ( + CONSTANT a, b : IN std_ulogic + ) RETURN std_ulogic IS + BEGIN + IF To_UX01(a) = To_UX01(b) + THEN RETURN To_UX01(a); + ELSE RETURN 'X'; + END IF; + END; + + --------------------------------------------------------------------------- + -- delay selection utilities + --------------------------------------------------------------------------- + + --------------------------------------------------------------------------- + -- Procedure : BufPath, InvPath + -- + -- Purpose : BufPath and InvPath compute output change times, based on + -- a change on an input port. The computed output change times + -- returned in the composite parameter 'schd'. + -- + -- BufPath and InpPath are used together with the delay path + -- selection functions (GetSchedDelay, VitalAND, VitalOR... ) + -- The 'schd' value from each of the input ports of a model are + -- combined by the delay selection functions (VitalAND, + -- VitalOR, ...). The GetSchedDelay procedure converts the + -- combined output changes times to the single delay (delta + -- time) value for scheduling the output change (passed to + -- VitalGlitchOnEvent). + -- + -- The values in 'schd' are: (absolute times) + -- inp0 : time of output change due to input change to 0 + -- inp1 : time of output change due to input change to 1 + -- inpX : time of output change due to input change to X + -- glch0 : time of output glitch due to input change to 0 + -- glch1 : time of output glitch due to input change to 1 + -- + -- The output times are computed from the model INPUT value + -- and not the final value. For this reason, 'BufPath' should + -- be used to compute the output times for a non-inverting + -- delay paths and 'InvPath' should be used to compute the + -- ouput times for inverting delay paths. Delay paths which + -- include both non-inverting and paths require usage of both + -- 'BufPath' and 'InvPath'. (IE this is needed for the + -- select->output path of a MUX -- See the VitalMUX model). + -- + -- + -- Parameters : schd....... Computed output result times. (INOUT parameter + -- modified only on input edges) + -- Iedg....... Input port edge/level value. + -- tpd....... Propagation delays from this input + -- + --------------------------------------------------------------------------- + + PROCEDURE BufPath ( + VARIABLE Schd : INOUT SchedType; + CONSTANT Iedg : IN EdgeType; + CONSTANT tpd : IN VitalDelayType01 + ) IS + BEGIN + CASE Iedg IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd.inp0 := TIME'HIGH; + Schd.inp1 := NOW + tpd(tr01); Schd.Glch1 := Schd.inp1; + Schd.InpX := Schd.inp1; + WHEN '\'|'F' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := NOW + tpd(tr10); Schd.Glch0 := Schd.inp0; + Schd.InpX := Schd.inp0; + WHEN 'r' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := TIME'HIGH; + Schd.InpX := NOW + tpd(tr01); + WHEN 'f' => Schd.inp0 := TIME'HIGH; + Schd.inp1 := TIME'HIGH; + Schd.InpX := NOW + tpd(tr10); + WHEN 'x' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := TIME'HIGH; + -- update for X->X change + Schd.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END; + + PROCEDURE BufPath ( + VARIABLE Schd : INOUT SchedArray; + CONSTANT Iedg : IN EdgeArray; + CONSTANT tpd : IN VitalDelayArrayType01 + ) IS + BEGIN + FOR n IN Schd'RANGE LOOP + CASE Iedg(n) IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd(n).inp0 := TIME'HIGH; + Schd(n).inp1 := NOW + tpd(n)(tr01); + Schd(n).Glch1 := Schd(n).inp1; + Schd(n).InpX := Schd(n).inp1; + WHEN '\'|'F' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := NOW + tpd(n)(tr10); + Schd(n).Glch0 := Schd(n).inp0; + Schd(n).InpX := Schd(n).inp0; + WHEN 'r' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := TIME'HIGH; + Schd(n).InpX := NOW + tpd(n)(tr01); + WHEN 'f' => Schd(n).inp0 := TIME'HIGH; + Schd(n).inp1 := TIME'HIGH; + Schd(n).InpX := NOW + tpd(n)(tr10); + WHEN 'x' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := TIME'HIGH; + -- update for X->X change + Schd(n).InpX := NOW + Minimum ( tpd(n)(tr10), + tpd(n)(tr01) ); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END LOOP; + END; + + PROCEDURE InvPath ( + VARIABLE Schd : INOUT SchedType; + CONSTANT Iedg : IN EdgeType; + CONSTANT tpd : IN VitalDelayType01 + ) IS + BEGIN + CASE Iedg IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd.inp0 := TIME'HIGH; + Schd.inp1 := NOW + tpd(tr10); Schd.Glch1 := Schd.inp1; + Schd.InpX := Schd.inp1; + WHEN '\'|'F' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := NOW + tpd(tr01); Schd.Glch0 := Schd.inp0; + Schd.InpX := Schd.inp0; + WHEN 'r' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := TIME'HIGH; + Schd.InpX := NOW + tpd(tr10); + WHEN 'f' => Schd.inp0 := TIME'HIGH; + Schd.inp1 := TIME'HIGH; + Schd.InpX := NOW + tpd(tr01); + WHEN 'x' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := TIME'HIGH; + -- update for X->X change + Schd.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END; + + PROCEDURE InvPath ( + VARIABLE Schd : INOUT SchedArray; + CONSTANT Iedg : IN EdgeArray; + CONSTANT tpd : IN VitalDelayArrayType01 + ) IS + BEGIN + FOR n IN Schd'RANGE LOOP + CASE Iedg(n) IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd(n).inp0 := TIME'HIGH; + Schd(n).inp1 := NOW + tpd(n)(tr10); + Schd(n).Glch1 := Schd(n).inp1; + Schd(n).InpX := Schd(n).inp1; + WHEN '\'|'F' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := NOW + tpd(n)(tr01); + Schd(n).Glch0 := Schd(n).inp0; + Schd(n).InpX := Schd(n).inp0; + WHEN 'r' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := TIME'HIGH; + Schd(n).InpX := NOW + tpd(n)(tr10); + WHEN 'f' => Schd(n).inp0 := TIME'HIGH; + Schd(n).inp1 := TIME'HIGH; + Schd(n).InpX := NOW + tpd(n)(tr01); + WHEN 'x' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := TIME'HIGH; + -- update for X->X change + Schd(n).InpX := NOW + Minimum ( tpd(n)(tr10), + tpd(n)(tr01) ); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END LOOP; + END; + + --------------------------------------------------------------------------- + -- Procedure : BufEnab, InvEnab + -- + -- Purpose : BufEnab and InvEnab compute output change times, from a + -- change on an input enable port for a 3-state driver. The + -- computed output change times are returned in the composite + -- parameters 'schd1', 'schd0'. + -- + -- BufEnab and InpEnab are used together with the delay path + -- selection functions (GetSchedDelay, VitalAND, VitalOR... ) + -- The 'schd' value from each of the non-enable input ports of + -- a model (See BufPath, InvPath) are combined using the delay + -- selection functions (VitalAND, VitalOR, ...). The + -- GetSchedDelay procedure combines the output times on the + -- enable path with the output times from the data path(s) and + -- computes the single delay (delta time) value for scheduling + -- the output change (passed to VitalGlitchOnEvent) + -- + -- The values in 'schd*' are: (absolute times) + -- inp0 : time of output change due to input change to 0 + -- inp1 : time of output change due to input change to 1 + -- inpX : time of output change due to input change to X + -- glch0 : time of output glitch due to input change to 0 + -- glch1 : time of output glitch due to input change to 1 + -- + -- 'schd1' contains output times for 1->Z, Z->1 transitions. + -- 'schd0' contains output times for 0->Z, Z->0 transitions. + -- + -- 'BufEnab' is used for computing the output times for an + -- high asserted enable (output 'Z' for enable='0'). + -- 'InvEnab' is used for computing the output times for an + -- low asserted enable (output 'Z' for enable='1'). + -- + -- Note: separate 'schd1', 'schd0' parameters are generated + -- so that the combination of the delay paths from + -- multiple enable signals may be combined using the + -- same functions/operators used in combining separate + -- data paths. (See exampe 2 below) + -- + -- + -- Parameters : schd1...... Computed output result times for 1->Z, Z->1 + -- transitions. This parameter is modified only on + -- input edge values (events). + -- schd0...... Computed output result times for 0->Z, 0->1 + -- transitions. This parameter is modified only on + -- input edge values (events). + -- Iedg....... Input port edge/level value. + -- tpd....... Propagation delays for the enable -> output path. + -- + --------------------------------------------------------------------------- + PROCEDURE BufEnab ( + VARIABLE Schd1 : INOUT SchedType; + VARIABLE Schd0 : INOUT SchedType; + CONSTANT Iedg : IN EdgeType; + CONSTANT tpd : IN VitalDelayType01Z + ) IS + BEGIN + CASE Iedg IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := NOW + tpd(trz1); + Schd1.Glch1 := Schd1.inp1; + Schd1.InpX := Schd1.inp1; + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := NOW + tpd(trz0); + Schd0.Glch1 := Schd0.inp1; + Schd0.InpX := Schd0.inp1; + WHEN '\'|'F' => Schd1.inp1 := TIME'HIGH; + Schd1.inp0 := NOW + tpd(tr1z); + Schd1.Glch0 := Schd1.inp0; + Schd1.InpX := Schd1.inp0; + Schd0.inp1 := TIME'HIGH; + Schd0.inp0 := NOW + tpd(tr0z); + Schd0.Glch0 := Schd0.inp0; + Schd0.InpX := Schd0.inp0; + WHEN 'r' => Schd1.inp1 := TIME'HIGH; + Schd1.inp0 := TIME'HIGH; + Schd1.InpX := NOW + tpd(trz1); + Schd0.inp1 := TIME'HIGH; + Schd0.inp0 := TIME'HIGH; + Schd0.InpX := NOW + tpd(trz0); + WHEN 'f' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := TIME'HIGH; + Schd1.InpX := NOW + tpd(tr1z); + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := TIME'HIGH; + Schd0.InpX := NOW + tpd(tr0z); + WHEN 'x' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := TIME'HIGH; + Schd1.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := TIME'HIGH; + Schd0.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END; + + PROCEDURE InvEnab ( + VARIABLE Schd1 : INOUT SchedType; + VARIABLE Schd0 : INOUT SchedType; + CONSTANT Iedg : IN EdgeType; + CONSTANT tpd : IN VitalDelayType01Z + ) IS + BEGIN + CASE Iedg IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := NOW + tpd(tr1z); + Schd1.Glch1 := Schd1.inp1; + Schd1.InpX := Schd1.inp1; + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := NOW + tpd(tr0z); + Schd0.Glch1 := Schd0.inp1; + Schd0.InpX := Schd0.inp1; + WHEN '\'|'F' => Schd1.inp1 := TIME'HIGH; + Schd1.inp0 := NOW + tpd(trz1); + Schd1.Glch0 := Schd1.inp0; + Schd1.InpX := Schd1.inp0; + Schd0.inp1 := TIME'HIGH; + Schd0.inp0 := NOW + tpd(trz0); + Schd0.Glch0 := Schd0.inp0; + Schd0.InpX := Schd0.inp0; + WHEN 'r' => Schd1.inp1 := TIME'HIGH; + Schd1.inp0 := TIME'HIGH; + Schd1.InpX := NOW + tpd(tr1z); + Schd0.inp1 := TIME'HIGH; + Schd0.inp0 := TIME'HIGH; + Schd0.InpX := NOW + tpd(tr0z); + WHEN 'f' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := TIME'HIGH; + Schd1.InpX := NOW + tpd(trz1); + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := TIME'HIGH; + Schd0.InpX := NOW + tpd(trz0); + WHEN 'x' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := TIME'HIGH; + Schd1.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := TIME'HIGH; + Schd0.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END; + + --------------------------------------------------------------------------- + -- Procedure : GetSchedDelay + -- + -- Purpose : GetSchedDelay computes the final delay (incremental) for + -- for scheduling an output signal. The delay is computed + -- from the absolute output times in the 'NewSched' parameter. + -- (See BufPath, InvPath). + -- + -- Computation of the output delay for non-3_state outputs + -- consists of selection the appropriate output time based + -- on the new output value 'NewValue' and subtracting 'NOW' + -- to convert to an incremental delay value. + -- + -- The Computation of the output delay for 3_state output + -- also includes combination of the enable path delay with + -- the date path delay. + -- + -- Parameters : NewDelay... Returned output delay value. + -- GlchDelay.. Returned output delay for the start of a glitch. + -- NewValue... New output value. + -- CurValue... Current value of the output. + -- NewSched... Composite containing the combined absolute + -- output times from the data inputs. + -- EnSched1... Composite containing the combined absolute + -- output times from the enable input(s). + -- (for a 3_state output transitions 1->Z, Z->1) + -- EnSched0... Composite containing the combined absolute + -- output times from the enable input(s). + -- (for a 3_state output transitions 0->Z, Z->0) + -- + --------------------------------------------------------------------------- + PROCEDURE GetSchedDelay ( + VARIABLE NewDelay : OUT TIME; + VARIABLE GlchDelay : OUT TIME; + CONSTANT NewValue : IN std_ulogic; + CONSTANT CurValue : IN std_ulogic; + CONSTANT NewSched : IN SchedType + ) IS + VARIABLE Tim, Glch : TIME; + BEGIN + + CASE To_UX01(NewValue) IS + WHEN '0' => Tim := NewSched.inp0; + Glch := NewSched.Glch1; + WHEN '1' => Tim := NewSched.inp1; + Glch := NewSched.Glch0; + WHEN OTHERS => Tim := NewSched.InpX; + Glch := -1 ns; + END CASE; + IF (CurValue /= NewValue) + THEN Glch := -1 ns; + END IF; + + NewDelay := Tim - NOW; + IF Glch < 0 ns + THEN GlchDelay := Glch; + ELSE GlchDelay := Glch - NOW; + END IF; -- glch < 0 ns + END; + + PROCEDURE GetSchedDelay ( + VARIABLE NewDelay : OUT VitalTimeArray; + VARIABLE GlchDelay : OUT VitalTimeArray; + CONSTANT NewValue : IN std_logic_vector; + CONSTANT CurValue : IN std_logic_vector; + CONSTANT NewSched : IN SchedArray + ) IS + VARIABLE Tim, Glch : TIME; + ALIAS NewDelayAlias : VitalTimeArray( NewDelay'LENGTH DOWNTO 1) + IS NewDelay; + ALIAS GlchDelayAlias : VitalTimeArray(GlchDelay'LENGTH DOWNTO 1) + IS GlchDelay; + ALIAS NewSchedAlias : SchedArray( NewSched'LENGTH DOWNTO 1) + IS NewSched; + ALIAS NewValueAlias : std_logic_vector ( NewValue'LENGTH DOWNTO 1 ) + IS NewValue; + ALIAS CurValueAlias : std_logic_vector ( CurValue'LENGTH DOWNTO 1 ) + IS CurValue; + BEGIN + FOR n IN NewDelay'LENGTH DOWNTO 1 LOOP + CASE To_UX01(NewValueAlias(n)) IS + WHEN '0' => Tim := NewSchedAlias(n).inp0; + Glch := NewSchedAlias(n).Glch1; + WHEN '1' => Tim := NewSchedAlias(n).inp1; + Glch := NewSchedAlias(n).Glch0; + WHEN OTHERS => Tim := NewSchedAlias(n).InpX; + Glch := -1 ns; + END CASE; + IF (CurValueAlias(n) /= NewValueAlias(n)) + THEN Glch := -1 ns; + END IF; + + NewDelayAlias(n) := Tim - NOW; + IF Glch < 0 ns + THEN GlchDelayAlias(n) := Glch; + ELSE GlchDelayAlias(n) := Glch - NOW; + END IF; -- glch < 0 ns + END LOOP; + RETURN; + END; + + PROCEDURE GetSchedDelay ( + VARIABLE NewDelay : OUT TIME; + VARIABLE GlchDelay : OUT TIME; + CONSTANT NewValue : IN std_ulogic; + CONSTANT CurValue : IN std_ulogic; + CONSTANT NewSched : IN SchedType; + CONSTANT EnSched1 : IN SchedType; + CONSTANT EnSched0 : IN SchedType + ) IS + SUBTYPE v2 IS std_logic_vector(0 TO 1); + VARIABLE Tim, Glch : TIME; + BEGIN + + CASE v2'(To_X01Z(CurValue) & To_X01Z(NewValue)) IS + WHEN "00" => Tim := Maximum (NewSched.inp0, EnSched0.inp1); + Glch := GlitchMinTime(NewSched.Glch1,EnSched0.Glch0); + WHEN "01" => Tim := Maximum (NewSched.inp1, EnSched1.inp1); + Glch := EnSched1.Glch0; + WHEN "0Z" => Tim := EnSched0.inp0; + Glch := NewSched.Glch1; + WHEN "0X" => Tim := Maximum (NewSched.InpX, EnSched1.InpX); + Glch := 0 ns; + WHEN "10" => Tim := Maximum (NewSched.inp0, EnSched0.inp1); + Glch := EnSched0.Glch0; + WHEN "11" => Tim := Maximum (NewSched.inp1, EnSched1.inp1); + Glch := GlitchMinTime(NewSched.Glch0,EnSched1.Glch0); + WHEN "1Z" => Tim := EnSched1.inp0; + Glch := NewSched.Glch0; + WHEN "1X" => Tim := Maximum (NewSched.InpX, EnSched0.InpX); + Glch := 0 ns; + WHEN "Z0" => Tim := Maximum (NewSched.inp0, EnSched0.inp1); + IF NewSched.Glch0 > NOW + THEN Glch := Maximum(NewSched.Glch1,EnSched1.inp1); + ELSE Glch := 0 ns; + END IF; + WHEN "Z1" => Tim := Maximum (NewSched.inp1, EnSched1.inp1); + IF NewSched.Glch1 > NOW + THEN Glch := Maximum(NewSched.Glch0,EnSched0.inp1); + ELSE Glch := 0 ns; + END IF; + WHEN "ZX" => Tim := Maximum (NewSched.InpX, EnSched1.InpX); + Glch := 0 ns; + WHEN "ZZ" => Tim := Maximum (EnSched1.InpX, EnSched0.InpX); + Glch := 0 ns; + WHEN "X0" => Tim := Maximum (NewSched.inp0, EnSched0.inp1); + Glch := 0 ns; + WHEN "X1" => Tim := Maximum (NewSched.inp1, EnSched1.inp1); + Glch := 0 ns; + WHEN "XZ" => Tim := Maximum (EnSched1.InpX, EnSched0.InpX); + Glch := 0 ns; + WHEN OTHERS => Tim := Maximum (NewSched.InpX, EnSched1.InpX); + Glch := 0 ns; + + END CASE; + NewDelay := Tim - NOW; + IF Glch < 0 ns + THEN GlchDelay := Glch; + ELSE GlchDelay := Glch - NOW; + END IF; -- glch < 0 ns + END; + + --------------------------------------------------------------------------- + -- Operators and Functions for combination (selection) of path delays + -- > These functions support selection of the "appripriate" path delay + -- dependent on the logic function. + -- > These functions only "select" from the possable output times. No + -- calculation (addition) of delays is performed. + -- > See description of 'BufPath', 'InvPath' and 'GetSchedDelay' + -- > See primitive PROCEDURE models for examples. + --------------------------------------------------------------------------- + + FUNCTION "not" ( + CONSTANT a : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + z.inp1 := a.inp0 ; + z.inp0 := a.inp1 ; + z.InpX := a.InpX ; + z.Glch1 := a.Glch0; + z.Glch0 := a.Glch1; + RETURN (z); + END; + + FUNCTION "and" ( + CONSTANT a, b : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + z.inp1 := Maximum ( a.inp1 , b.inp1 ); + z.inp0 := Minimum ( a.inp0 , b.inp0 ); + z.InpX := GlitchMinTime ( a.InpX , b.InpX ); + z.Glch1 := Maximum ( a.Glch1, b.Glch1 ); + z.Glch0 := GlitchMinTime ( a.Glch0, b.Glch0 ); + RETURN (z); + END; + + FUNCTION "or" ( + CONSTANT a, b : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + z.inp0 := Maximum ( a.inp0 , b.inp0 ); + z.inp1 := Minimum ( a.inp1 , b.inp1 ); + z.InpX := GlitchMinTime ( a.InpX , b.InpX ); + z.Glch0 := Maximum ( a.Glch0, b.Glch0 ); + z.Glch1 := GlitchMinTime ( a.Glch1, b.Glch1 ); + RETURN (z); + END; + + IMPURE FUNCTION "nand" ( + CONSTANT a, b : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + z.inp0 := Maximum ( a.inp1 , b.inp1 ); + z.inp1 := Minimum ( a.inp0 , b.inp0 ); + z.InpX := GlitchMinTime ( a.InpX , b.InpX ); + z.Glch0 := Maximum ( a.Glch1, b.Glch1 ); + z.Glch1 := GlitchMinTime ( a.Glch0, b.Glch0 ); + RETURN (z); + END; + + IMPURE FUNCTION "nor" ( + CONSTANT a, b : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + z.inp1 := Maximum ( a.inp0 , b.inp0 ); + z.inp0 := Minimum ( a.inp1 , b.inp1 ); + z.InpX := GlitchMinTime ( a.InpX , b.InpX ); + z.Glch1 := Maximum ( a.Glch0, b.Glch0 ); + z.Glch0 := GlitchMinTime ( a.Glch1, b.Glch1 ); + RETURN (z); + END; + + -- ------------------------------------------------------------------------ + -- Delay Calculation for 2-bit Logical gates. + -- ------------------------------------------------------------------------ + IMPURE FUNCTION VitalXOR2 ( + CONSTANT ab,ai, bb,bi : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + -- z = (a AND b) NOR (a NOR b) + z.inp1 := Maximum ( Minimum (ai.inp0 , bi.inp0 ), + Minimum (ab.inp1 , bb.inp1 ) ); + z.inp0 := Minimum ( Maximum (ai.inp1 , bi.inp1 ), + Maximum (ab.inp0 , bb.inp0 ) ); + z.InpX := Maximum ( Maximum (ai.InpX , bi.InpX ), + Maximum (ab.InpX , bb.InpX ) ); + z.Glch1 := Maximum (GlitchMinTime (ai.Glch0, bi.Glch0), + GlitchMinTime (ab.Glch1, bb.Glch1) ); + z.Glch0 := GlitchMinTime ( Maximum (ai.Glch1, bi.Glch1), + Maximum (ab.Glch0, bb.Glch0) ); + RETURN (z); + END; + + IMPURE FUNCTION VitalXNOR2 ( + CONSTANT ab,ai, bb,bi : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + -- z = (a AND b) OR (a NOR b) + z.inp0 := Maximum ( Minimum (ab.inp0 , bb.inp0 ), + Minimum (ai.inp1 , bi.inp1 ) ); + z.inp1 := Minimum ( Maximum (ab.inp1 , bb.inp1 ), + Maximum (ai.inp0 , bi.inp0 ) ); + z.InpX := Maximum ( Maximum (ab.InpX , bb.InpX ), + Maximum (ai.InpX , bi.InpX ) ); + z.Glch0 := Maximum (GlitchMinTime (ab.Glch0, bb.Glch0), + GlitchMinTime (ai.Glch1, bi.Glch1) ); + z.Glch1 := GlitchMinTime ( Maximum (ab.Glch1, bb.Glch1), + Maximum (ai.Glch0, bi.Glch0) ); + RETURN (z); + END; + + -- ------------------------------------------------------------------------ + -- Delay Calculation for 3-bit Logical gates. + -- ------------------------------------------------------------------------ + IMPURE FUNCTION VitalXOR3 ( + CONSTANT ab,ai, bb,bi, cb,ci : IN SchedType ) + RETURN SchedType IS + BEGIN + RETURN VitalXOR2 ( VitalXOR2 (ab,ai, bb,bi), + VitalXOR2 (ai,ab, bi,bb), + cb, ci ); + END; + + IMPURE FUNCTION VitalXNOR3 ( + CONSTANT ab,ai, bb,bi, cb,ci : IN SchedType ) + RETURN SchedType IS + BEGIN + RETURN VitalXNOR2 ( VitalXOR2 ( ab,ai, bb,bi ), + VitalXOR2 ( ai,ab, bi,bb ), + cb, ci ); + END; + + -- ------------------------------------------------------------------------ + -- Delay Calculation for 4-bit Logical gates. + -- ------------------------------------------------------------------------ + IMPURE FUNCTION VitalXOR4 ( + CONSTANT ab,ai, bb,bi, cb,ci, db,di : IN SchedType ) + RETURN SchedType IS + BEGIN + RETURN VitalXOR2 ( VitalXOR2 ( ab,ai, bb,bi ), + VitalXOR2 ( ai,ab, bi,bb ), + VitalXOR2 ( cb,ci, db,di ), + VitalXOR2 ( ci,cb, di,db ) ); + END; + + IMPURE FUNCTION VitalXNOR4 ( + CONSTANT ab,ai, bb,bi, cb,ci, db,di : IN SchedType ) + RETURN SchedType IS + BEGIN + RETURN VitalXNOR2 ( VitalXOR2 ( ab,ai, bb,bi ), + VitalXOR2 ( ai,ab, bi,bb ), + VitalXOR2 ( cb,ci, db,di ), + VitalXOR2 ( ci,cb, di,db ) ); + END; + + -- ------------------------------------------------------------------------ + -- Delay Calculation for N-bit Logical gates. + -- ------------------------------------------------------------------------ + -- Note: index range on datab,datai assumed to be 1 TO length. + -- This is enforced by internal only usage of this Function + IMPURE FUNCTION VitalXOR ( + CONSTANT DataB, DataI : IN SchedArray + ) RETURN SchedType IS + CONSTANT Leng : INTEGER := DataB'LENGTH; + BEGIN + IF Leng = 2 THEN + RETURN VitalXOR2 ( DataB(1),DataI(1), DataB(2),DataI(2) ); + ELSE + RETURN VitalXOR2 ( VitalXOR ( DataB(1 TO Leng-1), + DataI(1 TO Leng-1) ), + VitalXOR ( DataI(1 TO Leng-1), + DataB(1 TO Leng-1) ), + DataB(Leng),DataI(Leng) ); + END IF; + END; + + -- Note: index range on datab,datai assumed to be 1 TO length. + -- This is enforced by internal only usage of this Function + IMPURE FUNCTION VitalXNOR ( + CONSTANT DataB, DataI : IN SchedArray + ) RETURN SchedType IS + CONSTANT Leng : INTEGER := DataB'LENGTH; + BEGIN + IF Leng = 2 THEN + RETURN VitalXNOR2 ( DataB(1),DataI(1), DataB(2),DataI(2) ); + ELSE + RETURN VitalXNOR2 ( VitalXOR ( DataB(1 TO Leng-1), + DataI(1 TO Leng-1) ), + VitalXOR ( DataI(1 TO Leng-1), + DataB(1 TO Leng-1) ), + DataB(Leng),DataI(Leng) ); + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Multiplexor + -- MUX .......... result := data(dselect) + -- MUX2 .......... 2-input mux; result := data0 when (dselect = '0'), + -- data1 when (dselect = '1'), + -- 'X' when (dselect = 'X') and (data0 /= data1) + -- MUX4 .......... 4-input mux; result := data(dselect) + -- MUX8 .......... 8-input mux; result := data(dselect) + -- ------------------------------------------------------------------------ + FUNCTION VitalMUX2 ( + CONSTANT d1, d0 : IN SchedType; + CONSTANT sb, SI : IN SchedType + ) RETURN SchedType IS + BEGIN + RETURN (d1 AND sb) OR (d0 AND (NOT SI) ); + END; +-- + FUNCTION VitalMUX4 ( + CONSTANT Data : IN SchedArray4; + CONSTANT sb : IN SchedArray2; + CONSTANT SI : IN SchedArray2 + ) RETURN SchedType IS + BEGIN + RETURN ( sb(1) AND VitalMUX2(Data(3),Data(2), sb(0), SI(0)) ) + OR ( (NOT SI(1)) AND VitalMUX2(Data(1),Data(0), sb(0), SI(0)) ); + END; + + FUNCTION VitalMUX8 ( + CONSTANT Data : IN SchedArray8; + CONSTANT sb : IN SchedArray3; + CONSTANT SI : IN SchedArray3 + ) RETURN SchedType IS + BEGIN + RETURN ( ( sb(2)) AND VitalMUX4 (Data(7 DOWNTO 4), + sb(1 DOWNTO 0), SI(1 DOWNTO 0) ) ) + OR ( (NOT SI(2)) AND VitalMUX4 (Data(3 DOWNTO 0), + sb(1 DOWNTO 0), SI(1 DOWNTO 0) ) ); + END; +-- + FUNCTION VInterMux ( + CONSTANT Data : IN SchedArray; + CONSTANT sb : IN SchedArray; + CONSTANT SI : IN SchedArray + ) RETURN SchedType IS + CONSTANT sMsb : INTEGER := sb'LENGTH; + CONSTANT dMsbHigh : INTEGER := Data'LENGTH; + CONSTANT dMsbLow : INTEGER := Data'LENGTH/2; + BEGIN + IF sb'LENGTH = 1 THEN + RETURN VitalMUX2( Data(2), Data(1), sb(1), SI(1) ); + ELSIF sb'LENGTH = 2 THEN + RETURN VitalMUX4( Data, sb, SI ); + ELSIF sb'LENGTH = 3 THEN + RETURN VitalMUX8( Data, sb, SI ); + ELSIF sb'LENGTH > 3 THEN + RETURN (( sb(sMsb)) AND VInterMux( Data(dMsbLow DOWNTO 1), + sb(sMsb-1 DOWNTO 1), + SI(sMsb-1 DOWNTO 1) )) + OR ((NOT SI(sMsb)) AND VInterMux( Data(dMsbHigh DOWNTO dMsbLow+1), + sb(sMsb-1 DOWNTO 1), + SI(sMsb-1 DOWNTO 1) )); + ELSE + RETURN (0 ns, 0 ns, 0 ns, 0 ns, 0 ns); -- dselect'LENGTH < 1 + END IF; + END; +-- + FUNCTION VitalMUX ( + CONSTANT Data : IN SchedArray; + CONSTANT sb : IN SchedArray; + CONSTANT SI : IN SchedArray + ) RETURN SchedType IS + CONSTANT msb : INTEGER := 2**sb'LENGTH; + VARIABLE lDat : SchedArray(msb DOWNTO 1); + ALIAS DataAlias : SchedArray ( Data'LENGTH DOWNTO 1 ) IS Data; + ALIAS sbAlias : SchedArray ( sb'LENGTH DOWNTO 1 ) IS sb; + ALIAS siAlias : SchedArray ( SI'LENGTH DOWNTO 1 ) IS SI; + BEGIN + IF Data'LENGTH <= msb THEN + FOR i IN Data'LENGTH DOWNTO 1 LOOP + lDat(i) := DataAlias(i); + END LOOP; + FOR i IN msb DOWNTO Data'LENGTH+1 LOOP + lDat(i) := DefSchedAnd; + END LOOP; + ELSE + FOR i IN msb DOWNTO 1 LOOP + lDat(i) := DataAlias(i); + END LOOP; + END IF; + RETURN VInterMux( lDat, sbAlias, siAlias ); + END; + + -- ------------------------------------------------------------------------ + -- Decoder + -- General Algorithm : + -- (a) Result(...) := '0' when (enable = '0') + -- (b) Result(data) := '1'; all other subelements = '0' + -- ... Result array is decending (n-1 downto 0) + -- + -- DECODERn .......... n:2**n decoder + -- ------------------------------------------------------------------------ + FUNCTION VitalDECODER2 ( + CONSTANT DataB : IN SchedType; + CONSTANT DataI : IN SchedType; + CONSTANT Enable : IN SchedType + ) RETURN SchedArray IS + VARIABLE Result : SchedArray2; + BEGIN + Result(1) := Enable AND ( DataB); + Result(0) := Enable AND (NOT DataI); + RETURN Result; + END; + + FUNCTION VitalDECODER4 ( + CONSTANT DataB : IN SchedArray2; + CONSTANT DataI : IN SchedArray2; + CONSTANT Enable : IN SchedType + ) RETURN SchedArray IS + VARIABLE Result : SchedArray4; + BEGIN + Result(3) := Enable AND ( DataB(1)) AND ( DataB(0)); + Result(2) := Enable AND ( DataB(1)) AND (NOT DataI(0)); + Result(1) := Enable AND (NOT DataI(1)) AND ( DataB(0)); + Result(0) := Enable AND (NOT DataI(1)) AND (NOT DataI(0)); + RETURN Result; + END; + + FUNCTION VitalDECODER8 ( + CONSTANT DataB : IN SchedArray3; + CONSTANT DataI : IN SchedArray3; + CONSTANT Enable : IN SchedType + ) RETURN SchedArray IS + VARIABLE Result : SchedArray8; + BEGIN + Result(7):= Enable AND ( DataB(2))AND( DataB(1))AND( DataB(0)); + Result(6):= Enable AND ( DataB(2))AND( DataB(1))AND(NOT DataI(0)); + Result(5):= Enable AND ( DataB(2))AND(NOT DataI(1))AND( DataB(0)); + Result(4):= Enable AND ( DataB(2))AND(NOT DataI(1))AND(NOT DataI(0)); + Result(3):= Enable AND (NOT DataI(2))AND( DataB(1))AND( DataB(0)); + Result(2):= Enable AND (NOT DataI(2))AND( DataB(1))AND(NOT DataI(0)); + Result(1):= Enable AND (NOT DataI(2))AND(NOT DataI(1))AND( DataB(0)); + Result(0):= Enable AND (NOT DataI(2))AND(NOT DataI(1))AND(NOT DataI(0)); + RETURN Result; + END; + + + FUNCTION VitalDECODER ( + CONSTANT DataB : IN SchedArray; + CONSTANT DataI : IN SchedArray; + CONSTANT Enable : IN SchedType + ) RETURN SchedArray IS + CONSTANT DMsb : INTEGER := DataB'LENGTH - 1; + ALIAS DataBAlias : SchedArray ( DMsb DOWNTO 0 ) IS DataB; + ALIAS DataIAlias : SchedArray ( DMsb DOWNTO 0 ) IS DataI; + BEGIN + IF DataB'LENGTH = 1 THEN + RETURN VitalDECODER2 ( DataBAlias( 0 ), + DataIAlias( 0 ), Enable ); + ELSIF DataB'LENGTH = 2 THEN + RETURN VitalDECODER4 ( DataBAlias(1 DOWNTO 0), + DataIAlias(1 DOWNTO 0), Enable ); + ELSIF DataB'LENGTH = 3 THEN + RETURN VitalDECODER8 ( DataBAlias(2 DOWNTO 0), + DataIAlias(2 DOWNTO 0), Enable ); + ELSIF DataB'LENGTH > 3 THEN + RETURN VitalDECODER ( DataBAlias(DMsb-1 DOWNTO 0), + DataIAlias(DMsb-1 DOWNTO 0), + Enable AND ( DataBAlias(DMsb)) ) + & VitalDECODER ( DataBAlias(DMsb-1 DOWNTO 0), + DataIAlias(DMsb-1 DOWNTO 0), + Enable AND (NOT DataIAlias(DMsb)) ); + ELSE + RETURN DefSchedArray2; + END IF; + END; + + +------------------------------------------------------------------------------- +-- PRIMITIVES +------------------------------------------------------------------------------- + -- ------------------------------------------------------------------------ + -- N-bit wide Logical gates. + -- ------------------------------------------------------------------------ + FUNCTION VitalAND ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '1'; + FOR i IN Data'RANGE LOOP + Result := Result AND Data(i); + END LOOP; + RETURN ResultMap(Result); + END; +-- + FUNCTION VitalOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '0'; + FOR i IN Data'RANGE LOOP + Result := Result OR Data(i); + END LOOP; + RETURN ResultMap(Result); + END; +-- + FUNCTION VitalXOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '0'; + FOR i IN Data'RANGE LOOP + Result := Result XOR Data(i); + END LOOP; + RETURN ResultMap(Result); + END; +-- + FUNCTION VitalNAND ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '1'; + FOR i IN Data'RANGE LOOP + Result := Result AND Data(i); + END LOOP; + RETURN ResultMap(NOT Result); + END; +-- + FUNCTION VitalNOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '0'; + FOR i IN Data'RANGE LOOP + Result := Result OR Data(i); + END LOOP; + RETURN ResultMap(NOT Result); + END; +-- + FUNCTION VitalXNOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '0'; + FOR i IN Data'RANGE LOOP + Result := Result XOR Data(i); + END LOOP; + RETURN ResultMap(NOT Result); + END; + + -- ------------------------------------------------------------------------ + -- Commonly used 2-bit Logical gates. + -- ------------------------------------------------------------------------ + FUNCTION VitalAND2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a AND b); + END; +-- + FUNCTION VitalOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a OR b); + END; +-- + FUNCTION VitalXOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a XOR b); + END; +-- + FUNCTION VitalNAND2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a NAND b); + END; +-- + FUNCTION VitalNOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a NOR b); + END; +-- + FUNCTION VitalXNOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a XOR b)); + END; +-- + -- ------------------------------------------------------------------------ + -- Commonly used 3-bit Logical gates. + -- ------------------------------------------------------------------------ + FUNCTION VitalAND3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a AND b AND c); + END; +-- + FUNCTION VitalOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a OR b OR c); + END; +-- + FUNCTION VitalXOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a XOR b XOR c); + END; +-- + FUNCTION VitalNAND3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a AND b AND c)); + END; +-- + FUNCTION VitalNOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a OR b OR c)); + END; +-- + FUNCTION VitalXNOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a XOR b XOR c)); + END; + + -- --------------------------------------------------------------------------- + -- Commonly used 4-bit Logical gates. + -- --------------------------------------------------------------------------- + FUNCTION VitalAND4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a AND b AND c AND d); + END; +-- + FUNCTION VitalOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a OR b OR c OR d); + END; +-- + FUNCTION VitalXOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a XOR b XOR c XOR d); + END; +-- + FUNCTION VitalNAND4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a AND b AND c AND d)); + END; +-- + FUNCTION VitalNOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a OR b OR c OR d)); + END; +-- + FUNCTION VitalXNOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a XOR b XOR c XOR d)); + END; + + -- ------------------------------------------------------------------------ + -- Buffers + -- BUF ....... standard non-inverting buffer + -- BUFIF0 ....... non-inverting buffer Data passes thru if (Enable = '0') + -- BUFIF1 ....... non-inverting buffer Data passes thru if (Enable = '1') + -- ------------------------------------------------------------------------ + FUNCTION VitalBUF ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(To_UX01(Data)); + END; +-- + FUNCTION VitalBUFIF0 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(BufIf0_Table(Enable,Data)); + END; +-- + FUNCTION VitalBUFIF1 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(BufIf1_Table(Enable,Data)); + END; + FUNCTION VitalIDENT ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(To_UX01Z(Data)); + END; + + -- ------------------------------------------------------------------------ + -- Invertors + -- INV ......... standard inverting buffer + -- INVIF0 ......... inverting buffer Data passes thru if (Enable = '0') + -- INVIF1 ......... inverting buffer Data passes thru if (Enable = '1') + -- ------------------------------------------------------------------------ + FUNCTION VitalINV ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT Data); + END; +-- + FUNCTION VitalINVIF0 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(InvIf0_Table(Enable,Data)); + END; +-- + FUNCTION VitalINVIF1 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(InvIf1_Table(Enable,Data)); + END; + + -- ------------------------------------------------------------------------ + -- Multiplexor + -- MUX .......... result := data(dselect) + -- MUX2 .......... 2-input mux; result := data0 when (dselect = '0'), + -- data1 when (dselect = '1'), + -- 'X' when (dselect = 'X') and (data0 /= data1) + -- MUX4 .......... 4-input mux; result := data(dselect) + -- MUX8 .......... 8-input mux; result := data(dselect) + -- ------------------------------------------------------------------------ + FUNCTION VitalMUX2 ( + CONSTANT Data1, Data0 : IN std_ulogic; + CONSTANT dSelect : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + CASE To_X01(dSelect) IS + WHEN '0' => Result := To_UX01(Data0); + WHEN '1' => Result := To_UX01(Data1); + WHEN OTHERS => Result := VitalSame( Data1, Data0 ); + END CASE; + RETURN ResultMap(Result); + END; +-- + FUNCTION VitalMUX4 ( + CONSTANT Data : IN std_logic_vector4; + CONSTANT dSelect : IN std_logic_vector2; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Slct : std_logic_vector2; + VARIABLE Result : UX01; + BEGIN + Slct := To_X01(dSelect); + CASE Slct IS + WHEN "00" => Result := To_UX01(Data(0)); + WHEN "01" => Result := To_UX01(Data(1)); + WHEN "10" => Result := To_UX01(Data(2)); + WHEN "11" => Result := To_UX01(Data(3)); + WHEN "0X" => Result := VitalSame( Data(1), Data(0) ); + WHEN "1X" => Result := VitalSame( Data(2), Data(3) ); + WHEN "X0" => Result := VitalSame( Data(2), Data(0) ); + WHEN "X1" => Result := VitalSame( Data(3), Data(1) ); + WHEN OTHERS => Result := VitalSame( VitalSame(Data(3),Data(2)), + VitalSame(Data(1),Data(0))); + END CASE; + RETURN ResultMap(Result); + END; +-- + FUNCTION VitalMUX8 ( + CONSTANT Data : IN std_logic_vector8; + CONSTANT dSelect : IN std_logic_vector3; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + CASE To_X01(dSelect(2)) IS + WHEN '0' => Result := VitalMUX4( Data(3 DOWNTO 0), + dSelect(1 DOWNTO 0)); + WHEN '1' => Result := VitalMUX4( Data(7 DOWNTO 4), + dSelect(1 DOWNTO 0)); + WHEN OTHERS => Result := VitalSame( VitalMUX4( Data(3 DOWNTO 0), + dSelect(1 DOWNTO 0)), + VitalMUX4( Data(7 DOWNTO 4), + dSelect(1 DOWNTO 0))); + END CASE; + RETURN ResultMap(Result); + END; +-- + FUNCTION VInterMux ( + CONSTANT Data : IN std_logic_vector; + CONSTANT dSelect : IN std_logic_vector + ) RETURN std_ulogic IS + + CONSTANT sMsb : INTEGER := dSelect'LENGTH; + CONSTANT dMsbHigh : INTEGER := Data'LENGTH; + CONSTANT dMsbLow : INTEGER := Data'LENGTH/2; + ALIAS DataAlias : std_logic_vector ( Data'LENGTH DOWNTO 1) IS Data; + ALIAS dSelAlias : std_logic_vector (dSelect'LENGTH DOWNTO 1) IS dSelect; + + VARIABLE Result : UX01; + BEGIN + IF dSelect'LENGTH = 1 THEN + Result := VitalMUX2( DataAlias(2), DataAlias(1), dSelAlias(1) ); + ELSIF dSelect'LENGTH = 2 THEN + Result := VitalMUX4( DataAlias, dSelAlias ); + ELSIF dSelect'LENGTH > 2 THEN + CASE To_X01(dSelect(sMsb)) IS + WHEN '0' => + Result := VInterMux( DataAlias(dMsbLow DOWNTO 1), + dSelAlias(sMsb-1 DOWNTO 1) ); + WHEN '1' => + Result := VInterMux( DataAlias(dMsbHigh DOWNTO dMsbLow+1), + dSelAlias(sMsb-1 DOWNTO 1) ); + WHEN OTHERS => + Result := VitalSame( + VInterMux( DataAlias(dMsbLow DOWNTO 1), + dSelAlias(sMsb-1 DOWNTO 1) ), + VInterMux( DataAlias(dMsbHigh DOWNTO dMsbLow+1), + dSelAlias(sMsb-1 DOWNTO 1) ) + ); + END CASE; + ELSE + Result := 'X'; -- dselect'LENGTH < 1 + END IF; + RETURN Result; + END; +-- + FUNCTION VitalMUX ( + CONSTANT Data : IN std_logic_vector; + CONSTANT dSelect : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + CONSTANT msb : INTEGER := 2**dSelect'LENGTH; + ALIAS DataAlias : std_logic_vector ( Data'LENGTH DOWNTO 1) IS Data; + ALIAS dSelAlias : std_logic_vector (dSelect'LENGTH DOWNTO 1) IS dSelect; + VARIABLE lDat : std_logic_vector(msb DOWNTO 1) := (OTHERS=>'X'); + VARIABLE Result : UX01; + BEGIN + IF Data'LENGTH <= msb THEN + FOR i IN Data'LENGTH DOWNTO 1 LOOP + lDat(i) := DataAlias(i); + END LOOP; + ELSE + FOR i IN msb DOWNTO 1 LOOP + lDat(i) := DataAlias(i); + END LOOP; + END IF; + Result := VInterMux( lDat, dSelAlias ); + RETURN ResultMap(Result); + END; + + -- ------------------------------------------------------------------------ + -- Decoder + -- General Algorithm : + -- (a) Result(...) := '0' when (enable = '0') + -- (b) Result(data) := '1'; all other subelements = '0' + -- ... Result array is decending (n-1 downto 0) + -- + -- DECODERn .......... n:2**n decoder + -- ------------------------------------------------------------------------ + FUNCTION VitalDECODER2 ( + CONSTANT Data : IN std_ulogic; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector2 IS + VARIABLE Result : std_logic_vector2; + BEGIN + Result(1) := ResultMap(Enable AND ( Data)); + Result(0) := ResultMap(Enable AND (NOT Data)); + RETURN Result; + END; +-- + FUNCTION VitalDECODER4 ( + CONSTANT Data : IN std_logic_vector2; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector4 IS + VARIABLE Result : std_logic_vector4; + BEGIN + Result(3) := ResultMap(Enable AND ( Data(1)) AND ( Data(0))); + Result(2) := ResultMap(Enable AND ( Data(1)) AND (NOT Data(0))); + Result(1) := ResultMap(Enable AND (NOT Data(1)) AND ( Data(0))); + Result(0) := ResultMap(Enable AND (NOT Data(1)) AND (NOT Data(0))); + RETURN Result; + END; +-- + FUNCTION VitalDECODER8 ( + CONSTANT Data : IN std_logic_vector3; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector8 IS + VARIABLE Result : std_logic_vector8; + BEGIN + Result(7) := ( Data(2)) AND ( Data(1)) AND ( Data(0)); + Result(6) := ( Data(2)) AND ( Data(1)) AND (NOT Data(0)); + Result(5) := ( Data(2)) AND (NOT Data(1)) AND ( Data(0)); + Result(4) := ( Data(2)) AND (NOT Data(1)) AND (NOT Data(0)); + Result(3) := (NOT Data(2)) AND ( Data(1)) AND ( Data(0)); + Result(2) := (NOT Data(2)) AND ( Data(1)) AND (NOT Data(0)); + Result(1) := (NOT Data(2)) AND (NOT Data(1)) AND ( Data(0)); + Result(0) := (NOT Data(2)) AND (NOT Data(1)) AND (NOT Data(0)); + + Result(0) := ResultMap ( Enable AND Result(0) ); + Result(1) := ResultMap ( Enable AND Result(1) ); + Result(2) := ResultMap ( Enable AND Result(2) ); + Result(3) := ResultMap ( Enable AND Result(3) ); + Result(4) := ResultMap ( Enable AND Result(4) ); + Result(5) := ResultMap ( Enable AND Result(5) ); + Result(6) := ResultMap ( Enable AND Result(6) ); + Result(7) := ResultMap ( Enable AND Result(7) ); + + RETURN Result; + END; +-- + FUNCTION VitalDECODER ( + CONSTANT Data : IN std_logic_vector; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector IS + + CONSTANT DMsb : INTEGER := Data'LENGTH - 1; + ALIAS DataAlias : std_logic_vector ( DMsb DOWNTO 0 ) IS Data; + BEGIN + IF Data'LENGTH = 1 THEN + RETURN VitalDECODER2 (DataAlias( 0 ), Enable, ResultMap ); + ELSIF Data'LENGTH = 2 THEN + RETURN VitalDECODER4 (DataAlias(1 DOWNTO 0), Enable, ResultMap ); + ELSIF Data'LENGTH = 3 THEN + RETURN VitalDECODER8 (DataAlias(2 DOWNTO 0), Enable, ResultMap ); + ELSIF Data'LENGTH > 3 THEN + RETURN VitalDECODER (DataAlias(DMsb-1 DOWNTO 0), + Enable AND ( DataAlias(DMsb)), ResultMap ) + & VitalDECODER (DataAlias(DMsb-1 DOWNTO 0), + Enable AND (NOT DataAlias(DMsb)), ResultMap ); + ELSE RETURN "X"; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- N-bit wide Logical gates. + -- ------------------------------------------------------------------------ + PROCEDURE VitalAND ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE Data_Schd : SchedArray(Data'RANGE); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalAND(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := '1'; + new_schd := Data_Schd(Data_Schd'LEFT); + FOR i IN Data'RANGE LOOP + NewValue := NewValue AND Data(i); + new_schd := new_schd AND Data_Schd(i); + END LOOP; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; --SN + END; +-- + PROCEDURE VitalOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE Data_Schd : SchedArray(Data'RANGE); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalOR(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := '0'; + new_schd := Data_Schd(Data_Schd'LEFT); + FOR i IN Data'RANGE LOOP + NewValue := NewValue OR Data(i); + new_schd := new_schd OR Data_Schd(i); + END LOOP; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; --SN + END; +-- + PROCEDURE VitalXOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE DataB_Schd : SchedArray(1 TO Data'LENGTH); + VARIABLE DataI_Schd : SchedArray(1 TO Data'LENGTH); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + ALIAS ADataB_Schd : SchedArray(Data'RANGE) IS DataB_Schd; + ALIAS ADataI_Schd : SchedArray(Data'RANGE) IS DataI_Schd; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalXOR(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( ADataB_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + InvPath ( ADataI_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( ADataB_Schd, Data_Edge, Atpd_data_q ); + InvPath ( ADataI_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalXOR ( Data ); + new_schd := VitalXOR ( DataB_Schd, DataI_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; --SN + END; +-- + PROCEDURE VitalNAND ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE Data_Schd : SchedArray(Data'RANGE); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalNAND(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + InvPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + InvPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := '1'; + new_schd := Data_Schd(Data_Schd'LEFT); + FOR i IN Data'RANGE LOOP + NewValue := NewValue AND Data(i); + new_schd := new_schd AND Data_Schd(i); + END LOOP; + NewValue := NOT NewValue; + new_schd := NOT new_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE Data_Schd : SchedArray(Data'RANGE); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalNOR(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + InvPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + InvPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := '0'; + new_schd := Data_Schd(Data_Schd'LEFT); + FOR i IN Data'RANGE LOOP + NewValue := NewValue OR Data(i); + new_schd := new_schd OR Data_Schd(i); + END LOOP; + NewValue := NOT NewValue; + new_schd := NOT new_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; --SN + END; +-- + PROCEDURE VitalXNOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE DataB_Schd : SchedArray(1 TO Data'LENGTH); + VARIABLE DataI_Schd : SchedArray(1 TO Data'LENGTH); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + ALIAS ADataB_Schd : SchedArray(Data'RANGE) IS DataB_Schd; + ALIAS ADataI_Schd : SchedArray(Data'RANGE) IS DataI_Schd; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalXNOR(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( ADataB_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + InvPath ( ADataI_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( ADataB_Schd, Data_Edge, Atpd_data_q ); + InvPath ( ADataI_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalXNOR ( Data ); + new_schd := VitalXNOR ( DataB_Schd, DataI_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; --SN + END; +-- + + -- ------------------------------------------------------------------------ + -- Commonly used 2-bit Logical gates. + -- ------------------------------------------------------------------------ + PROCEDURE VitalAND2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalAND2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a AND b; + new_schd := a_schd AND b_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalOR2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a OR b; + new_schd := a_schd OR b_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNAND2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNAND2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a NAND b; + new_schd := a_schd NAND b_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNOR2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a NOR b; + new_schd := a_schd NOR b_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd : SchedType; + VARIABLE ai_schd, bi_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXOR2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a XOR b; + new_schd := VitalXOR2 ( ab_schd,ai_schd, bb_schd,bi_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXNOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd : SchedType; + VARIABLE ai_schd, bi_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXNOR2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := NOT (a XOR b); + new_schd := VitalXNOR2 ( ab_schd,ai_schd, bb_schd,bi_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Commonly used 3-bit Logical gates. + -- ------------------------------------------------------------------------ + PROCEDURE VitalAND3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN +-- + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalAND3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + BufPath ( c_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + BufPath ( c_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a AND b AND c; + new_schd := a_schd AND b_schd AND c_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalOR3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + BufPath ( c_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + BufPath ( c_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a OR b OR c; + new_schd := a_schd OR b_schd OR c_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNAND3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNAND3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + InvPath ( c_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + InvPath ( c_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := (a AND b) NAND c; + new_schd := (a_schd AND b_schd) NAND c_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNOR3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + InvPath ( c_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + InvPath ( c_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := (a OR b) NOR c; + new_schd := (a_schd OR b_schd) NOR c_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd, cb_schd : SchedType; + VARIABLE ai_schd, bi_schd, ci_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXOR3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + BufPath ( cb_schd, InitialEdge(c), tpd_c_q ); + InvPath ( ci_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + BufPath ( cb_schd, GetEdge(c), tpd_c_q ); + InvPath ( ci_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a XOR b XOR c; + new_schd := VitalXOR3 ( ab_schd,ai_schd, + bb_schd,bi_schd, + cb_schd,ci_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXNOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd, cb_schd : SchedType; + VARIABLE ai_schd, bi_schd, ci_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXNOR3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + BufPath ( cb_schd, InitialEdge(c), tpd_c_q ); + InvPath ( ci_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + BufPath ( cb_schd, GetEdge(c), tpd_c_q ); + InvPath ( ci_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := NOT (a XOR b XOR c); + new_schd := VitalXNOR3 ( ab_schd, ai_schd, + bb_schd, bi_schd, + cb_schd, ci_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Commonly used 4-bit Logical gates. + -- ------------------------------------------------------------------------ + PROCEDURE VitalAND4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalAND4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + BufPath ( c_schd, InitialEdge(c), tpd_c_q ); + BufPath ( d_Schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + BufPath ( c_schd, GetEdge(c), tpd_c_q ); + BufPath ( d_Schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a AND b AND c AND d; + new_schd := a_schd AND b_schd AND c_schd AND d_Schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalOR4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + BufPath ( c_schd, InitialEdge(c), tpd_c_q ); + BufPath ( d_Schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + BufPath ( c_schd, GetEdge(c), tpd_c_q ); + BufPath ( d_Schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a OR b OR c OR d; + new_schd := a_schd OR b_schd OR c_schd OR d_Schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNAND4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNAND4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + InvPath ( c_schd, InitialEdge(c), tpd_c_q ); + InvPath ( d_Schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + InvPath ( c_schd, GetEdge(c), tpd_c_q ); + InvPath ( d_Schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := (a AND b) NAND (c AND d); + new_schd := (a_schd AND b_schd) NAND (c_schd AND d_Schd); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNOR4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + InvPath ( c_schd, InitialEdge(c), tpd_c_q ); + InvPath ( d_Schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + InvPath ( c_schd, GetEdge(c), tpd_c_q ); + InvPath ( d_Schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := (a OR b) NOR (c OR d); + new_schd := (a_schd OR b_schd) NOR (c_schd OR d_Schd); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd, cb_schd, DB_Schd : SchedType; + VARIABLE ai_schd, bi_schd, ci_schd, di_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXOR4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + + BufPath ( cb_schd, InitialEdge(c), tpd_c_q ); + InvPath ( ci_schd, InitialEdge(c), tpd_c_q ); + + BufPath ( DB_Schd, InitialEdge(d), tpd_d_q ); + InvPath ( di_schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + BufPath ( cb_schd, GetEdge(c), tpd_c_q ); + InvPath ( ci_schd, GetEdge(c), tpd_c_q ); + + BufPath ( DB_Schd, GetEdge(d), tpd_d_q ); + InvPath ( di_schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a XOR b XOR c XOR d; + new_schd := VitalXOR4 ( ab_schd,ai_schd, bb_schd,bi_schd, + cb_schd,ci_schd, DB_Schd,di_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXNOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd, cb_schd, DB_Schd : SchedType; + VARIABLE ai_schd, bi_schd, ci_schd, di_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXNOR4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + + BufPath ( cb_schd, InitialEdge(c), tpd_c_q ); + InvPath ( ci_schd, InitialEdge(c), tpd_c_q ); + + BufPath ( DB_Schd, InitialEdge(d), tpd_d_q ); + InvPath ( di_schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + BufPath ( cb_schd, GetEdge(c), tpd_c_q ); + InvPath ( ci_schd, GetEdge(c), tpd_c_q ); + + BufPath ( DB_Schd, GetEdge(d), tpd_d_q ); + InvPath ( di_schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := NOT (a XOR b XOR c XOR d); + new_schd := VitalXNOR4 ( ab_schd,ai_schd, bb_schd,bi_schd, + cb_schd,ci_schd, DB_Schd,di_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Buffers + -- BUF ....... standard non-inverting buffer + -- BUFIF0 ....... non-inverting buffer Data passes thru if (Enable = '0') + -- BUFIF1 ....... non-inverting buffer Data passes thru if (Enable = '1') + -- ------------------------------------------------------------------------ + PROCEDURE VitalBUF ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_a_q = VitalZeroDelay01) THEN + LOOP + q <= ResultMap(To_UX01(a)); + WAIT ON a; + END LOOP; + + ELSE + LOOP + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := To_UX01(a); -- convert to forcing strengths + CASE EdgeType'(GetEdge(a)) IS + WHEN '1'|'/'|'R'|'r' => Dly := tpd_a_q(tr01); + WHEN '0'|'\'|'F'|'f' => Dly := tpd_a_q(tr10); + WHEN OTHERS => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10)); + END CASE; + + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode ); + + WAIT ON a; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalBUFIF1 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) IS + VARIABLE NewValue : UX01Z; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_data_q = VitalZeroDelay01 ) + AND (tpd_enable_q = VitalZeroDelay01Z)) THEN + LOOP + q <= VitalBUFIF1( Data, Enable, ResultMap ); + WAIT ON Data, Enable; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( d_Schd, InitialEdge(Data), tpd_data_q ); + BufEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( d_Schd, GetEdge(Data), tpd_data_q ); + BufEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalBUFIF1( Data, Enable ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), + d_Schd, e1_Schd, e0_Schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalBUFIF0 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) IS + VARIABLE NewValue : UX01Z; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType; + VARIABLE ne1_schd, ne0_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_data_q = VitalZeroDelay01 ) + AND (tpd_enable_q = VitalZeroDelay01Z)) THEN + LOOP + q <= VitalBUFIF0( Data, Enable, ResultMap ); + WAIT ON Data, Enable; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( d_Schd, InitialEdge(Data), tpd_data_q ); + InvEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( d_Schd, GetEdge(Data), tpd_data_q ); + InvEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalBUFIF0( Data, Enable ); + ne1_schd := NOT e1_Schd; + ne0_schd := NOT e0_Schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), + d_Schd, ne1_schd, ne0_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; + + PROCEDURE VitalIDENT ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) IS + SUBTYPE v2 IS std_logic_vector(0 TO 1); + VARIABLE NewValue : UX01Z; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_a_q = VitalZeroDelay01Z) THEN + LOOP + q <= ResultMap(To_UX01Z(a)); + WAIT ON a; + END LOOP; + + ELSE + LOOP + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + CASE v2'(To_X01Z(NewValue) & To_X01Z(a)) IS + WHEN "00" => Dly := tpd_a_q(tr10); + WHEN "01" => Dly := tpd_a_q(tr01); + WHEN "0Z" => Dly := tpd_a_q(tr0z); + WHEN "0X" => Dly := tpd_a_q(tr01); + WHEN "10" => Dly := tpd_a_q(tr10); + WHEN "11" => Dly := tpd_a_q(tr01); + WHEN "1Z" => Dly := tpd_a_q(tr1z); + WHEN "1X" => Dly := tpd_a_q(tr10); + WHEN "Z0" => Dly := tpd_a_q(trz0); + WHEN "Z1" => Dly := tpd_a_q(trz1); + WHEN "ZZ" => Dly := 0 ns; + WHEN "ZX" => Dly := Minimum (tpd_a_q(trz1), tpd_a_q(trz0)); + WHEN "X0" => Dly := tpd_a_q(tr10); + WHEN "X1" => Dly := tpd_a_q(tr01); + WHEN "XZ" => Dly := Minimum (tpd_a_q(tr0z), tpd_a_q(tr1z)); + WHEN OTHERS => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10)); + END CASE; + NewValue := To_UX01Z(a); + + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode ); + + WAIT ON a; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Invertors + -- INV ......... standard inverting buffer + -- INVIF0 ......... inverting buffer Data passes thru if (Enable = '0') + -- INVIF1 ......... inverting buffer Data passes thru if (Enable = '1') + -- ------------------------------------------------------------------------ + PROCEDURE VitalINV ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + IF (tpd_a_q = VitalZeroDelay01) THEN + LOOP + q <= ResultMap(NOT a); + WAIT ON a; + END LOOP; + + ELSE + LOOP + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := NOT a; + CASE EdgeType'(GetEdge(a)) IS + WHEN '1'|'/'|'R'|'r' => Dly := tpd_a_q(tr10); + WHEN '0'|'\'|'F'|'f' => Dly := tpd_a_q(tr01); + WHEN OTHERS => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10)); + END CASE; + + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode ); + + WAIT ON a; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalINVIF1 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) IS + VARIABLE NewValue : UX01Z; + VARIABLE new_schd : SchedType; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_data_q = VitalZeroDelay01 ) + AND (tpd_enable_q = VitalZeroDelay01Z)) THEN + LOOP + q <= VitalINVIF1( Data, Enable, ResultMap ); + WAIT ON Data, Enable; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( d_Schd, InitialEdge(Data), tpd_data_q ); + BufEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( d_Schd, GetEdge(Data), tpd_data_q ); + BufEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalINVIF1( Data, Enable ); + new_schd := NOT d_Schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), + new_schd, e1_Schd, e0_Schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalINVIF0 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) IS + VARIABLE NewValue : UX01Z; + VARIABLE new_schd : SchedType; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType; + VARIABLE ne1_schd, ne0_schd : SchedType := DefSchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_data_q = VitalZeroDelay01 ) + AND (tpd_enable_q = VitalZeroDelay01Z)) THEN + LOOP + q <= VitalINVIF0( Data, Enable, ResultMap ); + WAIT ON Data, Enable; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( d_Schd, InitialEdge(Data), tpd_data_q ); + InvEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( d_Schd, GetEdge(Data), tpd_data_q ); + InvEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalINVIF0( Data, Enable ); + ne1_schd := NOT e1_Schd; + ne0_schd := NOT e0_Schd; + new_schd := NOT d_Schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), + new_schd, ne1_schd, ne0_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Multiplexor + -- MUX .......... result := data(dselect) + -- MUX2 .......... 2-input mux; result := data0 when (dselect = '0'), + -- data1 when (dselect = '1'), + -- 'X' when (dselect = 'X') and (data0 /= data1) + -- MUX4 .......... 4-input mux; result := data(dselect) + -- MUX8 .......... 8-input mux; result := data(dselect) + -- ------------------------------------------------------------------------ + PROCEDURE VitalMUX2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL d1, d0 : IN std_ulogic; + SIGNAL dSel : IN std_ulogic; + CONSTANT tpd_d1_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d0_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_dsel_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + VARIABLE d1_Schd, d0_Schd : SchedType; + VARIABLE dSel_bSchd, dSel_iSchd : SchedType; + VARIABLE d1_Edge, d0_Edge, dSel_Edge : EdgeType; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_d1_q = VitalZeroDelay01) + AND (tpd_d0_q = VitalZeroDelay01) + AND (tpd_dsel_q = VitalZeroDelay01) ) THEN + LOOP + q <= VitalMUX2 ( d1, d0, dSel, ResultMap ); + WAIT ON d1, d0, dSel; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( d1_Schd, InitialEdge(d1), tpd_d1_q ); + BufPath ( d0_Schd, InitialEdge(d0), tpd_d0_q ); + BufPath ( dSel_bSchd, InitialEdge(dSel), tpd_dsel_q ); + InvPath ( dSel_iSchd, InitialEdge(dSel), tpd_dsel_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( d1_Schd, GetEdge(d1), tpd_d1_q ); + BufPath ( d0_Schd, GetEdge(d0), tpd_d0_q ); + BufPath ( dSel_bSchd, GetEdge(dSel), tpd_dsel_q ); + InvPath ( dSel_iSchd, GetEdge(dSel), tpd_dsel_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalMUX2 ( d1, d0, dSel ); + new_schd := VitalMUX2 ( d1_Schd, d0_Schd, dSel_bSchd, dSel_iSchd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON d1, d0, dSel; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalMUX4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector4; + SIGNAL dSel : IN std_logic_vector2; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE LastdSel : std_logic_vector(dSel'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + VARIABLE Data_Schd : SchedArray4; + VARIABLE Data_Edge : EdgeArray4; + VARIABLE dSel_Edge : EdgeArray2; + VARIABLE dSel_bSchd : SchedArray2; + VARIABLE dSel_iSchd : SchedArray2; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN dSel'RANGE LOOP + IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + + IF (AllZeroDelay) THEN LOOP + q <= VitalMUX(Data, dSel, ResultMap); + WAIT ON Data, dSel; + END LOOP; + END IF; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + FOR n IN dSel'RANGE LOOP + BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + GetEdge ( dSel, LastdSel, dSel_Edge ); + BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q ); + InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalMUX4 ( Data, dSel ); + new_schd := VitalMUX4 ( Data_Schd, dSel_bSchd, dSel_iSchd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, dSel; + END LOOP; + END IF; --SN + END; + + PROCEDURE VitalMUX8 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector8; + SIGNAL dSel : IN std_logic_vector3; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE LastdSel : std_logic_vector(dSel'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + VARIABLE Data_Schd : SchedArray8; + VARIABLE Data_Edge : EdgeArray8; + VARIABLE dSel_Edge : EdgeArray3; + VARIABLE dSel_bSchd : SchedArray3; + VARIABLE dSel_iSchd : SchedArray3; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN dSel'RANGE LOOP + IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + + IF (AllZeroDelay) THEN LOOP + q <= VitalMUX(Data, dSel, ResultMap); + WAIT ON Data, dSel; + END LOOP; + END IF; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + FOR n IN dSel'RANGE LOOP + BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + GetEdge ( dSel, LastdSel, dSel_Edge ); + BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q ); + InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalMUX8 ( Data, dSel ); + new_schd := VitalMUX8 ( Data_Schd, dSel_bSchd, dSel_iSchd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, dSel; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalMUX ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + SIGNAL dSel : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE LastdSel : std_logic_vector(dSel'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + VARIABLE Data_Schd : SchedArray(Data'RANGE); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE dSel_Edge : EdgeArray(dSel'RANGE); + VARIABLE dSel_bSchd : SchedArray(dSel'RANGE); + VARIABLE dSel_iSchd : SchedArray(dSel'RANGE); + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN dSel'RANGE LOOP + IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + + IF (AllZeroDelay) THEN LOOP + q <= VitalMUX(Data, dSel, ResultMap); + WAIT ON Data, dSel; + END LOOP; + END IF; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + FOR n IN dSel'RANGE LOOP + BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + GetEdge ( dSel, LastdSel, dSel_Edge ); + BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q ); + InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalMUX ( Data, dSel ); + new_schd := VitalMUX ( Data_Schd, dSel_bSchd, dSel_iSchd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, dSel; + END LOOP; + END IF; --SN + END; + + -- ------------------------------------------------------------------------ + -- Decoder + -- General Algorithm : + -- (a) Result(...) := '0' when (enable = '0') + -- (b) Result(data) := '1'; all other subelements = '0' + -- ... Result array is decending (n-1 downto 0) + -- + -- DECODERn .......... n:2**n decoder + -- Caution: If 'ResultMap' defines other than strength mapping, the + -- delay selection is not defined. + -- ------------------------------------------------------------------------ + PROCEDURE VitalDECODER2 ( + SIGNAL q : OUT std_logic_vector2; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE NewValue : std_logic_vector2; + VARIABLE Glitch_Data : GlitchArray2; + VARIABLE new_schd : SchedArray2; + VARIABLE Dly, Glch : TimeArray2; + VARIABLE Enable_Schd : SchedType := DefSchedType; + VARIABLE Data_BSchd, Data_ISchd : SchedType; + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_enable_q = VitalZeroDelay01) AND (tpd_data_q = VitalZeroDelay01) THEN + LOOP + q <= VitalDECODER2(Data, Enable, ResultMap); + WAIT ON Data, Enable; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( Data_BSchd, InitialEdge(Data), tpd_data_q ); + InvPath ( Data_ISchd, InitialEdge(Data), tpd_data_q ); + BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( Data_BSchd, GetEdge(Data), tpd_data_q ); + InvPath ( Data_ISchd, GetEdge(Data), tpd_data_q ); + + BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalDECODER2 ( Data, Enable, ResultMap ); + new_schd := VitalDECODER2 ( Data_BSchd, Data_ISchd, Enable_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; -- SN + END; +-- + PROCEDURE VitalDECODER4 ( + SIGNAL q : OUT std_logic_vector4; + SIGNAL Data : IN std_logic_vector2; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : std_logic_vector4; + VARIABLE Glitch_Data : GlitchArray4; + VARIABLE new_schd : SchedArray4; + VARIABLE Dly, Glch : TimeArray4; + VARIABLE Enable_Schd : SchedType; + VARIABLE Enable_Edge : EdgeType; + VARIABLE Data_Edge : EdgeArray2; + VARIABLE Data_BSchd, Data_ISchd : SchedArray2; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_enable_q /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + ELSE + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + END IF; + IF (AllZeroDelay) THEN LOOP + q <= VitalDECODER4(Data, Enable, ResultMap); + WAIT ON Data, Enable; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_BSchd, Data_Edge, Atpd_data_q ); + InvPath ( Data_ISchd, Data_Edge, Atpd_data_q ); + + BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalDECODER4 ( Data, Enable, ResultMap ); + new_schd := VitalDECODER4 ( Data_BSchd, Data_ISchd, Enable_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalDECODER8 ( + SIGNAL q : OUT std_logic_vector8; + SIGNAL Data : IN std_logic_vector3; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : std_logic_vector8; + VARIABLE Glitch_Data : GlitchArray8; + VARIABLE new_schd : SchedArray8; + VARIABLE Dly, Glch : TimeArray8; + VARIABLE Enable_Schd : SchedType; + VARIABLE Enable_Edge : EdgeType; + VARIABLE Data_Edge : EdgeArray3; + VARIABLE Data_BSchd, Data_ISchd : SchedArray3; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_enable_q /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + ELSE + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + END IF; + IF (AllZeroDelay) THEN LOOP + q <= VitalDECODER(Data, Enable, ResultMap); + WAIT ON Data, Enable; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_BSchd, Data_Edge, Atpd_data_q ); + InvPath ( Data_ISchd, Data_Edge, Atpd_data_q ); + + BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalDECODER8 ( Data, Enable, ResultMap ); + new_schd := VitalDECODER8 ( Data_BSchd, Data_ISchd, Enable_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; --SN + END; +-- + PROCEDURE VitalDECODER ( + SIGNAL q : OUT std_logic_vector; + SIGNAL Data : IN std_logic_vector; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : std_logic_vector(q'RANGE); + VARIABLE Glitch_Data : GlitchDataArrayType(q'RANGE); + VARIABLE new_schd : SchedArray(q'RANGE); + VARIABLE Dly, Glch : VitalTimeArray(q'RANGE); + VARIABLE Enable_Schd : SchedType; + VARIABLE Enable_Edge : EdgeType; + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE Data_BSchd, Data_ISchd : SchedArray(Data'RANGE); + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_enable_q /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + ELSE + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + END IF; + IF (AllZeroDelay) THEN LOOP + q <= VitalDECODER(Data, Enable, ResultMap); + WAIT ON Data, Enable; + END LOOP; + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_BSchd, Data_Edge, Atpd_data_q ); + InvPath ( Data_ISchd, Data_Edge, Atpd_data_q ); + + BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalDECODER ( Data, Enable, ResultMap ); + new_schd := VitalDECODER ( Data_BSchd, Data_ISchd, Enable_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + FUNCTION VitalTruthTable ( + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ) RETURN std_logic_vector IS + + CONSTANT InputSize : INTEGER := DataIn'LENGTH; + CONSTANT OutSize : INTEGER := TruthTable'LENGTH(2) - InputSize; + VARIABLE ReturnValue : std_logic_vector(OutSize - 1 DOWNTO 0) + := (OTHERS => 'X'); + VARIABLE DataInAlias : std_logic_vector(0 TO InputSize - 1) + := To_X01(DataIn); + VARIABLE Index : INTEGER; + VARIABLE Err : BOOLEAN := FALSE; + + -- This needs to be done since the TableLookup arrays must be + -- ascending starting with 0 + VARIABLE TableAlias : VitalTruthTableType(0 TO (TruthTable'LENGTH(1)-1), + 0 TO (TruthTable'LENGTH(2)-1)) + := TruthTable; + + BEGIN + -- search through each row of the truth table + IF OutSize > 0 THEN + ColLoop: + FOR i IN TableAlias'RANGE(1) LOOP + + RowLoop: -- Check each input element of the entry + FOR j IN 0 TO InputSize LOOP + + IF (j = InputSize) THEN -- This entry matches + -- Return the Result + Index := 0; + FOR k IN TruthTable'LENGTH(2) - 1 DOWNTO InputSize LOOP + TruthOutputX01Z ( TableAlias(i,k), + ReturnValue(Index), Err); + EXIT WHEN Err; + Index := Index + 1; + END LOOP; + + IF Err THEN + ReturnValue := (OTHERS => 'X'); + END IF; + RETURN ReturnValue; + END IF; + IF NOT ValidTruthTableInput(TableAlias(i,j)) THEN + VitalError ( "VitalTruthTable", ErrInpSym, + To_TruthChar(TableAlias(i,j)) ); + EXIT ColLoop; + END IF; + EXIT RowLoop WHEN NOT ( TruthTableMatch( DataInAlias(j), + TableAlias(i, j))); + END LOOP RowLoop; + END LOOP ColLoop; + + ELSE + VitalError ( "VitalTruthTable", ErrTabWidSml ); + END IF; + RETURN ReturnValue; + END VitalTruthTable; + + FUNCTION VitalTruthTable ( + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ) RETURN std_logic IS + + CONSTANT InputSize : INTEGER := DataIn'LENGTH; + CONSTANT OutSize : INTEGER := TruthTable'LENGTH(2) - InputSize; + VARIABLE TempResult : std_logic_vector(OutSize - 1 DOWNTO 0) + := (OTHERS => 'X'); + BEGIN + IF (OutSize > 0) THEN + TempResult := VitalTruthTable(TruthTable, DataIn); + IF ( 1 > OutSize) THEN + VitalError ( "VitalTruthTable", ErrTabResSml ); + ELSIF ( 1 < OutSize) THEN + VitalError ( "VitalTruthTable", ErrTabResLrg ); + END IF; + RETURN (TempResult(0)); + ELSE + VitalError ( "VitalTruthTable", ErrTabWidSml ); + RETURN 'X'; + END IF; + END VitalTruthTable; + + PROCEDURE VitalTruthTable ( + SIGNAL Result : OUT std_logic_vector; + CONSTANT TruthTable : IN VitalTruthTableType; + SIGNAL DataIn : IN std_logic_vector -- IR#236 + ) IS + CONSTANT ResLeng : INTEGER := Result'LENGTH; + CONSTANT ActResLen : INTEGER := TruthTable'LENGTH(2) - DataIn'LENGTH; + CONSTANT FinalResLen : INTEGER := Minimum(ActResLen, ResLeng); + VARIABLE TempResult : std_logic_vector(ActResLen - 1 DOWNTO 0) + := (OTHERS => 'X'); + + BEGIN + TempResult := VitalTruthTable(TruthTable, DataIn); + + IF (ResLeng > ActResLen) THEN + VitalError ( "VitalTruthTable", ErrTabResSml ); + ELSIF (ResLeng < ActResLen) THEN + VitalError ( "VitalTruthTable", ErrTabResLrg ); + END IF; + TempResult(FinalResLen-1 DOWNTO 0) := TempResult(FinalResLen-1 DOWNTO 0); + Result <= TempResult; + + END VitalTruthTable; + + PROCEDURE VitalTruthTable ( + SIGNAL Result : OUT std_logic; + CONSTANT TruthTable : IN VitalTruthTableType; + SIGNAL DataIn : IN std_logic_vector -- IR#236 + ) IS + + CONSTANT ActResLen : INTEGER := TruthTable'LENGTH(2) - DataIn'LENGTH; + VARIABLE TempResult : std_logic_vector(ActResLen - 1 DOWNTO 0) + := (OTHERS => 'X'); + + BEGIN + TempResult := VitalTruthTable(TruthTable, DataIn); + + IF ( 1 > ActResLen) THEN + VitalError ( "VitalTruthTable", ErrTabResSml ); + ELSIF ( 1 < ActResLen) THEN + VitalError ( "VitalTruthTable", ErrTabResLrg ); + END IF; + IF (ActResLen > 0) THEN + Result <= TempResult(0); + END IF; + + END VitalTruthTable; + + -- ------------------------------------------------------------------------ + PROCEDURE VitalStateTable ( + VARIABLE Result : INOUT std_logic_vector; + VARIABLE PreviousDataIn : INOUT std_logic_vector; + CONSTANT StateTable : IN VitalStateTableType; + CONSTANT DataIn : IN std_logic_vector; + CONSTANT NumStates : IN NATURAL + ) IS + + CONSTANT InputSize : INTEGER := DataIn'LENGTH; + CONSTANT OutSize : INTEGER + := StateTable'LENGTH(2) - InputSize - NumStates; + CONSTANT ResLeng : INTEGER := Result'LENGTH; + VARIABLE DataInAlias : std_logic_vector(0 TO DataIn'LENGTH-1) + := To_X01(DataIn); + VARIABLE PrevDataAlias : std_logic_vector(0 TO PreviousDataIn'LENGTH-1) + := To_X01(PreviousDataIn); + VARIABLE ResultAlias : std_logic_vector(0 TO ResLeng-1) + := To_X01(Result); + VARIABLE ExpResult : std_logic_vector(0 TO OutSize-1); + + BEGIN + IF (PreviousDataIn'LENGTH < DataIn'LENGTH) THEN + VitalError ( "VitalStateTable", ErrVctLng, "PreviousDataIn 'X'); + Result := ResultAlias; + + ELSIF (OutSize <= 0) THEN + VitalError ( "VitalStateTable", ErrTabWidSml ); + + ResultAlias := (OTHERS => 'X'); + Result := ResultAlias; + + ELSE + IF (ResLeng > OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResSml ); + ELSIF (ResLeng < OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResLrg ); + END IF; + + ExpResult := StateTableLookUp ( StateTable, DataInAlias, + PrevDataAlias, NumStates, + ResultAlias); + ResultAlias := (OTHERS => 'X'); + ResultAlias ( Maximum(0, ResLeng - OutSize) TO ResLeng - 1) + := ExpResult(Maximum(0, OutSize - ResLeng) TO OutSize-1); + + Result := ResultAlias; + PrevDataAlias(0 TO InputSize - 1) := DataInAlias; + PreviousDataIn := PrevDataAlias; + + END IF; + END VitalStateTable; + + + PROCEDURE VitalStateTable ( + VARIABLE Result : INOUT std_logic; -- states + VARIABLE PreviousDataIn : INOUT std_logic_vector; -- previous inputs and states + CONSTANT StateTable : IN VitalStateTableType; -- User's StateTable data + CONSTANT DataIn : IN std_logic_vector -- Inputs + ) IS + + VARIABLE ResultAlias : std_logic_vector(0 TO 0); + BEGIN + ResultAlias(0) := Result; + VitalStateTable ( StateTable => StateTable, + DataIn => DataIn, + NumStates => 1, + Result => ResultAlias, + PreviousDataIn => PreviousDataIn + ); + Result := ResultAlias(0); + + END VitalStateTable; + + PROCEDURE VitalStateTable ( + SIGNAL Result : INOUT std_logic_vector; + CONSTANT StateTable : IN VitalStateTableType; + SIGNAL DataIn : IN std_logic_vector; + CONSTANT NumStates : IN NATURAL + ) IS + + CONSTANT InputSize : INTEGER := DataIn'LENGTH; + CONSTANT OutSize : INTEGER + := StateTable'LENGTH(2) - InputSize - NumStates; + CONSTANT ResLeng : INTEGER := Result'LENGTH; + + VARIABLE PrevData : std_logic_vector(0 TO DataIn'LENGTH-1) + := (OTHERS => 'X'); + VARIABLE DataInAlias : std_logic_vector(0 TO DataIn'LENGTH-1); + VARIABLE ResultAlias : std_logic_vector(0 TO ResLeng-1); + VARIABLE ExpResult : std_logic_vector(0 TO OutSize-1); + + BEGIN + IF (OutSize <= 0) THEN + VitalError ( "VitalStateTable", ErrTabWidSml ); + + ResultAlias := (OTHERS => 'X'); + Result <= ResultAlias; + + ELSE + IF (ResLeng > OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResSml ); + ELSIF (ResLeng < OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResLrg ); + END IF; + + LOOP + DataInAlias := To_X01(DataIn); + ResultAlias := To_X01(Result); + ExpResult := StateTableLookUp ( StateTable, DataInAlias, + PrevData, NumStates, + ResultAlias); + ResultAlias := (OTHERS => 'X'); + ResultAlias(Maximum(0, ResLeng - OutSize) TO ResLeng-1) + := ExpResult(Maximum(0, OutSize - ResLeng) TO OutSize-1); + + Result <= ResultAlias; + PrevData := DataInAlias; + + WAIT ON DataIn; + END LOOP; + + END IF; + + END VitalStateTable; + + PROCEDURE VitalStateTable ( + SIGNAL Result : INOUT std_logic; + CONSTANT StateTable : IN VitalStateTableType; + SIGNAL DataIn : IN std_logic_vector + ) IS + + CONSTANT InputSize : INTEGER := DataIn'LENGTH; + CONSTANT OutSize : INTEGER := StateTable'LENGTH(2) - InputSize-1; + + VARIABLE PrevData : std_logic_vector(0 TO DataIn'LENGTH-1) + := (OTHERS => 'X'); + VARIABLE DataInAlias : std_logic_vector(0 TO DataIn'LENGTH-1); + VARIABLE ResultAlias : std_logic_vector(0 TO 0); + VARIABLE ExpResult : std_logic_vector(0 TO OutSize-1); + + BEGIN + IF (OutSize <= 0) THEN + VitalError ( "VitalStateTable", ErrTabWidSml ); + + Result <= 'X'; + + ELSE + IF ( 1 > OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResSml ); + ELSIF ( 1 < OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResLrg ); + END IF; + + LOOP + ResultAlias(0) := To_X01(Result); + DataInAlias := To_X01(DataIn); + ExpResult := StateTableLookUp ( StateTable, DataInAlias, + PrevData, 1, ResultAlias); + + Result <= ExpResult(OutSize-1); + PrevData := DataInAlias; + + WAIT ON DataIn; + END LOOP; + END IF; + + END VitalStateTable; + + -- ------------------------------------------------------------------------ + -- std_logic resolution primitive + -- ------------------------------------------------------------------------ + PROCEDURE VitalResolve ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector --IR236 4/2/98 + ) IS + VARIABLE uData : std_ulogic_vector(Data'RANGE); + BEGIN + FOR i IN Data'RANGE LOOP + uData(i) := Data(i); + END LOOP; + q <= resolved(uData); + END; + +END VITAL_Primitives; + diff --git a/libraries/vital2000/prmtvs_p.vhdl b/libraries/vital2000/prmtvs_p.vhdl new file mode 100644 index 000000000..764ac449a --- /dev/null +++ b/libraries/vital2000/prmtvs_p.vhdl @@ -0,0 +1,1413 @@ +-- ----------------------------------------------------------------------------- +-- Title : Standard VITAL_Primitives Package +-- : $Revision: 598 $ +-- : +-- Library : This package shall be compiled into a library +-- : symbolically named IEEE. +-- : +-- Developers : IEEE DASC Timing Working Group (TWG), PAR 1076.4 +-- : +-- Purpose : This packages defines standard types, constants, functions +-- : and procedures for use in developing ASIC models. +-- : Specifically a set of logic primitives are defined. +-- : +-- Known Errors : +-- : +-- Note : No declarations or definitions shall be included in, +-- : or excluded from this package. The "package declaration" +-- : defines the objects (types, subtypes, constants, functions, +-- : procedures ... etc.) that can be used by a user. The package +-- : body shall be considered the formal definition of the +-- : semantics of this package. Tool developers may choose to +-- : implement the package body in the most efficient manner +-- : available to them. +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Acknowledgments: +-- This code was originally developed under the "VHDL Initiative Toward ASIC +-- Libraries" (VITAL), an industry sponsored initiative. Technical +-- Director: William Billowitch, VHDL Technology Group; U.S. Coordinator: +-- Steve Schultz; Steering Committee Members: Victor Berman, Cadence Design +-- Systems; Oz Levia, Synopsys Inc.; Ray Ryan, Ryan & Ryan; Herman van Beek, +-- Texas Instruments; Victor Martin, Hewlett-Packard Company. +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Modification History : +-- ---------------------------------------------------------------------------- +-- Version No:|Auth:| Mod.Date:| Changes Made: +-- v95.0 A | | 06/02/95 | Initial ballot draft 1995 +-- ---------------------------------------------------------------------------- +-- v95.3 | ddl | 09/24/96 | #236 - VitalTruthTable DataIn should be of +-- | | | of class SIGNAL (PROPOSED) +-- ---------------------------------------------------------------------------- + +LIBRARY IEEE; +USE IEEE.Std_Logic_1164.ALL; +USE IEEE.VITAL_Timing.ALL; + +PACKAGE VITAL_Primitives IS + -- ------------------------------------------------------------------------ + -- Type and Subtype Declarations + -- ------------------------------------------------------------------------ + + -- For Truth and State Tables + SUBTYPE VitalTruthSymbolType IS VitalTableSymbolType RANGE 'X' TO 'Z'; + SUBTYPE VitalStateSymbolType IS VitalTableSymbolType RANGE '/' TO 'S'; + + TYPE VitalTruthTableType IS ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> ) + OF VitalTruthSymbolType; + TYPE VitalStateTableType IS ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> ) + OF VitalStateSymbolType; + + -- --------------------------------- + -- Default values used by primitives + -- --------------------------------- + CONSTANT VitalDefDelay01 : VitalDelayType01; -- Propagation delays + CONSTANT VitalDefDelay01Z : VitalDelayType01Z; + + -- ------------------------------------------------------------------------ + -- VITAL Primitives + -- + -- The primitives packages contains a collections of common gates, + -- including AND, OR, XOR, NAND, NOR, XNOR, BUF, INV, MUX and DECODER + -- functions. In addition, for sequential devices, a STATE TABLE construct + -- is provided. For complex functions a modeler may wish to use either + -- a collection of connected VITAL primitives, or a TRUTH TABLE construct. + -- + -- For each primitive a Function and Procedure is provided. The primitive + -- functions are provided to support behavioral modeling styles. The + -- primitive procedures are provided to support structural modeling styles. + -- + -- The procedures wait internally for an event on an input signal, compute + -- the new result, perform glitch handling, schedule transaction on the + -- output signals, and wait for future input events. All of the functional + -- (logic) input or output parameters of the primitive procedures are + -- signals. All the other parameters are constants. + -- + -- The procedure primitives are parameterized for separate path delays + -- from each input signal. All path delays default to 0 ns. + -- + -- The sequential primitive functions compute the defined function and + -- return a value of type std_ulogic or std_logic_vector. All parameters + -- of the primitive functions are constants of mode IN. + -- + -- The primitives are based on 1164 operators. The user may also elect to + -- express functions using the 1164 operators as well. These styles are + -- all equally acceptable methods for device modeling. + -- + -- ------------------------------------------------------------------------ + -- + -- Sequential + -- Primitive + -- Function Name: N-input logic device function calls: + -- VitalAND VitalOR VitalXOR + -- VitalNAND VitalNOR VitalXNOR + -- + -- Description: The function calls return the evaluated logic function + -- corresponding to the function name. + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_logic_vector The input signals for the n-bit + -- wide logic functions. + -- ResultMap VitalResultMapType The output signal strength + -- result map to modify default + -- result mapping. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_ulogic The evaluated logic function of + -- the n-bit wide primitives. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalAND ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNAND ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXNOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: N-input logic device concurrent procedure calls. + -- VitalAND VitalOR VitalXOR + -- VitalNAND VitalNOR VitalXNOR + -- + -- Description: The procedure calls return the evaluated logic function + -- corresponding to the function name as a parameter to the + -- procedure. Propagation delay form data to q is a + -- a parameter to the procedure. A vector of delay values + -- for inputs to output are provided. It is noted that + -- limitations in SDF make the back annotation of the delay + -- array difficult. + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_logic_vector The input signals for the n- + -- bit wide logic functions. + -- tpd_data_q VitalDelayArrayType01 The propagation delay from + -- the data inputs to the output + -- q. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic The output signal of the + -- evaluated logic function. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalAND ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNAND ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXNOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + -- ------------------------------------------------------------------------- + -- + -- Sequential + -- Primitive + -- Function Name: 2,3 and 4 input logic device function calls. + -- + -- VitalAND2 VitalOR2 VitalXOR2 + -- VitalAND3 VitalOR3 VitalXOR3 + -- VitalAND4 VitalOR4 VitalXOR4 + -- + -- VitalNAND2 VitalNOR2 VitalXNOR2 + -- VitalNAND3 VitalNOR3 VitalXNOR3 + -- VitalNAND4 VitalNOR4 VitalXNOR4 + -- + -- Description: The function calls return the evaluated 2, 3 or 4 input + -- logic function corresponding to the function name. + -- + -- Arguments: + -- + -- IN Type Description + -- a, b, c, d std_ulogic 2 input devices have a and b as + -- inputs. 3 input devices have a, b + -- and c as inputs. 4 input devices + -- have a, b, c and d as inputs. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_ulogic The result of the evaluated logic + -- function. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalAND2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNAND2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXNOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalAND3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNAND3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXNOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalAND4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNAND4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXNOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: 2, 3 and 4 input logic device concurrent procedure + -- calls. + -- + -- VitalAND2 VitalOR2 VitalXOR2 + -- VitalAND3 VitalOR3 VitalXOR3 + -- VitalAND4 VitalOR4 VitalXOR4 + -- + -- VitalNAND2 VitalNOR2 VitalXNOR2 + -- VitalNAND3 VitalNOR3 VitalXNOR3 + -- VitalNAND4 VitalNOR4 VitalXNOR4 + -- + -- Description: The procedure calls return the evaluated logic function + -- corresponding to the function name as a parameter to the + -- procedure. Propagation delays from a and b to q are + -- a parameter to the procedure. The default propagation + -- delay is 0 ns. + -- + -- Arguments: + -- + -- IN Type Description + -- a, b, c, d std_ulogic 2 input devices have a and b as + -- inputs. 3 input devices have a, b + -- and c as inputs. 4 input devices + -- have a, b, c and d as inputs. + -- tpd_a_q VitalDelayType01 The propagation delay from the a + -- input to output q for 2, 3 and 4 + -- input devices. + -- tpd_b_q VitalDelayType01 The propagation delay from the b + -- input to output q for 2, 3 and 4 + -- input devices. + -- tpd_c_q VitalDelayType01 The propagation delay from the c + -- input to output q for 3 and 4 input + -- devices. + -- tpd_d_q VitalDelayType01 The propagation delay from the d + -- input to output q for 4 input + -- devices. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic The output signal of the evaluated + -- logic function. + -- + -- Returns + -- none + -- ------------------------------------------------------------------------- + PROCEDURE VitalAND2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNAND2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXNOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalAND3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNAND3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXNOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalAND4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNAND4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXNOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + -- ------------------------------------------------------------------------ + -- + -- Sequential + -- Primitive + -- Function Name: Buffer logic device concurrent procedure calls. + -- + -- Description: Four buffer sequential primitive function calls are + -- provided. One is a simple buffer and the others + -- offer high and low enables and the four permits + -- propagation of Z as shown below: + -- + -- VitalBUF Standard non-inverting buffer + -- VitalBUFIF0 Non-inverting buffer with Enable low + -- VitalBUFIF1 Non-inverting buffer with Enable high + -- VitalIDENT Pass buffer capable of propagating Z + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_ulogic Input to the buffers + -- Enable std_ulogic Enable for the enable high and low + -- buffers. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping for + -- simple buffer. + -- VitalResultZMapType The output signal strength result map + -- to modify default result mapping + -- which has high impedance capability + -- for the enable high, enable low and + -- identity buffers. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_ulogic The output signal of the evaluated + -- buffer function. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalBUF ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + FUNCTION VitalBUFIF0 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic; + FUNCTION VitalBUFIF1 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic; + FUNCTION VitalIDENT ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: Buffer device procedure calls. + -- + -- Description: Four buffer concurrent primitive procedure calls are + -- provided. One is a simple buffer and the others + -- offer high and low enables and the fourth permits + -- propagation of Z as shown below: + -- + -- VitalBUF Standard non-inverting buffer + -- VitalBUFIF0 Non-inverting buffer with Enable low + -- VitalBUFIF1 Non-inverting buffer with Enable high + -- VitalIDENT Pass buffer capable of propagating Z + -- + -- Arguments: + -- + -- IN Type Description + -- a std_ulogic Input signal to the buffers + -- Enable std_ulogic Enable signal for the enable high and + -- low buffers. + -- tpd_a_q VitalDelayType01 Propagation delay from input to + -- output for the simple buffer. + -- VitalDelayType01Z Propagation delay from input to + -- to output for the enable high and low + -- and identity buffers. + -- tpd_enable_q VitalDelayType01Z Propagation delay from enable to + -- output for the enable high and low + -- buffers. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping for + -- simple buffer. + -- VitalResultZMapType The output signal strength result map + -- to modify default result mapping + -- which has high impedance capability + -- for the enable high, enable low and + -- identity buffers. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic Output of the buffers. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalBUF ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalBUFIF0 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap); + + + PROCEDURE VitalBUFIF1 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap); + + PROCEDURE VitalIDENT ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap ); + + -- ------------------------------------------------------------------------ + -- + -- Sequential + -- Primitive + -- Function Name: VitalINV, VitalINVIF0, VitalINVIF1 + -- + -- Description: Inverter functions which return the inverted signal + -- value. Inverters with enable low and high are provided + -- which can drive high impedance when inactive. + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_ulogic Input to the inverter + -- Enable std_ulogic Enable to the enable high and low + -- inverters. + -- ResultMap VitalResultMap The output signal strength result map + -- to modify default result mapping for + -- simple inverter. + -- VitalResultZMapType The output signal strength result map + -- to modify default result mapping + -- which has high impedance capability + -- for the enable high, enable low + -- inverters. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_ulogic Output of the inverter + -- + -- ------------------------------------------------------------------------- + + FUNCTION VitalINV ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalINVIF0 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic; + + FUNCTION VitalINVIF1 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: VitalINV, VitalINVIF0, VitalINVIF1 + -- + -- Description: The concurrent primitive procedure calls implement a + -- signal inversion function. The output is a parameter to + -- the procedure. The path delay information is passed as + -- a parameter to the call. + -- + -- Arguments: + -- + -- IN Type Description + -- a std_ulogic Input signal for the simple inverter + -- Data std_ulogic Input signal for the enable high and + -- low inverters. + -- Enable std_ulogic Enable signal for the enable high and + -- low inverters. + -- tpd_a_q VitalDelayType01 Propagation delay from input a to + -- output q for the simple inverter. + -- tpd_data_q VitalDelayType01 Propagation delay from input data to + -- output q for the enable high and low + -- inverters. + -- tpd_enable_q VitalDelayType01Z Propagation delay from input enable + -- to output q for the enable high and + -- low inverters. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping for + -- simple inverter. + -- VitalResultZMapType The output signal strength result map + -- to modify default result mapping + -- which has high impedance capability + -- for the enable high, enable low + -- inverters. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic Output signal of the inverter. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalINV ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + PROCEDURE VitalINVIF0 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap); + + PROCEDURE VitalINVIF1 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap); + + -- ------------------------------------------------------------------------ + -- + -- Sequential + -- Primitive + -- Function Name: VitalMUX, VitalMUX2, VitalMUX4, VitalMUX8 + -- + -- Description: The VitalMUX functions return the selected data bit + -- based on the value of dSelect. For MUX2, the function + -- returns data0 when dselect is 0 and returns data1 when + -- dselect is 1. When dselect is X, result is X for MUX2 + -- when data0 /= data1. X propagation is reduced when the + -- dselect signal is X and both data signals are identical. + -- When this is the case, the result returned is the value + -- of the data signals. + -- + -- For the N input device: + -- + -- N must equal 2**(bits of dSelect) + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_logic_vector Input signal for the N-bit, 4-bit and + -- 8-bit mux. + -- Data1,Data0 std_ulogic Input signals for the 2-bit mux. + -- dSelect std_ulogic Select signal for 2-bit mux + -- std_logic_vector2 Select signal for 4-bit mux + -- std_logic_vector3 Select signal for 8-bit mux + -- std_logic_vector Select signal for N-Bit mux + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping for + -- all muxes. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_ulogic The value of the selected bit is + -- returned. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalMUX ( + CONSTANT Data : IN std_logic_vector; + CONSTANT dSelect : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalMUX2 ( + CONSTANT Data1, Data0 : IN std_ulogic; + CONSTANT dSelect : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalMUX4 ( + CONSTANT Data : IN std_logic_vector4; + CONSTANT dSelect : IN std_logic_vector2; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalMUX8 ( + CONSTANT Data : IN std_logic_vector8; + CONSTANT dSelect : IN std_logic_vector3; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: VitalMUX, VitalMUX2, VitalMUX4, VitalMUX8 + -- + -- Description: The VitalMUX concurrent primitive procedures calls + -- return in the output q the value of the selected data + -- bit based on the value of dsel. For the two bit mux, + -- the data returned is either d0 or d1, the data input. + -- For 4, 8 and N-bit functions, data is the input and is + -- of type std_logic_vector. For the 2-bit mux, if d0 or + -- d1 are X, the output is X only when d0 do not equal d1. + -- When d0 and d1 are equal, the return value is this value + -- to reduce X propagation. + -- + -- Propagation delay information is passed as a parameter + -- to the procedure call for delays from data to output and + -- select to output. For 2-bit muxes, the propagation + -- delays from data are provided for d0 and d1 to output. + -- + -- + -- Arguments: + -- + -- IN Type Description + -- d1,d0 std_ulogic Input signals for the 2-bit mux. + -- Data std_logic_vector4 Input signals for the 4-bit mux. + -- std_logic_vector8 Input signals for the 8-bit mux. + -- std_logic_vector Input signals for the N-bit mux. + -- dsel std_ulogic Select signal for the 2-bit mux. + -- std_logic_vector2 Select signals for the 4-bit mux. + -- std_logic_vector3 Select signals for the 8-bit mux. + -- std_logic_vector Select signals for the N-bit mux. + -- tpd_d1_q VitalDelayType01 Propagation delay from input d1 to + -- output q for 2-bit mux. + -- tpd_d0_q VitalDelayType01 Propagation delay from input d0 to + -- output q for 2-bit mux. + -- tpd_data_q VitalDelayArrayType01 Propagation delay from input data + -- to output q for 4-bit, 8-bit and + -- N-bit muxes. + -- tpd_dsel_q VitalDelayType01 Propagation delay from input dsel + -- to output q for 2-bit mux. + -- VitalDelayArrayType01 Propagation delay from input dsel + -- to output q for 4-bit, 8-bit and + -- N-bit muxes. + -- ResultMap VitalResultMapType The output signal strength result + -- map to modify default result + -- mapping for all muxes. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic The value of the selected signal. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalMUX ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + SIGNAL dSel : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalMUX2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL d1, d0 : IN std_ulogic; + SIGNAL dSel : IN std_ulogic; + CONSTANT tpd_d1_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d0_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_dsel_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalMUX4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector4; + SIGNAL dSel : IN std_logic_vector2; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalMUX8 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector8; + SIGNAL dSel : IN std_logic_vector3; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + -- ------------------------------------------------------------------------ + -- + -- Sequential + -- Primitive + -- Function Name: VitalDECODER, VitalDECODER2, VitalDECODER4, + -- VitalDECODER8 + -- + -- Description: The VitalDECODER functions are the sequential primitive + -- calls for decoder logic. The functions are provided + -- for N, 2, 4 and 8-bit outputs. + -- + -- The N-bit decoder is (2**(bits of data)) wide. + -- + -- The VitalDECODER returns 0 if enable is 0. + -- The VitalDECODER returns the result bit set to 1 if + -- enable is 1. All other bits of returned result are + -- set to 0. + -- + -- The returned array is in descending order: + -- (n-1 downto 0). + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_ulogic Input signal for 2-bit decoder. + -- std_logic_vector2 Input signals for 4-bit decoder. + -- std_logic_vector3 Input signals for 8-bit decoder. + -- std_logic_vector Input signals for N-bit decoder. + -- Enable std_ulogic Enable input signal. The result is + -- output when enable is high. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping for + -- all output signals of the decoders. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_logic_vector2 The output of the 2-bit decoder. + -- std_logic_vector4 The output of the 4-bit decoder. + -- std_logic_vector8 The output of the 8-bit decoder. + -- std_logic_vector The output of the n-bit decoder. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalDECODER ( + CONSTANT Data : IN std_logic_vector; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector; + + FUNCTION VitalDECODER2 ( + CONSTANT Data : IN std_ulogic; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector2; + + FUNCTION VitalDECODER4 ( + CONSTANT Data : IN std_logic_vector2; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector4; + + FUNCTION VitalDECODER8 ( + CONSTANT Data : IN std_logic_vector3; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector8; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: VitalDECODER, VitalDECODER2, VitalDECODER4, + -- VitalDECODER8 + -- + -- Description: The VitalDECODER procedures are the concurrent primitive + -- procedure calls for decoder functions. The procedures + -- are provided for N, 2, 4 and 8 outputs. + -- + -- The N-bit decoder is (2**(bits of data)) wide. + -- + -- The procedural form of the decoder is used for + -- distributed delay modeling. The delay information for + -- each path is passed as an argument to the procedure. + -- + -- Result is set to 0 if enable is 0. + -- The result bit represented by data is set to 1 if + -- enable is 1. All other bits of result are set to 0. + -- + -- The result array is in descending order: (n-1 downto 0). + -- + -- For the N-bit decoder, the delay path is a vector of + -- delays from inputs to outputs. + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_ulogic Input signal for 2-bit decoder. + -- std_logic_vector2 Input signals for 4-bit decoder. + -- std_logic_vector3 Input signals for 8-bit decoder. + -- std_logic_vector Input signals for N-bit decoder. + -- enable std_ulogic Enable input signal. The result is + -- output when enable is high. + -- tpd_data_q VitalDelayType01 Propagation delay from input data + -- to output q for 2-bit decoder. + -- VitalDelayArrayType01 Propagation delay from input data + -- to output q for 4, 8 and n-bit + -- decoders. + -- tpd_enable_q VitalDelayType01 Propagation delay from input enable + -- to output q for 2, 4, 8 and n-bit + -- decoders. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_logic_vector2 Output signals for 2-bit decoder. + -- std_logic_vector4 Output signals for 4-bit decoder. + -- std_logic_vector8 Output signals for 8-bit decoder. + -- std_logic_vector Output signals for n-bit decoder. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalDECODER ( + SIGNAL q : OUT std_logic_vector; + SIGNAL Data : IN std_logic_vector; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + PROCEDURE VitalDECODER2 ( + SIGNAL q : OUT std_logic_vector2; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalDECODER4 ( + SIGNAL q : OUT std_logic_vector4; + SIGNAL Data : IN std_logic_vector2; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + PROCEDURE VitalDECODER8 ( + SIGNAL q : OUT std_logic_vector8; + SIGNAL Data : IN std_logic_vector3; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + -- ------------------------------------------------------------------------- + -- Function Name: VitalTruthTable + -- + -- Description: VitalTruthTable implements a truth table. Given + -- a set of inputs, a sequential search is performed + -- to match the input. If a match is found, the output + -- is set based on the contents of the CONSTANT TruthTable. + -- If there is no match, all X's are returned. There is + -- no limit to the size of the table. + -- + -- There is a procedure and function for VitalTruthTable. + -- For each of these, a single value output (std_logic) and + -- a multi-value output (std_logic_vector) are provided. + -- + -- The first dimension of the table is for number of + -- entries in the truth table and second dimension is for + -- the number of elements in a row. The number of inputs + -- in the row should be Data'LENGTH plus result'LENGTH. + -- + -- Elements is a row will be interpreted as + -- Input(NumInputs - 1),.., Input(0), + -- Result(NumOutputs - 1),.., Result(0) + -- + -- All inputs will be mapped to the X01 subtype + -- + -- If the value of Result is not in the range 'X' to 'Z' + -- then an error will be reported. Also, the Result is + -- always given either as a 0, 1, X or Z value. + -- + -- Arguments: + -- + -- IN Type Description + -- TruthTable The input constant which defines the + -- behavior in truth table form. + -- DataIn The inputs to the truth table used to + -- perform input match to select + -- output(s) to value(s) to drive. + -- + -- INOUT + -- none + -- + -- OUT + -- Result std_logic Concurrent procedure version scalar + -- output. + -- std_logic_vector Concurrent procedure version vector + -- output. + -- + -- Returns + -- Result std_logic Function version scalar output. + -- std_logic_vector Function version vector output. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalTruthTable ( + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ) RETURN std_logic_vector; + + FUNCTION VitalTruthTable ( + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ) RETURN std_logic; + + PROCEDURE VitalTruthTable ( + SIGNAL Result : OUT std_logic_vector; + CONSTANT TruthTable : IN VitalTruthTableType; + SIGNAL DataIn : IN std_logic_vector -- IR#236 + ); + PROCEDURE VitalTruthTable ( + SIGNAL Result : OUT std_logic; + CONSTANT TruthTable : IN VitalTruthTableType; + SIGNAL DataIn : IN std_logic_vector -- IR#236 + ); + -- ------------------------------------------------------------------------- + -- + -- Function Name: VitalStateTable + -- + -- Description: VitalStateTable is a non-concurrent implementation of a + -- state machine (Moore Machine). It is used to model + -- sequential devices and devices with internal states. + -- + -- The procedure takes the value of the state table + -- data set and performs a sequential search of the + -- CONSTANT StateTable until a match is found. Once a + -- match is found, the result of that match is applied + -- to Result. If there is no match, all X's are returned. + -- The resultant output becomes the input for the next + -- state. + -- + -- The first dimension of the table is the number of + -- entries in the state table and second dimension is the + -- number of elements in a row of the table. The number of + -- inputs in the row should be DataIn'LENGTH. Result should + -- contain the current state (which will become the next + -- state) as well as the outputs + -- + -- Elements is a row of the table will be interpreted as + -- Input(NumInputs-1),.., Input(0), State(NumStates-1), + -- ..., State(0),Output(NumOutputs-1),.., Output(0) + -- + -- where State(numStates-1) DOWNTO State(0) represent the + -- present state and Output(NumOutputs - 1) DOWNTO + -- Outputs(NumOutputs - NumStates) represent the new + -- values of the state variables (i.e. the next state). + -- Also, Output(NumOutputs - NumStates - 1) + -- + -- This procedure returns the next state and the new + -- outputs when a match is made between the present state + -- and present inputs and the state table. A search is + -- made starting at the top of the state table and + -- terminates with the first match. If no match is found + -- then the next state and new outputs are set to all 'X's. + -- + -- (Asynchronous inputs (i.e. resets and clears) must be + -- handled by placing the corresponding entries at the top + -- of the table. ) + -- + -- All inputs will be mapped to the X01 subtype. + -- + -- NOTE: Edge transitions should not be used as values + -- for the state variables in the present state + -- portion of the state table. The only valid + -- values that can be used for the present state + -- portion of the state table are: + -- 'X', '0', '1', 'B', '-' + -- + -- Arguments: + -- + -- IN Type Description + -- StateTable VitalStateTableType The input constant which defines + -- the behavior in state table form. + -- DataIn std_logic_vector The current state inputs to the + -- state table used to perform input + -- matches and transition + -- calculations. + -- NumStates NATURAL Number of state variables + -- + -- INOUT + -- Result std_logic Output signal for scalar version of + -- the concurrent procedure call. + -- std_logic_vector Output signals for vector version + -- of the concurrent procedure call. + -- PreviousDataIn std_logic_vector The previous inputs and states used + -- in transition calculations and to + -- set outputs for steady state cases. + -- + -- OUT + -- none + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalStateTable ( + VARIABLE Result : INOUT std_logic_vector; + VARIABLE PreviousDataIn : INOUT std_logic_vector; + CONSTANT StateTable : IN VitalStateTableType; + CONSTANT DataIn : IN std_logic_vector; + CONSTANT NumStates : IN NATURAL + ); + + PROCEDURE VitalStateTable ( + VARIABLE Result : INOUT std_logic; + VARIABLE PreviousDataIn : INOUT std_logic_vector; + CONSTANT StateTable : IN VitalStateTableType; + CONSTANT DataIn : IN std_logic_vector + ); + + PROCEDURE VitalStateTable ( + SIGNAL Result : INOUT std_logic_vector; + CONSTANT StateTable : IN VitalStateTableType; + SIGNAL DataIn : IN std_logic_vector; + CONSTANT NumStates : IN NATURAL + ); + + PROCEDURE VitalStateTable ( + SIGNAL Result : INOUT std_logic; + CONSTANT StateTable : IN VitalStateTableType; + SIGNAL DataIn : IN std_logic_vector + ); + + -- ------------------------------------------------------------------------- + -- + -- Function Name: VitalResolve + -- + -- Description: VitalResolve takes a vector of signals and resolves + -- them to a std_ulogic value. This procedure can be used + -- to resolve multiple drivers in a single model. + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_logic_vector Set of input signals which drive a + -- common signal. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic Output signal which is the resolved + -- value being driven by the collection of + -- input signals. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalResolve ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector); --IR236 4/2/98 + +END VITAL_Primitives; diff --git a/libraries/vital2000/timing_b.vhdl b/libraries/vital2000/timing_b.vhdl new file mode 100644 index 000000000..28bf52095 --- /dev/null +++ b/libraries/vital2000/timing_b.vhdl @@ -0,0 +1,2187 @@ +------------------------------------------------------------------------------- +-- Title : Standard VITAL TIMING Package +-- : $Revision: 598 $ +-- Library : VITAL +-- : +-- Developers : IEEE DASC Timing Working Group (TWG), PAR 1076.4 +-- : +-- Purpose : This packages defines standard types, attributes, constants, +-- : functions and procedures for use in developing ASIC models. +-- : This file contains the Package Body. +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Modification History : +-- ---------------------------------------------------------------------------- +-- Version No:|Auth:| Mod.Date:| Changes Made: +-- v95.0 A | | 06/08/95 | Initial ballot draft 1995 +-- v95.1 | | 08/31/95 | #IR203 - Timing violations at time 0 +-- #IR204 - Output mapping prior to glitch detection +-- v98.0 |TAG | 03/27/98 | Initial ballot draft 1998 +-- | #IR225 - Negative Premptive Glitch +-- **Code_effected=ReportGlitch,VitalGlitch, +-- VitalPathDelay,VitalPathDelay01, +-- VitalPathDelay01z. +-- #IR105 - Skew timing check needed +-- **Code_effected=NONE, New code added!! +-- #IR245,IR246,IR251 ITC code to fix false boundry cases +-- **Code_effected=InternalTimingCheck. +-- #IR248 - Allows VPD to use a default timing delay +-- **Code_effected=VitalPathDelay, +-- VitalPathDelay01,VitalPathDelay01z, +-- VitalSelectPathDelay,VitalSelectPathDelay01, +-- VitalSelectPathDelay01z. +-- #IR250 - Corrects fastpath condition in VPD +-- **Code_effected=VitalPathDelay01, +-- VitalPathDelay01z, +-- #IR252 - Corrects cancelled timing check call if +-- condition expires. +-- **Code_effected=VitalSetupHoldCheck, +-- VitalRecoveryRemovalCheck. +-- v98.1 | jdc | 03/25/99 | Changed UseDefaultDelay to IgnoreDefaultDelay +-- and set default to FALSE in VitalPathDelay() +-- +-- ---------------------------------------------------------------------------- + +LIBRARY STD; +USE STD.TEXTIO.ALL; + +PACKAGE BODY VITAL_Timing IS + + -- -------------------------------------------------------------------- + -- Package Local Declarations + -- -------------------------------------------------------------------- + + TYPE CheckType IS ( SetupCheck, HoldCheck, RecoveryCheck, RemovalCheck, + PulseWidCheck, PeriodCheck ); + + TYPE CheckInfoType IS RECORD + Violation : BOOLEAN; + CheckKind : CheckType; + ObsTime : TIME; + ExpTime : TIME; + DetTime : TIME; + State : X01; + END RECORD; + + TYPE LogicCvtTableType IS ARRAY (std_ulogic) OF CHARACTER; + TYPE HiLoStrType IS ARRAY (std_ulogic RANGE 'X' TO '1') OF STRING(1 TO 4); + + CONSTANT LogicCvtTable : LogicCvtTableType + := ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-'); + CONSTANT HiLoStr : HiLoStrType := (" X ", " Low", "High" ); + + TYPE EdgeSymbolMatchType IS ARRAY (X01,X01,VitalEdgeSymbolType) OF BOOLEAN; + -- last value, present value, edge symbol + CONSTANT EdgeSymbolMatch : EdgeSymbolMatchType := ( + 'X'=>('X'=>( OTHERS => FALSE), + '0'=>('N'|'F'|'v'|'E'|'D'|'*' => TRUE, OTHERS => FALSE ), + '1'=>('P'|'R'|'^'|'E'|'A'|'*' => TRUE, OTHERS => FALSE ) ), + '0'=>('X'=>( 'r'|'p'|'R'|'A'|'*' => TRUE, OTHERS => FALSE ), + '0'=>( OTHERS => FALSE ), + '1'=>( '/'|'P'|'p'|'R'|'*' => TRUE, OTHERS => FALSE ) ), + '1'=>('X'=>( 'f'|'n'|'F'|'D'|'*' => TRUE, OTHERS => FALSE ), + '0'=>( '\'|'N'|'n'|'F'|'*' => TRUE, OTHERS => FALSE ), + '1'=>( OTHERS => FALSE ) ) ); + + + + + --------------------------------------------------------------------------- + -- Tables used to implement 'posedge' and 'negedge' in path delays + -- These are new tables for Skewcheck routines. IR105 + --------------------------------------------------------------------------- + + TYPE EdgeRable IS ARRAY(std_ulogic, std_ulogic) OF boolean; + + CONSTANT Posedge : EdgeRable := ( + -- ------------------------------------------------------------------------ + -- | U X 0 1 Z W L H - + -- ------------------------------------------------------------------------ + ( FALSE, FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE ), -- U + ( FALSE, FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE ), -- X + ( TRUE , TRUE , FALSE, TRUE , TRUE , TRUE , FALSE, TRUE , TRUE ), -- 0 + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- 1 + ( FALSE, FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE ), -- Z + ( FALSE, FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE ), -- W + ( TRUE , TRUE , FALSE, TRUE , TRUE , TRUE , FALSE, TRUE , TRUE ), -- L + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- H + ( FALSE, FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE ) -- - + + ); --IR105 + + + CONSTANT Negedge : EdgeRable := ( + -- ----------------------------------------------------------------------- + -- | U X 0 1 Z W L H - + -- ----------------------------------------------------------------------- + ( FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE, FALSE ), -- U + ( FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE, FALSE ), -- X + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- 0 + ( TRUE , TRUE , TRUE , FALSE, TRUE , TRUE , TRUE , FALSE, TRUE ), -- 1 + ( FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE, FALSE ), -- Z + ( FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE, FALSE ), -- W + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE ), -- L + ( TRUE , TRUE , TRUE , FALSE, TRUE , TRUE , TRUE , FALSE, TRUE ), -- H + ( FALSE, FALSE, TRUE , FALSE, FALSE, FALSE, TRUE , FALSE, FALSE ) -- - + + ); --IR105 + + TYPE SkewType IS (Inphase, Outphase); --IR105 + + CONSTANT noTrigger : TIME := -1 ns; --IR105 + --------------------------------------------------------------------------- + -- End of Skew (IR105 additions) + --------------------------------------------------------------------------- + + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + -- Misc Utilities Local Utilities + --------------------------------------------------------------------------- + ----------------------------------------------------------------------- + FUNCTION Minimum ( CONSTANT t1,t2 : IN TIME ) RETURN TIME IS + BEGIN + IF ( t1 < t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF; + END Minimum; + ----------------------------------------------------------------------- + FUNCTION Maximum ( CONSTANT t1,t2 : IN TIME ) RETURN TIME IS + BEGIN + IF ( t1 > t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF; + END Maximum; + + -------------------------------------------------------------------- + -- Error Message Types and Tables + -------------------------------------------------------------------- + TYPE VitalErrorType IS ( + ErrVctLng , + ErrNoPath , + ErrNegPath , + ErrNegDel + ); + + TYPE VitalErrorSeverityType IS ARRAY (VitalErrorType) OF SEVERITY_LEVEL; + CONSTANT VitalErrorSeverity : VitalErrorSeverityType := ( + ErrVctLng => ERROR, + ErrNoPath => WARNING, + ErrNegPath => WARNING, + ErrNegDel => WARNING + ); + + CONSTANT MsgNoPath : STRING := + "No Delay Path Condition TRUE. 0-delay used. Output signal is: "; + CONSTANT MsgNegPath : STRING := + "Path Delay less than time since input. 0 delay used. Output signal is: "; + CONSTANT MsgNegDel : STRING := + "Negative delay. New output value not scheduled. Output signal is: "; + CONSTANT MsgVctLng : STRING := + "Vector (array) lengths not equal. "; + + CONSTANT MsgUnknown : STRING := + "Unknown error message."; + + FUNCTION VitalMessage ( + CONSTANT ErrorId : IN VitalErrorType + ) RETURN STRING IS + BEGIN + CASE ErrorId IS + WHEN ErrVctLng => RETURN MsgVctLng; + WHEN ErrNoPath => RETURN MsgNoPath; + WHEN ErrNegPath => RETURN MsgNegPath; + WHEN ErrNegDel => RETURN MsgNegDel; + WHEN OTHERS => RETURN MsgUnknown; + END CASE; + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) + SEVERITY VitalErrorSeverity(ErrorId); + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType; + CONSTANT Info : IN STRING + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) & Info + SEVERITY VitalErrorSeverity(ErrorId); + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType; + CONSTANT Info : IN CHARACTER + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) & Info + SEVERITY VitalErrorSeverity(ErrorId); + END; + + --------------------------------------------------------------------------- + -- Time Delay Assignment Subprograms + --------------------------------------------------------------------------- + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType + ) RETURN VitalDelayType01Z IS + BEGIN + RETURN (OTHERS => Delay); + END VitalExtendToFillDelay; + + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType01 + ) RETURN VitalDelayType01Z IS + VARIABLE Delay01Z : VitalDelayType01Z; + BEGIN + Delay01Z(tr01) := Delay(tr01); + Delay01Z(tr0z) := Delay(tr01); + Delay01Z(trz1) := Delay(tr01); + Delay01Z(tr10) := Delay(tr10); + Delay01Z(tr1z) := Delay(tr10); + Delay01Z(trz0) := Delay(tr10); + RETURN (Delay01Z); + END VitalExtendToFillDelay; + + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType01Z + ) RETURN VitalDelayType01Z IS + BEGIN + RETURN Delay; + END VitalExtendToFillDelay; + + --------------------------------------------------------------------------- + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType + ) RETURN TIME IS + BEGIN + RETURN delay; + END VitalCalcDelay; + + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType01 + ) RETURN TIME IS + VARIABLE Result : TIME; + BEGIN + CASE Newval IS + WHEN '0' | 'L' => Result := Delay(tr10); + WHEN '1' | 'H' => Result := Delay(tr01); + WHEN 'Z' => + CASE Oldval IS + WHEN '0' | 'L' => Result := Delay(tr01); + WHEN '1' | 'H' => Result := Delay(tr10); + WHEN OTHERS => Result := MAXIMUM(Delay(tr10), Delay(tr01)); + END CASE; + WHEN OTHERS => + CASE Oldval IS + WHEN '0' | 'L' => Result := Delay(tr01); + WHEN '1' | 'H' => Result := Delay(tr10); + WHEN 'Z' => Result := MINIMUM(Delay(tr10), Delay(tr01)); + WHEN OTHERS => Result := MAXIMUM(Delay(tr10), Delay(tr01)); + END CASE; + END CASE; + RETURN Result; + END VitalCalcDelay; + + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType01Z + ) RETURN TIME IS + VARIABLE Result : TIME; + BEGIN + CASE Oldval IS + WHEN '0' | 'L' => + CASE Newval IS + WHEN '0' | 'L' => Result := Delay(tr10); + WHEN '1' | 'H' => Result := Delay(tr01); + WHEN 'Z' => Result := Delay(tr0z); + WHEN OTHERS => Result := MINIMUM(Delay(tr01), Delay(tr0z)); + END CASE; + WHEN '1' | 'H' => + CASE Newval IS + WHEN '0' | 'L' => Result := Delay(tr10); + WHEN '1' | 'H' => Result := Delay(tr01); + WHEN 'Z' => Result := Delay(tr1z); + WHEN OTHERS => Result := MINIMUM(Delay(tr10), Delay(tr1z)); + END CASE; + WHEN 'Z' => + CASE Newval IS + WHEN '0' | 'L' => Result := Delay(trz0); + WHEN '1' | 'H' => Result := Delay(trz1); + WHEN 'Z' => Result := MAXIMUM (Delay(tr0z), Delay(tr1z)); + WHEN OTHERS => Result := MINIMUM (Delay(trz1), Delay(trz0)); + END CASE; + WHEN 'U' | 'X' | 'W' | '-' => + CASE Newval IS + WHEN '0' | 'L' => Result := MAXIMUM(Delay(tr10), Delay(trz0)); + WHEN '1' | 'H' => Result := MAXIMUM(Delay(tr01), Delay(trz1)); + WHEN 'Z' => Result := MAXIMUM(Delay(tr1z), Delay(tr0z)); + WHEN OTHERS => Result := MAXIMUM(Delay(tr10), Delay(tr01)); + END CASE; + END CASE; + RETURN Result; + END VitalCalcDelay; + + --------------------------------------------------------------------------- + -- + -- VitalSelectPathDelay returns the path delay selected by the Paths array. + -- If no paths are selected, it returns either the appropriate default + -- delay or TIME'HIGH, depending upon the value of IgnoreDefaultDelay. + -- + + FUNCTION VitalSelectPathDelay ( + CONSTANT NewValue : IN std_logic; + CONSTANT OldValue : IN std_logic; + CONSTANT OutSignalName : IN string; + CONSTANT Paths : IN VitalPathArrayType; + CONSTANT DefaultDelay : IN VitalDelayType; + CONSTANT IgnoreDefaultDelay : IN BOOLEAN + ) RETURN TIME IS + + VARIABLE TmpDelay : TIME; + VARIABLE InputAge : TIME := TIME'HIGH; + VARIABLE PropDelay : TIME := TIME'HIGH; + BEGIN + -- for each delay path + FOR i IN Paths'RANGE LOOP + -- ignore the delay path if it is not enabled + NEXT WHEN NOT Paths(i).PathCondition; + -- ignore the delay path if a more recent input event has been seen + NEXT WHEN Paths(i).InputChangeTime > InputAge; + + -- This is the most recent input change (so far) + -- Get the transition dependent delay + TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay); + + -- If other inputs changed at the same time, + -- then use the minimum of their propagation delays, + -- else use the propagation delay from this input. + IF Paths(i).InputChangeTime < InputAge THEN + PropDelay := TmpDelay; + ELSE -- Simultaneous inputs change + IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF; + end if; + + InputAge := Paths(i).InputChangeTime; + END LOOP; + + -- If there were no paths (with an enabled condition), + -- use the default delay, if so indicated, otherwise return TIME'HIGH + IF (PropDelay = TIME'HIGH) THEN + IF (IgnoreDefaultDelay) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + END IF; + + -- If the time since the most recent selected input event is + -- greater than the propagation delay from that input, + -- then use the default delay (won't happen if no paths are selected) + ELSIF (InputAge > PropDelay) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + + -- Adjust the propagation delay by the time since the + -- the input event occurred (Usually 0 ns). + ELSE + PropDelay := PropDelay - InputAge; + END IF; + + RETURN PropDelay; + END; + + FUNCTION VitalSelectPathDelay ( + CONSTANT NewValue : IN std_logic; + CONSTANT OldValue : IN std_logic; + CONSTANT OutSignalName : IN string; + CONSTANT Paths : IN VitalPathArray01Type; + CONSTANT DefaultDelay : IN VitalDelayType01; + CONSTANT IgnoreDefaultDelay : IN BOOLEAN + ) RETURN TIME IS + + VARIABLE TmpDelay : TIME; + VARIABLE InputAge : TIME := TIME'HIGH; + VARIABLE PropDelay : TIME := TIME'HIGH; + BEGIN + -- for each delay path + FOR i IN Paths'RANGE LOOP + -- ignore the delay path if it is not enabled + NEXT WHEN NOT Paths(i).PathCondition; + -- ignore the delay path if a more recent input event has been seen + NEXT WHEN Paths(i).InputChangeTime > InputAge; + + -- This is the most recent input change (so far) + -- Get the transition dependent delay + TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay); + + -- If other inputs changed at the same time, + -- then use the minimum of their propagation delays, + -- else use the propagation delay from this input. + IF Paths(i).InputChangeTime < InputAge THEN + PropDelay := TmpDelay; + ELSE -- Simultaneous inputs change + IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF; + end if; + + InputAge := Paths(i).InputChangeTime; + END LOOP; + + -- If there were no paths (with an enabled condition), + -- use the default delay, if so indicated, otherwise return TIME'HIGH + IF (PropDelay = TIME'HIGH) THEN + IF (IgnoreDefaultDelay) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + END IF; + + -- If the time since the most recent selected input event is + -- greater than the propagation delay from that input, + -- then use the default delay (won't happen if no paths are selected) + ELSIF (InputAge > PropDelay) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + + -- Adjust the propagation delay by the time since the + -- the input event occurred (Usually 0 ns). + ELSE + PropDelay := PropDelay - InputAge; + END IF; + + RETURN PropDelay; + END; + + FUNCTION VitalSelectPathDelay ( + CONSTANT NewValue : IN std_logic; + CONSTANT OldValue : IN std_logic; + CONSTANT OutSignalName : IN string; + CONSTANT Paths : IN VitalPathArray01ZType; + CONSTANT DefaultDelay : IN VitalDelayType01Z; + CONSTANT IgnoreDefaultDelay : IN BOOLEAN + ) RETURN TIME IS + + VARIABLE TmpDelay : TIME; + VARIABLE InputAge : TIME := TIME'HIGH; + VARIABLE PropDelay : TIME := TIME'HIGH; + BEGIN + -- for each delay path + FOR i IN Paths'RANGE LOOP + -- ignore the delay path if it is not enabled + NEXT WHEN NOT Paths(i).PathCondition; + -- ignore the delay path if a more recent input event has been seen + NEXT WHEN Paths(i).InputChangeTime > InputAge; + + -- This is the most recent input change (so far) + -- Get the transition dependent delay + TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay); + + -- If other inputs changed at the same time, + -- then use the minimum of their propagation delays, + -- else use the propagation delay from this input. + IF Paths(i).InputChangeTime < InputAge THEN + PropDelay := TmpDelay; + ELSE -- Simultaneous inputs change + IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF; + end if; + + InputAge := Paths(i).InputChangeTime; + END LOOP; + + -- If there were no paths (with an enabled condition), + -- use the default delay, if so indicated, otherwise return TIME'HIGH + IF (PropDelay = TIME'HIGH) THEN + IF (IgnoreDefaultDelay) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + END IF; + + -- If the time since the most recent selected input event is + -- greater than the propagation delay from that input, + -- then use the default delay (won't happen if no paths are selected) + ELSIF (InputAge > PropDelay) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + + -- Adjust the propagation delay by the time since the + -- the input event occurred (Usually 0 ns). + ELSE + PropDelay := PropDelay - InputAge; + END IF; + + RETURN PropDelay; + END; + + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + -- Glitch Handlers + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + PROCEDURE ReportGlitch ( + CONSTANT GlitchRoutine : IN STRING; + CONSTANT OutSignalName : IN STRING; + CONSTANT PreemptedTime : IN TIME; + CONSTANT PreemptedValue : IN std_ulogic; + CONSTANT NewTime : IN TIME; + CONSTANT NewValue : IN std_ulogic; + CONSTANT Index : IN INTEGER := 0; + CONSTANT IsArraySignal : IN BOOLEAN := FALSE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + VARIABLE StrPtr1, StrPtr2, StrPtr3, StrPtr4, StrPtr5 : LINE; + BEGIN + + Write (StrPtr1, PreemptedTime ); + Write (StrPtr2, NewTime); + Write (StrPtr3, LogicCvtTable(PreemptedValue)); + Write (StrPtr4, LogicCvtTable(NewValue)); + IF IsArraySignal THEN + Write (StrPtr5, STRING'( "(" ) ); + Write (StrPtr5, Index); + Write (StrPtr5, STRING'( ")" ) ); + ELSE + Write (StrPtr5, STRING'( " " ) ); + END IF; + + -- Issue Report only if Preempted value has not been + -- removed from event queue + ASSERT PreemptedTime > NewTime + REPORT GlitchRoutine & ": GLITCH Detected on port " & + OutSignalName & StrPtr5.ALL & + "; Preempted Future Value := " & StrPtr3.ALL & + " @ " & StrPtr1.ALL & + "; Newly Scheduled Value := " & StrPtr4.ALL & + " @ " & StrPtr2.ALL & + ";" + SEVERITY MsgSeverity; + + + ASSERT PreemptedTime <= NewTime + REPORT GlitchRoutine & ": GLITCH Detected on port " & + OutSignalName & StrPtr5.ALL & + "; Negative Preempted Value := " & StrPtr3.ALL & + " @ " & StrPtr1.ALL & + "; Newly Scheduled Value := " & StrPtr4.ALL & + " @ " & StrPtr2.ALL & + ";" + SEVERITY MsgSeverity; + + + DEALLOCATE(StrPtr1); + DEALLOCATE(StrPtr2); + DEALLOCATE(StrPtr3); + DEALLOCATE(StrPtr4); + DEALLOCATE(StrPtr5); + RETURN; + END ReportGlitch; + + --------------------------------------------------------------------------- + PROCEDURE VitalGlitch ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT NewValue : IN std_logic; + CONSTANT NewDelay : IN TIME := 0 ns; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT NegPreemptOn : IN BOOLEAN := FALSE; --IR225 + CONSTANT MsgOn : IN BOOLEAN := FALSE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + --------------------------------------------------------------------------- + VARIABLE NewGlitch : BOOLEAN := TRUE; + VARIABLE dly : TIME := NewDelay; + VARIABLE NOW_TIME : TIME := NOW; + VARIABLE NegPreemptGlitch : BOOLEAN := FALSE; + + BEGIN + NegPreemptGlitch:=FALSE;--reset Preempt-Glitch + + -- If nothing to schedule, just return + IF NewDelay < 0 ns THEN + IF (NewValue /= GlitchData.SchedValue) THEN + VitalError ( "VitalGlitch", ErrNegDel, OutSignalName ); + END IF; + RETURN; + END IF; + + -- If simple signal assignment + -- perform the signal assignment + IF ( Mode = VitalInertial) THEN + OutSignal <= NewValue AFTER dly; + ELSIF ( Mode = VitalTransport ) THEN + OutSignal <= TRANSPORT NewValue AFTER dly; + ELSE + -- Glitch Processing --- + -- If nothing currently scheduled + IF GlitchData.SchedTime <= NOW THEN -- NOW >= last event + -- Note: NewValue is always /= OldValue when called from VPPD + IF (NewValue = GlitchData.SchedValue) THEN RETURN; END IF; + NewGlitch := FALSE; + GlitchData.GlitchTime := NOW+dly; + + -- New value earlier than the earliest previous value scheduled + -- (negative preemptive) + ELSIF (NOW+dly <= GlitchData.GlitchTime) + AND (NOW+dly <= GlitchData.SchedTime) THEN + + -- Glitch is negative preemptive - check if same value and + -- NegPreempt is on IR225 + IF (GlitchData.SchedValue /= NewValue) AND (NegPreemptOn) AND + (NOW > 0 NS) THEN + NewGlitch := TRUE; + NegPreemptGlitch :=TRUE; -- Set preempt Glitch condition + ELSE + NewGlitch := FALSE; -- No new glitch, save time for + -- possible future glitch + END IF; + GlitchData.GlitchTime := NOW+dly; + + -- Transaction currently scheduled - if glitch already happened + ELSIF GlitchData.GlitchTime <= NOW THEN + IF (GlitchData.SchedValue = NewValue) THEN + dly := Minimum( GlitchData.SchedTime-NOW, NewDelay ); + END IF; + NewGlitch := FALSE; + + -- Transaction currently scheduled (no glitch if same value) + ELSIF (GlitchData.SchedValue = NewValue) + AND (GlitchData.SchedTime = GlitchData.GlitchTime) THEN + -- revise scheduled output time if new delay is sooner + dly := Minimum( GlitchData.SchedTime-NOW, NewDelay ); + -- No new glitch, save time for possable future glitch + NewGlitch := FALSE; + GlitchData.GlitchTime := NOW+dly; + + -- Transaction currently scheduled represents a glitch + ELSE + NewGlitch := TRUE; -- A new glitch has been detected + END IF; + + IF NewGlitch THEN + -- If messages requested, report the glitch + IF MsgOn THEN + IF NegPreemptGlitch THEN --IR225 + ReportGlitch ("VitalGlitch-Neg", OutSignalName, + GlitchData.GlitchTime, GlitchData.SchedValue, + (dly + NOW), NewValue, + MsgSeverity=>MsgSeverity ); + ELSE + ReportGlitch ("VitalGlitch", OutSignalName, + GlitchData.GlitchTime, GlitchData.SchedValue, + (dly + NOW), NewValue, + MsgSeverity=>MsgSeverity ); + END IF; + END IF; + + -- If 'X' generation is requested, schedule the new value + -- preceeded by a glitch pulse. + -- Otherwise just schedule the new value (inertial mode). + IF XOn THEN + IF (Mode = OnDetect) THEN + OutSignal <= 'X'; + ELSE + OutSignal <= 'X' AFTER GlitchData.GlitchTime-NOW; + END IF; + + IF NegPreemptGlitch THEN -- IR225 + OutSignal <= TRANSPORT NewValue AFTER GlitchData.SchedTime-NOW; + ELSE + OutSignal <= TRANSPORT NewValue AFTER dly; + END IF; + ELSE + OutSignal <= NewValue AFTER dly; -- no glitch regular prop delay + END IF; + + -- If there no new glitch was detected, just schedule the new value. + ELSE + OutSignal <= NewValue AFTER dly; + END IF; + END IF; + + -- Record the new value and time depending on glitch type just scheduled. + IF NOT NegPreemptGlitch THEN -- 5/2/96 for "x-pulse" IR225 + GlitchData.SchedValue := NewValue; + GlitchData.SchedTime := NOW+dly; -- pulse timing. + ELSE + GlitchData.SchedValue := 'X'; + -- leave GlitchData.SchedTime to old value since glitch is negative + END IF; + RETURN; + END; + + --------------------------------------------------------------------------- + PROCEDURE VitalPathDelay ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArrayType; + CONSTANT DefaultDelay : IN VitalDelayType := VitalZeroDelay; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT NegPreemptOn : IN BOOLEAN := FALSE; --IR225 3/14/98 + CONSTANT IgnoreDefaultDelay : IN BOOLEAN := FALSE --IR248 3/14/98 + ) IS + + VARIABLE PropDelay : TIME; + + BEGIN + -- Check if the new value to be scheduled is different than the + -- previously scheduled value + IF (GlitchData.SchedTime <= NOW) AND + (GlitchData.SchedValue = OutTemp) + THEN RETURN; + END IF; + + -- Evaluate propagation delay paths + PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue, + OutSignalName, Paths, DefaultDelay, + IgnoreDefaultDelay); + + GlitchData.LastValue := OutTemp; + + -- Schedule the output transactions - including glitch handling + VitalGlitch (OutSignal, GlitchData, OutSignalName, OutTemp, + PropDelay, Mode, XOn, NegPreemptOn, MsgOn, MsgSeverity ); + + END VitalPathDelay; + + --------------------------------------------------------------------------- + + PROCEDURE VitalPathDelay01 ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArray01Type; + CONSTANT DefaultDelay : IN VitalDelayType01 := VitalZeroDelay01; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT NegPreemptOn : IN BOOLEAN := FALSE; --IR225 3/14/98 + CONSTANT IgnoreDefaultDelay : IN BOOLEAN := FALSE; --IR248 3/14/98 + CONSTANT RejectFastPath : IN BOOLEAN := FALSE --IR250 + + + ) IS + + VARIABLE PropDelay : TIME; + BEGIN + + -- Check if the new value to be scheduled is different than the + -- previously scheduled value + IF (GlitchData.SchedTime <= NOW) AND + (GlitchData.SchedValue = OutTemp) + THEN RETURN; + -- Check if the new value to be Scheduled is the same as the + -- previously scheduled output transactions. If this condition + -- exists and the new scheduled time is < the current GlitchData. + -- schedTime then a fast path condition exists (IR250). If the + -- modeler wants this condition rejected by setting the + -- RejectFastPath actual to true then exit out. + ELSIF (GlitchData.SchedValue=OutTemp) AND (RejectFastPath) + THEN RETURN; + END IF; + + -- Evaluate propagation delay paths + PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue, + OutSignalName, Paths, DefaultDelay, + IgnoreDefaultDelay); + + GlitchData.LastValue := OutTemp; + + + VitalGlitch (OutSignal, GlitchData, OutSignalName, OutTemp, + PropDelay, Mode, XOn, NegPreemptOn, MsgOn, MsgSeverity ); + END VitalPathDelay01; + + --------------------------------------------------------------------------- + PROCEDURE VitalPathDelay01Z ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArray01ZType; + CONSTANT DefaultDelay : IN VitalDelayType01Z := VitalZeroDelay01Z; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT OutputMap : IN VitalOutputMapType := VitalDefaultOutputMap; + CONSTANT NegPreemptOn : IN BOOLEAN := FALSE; --IR225 3/14/98 + CONSTANT IgnoreDefaultDelay : IN BOOLEAN := FALSE; --IR248 3/14/98 + CONSTANT RejectFastPath : IN BOOLEAN := FALSE --IR250 + ) IS + + VARIABLE PropDelay : TIME; + + BEGIN + -- Check if the new value to be scheduled is different than the + -- previously scheduled value + IF (GlitchData.SchedTime <= NOW) AND + (GlitchData.SchedValue = OutTemp) + THEN RETURN; + -- Check if the new value to be Scheduled is the same as the + -- previously scheduled output transactions. If this condition + -- exists and the new scheduled time is < the current GlitchData. + -- schedTime then a fast path condition exists (IR250). If the + -- modeler wants this condition rejected by setting the + -- RejectFastPath actual to true then exit out. + ELSIF (GlitchData.SchedValue=OutTemp) AND (RejectFastPath) + THEN RETURN; + END IF; + + -- Evaluate propagation delay paths + PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue, + OutSignalName, Paths, DefaultDelay, + IgnoreDefaultDelay); + + GlitchData.LastValue := OutTemp; + + + -- Schedule the output transactions - including glitch handling + VitalGlitch (OutSignal, GlitchData, OutSignalName, OutTemp, + PropDelay, Mode, XOn, NegPreemptOn, MsgOn, MsgSeverity ); + END VitalPathDelay01Z; + + + ---------------------------------------------------------------------------- + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType + ) IS + BEGIN + OutSig <= TRANSPORT InSig AFTER twire; + END VitalWireDelay; + + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType01 + ) IS + VARIABLE Delay : TIME; + BEGIN + Delay := VitalCalcDelay( InSig, InSig'LAST_VALUE, twire ); + OutSig <= TRANSPORT InSig AFTER Delay; + END VitalWireDelay; + + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType01Z + ) IS + VARIABLE Delay : TIME; + BEGIN + Delay := VitalCalcDelay( InSig, InSig'LAST_VALUE, twire ); + OutSig <= TRANSPORT InSig AFTER Delay; + END VitalWireDelay; + + ---------------------------------------------------------------------------- + PROCEDURE VitalSignalDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT dly : IN TIME + ) IS + BEGIN + OutSig <= TRANSPORT InSig AFTER dly; + END; + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + -- Setup and Hold Time Check Routine + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + PROCEDURE ReportViolation ( + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT CheckInfo : IN CheckInfoType; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + VARIABLE Message : LINE; + BEGIN + IF NOT CheckInfo.Violation THEN RETURN; END IF; + + Write ( Message, HeaderMsg ); + Case CheckInfo.CheckKind IS + WHEN SetupCheck => Write ( Message, STRING'(" SETUP ") ); + WHEN HoldCheck => Write ( Message, STRING'(" HOLD ") ); + WHEN RecoveryCheck => Write ( Message, STRING'(" RECOVERY ") ); + WHEN RemovalCheck => Write ( Message, STRING'(" REMOVAL ") ); + WHEN PulseWidCheck => Write ( Message, STRING'(" PULSE WIDTH ")); + WHEN PeriodCheck => Write ( Message, STRING'(" PERIOD ") ); + END CASE; + Write ( Message, HiLoStr(CheckInfo.State) ); + Write ( Message, STRING'(" VIOLATION ON ") ); + Write ( Message, TestSignalName ); + IF (RefSignalName'LENGTH > 0) THEN + Write ( Message, STRING'(" WITH RESPECT TO ") ); + Write ( Message, RefSignalName ); + END IF; + Write ( Message, ';' & LF ); + Write ( Message, STRING'(" Expected := ") ); + Write ( Message, CheckInfo.ExpTime); + Write ( Message, STRING'("; Observed := ") ); + Write ( Message, CheckInfo.ObsTime); + Write ( Message, STRING'("; At : ") ); + Write ( Message, CheckInfo.DetTime); + + ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity; + + DEALLOCATE (Message); + END ReportViolation; + + + --------------------------------------------------------------------------- + -- Procedure : InternalTimingCheck + --------------------------------------------------------------------------- + PROCEDURE InternalTimingCheck ( + CONSTANT TestSignal : IN std_ulogic; + CONSTANT RefSignal : IN std_ulogic; + CONSTANT TestDelay : IN TIME := 0 ns; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + VARIABLE RefTime : IN TIME; + VARIABLE RefEdge : IN BOOLEAN; + VARIABLE TestTime : IN TIME; + VARIABLE TestEvent : IN BOOLEAN; + VARIABLE SetupEn : INOUT BOOLEAN; + VARIABLE HoldEn : INOUT BOOLEAN; + VARIABLE CheckInfo : INOUT CheckInfoType; + CONSTANT MsgOn : IN BOOLEAN + ) IS + VARIABLE bias : TIME; + VARIABLE actualObsTime : TIME; + VARIABLE BC : TIME; + VARIABLE Message:LINE; + BEGIN + -- Check SETUP constraint + IF RefEdge THEN + IF SetupEn THEN + CheckInfo.ObsTime := RefTime - TestTime; + CheckInfo.State := To_X01(TestSignal); + CASE CheckInfo.State IS + WHEN '0' => CheckInfo.ExpTime := SetupLow; + -- start of new code IR245-246 + BC := HoldHigh; + -- end of new code IR245-246 + WHEN '1' => CheckInfo.ExpTime := SetupHigh; + -- start of new code IR245-246 + BC := HoldLow; + -- end of new code IR245-246 + WHEN 'X' => CheckInfo.ExpTime := Maximum(SetupHigh,SetupLow); + -- start of new code IR245-246 + BC := Maximum(HoldHigh,HoldLow); + -- end of new code IR245-246 + END CASE; + -- added the second condition for IR 245-246 + CheckInfo.Violation := ( (CheckInfo.ObsTime < CheckInfo.ExpTime) + AND ( NOT ((CheckInfo.ObsTime = BC) and (BC = 0 ns))) ); + -- start of new code IR245-246 + IF(CheckInfo.ExpTime = 0 ns) THEN + CheckInfo.CheckKind := HoldCheck; + ELSE + CheckInfo.CheckKind := SetupCheck; + END IF; + -- end of new code IR245-246 + SetupEn := FALSE; + ELSE + CheckInfo.Violation := FALSE; + END IF; + + -- Check HOLD constraint + ELSIF TestEvent THEN + IF HoldEn THEN + CheckInfo.ObsTime := TestTime - RefTime; + CheckInfo.State := To_X01(TestSignal); + CASE CheckInfo.State IS + WHEN '0' => CheckInfo.ExpTime := HoldHigh; + + -- new code for unnamed IR + CheckInfo.State := '1'; + + -- start of new code IR245-246 + BC := SetupLow; + -- end of new code IR245-246 + WHEN '1' => CheckInfo.ExpTime := HoldLow; + + -- new code for unnamed IR + CheckInfo.State := '0'; + + -- start of new code IR245-246 + BC := SetupHigh; + -- end of new code IR245-246 + WHEN 'X' => CheckInfo.ExpTime := Maximum(HoldHigh,HoldLow); + -- start of new code IR245-246 + BC := Maximum(SetupHigh,SetupLow); + -- end of new code IR245-246 + END CASE; + -- added the second condition for IR 245-246 + CheckInfo.Violation := ( (CheckInfo.ObsTime < CheckInfo.ExpTime) + AND ( NOT ((CheckInfo.ObsTime = BC) and (BC = 0 ns))) ); + + -- start of new code IR245-246 + IF(CheckInfo.ExpTime = 0 ns) THEN + CheckInfo.CheckKind := SetupCheck; + ELSE + CheckInfo.CheckKind := HoldCheck; + END IF; + -- end of new code IR245-246 + HoldEn := NOT CheckInfo.Violation; + ELSE + CheckInfo.Violation := FALSE; + END IF; + ELSE + CheckInfo.Violation := FALSE; + END IF; + + -- Adjust report values to account for internal model delays + -- Note: TestDelay, RefDelay, TestTime, RefTime are non-negative + -- Note: bias may be negative or positive + IF MsgOn AND CheckInfo.Violation THEN + -- modified the code for correct reporting of violation in case of + -- order of signals being reversed because of internal delays + -- new variable + actualObsTime := (TestTime-TestDelay)-(RefTime-RefDelay); + bias := TestDelay - RefDelay; + IF (actualObsTime < 0 ns) THEN -- It should be a setup check + IF ( CheckInfo.CheckKind = HoldCheck) then + CheckInfo.CheckKind := SetupCheck; + CASE CheckInfo.State IS + WHEN '0' => CheckInfo.ExpTime := SetupLow; + WHEN '1' => CheckInfo.ExpTime := SetupHigh; + WHEN 'X' => CheckInfo.ExpTime := Maximum(SetupHigh,SetupLow); + END CASE; + END IF; + + CheckInfo.ObsTime := -actualObsTime; + CheckInfo.ExpTime := CheckInfo.ExpTime + bias; + CheckInfo.DetTime := RefTime - RefDelay; + ELSE -- It should be a hold check + IF ( CheckInfo.CheckKind = SetupCheck) then + CheckInfo.CheckKind := HoldCheck; + CASE CheckInfo.State IS + WHEN '0' => CheckInfo.ExpTime := HoldHigh; + CheckInfo.State := '1'; + WHEN '1' => CheckInfo.ExpTime := HoldLow; + CheckInfo.State := '0'; + WHEN 'X' => CheckInfo.ExpTime := Maximum(HoldHigh,HoldLow); + END CASE; + END IF; + + CheckInfo.ObsTime := actualObsTime; + CheckInfo.ExpTime := CheckInfo.ExpTime - bias; + CheckInfo.DetTime := TestTime - TestDelay; + END IF; + + END IF; + END InternalTimingCheck; + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + FUNCTION VitalTimingDataInit + RETURN VitalTimingDataType IS + BEGIN + RETURN (FALSE,'X', 0 ns, FALSE, 'X', 0 ns, FALSE, NULL, NULL, NULL, NULL); + END; + + --------------------------------------------------------------------------- + -- Procedure : VitalSetupHoldCheck + --------------------------------------------------------------------------- + PROCEDURE VitalSetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE --IR252 3/23/98 + ) IS + + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge, TestEvent : BOOLEAN; + VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay); + VARIABLE RefDly : TIME := Maximum(0 ns, RefDelay); + VARIABLE bias : TIME; + BEGIN + + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLast := To_X01(TestSignal); + TimingData.RefLast := To_X01(RefSignal); + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal), + RefTransition); + TimingData.RefLast := To_X01(RefSignal); + IF RefEdge THEN + TimingData.RefTime := NOW; + TimingData.SetupEn := TimingData.SetupEn AND EnableSetupOnRef; --IR252 3/23/98 + TimingData.HoldEn := EnableHoldOnRef; --IR252 3/23/98 + END IF; + + -- Detect test (data) changes and record the time of the last change + TestEvent := TimingData.TestLast /= To_X01Z(TestSignal); + TimingData.TestLast := To_X01Z(TestSignal); + IF TestEvent THEN + TimingData.TestTime := NOW; + TimingData.SetupEn := EnableSetupOnTest; --IR252 3/23/98 + TimingData.HoldEn := TimingData.HoldEn AND EnableHoldOnTest; --IR252 3/23/98 + END IF; + + -- Perform timing checks (if enabled) + Violation := '0'; + IF (CheckEnabled) THEN + InternalTimingCheck ( + TestSignal => TestSignal, + RefSignal => RefSignal, + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHigh, + SetupLow => SetupLow, + HoldHigh => HoldHigh, + HoldLow => HoldLow, + RefTime => TimingData.RefTime, + RefEdge => RefEdge, + TestTime => TimingData.TestTime, + TestEvent => TestEvent, + SetupEn => TimingData.SetupEn, + HoldEn => TimingData.HoldEn, + CheckInfo => CheckInfo, + MsgOn => MsgOn ); + + -- Report any detected violations and set return violation flag + IF CheckInfo.Violation THEN + IF (MsgOn) THEN + ReportViolation (TestSignalName, RefSignalName, + HeaderMsg, CheckInfo, MsgSeverity ); + END IF; + IF (XOn) THEN Violation := 'X'; END IF; + END IF; + END IF; + + END VitalSetupHoldCheck; + + --------------------------------------------------------------------------- + PROCEDURE VitalSetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE --IR252 3/23/98 + + ) IS + + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge : BOOLEAN; + VARIABLE TestEvent : VitalBoolArrayT(TestSignal'RANGE); + VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay); + VARIABLE RefDly : TIME := Maximum(0 ns, RefDelay); + VARIABLE bias : TIME; + VARIABLE ChangedAllAtOnce : BOOLEAN := TRUE; + VARIABLE StrPtr1 : LINE; + + BEGIN + -- Initialization of working area. + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLastA := NEW std_logic_vector(TestSignal'RANGE); + TimingData.TestTimeA := NEW VitalTimeArrayT(TestSignal'RANGE); + TimingData.HoldEnA := NEW VitalBoolArrayT(TestSignal'RANGE); + TimingData.SetupEnA := NEW VitalBoolArrayT(TestSignal'RANGE); + FOR i IN TestSignal'RANGE LOOP + TimingData.TestLastA(i) := To_X01(TestSignal(i)); + END LOOP; + TimingData.RefLast := To_X01(RefSignal); + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal), + RefTransition); + TimingData.RefLast := To_X01(RefSignal); + IF RefEdge THEN + TimingData.RefTime := NOW; + TimingData.SetupEn := TimingData.SetupEn AND EnableSetupOnRef; --IR252 3/23/98 + TimingData.HoldEnA.all := (TestSignal'RANGE => EnableHoldOnRef); --IR252 3/23/98 + END IF; + + -- Detect test (data) changes and record the time of the last change + FOR i IN TestSignal'RANGE LOOP + TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignal(i)); + TimingData.TestLastA(i) := To_X01Z(TestSignal(i)); + IF TestEvent(i) THEN + TimingData.TestTimeA(i) := NOW; + TimingData.SetupEnA(i) := EnableSetupOnTest; --IR252 3/23/98 + TimingData.HoldEnA(i) := TimingData.HoldEn AND EnableHoldOnTest; --IR252 3/23/98 + TimingData.TestTime := NOW; --IR252 3/23/98 + END IF; + END LOOP; + + -- Check to see if the Bus subelements changed all at the same time. + -- If so, then we can reduce the volume of error messages since we no + -- longer have to report every subelement individually + FOR i IN TestSignal'RANGE LOOP + IF TimingData.TestTimeA(i) /= TimingData.TestTime THEN + ChangedAllAtOnce := FALSE; + EXIT; + END IF; + END LOOP; + + -- Perform timing checks (if enabled) + Violation := '0'; + IF (CheckEnabled) THEN + FOR i IN TestSignal'RANGE LOOP + InternalTimingCheck ( + TestSignal => TestSignal(i), + RefSignal => RefSignal, + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHigh, + SetupLow => SetupLow, + HoldHigh => HoldHigh, + HoldLow => HoldLow, + RefTime => TimingData.RefTime, + RefEdge => RefEdge, + TestTime => TimingData.TestTimeA(i), + TestEvent => TestEvent(i), + SetupEn => TimingData.SetupEnA(i), + HoldEn => TimingData.HoldEnA(i), + CheckInfo => CheckInfo, + MsgOn => MsgOn ); + + -- Report any detected violations and set return violation flag + IF CheckInfo.Violation THEN + IF (MsgOn) THEN + IF ( ChangedAllAtOnce AND (i = TestSignal'LEFT) ) THEN + ReportViolation (TestSignalName&"(...)", RefSignalName, + HeaderMsg, CheckInfo, MsgSeverity ); + ELSIF (NOT ChangedAllAtOnce) THEN + Write (StrPtr1, i); + ReportViolation (TestSignalName & "(" & StrPtr1.ALL & ")", + RefSignalName, + HeaderMsg, CheckInfo, MsgSeverity ); + DEALLOCATE (StrPtr1); + END IF; + END IF; + IF (XOn) THEN + Violation := 'X'; + END IF; + END IF; + END LOOP; + END IF; + + DEALLOCATE (StrPtr1); + + END VitalSetupHoldCheck; + + --------------------------------------------------------------------------- + -- Function : VitalRecoveryRemovalCheck + --------------------------------------------------------------------------- + PROCEDURE VitalRecoveryRemovalCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT Recovery : IN TIME := 0 ns; + CONSTANT Removal : IN TIME := 0 ns; + CONSTANT ActiveLow : IN BOOLEAN := TRUE; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT EnableRecOnTest : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableRecOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableRemOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableRemOnTest : IN BOOLEAN := TRUE --IR252 3/23/98 + ) IS + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge, TestEvent : BOOLEAN; + VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay); + VARIABLE RefDly : TIME := Maximum(0 ns, RefDelay); + VARIABLE bias : TIME; + BEGIN + + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLast := To_X01(TestSignal); + TimingData.RefLast := To_X01(RefSignal); + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal), + RefTransition); + TimingData.RefLast := To_X01(RefSignal); + IF RefEdge THEN + TimingData.RefTime := NOW; + TimingData.SetupEn := TimingData.SetupEn AND EnableRecOnRef; --IR252 3/23/98 + TimingData.HoldEn := EnableRemOnRef; --IR252 3/23/98 + END IF; + + -- Detect test (data) changes and record the time of the last change + TestEvent := TimingData.TestLast /= To_X01Z(TestSignal); + TimingData.TestLast := To_X01Z(TestSignal); + IF TestEvent THEN + TimingData.TestTime := NOW; + TimingData.SetupEn := EnableRecOnTest; --IR252 3/23/98 + TimingData.HoldEn := TimingData.HoldEn AND EnableRemOnTest; --IR252 3/23/98 + END IF; + + -- Perform timing checks (if enabled) + Violation := '0'; + IF (CheckEnabled) THEN + + IF ActiveLow THEN + InternalTimingCheck ( + TestSignal, RefSignal, TestDly, RefDly, + Recovery, 0 ns, 0 ns, Removal, + TimingData.RefTime, RefEdge, + TimingData.TestTime, TestEvent, + TimingData.SetupEn, TimingData.HoldEn, + CheckInfo, MsgOn ); + ELSE + InternalTimingCheck ( + TestSignal, RefSignal, TestDly, RefDly, + 0 ns, Recovery, Removal, 0 ns, + TimingData.RefTime, RefEdge, + TimingData.TestTime, TestEvent, + TimingData.SetupEn, TimingData.HoldEn, + CheckInfo, MsgOn ); + END IF; + + + -- Report any detected violations and set return violation flag + IF CheckInfo.Violation THEN + IF CheckInfo.CheckKind = SetupCheck THEN + CheckInfo.CheckKind := RecoveryCheck; + ELSE + CheckInfo.CheckKind := RemovalCheck; + END IF; + IF (MsgOn) THEN + ReportViolation (TestSignalName, RefSignalName, + HeaderMsg, CheckInfo, MsgSeverity ); + END IF; + IF (XOn) THEN Violation := 'X'; END IF; + END IF; + END IF; + + END VitalRecoveryRemovalCheck; + + --------------------------------------------------------------------------- + PROCEDURE VitalPeriodPulseCheck ( + VARIABLE Violation : OUT X01; + VARIABLE PeriodData : INOUT VitalPeriodDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + CONSTANT Period : IN TIME := 0 ns; + CONSTANT PulseWidthHigh : IN TIME := 0 ns; + CONSTANT PulseWidthLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay); + VARIABLE CheckInfo : CheckInfoType; + VARIABLE PeriodObs : TIME; + VARIABLE PulseTest, PeriodTest : BOOLEAN; + VARIABLE TestValue : X01 := To_X01(TestSignal); + BEGIN + + IF (PeriodData.NotFirstFlag = FALSE) THEN + PeriodData.Rise := + -maximum(Period, maximum(PulseWidthHigh, PulseWidthLow)); + PeriodData.Fall := + -maximum(Period, maximum(PulseWidthHigh, PulseWidthLow)); + PeriodData.Last := To_X01(TestSignal); + PeriodData.NotFirstFlag := TRUE; + END IF; + + -- Initialize for no violation + -- No violation possible if no test signal change + Violation := '0'; + IF (PeriodData.Last = TestValue) THEN + RETURN; + END IF; + + -- record starting pulse times + IF EdgeSymbolMatch(PeriodData.Last, TestValue, 'P') THEN + -- Compute period times, then record the High Rise Time + PeriodObs := NOW - PeriodData.Rise; + PeriodData.Rise := NOW; + PeriodTest := TRUE; + ELSIF EdgeSymbolMatch(PeriodData.Last, TestValue, 'N') THEN + -- Compute period times, then record the Low Fall Time + PeriodObs := NOW - PeriodData.Fall; + PeriodData.Fall := NOW; + PeriodTest := TRUE; + ELSE + PeriodTest := FALSE; + END IF; + + -- do checks on pulse ends + IF EdgeSymbolMatch(PeriodData.Last, TestValue, 'p') THEN + -- Compute pulse times + CheckInfo.ObsTime := NOW - PeriodData.Fall; + CheckInfo.ExpTime := PulseWidthLow; + PulseTest := TRUE; + ELSIF EdgeSymbolMatch(PeriodData.Last, TestValue, 'n') THEN + -- Compute pulse times + CheckInfo.ObsTime := NOW - PeriodData.Rise; + CheckInfo.ExpTime := PulseWidthHigh; + PulseTest := TRUE; + ELSE + PulseTest := FALSE; + END IF; + + IF PulseTest AND CheckEnabled THEN + -- Verify Pulse Width [ignore 1st edge] + IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN + IF (XOn) THEN Violation := 'X'; END IF; + IF (MsgOn) THEN + CheckInfo.Violation := TRUE; + CheckInfo.CheckKind := PulseWidCheck; + CheckInfo.DetTime := NOW - TestDly; + CheckInfo.State := PeriodData.Last; + ReportViolation (TestSignalName, "", + HeaderMsg, CheckInfo, MsgSeverity ); + END IF; -- MsgOn + END IF; + END IF; + + IF PeriodTest AND CheckEnabled THEN + -- Verify the Period [ignore 1st edge] + CheckInfo.ObsTime := PeriodObs; + CheckInfo.ExpTime := Period; + IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN + IF (XOn) THEN Violation := 'X'; END IF; + IF (MsgOn) THEN + CheckInfo.Violation := TRUE; + CheckInfo.CheckKind := PeriodCheck; + CheckInfo.DetTime := NOW - TestDly; + CheckInfo.State := TestValue; + ReportViolation (TestSignalName, "", + HeaderMsg, CheckInfo, MsgSeverity ); + END IF; -- MsgOn + END IF; + END IF; + + PeriodData.Last := TestValue; + + END VitalPeriodPulseCheck; + + + + PROCEDURE ReportSkewViolation ( + CONSTANT Signal1Name : IN STRING := ""; + CONSTANT Signal2Name : IN STRING := ""; + CONSTANT ExpectedTime : IN TIME; + CONSTANT OccuranceTime : IN TIME; + CONSTANT HeaderMsg : IN STRING; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT SkewPhase : IN SkewType; + CONSTANT ViolationFlag : IN BOOLEAN := TRUE + ) IS + VARIABLE Message : LINE; + BEGIN + Write ( Message, HeaderMsg ); + IF (ViolationFlag /= TRUE) THEN + Write ( Message, STRING'(" POSSIBLE") ); + END IF; + IF (SkewPhase = Inphase) THEN + Write ( Message, STRING'(" IN PHASE ") ); + ELSE + Write ( Message, STRING'(" OUT OF PHASE ") ); + END IF; + Write ( Message, STRING'("SKEW VIOLATION ON ") ); + Write ( Message, Signal2Name ); + IF (Signal1Name'LENGTH > 0) THEN + Write ( Message, STRING'(" WITH RESPECT TO ") ); + Write ( Message, Signal1Name ); + END IF; + Write ( Message, ';' & LF ); + Write ( Message, STRING'(" At : ") ); + Write ( Message, OccuranceTime); + Write ( Message, STRING'("; Skew Limit : ") ); + Write ( Message, ExpectedTime); + + ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity; + + DEALLOCATE (Message); + END ReportSkewViolation; + + + PROCEDURE VitalInPhaseSkewCheck ( + VARIABLE Violation : OUT X01; + VARIABLE SkewData : INOUT VitalSkewDataType; + SIGNAL Signal1 : IN std_ulogic; + CONSTANT Signal1Name : IN STRING := ""; + CONSTANT Signal1Delay : IN TIME := 0 ns; + SIGNAL Signal2 : IN std_ulogic; + CONSTANT Signal2Name : IN STRING := ""; + CONSTANT Signal2Delay : IN TIME := 0 ns; + CONSTANT SkewS1S2RiseRise : IN TIME := TIME'HIGH; + CONSTANT SkewS2S1RiseRise : IN TIME := TIME'HIGH; + CONSTANT SkewS1S2FallFall : IN TIME := TIME'HIGH; + CONSTANT SkewS2S1FallFall : IN TIME := TIME'HIGH; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT HeaderMsg : IN STRING := ""; + SIGNAL Trigger : INOUT std_ulogic + ) IS + VARIABLE ReportType : VitalSkewExpectedType := none; + VARIABLE ExpectedType : VitalSkewExpectedType := none; + VARIABLE ReportTime : TIME; + VARIABLE TriggerDelay : TIME; + VARIABLE ViolationCertain : Boolean := TRUE; + BEGIN + Violation := '0'; + ReportType := none; + TriggerDelay := noTrigger; + + IF (CheckEnabled) THEN + IF (SkewData.ExpectedType /= none) THEN + IF (trigger'Event) THEN + CASE SkewData.ExpectedType IS + WHEN s1r => ReportType := s1r; + ReportTime := NOW - Signal1Delay; + WHEN s1f => ReportType := s1f; + ReportTime := NOW - Signal1Delay; + WHEN s2r => ReportType := s2r; + ReportTime := NOW - Signal2Delay; + WHEN s2f => ReportType := s2f; + ReportTime := NOW - Signal2Delay; + WHEN OTHERS => + END CASE; + SkewData.ExpectedType := none; + ELSIF ( Signal1'Event OR Signal2'Event ) THEN + IF ( Signal1 /= 'X' AND Signal2 /= 'X' ) THEN + TriggerDelay := 0 ns; + ExpectedType := none; + END IF; + END IF; + END IF; + + IF (Signal1'EVENT and Signal2'EVENT) THEN + IF (Signal1 = Signal2) THEN + IF (Posedge(Signal1'LAST_VALUE, Signal1)) THEN + IF ((Signal1Delay - Signal2Delay) >= + SkewS1S2RiseRise) THEN + ReportType := s2r; + ReportTime := NOW - Signal1Delay + + SkewS1S2RiseRise; + ELSIF ((Signal2Delay -Signal1Delay) >= + SkewS2S1RiseRise) THEN + ReportType := s1r; + ReportTime := NOW - Signal2Delay + + SkewS2S1RiseRise; + END IF; + ELSIF (Negedge(Signal1'LAST_VALUE, Signal1)) THEN + IF ((Signal1Delay - Signal2Delay) >= + SkewS1S2FallFall) THEN + ReportType := s2f; + ReportTime := NOW - Signal1Delay + + SkewS1S2FallFall; + ELSIF ((Signal2Delay - Signal1Delay) >= + SkewS2S1FallFall) THEN + ReportType := s1f; + ReportTime := NOW - Signal2Delay + + SkewS2S1FallFall; + END IF; + END IF; + ELSIF (Posedge(Signal1'LAST_VALUE , Signal1)) THEN + IF ((Signal1Delay >= Signal2Delay) and (Signal2Delay > + SkewS2S1FallFall)) THEN + ReportType := s1f; + ReportTime := NOW - Signal2Delay + + SkewS2S1FallFall; + ELSIF ((Signal2Delay >= Signal1Delay) and (Signal1Delay > + SkewS1S2RiseRise)) THEN + ReportType := s2r; + ReportTime := NOW - Signal1Delay + + SkewS1S2RiseRise; + ELSIF (Signal2Delay > Signal1Delay) THEN + SkewData.ExpectedType := s2r; + TriggerDelay := SkewS1S2RiseRise + + Signal2Delay - Signal1Delay; + ELSIF (Signal1Delay > Signal2Delay) THEN + SkewData.ExpectedType := s1r; + TriggerDelay := SkewS2S1RiseRise + + Signal1Delay - Signal2Delay; + ELSIF (SkewS1S2RiseRise < SkewS2S1RiseRise) THEN + SkewData.ExpectedType := s2r; + TriggerDelay := SkewS1S2RiseRise; + ELSE + SkewData.ExpectedType := s1r; + TriggerDelay := SkewS2S1RiseRise; + END IF; + ELSIF (Negedge(Signal1'LAST_VALUE , Signal1)) THEN + IF ((Signal1Delay >= Signal2Delay) and (Signal2Delay > + SkewS2S1RiseRise)) THEN + ReportType := s1r; + ReportTime := NOW - Signal2Delay + + SkewS2S1RiseRise; + ELSIF ((Signal2Delay >= Signal1Delay) and (Signal1Delay > + SkewS1S2FallFall)) THEN + ReportType := s2f; + ReportTime := NOW - Signal1Delay + + SkewS1S2FallFall; + ELSIF (Signal2Delay > Signal1Delay) THEN + SkewData.ExpectedType := s2f; + TriggerDelay := SkewS1S2FallFall + + Signal2Delay - Signal1Delay; + ELSIF (Signal1Delay > Signal2Delay) THEN + SkewData.ExpectedType := s1f; + TriggerDelay := SkewS2S1FallFall + + Signal1Delay - Signal2Delay; + ELSIF (SkewS1S2FallFall < SkewS2S1FallFall) THEN + SkewData.ExpectedType := s2f; + TriggerDelay := SkewS1S2FallFall; + ELSE + SkewData.ExpectedType := s1f; + TriggerDelay := SkewS2S1FallFall; + END IF; + END IF; + ELSIF (Signal1'EVENT) THEN + IF ( Signal1 /= Signal2) THEN + IF ( Posedge( Signal1'LAST_VALUE, Signal1)) THEN + IF (SkewS1S2RiseRise > (Signal1Delay - + Signal2Delay)) THEN + SkewData.ExpectedType := s2r; + TriggerDelay := SkewS1S2RiseRise + + Signal2Delay - + Signal1Delay; + ELSE + ReportType := s2r; + ReportTime := NOW + SkewS1S2RiseRise - + Signal1Delay; + END IF; + ELSIF ( Negedge( Signal1'LAST_VALUE, Signal1)) THEN + IF (SkewS1S2FallFall > (Signal1Delay - + Signal2Delay)) THEN + SkewData.ExpectedType := s2f; + TriggerDelay := SkewS1S2FallFall + + Signal2Delay - + Signal1Delay; + ELSE + ReportType := s2f; + ReportTime := NOW + SkewS1S2FallFall - + Signal1Delay; + END IF; + END IF; + ELSE + IF ( Posedge( Signal1'LAST_VALUE, Signal1)) THEN + IF ((Signal1Delay - SkewS1S2RiseRise) > + (Signal2'LAST_EVENT + Signal2Delay)) THEN + IF ((SkewData.Signal2Old2 - Signal2Delay) > + (NOW - Signal1Delay + + SkewS1S2RiseRise)) THEN + ViolationCertain := FALSE; + ReportType := s2r; + ReportTime := NOW + SkewS1S2RiseRise - + Signal1Delay; + END IF; + END IF; + ELSIF ( Negedge( Signal1'LAST_VALUE, Signal1)) THEN + IF ((Signal1Delay - SkewS1S2FallFall) > + (Signal2'LAST_EVENT + Signal2Delay)) THEN + IF (( SkewData.Signal2Old2 - Signal2Delay) > + (NOW - Signal1Delay + + SkewS1S2FallFall )) THEN + ViolationCertain := FALSE; + ReportType := s2f; + ReportTime := NOW + SkewS1S2FallFall - + Signal1Delay; + END IF; + END IF; + END IF; + END IF; + ELSIF (Signal2'EVENT) THEN + IF (Signal1 /= Signal2) THEN + IF (Posedge(Signal2'LAST_VALUE,Signal2)) THEN + IF ( SkewS2S1RiseRise > (Signal2Delay - + Signal1Delay)) THEN + SkewData.ExpectedType := s1r; + TriggerDelay := SkewS2S1RiseRise + + Signal1Delay - + Signal2Delay; + ELSE + ReportType := s2r; + ReportTime := NOW + SkewS2S1RiseRise - + Signal2Delay; + END IF; + ELSIF (Negedge(Signal2'LAST_VALUE,Signal2)) THEN + IF ( SkewS2S1FallFall > (Signal2Delay - + Signal1Delay)) THEN + SkewData.ExpectedType := s1f; + TriggerDelay := SkewS2S1FallFall + + Signal1Delay - + Signal2Delay; + ELSE + ReportType := s1f; + ReportTime := NOW + SkewS2S1FallFall - + Signal2Delay; + END IF; + END IF; + ELSE + IF (Posedge(Signal2'LAST_VALUE, Signal2)) THEN + IF ((Signal2Delay - SkewS2S1RiseRise) > + (Signal1'LAST_EVENT + Signal1Delay)) THEN + IF (( SkewData.Signal1Old2 - Signal1Delay) > + (NOW - Signal2Delay + + SkewS2S1RiseRise )) THEN + ViolationCertain := FALSE; + ReportType := s1r; + ReportTime := NOW + SkewS2S1RiseRise - + Signal2Delay; + END IF; + END IF; + ELSIF (Negedge(Signal2'LAST_VALUE, Signal2)) THEN + IF ((Signal2Delay - SkewS2S1FallFall) > + (Signal1'LAST_EVENT + Signal1Delay)) THEN + IF (( SkewData.Signal1Old2 - Signal1Delay) > + (NOW - Signal2Delay + + SkewS2S1FallFall )) THEN + ViolationCertain := FALSE; + ReportType := s1f; + ReportTime := NOW + SkewS2S1FallFall - + Signal2Delay; + END IF; + END IF; + END IF; + END IF; + END IF; + + IF (ReportType /= none) THEN + IF (MsgOn) THEN + CASE ReportType IS + WHEN s1r => + ReportSkewViolation( + Signal2Name, + Signal1Name, + SkewS2S1RiseRise, + ReportTime, + HeaderMsg, + MsgSeverity, + Inphase, + ViolationCertain); + WHEN s1f => + ReportSkewViolation( + Signal2Name, + Signal1Name, + SkewS2S1FallFall, + ReportTime, + HeaderMsg, + MsgSeverity, + Inphase, + ViolationCertain); + WHEN s2r => + ReportSkewViolation( + Signal1Name, + Signal2Name, + SkewS1S2RiseRise, + ReportTime, + HeaderMsg, + MsgSeverity, + Inphase, + ViolationCertain); + WHEN s2f => + ReportSkewViolation( + Signal1Name, + Signal2Name, + SkewS1S2FallFall, + ReportTime, + HeaderMsg, + MsgSeverity, + Inphase, + ViolationCertain); + WHEN OTHERS => + END CASE; + END IF; + IF (XOn) THEN + Violation := 'X'; + END IF; + SkewData.ExpectedType := none; + END IF; + IF (TriggerDelay /= noTrigger) THEN + IF (TriggerDelay = 0 ns) THEN + trigger <= TRANSPORT trigger AFTER 0 ns; + ELSE + trigger <= TRANSPORT not (trigger) AFTER + TriggerDelay; + END IF; + END IF; + END IF; + IF (Signal1'EVENT and SkewData.Signal1Old1 /= NOW) THEN + SkewData.Signal1Old2 := SkewData.Signal1Old1; + SkewData.Signal1Old1 := NOW; + END IF; + IF (Signal2'EVENT and SkewData.Signal2Old1 /= NOW) THEN + SkewData.Signal2Old2 := SkewData.Signal2Old1; + SkewData.Signal2Old1 := NOW; + END IF; + END VitalInPhaseSkewCheck; + + PROCEDURE VitalOutPhaseSkewCheck ( + VARIABLE Violation : OUT X01; + VARIABLE SkewData : INOUT VitalSkewDataType; + SIGNAL Signal1 : IN std_ulogic; + CONSTANT Signal1Name : IN STRING := ""; + CONSTANT Signal1Delay : IN TIME := 0 ns; + SIGNAL Signal2 : IN std_ulogic; + CONSTANT Signal2Name : IN STRING := ""; + CONSTANT Signal2Delay : IN TIME := 0 ns; + CONSTANT SkewS1S2RiseFall : IN TIME := TIME'HIGH; + CONSTANT SkewS2S1RiseFall : IN TIME := TIME'HIGH; + CONSTANT SkewS1S2FallRise : IN TIME := TIME'HIGH; + CONSTANT SkewS2S1FallRise : IN TIME := TIME'HIGH; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT HeaderMsg : IN STRING := ""; + SIGNAL Trigger : INOUT std_ulogic + ) IS + VARIABLE ReportType : VitalSkewExpectedType := none; + VARIABLE ExpectedType : VitalSkewExpectedType := none; + VARIABLE ReportTime : TIME; + VARIABLE TriggerDelay : TIME; + VARIABLE ViolationCertain : Boolean := TRUE; + BEGIN + Violation := '0'; + TriggerDelay := noTrigger; + IF (CheckEnabled) THEN + IF (SkewData.ExpectedType /= none) THEN + IF (trigger'Event) THEN + CASE SkewData.ExpectedType IS + WHEN s1r => ReportType := s1r; + ReportTime := NOW - Signal1Delay; + WHEN s1f => ReportType := s1f; + ReportTime := NOW - Signal1Delay; + WHEN s2r => ReportType := s2r; + ReportTime := NOW - Signal2Delay; + WHEN s2f => ReportType := s2f; + ReportTime := NOW - Signal2Delay; + WHEN OTHERS => + END CASE; + SkewData.ExpectedType := none; + ELSIF (Signal1'Event OR Signal2'Event ) THEN + IF (Signal1 /= 'X' AND Signal2 /= 'X' ) THEN + TriggerDelay := 0 ns; + SkewData.ExpectedType := none; + END IF; + END IF; + END IF; + + IF (Signal1'EVENT and Signal2'EVENT) THEN + IF (Signal1 /= Signal2) THEN + IF (Posedge(Signal1'LAST_VALUE, Signal1)) THEN + IF ((Signal1Delay - Signal2Delay) >= + SkewS1S2RiseFall) THEN + ReportType := s2f; + ReportTime := NOW - Signal1Delay + + SkewS1S2RiseFall; + ELSIF ((Signal2Delay - Signal1Delay) >= + SkewS2S1FallRise) THEN + ReportType := s1r; + ReportTime := NOW - Signal2Delay + + SkewS2S1FallRise; + END IF; + ELSIF (Negedge(Signal1'LAST_VALUE, Signal1)) THEN + IF ((Signal1Delay - Signal2Delay) >= + SkewS1S2FallRise) THEN + ReportType := s2r; + ReportTime := NOW - Signal1Delay + + SkewS1S2FallRise; + ELSIF ((Signal2Delay - Signal1Delay) >= + SkewS2S1RiseFall) THEN + ReportType := s1f; + ReportTime := NOW - Signal2Delay + + SkewS2S1RiseFall; + END IF; + END IF; + ELSIF (Posedge(Signal1'LAST_VALUE, Signal1)) THEN + IF ((Signal1Delay >= Signal2Delay) and (Signal2Delay > + SkewS2S1RiseFall)) THEN + ReportType := s1f; + ReportTime := NOW - Signal2Delay + + SkewS2S1RiseFall; + ELSIF ((Signal2Delay >= Signal1Delay) and (Signal1Delay > + SkewS1S2RiseFall)) THEN + ReportType := s2f; + ReportTime := NOW - Signal1Delay + + SkewS1S2RiseFall; + ELSIF (Signal1Delay > Signal2Delay) THEN + SkewData.ExpectedType := s1f; + TriggerDelay := SkewS2S1RiseFall + + Signal1Delay - Signal2Delay; + ELSIF (Signal2Delay > Signal1Delay) THEN + SkewData.ExpectedType := s2f; + TriggerDelay := SkewS1S2RiseFall + + Signal2Delay - Signal1Delay; + ELSIF (SkewS2S1RiseFall < SkewS1S2RiseFall) THEN + SkewData.ExpectedType := s1f; + TriggerDelay := SkewS2S1RiseFall; + ELSE + SkewData.ExpectedType := s2f; + TriggerDelay := SkewS1S2RiseFall; + END IF; + ELSIF (Negedge(Signal1'LAST_VALUE, Signal1)) THEN + IF ((Signal1Delay >= Signal2Delay) and (Signal2Delay > + SkewS2S1FallRise)) THEN + ReportType := s1r; + ReportTime := NOW - Signal2Delay + + SkewS2S1FallRise; + ELSIF ((Signal2Delay >= Signal1Delay) and (Signal1Delay > + SkewS1S2FallRise)) THEN + ReportType := s2r; + ReportTime := NOW - Signal1Delay + + SkewS1S2FallRise; + ELSIF (Signal1Delay > Signal2Delay) THEN + SkewData.ExpectedType := s1r; + TriggerDelay := SkewS2S1FallRise + + Signal1Delay - Signal2Delay; + ELSIF (Signal2Delay > Signal1Delay) THEN + SkewData.ExpectedType := s2r; + TriggerDelay := SkewS1S2FallRise + + Signal2Delay - Signal1Delay; + ELSIF (SkewS2S1FallRise < SkewS1S2FallRise) THEN + SkewData.ExpectedType := s1r; + TriggerDelay := SkewS2S1FallRise; + ELSE + SkewData.ExpectedType := s2r; + TriggerDelay := SkewS1S2FallRise; + END IF; + END IF; + ELSIF (Signal1'EVENT) THEN + IF (Signal1 = Signal2) THEN + IF (Posedge(Signal1'LAST_VALUE,Signal1)) THEN + IF (SkewS1S2RiseFall > (Signal1Delay - + Signal2Delay)) THEN + SkewData.ExpectedType := s2f; + TriggerDelay := SkewS1S2RiseFall + + Signal2Delay - Signal1Delay; + ELSE + ReportType := s2f; + ReportTime := NOW - Signal1Delay + + SkewS1S2RiseFall; + END IF; + ELSIF ( Negedge(Signal1'LAST_VALUE, Signal1)) THEN + IF ( SkewS1S2FallRise > (Signal1Delay - + Signal2Delay)) THEN + SkewData.ExpectedType := s2r; + TriggerDelay := SkewS1S2FallRise + + Signal2Delay - Signal1Delay; + ELSE + ReportType := s2r; + ReportTime := NOW - Signal1Delay + + SkewS1S2FallRise; + END IF; + END IF; + ELSE + IF (Posedge( Signal1'LAST_VALUE, Signal1 )) THEN + IF ((Signal1Delay - SkewS1S2RiseFall) > + (Signal2'LAST_EVENT + Signal2Delay)) THEN + IF (( SkewData.Signal2Old2 - Signal2Delay) > + (NOW - Signal1Delay + + SkewS1S2RiseFall )) THEN + ViolationCertain := FALSE; + ReportType := s2f; + ReportTime := NOW + SkewS1S2RiseFall - + Signal1Delay; + END IF; + END IF; + ELSIF (Negedge(Signal1'LAST_VALUE, Signal1)) THEN + IF ((Signal1Delay - SkewS1S2FallRise) > + (Signal2'LAST_EVENT + Signal2Delay)) THEN + IF (( SkewData.Signal2Old2 - Signal2Delay) > + (NOW - Signal1Delay + + SkewS1S2FallRise )) THEN + ViolationCertain := FALSE; + ReportType := s2r; + ReportTime := NOW + SkewS1S2FallRise - + Signal1Delay; + END IF; + END IF; + END IF; + END IF; + ELSIF (Signal2'EVENT) THEN + IF (Signal1 = Signal2) THEN + IF (Posedge(Signal2'LAST_VALUE,Signal2)) THEN + IF (SkewS2S1RiseFall > (Signal2Delay - + Signal1Delay)) THEN + SkewData.ExpectedType := s1f; + TriggerDelay := SkewS2S1RiseFall + Signal1Delay - + Signal2Delay ; + ELSE + ReportType := s1f; + ReportTime := NOW + SkewS2S1RiseFall - + Signal2Delay; + END IF; + ELSIF (Negedge(Signal2'LAST_VALUE,Signal2)) THEN + IF (SkewS2S1FallRise > (Signal2Delay - + Signal1Delay)) THEN + SkewData.ExpectedType := s1r; + TriggerDelay := SkewS2S1FallRise + Signal1Delay - + Signal2Delay; + ELSE + ReportType := s1r; + ReportTime := NOW + SkewS2S1FallRise - + Signal2Delay; + END IF; + END IF; + ELSE + IF (Posedge(Signal2'LAST_VALUE,Signal2)) THEN + IF ((Signal2Delay - SkewS2S1RiseFall) > + (Signal1'LAST_EVENT + Signal1Delay)) THEN + IF (( SkewData.Signal1Old2 - Signal1Delay) > + (NOW - Signal2Delay + + SkewS2S1RiseFall )) THEN + ViolationCertain := FALSE; + ReportType := s1f; + ReportTime := NOW + SkewS2S1RiseFall - + Signal2Delay; + END IF; + END IF; + ELSIF (Negedge(Signal2'LAST_VALUE,Signal2)) THEN + IF ((Signal2Delay - SkewS2S1FallRise) > + (Signal1'LAST_EVENT + Signal1Delay)) THEN + IF (( SkewData.Signal1Old2 - Signal1Delay) > + (NOW - Signal2Delay + + SkewS2S1FallRise )) THEN + ViolationCertain := FALSE; + ReportType := s1r; + ReportTime := NOW + SkewS2S1FallRise - + Signal2Delay; + END IF; + END IF; + END IF; + END IF; + END IF; + + IF (ReportType /= none) THEN + IF (MsgOn) THEN + CASE ReportType IS + WHEN s1r => + ReportSkewViolation( + Signal2Name, + Signal1Name, + SkewS2S1FallRise, + ReportTime, + HeaderMsg, + MsgSeverity, + Outphase, + ViolationCertain); + WHEN s1f => + ReportSkewViolation( + Signal2Name, + Signal1Name, + SkewS2S1RiseFall, + ReportTime, + HeaderMsg, + MsgSeverity, + Outphase, + ViolationCertain); + WHEN s2r => + ReportSkewViolation( + Signal1Name, + Signal2Name, + SkewS1S2FallRise, + ReportTime, + HeaderMsg, + MsgSeverity, + Outphase, + ViolationCertain); + WHEN s2f => + ReportSkewViolation( + Signal1Name, + Signal2Name, + SkewS1S2RiseFall, + ReportTime, + HeaderMsg, + MsgSeverity, + Outphase, + ViolationCertain); + WHEN OTHERS => + END CASE; + END IF; + IF (XOn) THEN + Violation := 'X'; + END IF; + ReportType := none; + END IF; + IF (TriggerDelay /= noTrigger) THEN + IF (TriggerDelay = 0 ns) THEN + trigger <= TRANSPORT trigger AFTER 0 ns; + ELSE + trigger <= TRANSPORT not (trigger) AFTER + TriggerDelay; + END IF; + END IF; + END IF; + IF (Signal1'EVENT and SkewData.Signal1Old1 /= NOW) THEN + SkewData.Signal1Old2 := SkewData.Signal1Old1; + SkewData.Signal1Old1 := NOW; + END IF; + IF (Signal2'EVENT and SkewData.Signal2Old1 /= NOW) THEN + SkewData.Signal2Old2 := SkewData.Signal2Old1; + SkewData.Signal2Old1 := NOW; + END IF; + END VitalOutPhaseSkewCheck; + +END VITAL_Timing; diff --git a/libraries/vital2000/timing_p.vhdl b/libraries/vital2000/timing_p.vhdl new file mode 100644 index 000000000..e18c8c24a --- /dev/null +++ b/libraries/vital2000/timing_p.vhdl @@ -0,0 +1,1202 @@ +------------------------------------------------------------------------------- +-- Title : Standard VITAL TIMING Package +-- : $Revision: 598 $ +-- : +-- Library : This package shall be compiled into a library +-- : symbolically named IEEE. +-- : +-- Developers : IEEE DASC Timing Working Group (TWG), PAR 1076.4 +-- : +-- Purpose : This packages defines standard types, attributes, constants, +-- : functions and procedures for use in developing ASIC models. +-- : +-- Known Errors : +-- : +-- Note : No declarations or definitions shall be included in, +-- : or excluded from this package. The "package declaration" +-- : defines the objects (types, subtypes, constants, functions, +-- : procedures ... etc.) that can be used by a user. The package +-- : body shall be considered the formal definition of the +-- : semantics of this package. Tool developers may choose to +-- : implement the package body in the most efficient manner +-- : available to them. +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Acknowledgments: +-- This code was originally developed under the "VHDL Initiative Toward ASIC +-- Libraries" (VITAL), an industry sponsored initiative. Technical +-- Director: William Billowitch, VHDL Technology Group; U.S. Coordinator: +-- Steve Schultz; Steering Committee Members: Victor Berman, Cadence Design +-- Systems; Oz Levia, Synopsys Inc.; Ray Ryan, Ryan & Ryan; Herman van Beek, +-- Texas Instruments; Victor Martin, Hewlett-Packard Company. +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Modification History : +-- ---------------------------------------------------------------------------- +-- Version No:|Auth:| Mod.Date:| Changes Made: +-- v95.0 A | | 06/02/95 | Initial ballot draft 1995 +-- v95.1 | | 08/31/95 | #203 - Timing violations at time 0 +-- #204 - Output mapping prior to glitch detection +-- v98.0 |TAG | 03/27/98 | Initial ballot draft 1998 +-- | #IR225 - Negative Premptive Glitch +-- **Pkg_effected=VitalPathDelay, +-- VitalPathDelay01,VitalPathDelay01z. +-- #IR105 - Skew timing check needed +-- **Pkg_effected=NONE, New code added!! +-- #IR248 - Allows VPD to use a default timing +-- delay +-- **Pkg_effected=VitalPathDelay, +-- VitalPathDelay01,VitalPathDelay01z, +-- #IR250 - Corrects fastpath condition in VPD +-- **Pkg_effected=VitalPathDelay01, +-- VitalPathDelay01z, +-- #IR252 - Corrects cancelled timing check call if +-- condition expires. +-- **Pkg_effected=VitalSetupHoldCheck, +-- VitalRecoveryRemovalCheck. +-- #IR105 - Skew timing check +-- **Pkg_effected=NONE, New code added +-- v98.1 | jdc | 03/25/99 | Changed UseDefaultDelay to IgnoreDefaultDelay +-- and set default to FALSE in VitalPathDelay() +-- v00.7 | dbb | 07/18/00 | Removed "maximum" from VitalPeriodPulse() +-- comments + + +LIBRARY IEEE; +USE IEEE.Std_Logic_1164.ALL; + +PACKAGE VITAL_Timing IS + TYPE VitalTransitionType IS ( tr01, tr10, tr0z, trz1, tr1z, trz0, + tr0X, trx1, tr1x, trx0, trxz, trzx); + + SUBTYPE VitalDelayType IS TIME; + TYPE VitalDelayType01 IS ARRAY (VitalTransitionType RANGE tr01 to tr10) + OF TIME; + TYPE VitalDelayType01Z IS ARRAY (VitalTransitionType RANGE tr01 to trz0) + OF TIME; + TYPE VitalDelayType01ZX IS ARRAY (VitalTransitionType RANGE tr01 to trzx) + OF TIME; + + TYPE VitalDelayArrayType IS ARRAY (NATURAL RANGE <>) OF VitalDelayType; + TYPE VitalDelayArrayType01 IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01; + TYPE VitalDelayArrayType01Z IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01Z; + TYPE VitalDelayArrayType01ZX IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01ZX; + -- ---------------------------------------------------------------------- + -- ********************************************************************** + -- ---------------------------------------------------------------------- + + CONSTANT VitalZeroDelay : VitalDelayType := 0 ns; + CONSTANT VitalZeroDelay01 : VitalDelayType01 := ( 0 ns, 0 ns ); + CONSTANT VitalZeroDelay01Z : VitalDelayType01Z := ( OTHERS => 0 ns ); + CONSTANT VitalZeroDelay01ZX : VitalDelayType01ZX := ( OTHERS => 0 ns ); + + --------------------------------------------------------------------------- + -- examples of usage: + --------------------------------------------------------------------------- + -- tpd_CLK_Q : VitalDelayType := 5 ns; + -- tpd_CLK_Q : VitalDelayType01 := (tr01 => 2 ns, tr10 => 3 ns); + -- tpd_CLK_Q : VitalDelayType01Z := ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns ); + -- tpd_CLK_Q : VitalDelayArrayType(0 to 1) + -- := (0 => 5 ns, 1 => 6 ns); + -- tpd_CLK_Q : VitalDelayArrayType01(0 to 1) + -- := (0 => (tr01 => 2 ns, tr10 => 3 ns), + -- 1 => (tr01 => 2 ns, tr10 => 3 ns)); + -- tpd_CLK_Q : VitalDelayArrayType01Z(0 to 1) + -- := (0 => ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns ), + -- 1 => ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns )); + --------------------------------------------------------------------------- + + -- TRUE if the model is LEVEL0 | LEVEL1 compliant + ATTRIBUTE VITAL_Level0 : BOOLEAN; + ATTRIBUTE VITAL_Level1 : BOOLEAN; + + SUBTYPE std_logic_vector2 IS std_logic_vector(1 DOWNTO 0); + SUBTYPE std_logic_vector3 IS std_logic_vector(2 DOWNTO 0); + SUBTYPE std_logic_vector4 IS std_logic_vector(3 DOWNTO 0); + SUBTYPE std_logic_vector8 IS std_logic_vector(7 DOWNTO 0); + + -- Types for strength mapping of outputs + TYPE VitalOutputMapType IS ARRAY ( std_ulogic ) OF std_ulogic; + TYPE VitalResultMapType IS ARRAY ( UX01 ) OF std_ulogic; + TYPE VitalResultZMapType IS ARRAY ( UX01Z ) OF std_ulogic; + CONSTANT VitalDefaultOutputMap : VitalOutputMapType + := "UX01ZWLH-"; + CONSTANT VitalDefaultResultMap : VitalResultMapType + := ( 'U', 'X', '0', '1' ); + CONSTANT VitalDefaultResultZMap : VitalResultZMapType + := ( 'U', 'X', '0', '1', 'Z' ); + + -- Types for fields of VitalTimingDataType + TYPE VitalTimeArrayT IS ARRAY (INTEGER RANGE <>) OF TIME; + TYPE VitalTimeArrayPT IS ACCESS VitalTimeArrayT; + TYPE VitalBoolArrayT IS ARRAY (INTEGER RANGE <>) OF BOOLEAN; + TYPE VitalBoolArrayPT IS ACCESS VitalBoolArrayT; + TYPE VitalLogicArrayPT IS ACCESS std_logic_vector; + + TYPE VitalTimingDataType IS RECORD + NotFirstFlag : BOOLEAN; + RefLast : X01; + RefTime : TIME; + HoldEn : BOOLEAN; + TestLast : std_ulogic; + TestTime : TIME; + SetupEn : BOOLEAN; + TestLastA : VitalLogicArrayPT; + TestTimeA : VitalTimeArrayPT; + HoldEnA : VitalBoolArrayPT; + SetupEnA : VitalBoolArrayPT; + END RECORD; + + FUNCTION VitalTimingDataInit RETURN VitalTimingDataType; + + -- type for internal data of VitalPeriodPulseCheck + TYPE VitalPeriodDataType IS RECORD + Last : X01; + Rise : TIME; + Fall : TIME; + NotFirstFlag : BOOLEAN; + END RECORD; + CONSTANT VitalPeriodDataInit : VitalPeriodDataType + := ('X', 0 ns, 0 ns, FALSE ); + + -- Type for specifying the kind of Glitch handling to use + TYPE VitalGlitchKindType IS (OnEvent, + OnDetect, + VitalInertial, + VitalTransport); + + TYPE VitalGlitchDataType IS + RECORD + SchedTime : TIME; + GlitchTime : TIME; + SchedValue : std_ulogic; + LastValue : std_ulogic; + END RECORD; + TYPE VitalGlitchDataArrayType IS ARRAY (NATURAL RANGE <>) + OF VitalGlitchDataType; + + -- PathTypes: for handling simple PathDelay info + TYPE VitalPathType IS RECORD + InputChangeTime : TIME; -- timestamp for path input signal + PathDelay : VitalDelayType; -- delay for this path + PathCondition : BOOLEAN; -- path sensitize condition + END RECORD; + TYPE VitalPath01Type IS RECORD + InputChangeTime : TIME; -- timestamp for path input signal + PathDelay : VitalDelayType01; -- delay for this path + PathCondition : BOOLEAN; -- path sensitize condition + END RECORD; + TYPE VitalPath01ZType IS RECORD + InputChangeTime : TIME; -- timestamp for path input signal + PathDelay : VitalDelayType01Z;-- delay for this path + PathCondition : BOOLEAN; -- path sensitize condition + END RECORD; + + -- For representing multiple paths to an output + TYPE VitalPathArrayType IS ARRAY (NATURAL RANGE <> ) OF VitalPathType; + TYPE VitalPathArray01Type IS ARRAY (NATURAL RANGE <> ) OF VitalPath01Type; + TYPE VitalPathArray01ZType IS ARRAY (NATURAL RANGE <> ) OF VitalPath01ZType; + + TYPE VitalTableSymbolType IS ( + '/', -- 0 -> 1 + '\', -- 1 -> 0 + 'P', -- Union of '/' and '^' (any edge to 1) + 'N', -- Union of '\' and 'v' (any edge to 0) + 'r', -- 0 -> X + 'f', -- 1 -> X + 'p', -- Union of '/' and 'r' (any edge from 0) + 'n', -- Union of '\' and 'f' (any edge from 1) + 'R', -- Union of '^' and 'p' (any possible rising edge) + 'F', -- Union of 'v' and 'n' (any possible falling edge) + '^', -- X -> 1 + 'v', -- X -> 0 + 'E', -- Union of 'v' and '^' (any edge from X) + 'A', -- Union of 'r' and '^' (rising edge to or from 'X') + 'D', -- Union of 'f' and 'v' (falling edge to or from 'X') + '*', -- Union of 'R' and 'F' (any edge) + 'X', -- Unknown level + '0', -- low level + '1', -- high level + '-', -- don't care + 'B', -- 0 or 1 + 'Z', -- High Impedance + 'S' -- steady value + ); + + SUBTYPE VitalEdgeSymbolType IS VitalTableSymbolType RANGE '/' TO '*'; + + + + + -- Addition of Vital Skew Type Information + -- March 14, 1998 + + --------------------------------------------------------------------------- + -- Procedures and Type Definitions for Defining Skews + --------------------------------------------------------------------------- + + TYPE VitalSkewExpectedType IS (none, s1r, s1f, s2r, s2f); + + TYPE VitalSkewDataType IS RECORD + ExpectedType : VitalSkewExpectedType; + Signal1Old1 : TIME; + Signal2Old1 : TIME; + Signal1Old2 : TIME; + Signal2Old2 : TIME; + END RECORD; + + CONSTANT VitalSkewDataInit : VitalSkewDataType := ( none, 0 ns, 0 ns, 0 ns, 0 ns ); + + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalExtendToFillDelay + -- + -- Description: A six element array of delay values of type + -- VitalDelayType01Z is returned when a 1, 2 or 6 + -- element array is given. This function will convert + -- VitalDelayType and VitalDelayType01 delay values into + -- a VitalDelayType01Z type following these rules: + -- + -- When a VitalDelayType is passed, all six transition + -- values are assigned the input value. When a + -- VitalDelayType01 is passed, the 01 transitions are + -- assigned to the 01, 0Z and Z1 transitions and the 10 + -- transitions are assigned to 10, 1Z and Z0 transition + -- values. When a VitalDelayType01Z is passed, the values + -- are kept as is. + -- + -- The function is overloaded based on input type. + -- + -- There is no function to fill a 12 value delay + -- type. + -- + -- Arguments: + -- + -- IN Type Description + -- Delay A one, two or six delay value Vital- + -- DelayType is passed and a six delay, + -- VitalDelayType01Z, item is returned. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- VitalDelayType01Z + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType + ) RETURN VitalDelayType01Z; + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType01 + ) RETURN VitalDelayType01Z; + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType01Z + ) RETURN VitalDelayType01Z; + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalCalcDelay + -- + -- Description: This function accepts a 1, 2 or 6 value delay and + -- chooses the correct delay time to delay the NewVal + -- signal. This function is overloaded based on the + -- delay type passed. The function returns a single value + -- of time. + -- + -- This function is provided for Level 0 models in order + -- to calculate the delay which should be applied + -- for the passed signal. The delay selection is performed + -- using the OldVal and the NewVal to determine the + -- transition to select. The default value of OldVal is X. + -- + -- This function cannot be used in a Level 1 model since + -- the VitalPathDelay routines perform the delay path + -- selection and output driving function. + -- + -- Arguments: + -- + -- IN Type Description + -- NewVal New value of the signal to be + -- assigned + -- OldVal Previous value of the signal. + -- Default value is 'X' + -- Delay The delay structure from which to + -- select the appropriate delay. The + -- function overload is based on the + -- type of delay passed. In the case of + -- the single delay, VitalDelayType, no + -- selection is performed, since there + -- is only one value to choose from. + -- For the other cases, the transition + -- from the old value to the new value + -- decide the value returned. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- Time The time value selected from the + -- Delay INPUT is returned. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType + ) RETURN TIME; + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType01 + ) RETURN TIME; + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType01Z + ) RETURN TIME; + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalPathDelay + -- + -- Description: VitalPathDelay is the Level 1 routine used to select + -- the propagation delay path and schedule a new output + -- value. + -- + -- For single and dual delay values, VitalDelayType and + -- VitalDelayType01 are used. The output value is + -- scheduled with a calculated delay without strength + -- modification. + -- + -- For the six delay value, VitalDelayType01Z, the output + -- value is scheduled with a calculated delay. The drive + -- strength can be modified to handle weak signal strengths + -- to model tri-state devices, pull-ups and pull-downs as + -- an example. + -- + -- The correspondence between the delay type and the + -- path delay function is as follows: + -- + -- Delay Type Path Type + -- + -- VitalDelayType VitalPathDelay + -- VitalDelayType01 VitalPathDelay01 + -- VitalDelayType01Z VitalPathDelay01Z + -- + -- For each of these routines, the following capabilities + -- is provided: + -- + -- o Transition dependent path delay selection + -- o User controlled glitch detection with the ability + -- to generate "X" on output and report the violation + -- o Control of the severity level for message generation + -- o Scheduling of the computed values on the specified + -- signal. + -- + -- Selection of the appropriate path delay begins with the + -- candidate paths. The candidate paths are selected by + -- identifying the paths for which the PathCondition is + -- true. If there is a single candidate path, then that + -- delay is selected. If there is more than one candidate + -- path, then the shortest delay is selected using + -- transition dependent delay selection. If there is no + -- candidate paths, then the delay specified by the + -- DefaultDelay parameter to the path delay is used. + -- + -- Once the delay is known, the output signal is then + -- scheduled with that delay. In the case of + -- VitalPathDelay01Z, an additional result mapping of + -- the output value is performed before scheduling. The + -- result mapping is performed after transition dependent + -- delay selection but before scheduling the final output. + -- + -- In order to perform glitch detection, the user is + -- obligated to provide a variable of VitalGlitchDataType + -- for the propagation delay functions to use. The user + -- cannot modify or use this information. + -- + -- Arguments: + -- + -- IN Type Description + -- OutSignalName string The name of the output signal + -- OutTemp std_logic The new output value to be driven + -- Paths VitalPathArrayType A list of paths of VitalPathArray + -- VitalPathArrayType01 type. The VitalPathDelay routine + -- VitalPathArrayType01Z is overloaded based on the type + -- of constant passed in. With + -- VitalPathArrayType01Z, the + -- resulting output strengths can be + -- mapped. + -- DefaultDelay VitalDelayType The default delay can be changed + -- VitalDelayType01 from zero-delay to another set + -- VitalDelayType01Z of values. + -- + -- IgnoreDefaultDelay BOOLEAN If TRUE, the default delay will + -- be used when no paths are + -- selected. If false, no event + -- will be scheduled if no paths are + -- selected. + -- + -- Mode VitalGlitchKindType The value of this constant + -- selects the type of glitch + -- detection. + -- OnEvent Glitch on transition event + -- | OnDetect Glitch immediate on detection + -- | VitalInertial No glitch, use INERTIAL + -- assignment + -- | VitalTransport No glitch, use TRANSPORT + -- assignment + -- XOn BOOLEAN Control for generation of 'X' on + -- glitch. When TRUE, 'X's are + -- scheduled for glitches, otherwise + -- no are generated. + -- MsgOn BOOLEAN Control for message generation on + -- glitch detect. When TRUE, + -- glitches are reported, otherwise + -- they are not reported. + -- MsgSeverity SEVERITY_LEVEL The level at which the message, + -- or assertion, will be reported. + -- IgnoreDefaultDelay BOOLEAN Tells the VPD whether to use the + -- default delay value in the absense + -- of a valid delay for input conditions 3/14/98 MG + -- + -- OutputMap VitalOutputMapType For VitalPathDelay01Z, the output + -- can be mapped to alternate + -- strengths to model tri-state + -- devices, pull-ups and pull-downs. + -- + -- INOUT + -- GlitchData VitalGlitchDataType The internal data storage + -- variable required to detect + -- glitches. + -- + -- OUT + -- OutSignal std_logic The output signal to be driven + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalPathDelay ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArrayType; + CONSTANT DefaultDelay : IN VitalDelayType := VitalZeroDelay; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT NegPreemptOn : IN BOOLEAN := FALSE; --IR225 3/14/98 + CONSTANT IgnoreDefaultDelay : IN BOOLEAN := FALSE --IR248 3/14/98 + ); + PROCEDURE VitalPathDelay01 ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArray01Type; + CONSTANT DefaultDelay : IN VitalDelayType01 := VitalZeroDelay01; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT NegPreemptOn : IN BOOLEAN := FALSE; --IR225 3/14/98 + CONSTANT IgnoreDefaultDelay : IN BOOLEAN := FALSE; --IR248 3/14/98 + CONSTANT RejectFastPath : IN BOOLEAN := FALSE --IR250 + ); + PROCEDURE VitalPathDelay01Z ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArray01ZType; + CONSTANT DefaultDelay : IN VitalDelayType01Z := VitalZeroDelay01Z; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT OutputMap : IN VitalOutputMapType := VitalDefaultOutputMap; + CONSTANT NegPreemptOn : IN BOOLEAN := FALSE; --IR225 3/14/98 + CONSTANT IgnoreDefaultDelay : IN BOOLEAN := FALSE; --IR248 3/14/98 + CONSTANT RejectFastPath : IN BOOLEAN := FALSE --IR250 + ); + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalWireDelay + -- + -- Description: VitalWireDelay is used to delay an input signal. + -- The delay is selected from the input parameter passed. + -- The function is useful for back annotation of actual + -- net delays. + -- + -- The function is overloaded to permit passing a delay + -- value for twire for VitalDelayType, VitalDelayType01 + -- and VitalDelayType01Z. twire is a generic which can + -- be back annotated and must be constructed to follow + -- the SDF to generic mapping rules. + -- + -- Arguments: + -- + -- IN Type Description + -- InSig std_ulogic The input signal (port) to be + -- delayed. + -- twire VitalDelayType The delay value for which the input + -- VitalDelayType01 signal should be delayed. For Vital- + -- VitalDelayType01Z DelayType, the value is single value + -- passed. For VitalDelayType01 and + -- VitalDelayType01Z, the appropriate + -- delay value is selected by VitalCalc- + -- Delay. + -- + -- INOUT + -- none + -- + -- OUT + -- OutSig std_ulogic The internal delayed signal + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType + ); + + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType01 + ); + + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType01Z + ); + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalSignalDelay + -- + -- Description: The VitalSignalDelay procedure is called in a signal + -- delay block in the architecture to delay the + -- appropriate test or reference signal in order to + -- accommodate negative constraint checks. + -- + -- The amount of delay is of type TIME and is a constant. + -- + -- Arguments: + -- + -- IN Type Description + -- InSig std_ulogic The signal to be delayed. + -- dly TIME The amount of time the signal is + -- delayed. + -- + -- INOUT + -- none + -- + -- OUT + -- OutSig std_ulogic The delayed signal + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalSignalDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT dly : IN TIME + ); + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalSetupHoldCheck + -- + -- Description: The VitalSetupHoldCheck procedure detects a setup or a + -- hold violation on the input test signal with respect + -- to the corresponding input reference signal. The timing + -- constraints are specified through parameters + -- representing the high and low values for the setup and + -- hold values for the setup and hold times. This + -- procedure assumes non-negative values for setup and hold + -- timing constraints. + -- + -- It is assumed that negative timing constraints + -- are handled by internally delaying the test or + -- reference signals. Negative setup times result in + -- a delayed reference signal. Negative hold times + -- result in a delayed test signal. Furthermore, the + -- delays and constraints associated with these and + -- other signals may need to be appropriately + -- adjusted so that all constraint intervals overlap + -- the delayed reference signals and all constraint + -- values (with respect to the delayed signals) are + -- non-negative. + -- + -- This function is overloaded based on the input + -- TestSignal. A vector and scalar form are provided. + -- + -- TestSignal XXXXXXXXXXXX____________________________XXXXXXXXXXXXXXXXXXXXXX + -- : + -- : -->| error region |<-- + -- : + -- _______________________________ + -- RefSignal \______________________________ + -- : | | | + -- : | -->| |<-- thold + -- : -->| tsetup |<-- + -- + -- Arguments: + -- + -- IN Type Description + -- TestSignal std_ulogic Value of test signal + -- std_logic_vector + -- TestSignalName STRING Name of test signal + -- TestDelay TIME Model's internal delay associated + -- with TestSignal + -- RefSignal std_ulogic Value of reference signal + -- RefSignalName STRING Name of reference signal + -- RefDelay TIME Model's internal delay associated + -- with RefSignal + -- SetupHigh TIME Absolute minimum time duration before + -- the transition of RefSignal for which + -- transitions of TestSignal are allowed + -- to proceed to the "1" state without + -- causing a setup violation. + -- SetupLow TIME Absolute minimum time duration before + -- the transition of RefSignal for which + -- transitions of TestSignal are allowed + -- to proceed to the "0" state without + -- causing a setup violation. + -- HoldHigh TIME Absolute minimum time duration after + -- the transition of RefSignal for which + -- transitions of TestSignal are allowed + -- to proceed to the "1" state without + -- causing a hold violation. + -- HoldLow TIME Absolute minimum time duration after + -- the transition of RefSignal for which + -- transitions of TestSignal are allowed + -- to proceed to the "0" state without + -- causing a hold violation. + -- CheckEnabled BOOLEAN Check performed if TRUE. + -- RefTransition VitalEdgeSymbolType + -- Reference edge specified. Events on + -- the RefSignal which match the edge + -- spec. are used as reference edges. + -- HeaderMsg STRING String that will accompany any + -- assertion messages produced. + -- XOn BOOLEAN If TRUE, Violation output parameter + -- is set to "X". Otherwise, Violation + -- is always set to "0". + -- MsgOn BOOLEAN If TRUE, set and hold violation + -- message will be generated. + -- Otherwise, no messages are generated, + -- even upon violations. + -- MsgSeverity SEVERITY_LEVEL Severity level for the assertion. + -- EnableSetupOnTest BOOLEAN If FALSE at the time that the + -- TestSignal signal changes, + -- no setup check will be performed. + -- EnableSetupOnRef BOOLEAN If FALSE at the time that the + -- RefSignal signal changes, + -- no setup check will be performed. + -- EnableHoldOnRef BOOLEAN If FALSE at the time that the + -- RefSignal signal changes, + -- no hold check will be performed. + -- EnableHoldOnTest BOOLEAN If FALSE at the time that the + -- TestSignal signal changes, + -- no hold check will be performed. + -- + -- INOUT + -- TimingData VitalTimingDataType + -- VitalSetupHoldCheck information + -- storage area. This is used + -- internally to detect reference edges + -- and record the time of the last edge. + -- + -- OUT + -- Violation X01 This is the violation flag returned. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalSetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE --IR252 3/23/98 + ); + + PROCEDURE VitalSetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT EnableSetupOnTest : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableSetupOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableHoldOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableHoldOnTest : IN BOOLEAN := TRUE --IR252 3/23/98 + ); + + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalRecoveryRemovalCheck + -- + -- Description: The VitalRecoveryRemovalCheck detects the presence of + -- a recovery or removal violation on the input test + -- signal with respect to the corresponding input reference + -- signal. It assumes non-negative values of setup and + -- hold timing constraints. The timing constraint is + -- specified through parameters representing the recovery + -- and removal times associated with a reference edge of + -- the reference signal. A flag indicates whether a test + -- signal is asserted when it is high or when it is low. + -- + -- It is assumed that negative timing constraints + -- are handled by internally delaying the test or + -- reference signals. Negative recovery times result in + -- a delayed reference signal. Negative removal times + -- result in a delayed test signal. Furthermore, the + -- delays and constraints associated with these and + -- other signals may need to be appropriately + -- adjusted so that all constraint intervals overlap + -- the delayed reference signals and all constraint + -- values (with respect to the delayed signals) are + -- non-negative. + -- + -- Arguments: + -- + -- IN Type Description + -- TestSignal std_ulogic Value of TestSignal. The routine is + -- TestSignalName STRING Name of TestSignal + -- TestDelay TIME Model internal delay associated with + -- the TestSignal + -- RefSignal std_ulogic Value of RefSignal + -- RefSignalName STRING Name of RefSignal + -- RefDelay TIME Model internal delay associated with + -- the RefSignal + -- Recovery TIME A change to an unasserted value on + -- the asynchronous TestSignal must + -- precede reference edge (on RefSignal) + -- by at least this time. + -- Removal TIME An asserted condition must be present + -- on the asynchronous TestSignal for at + -- least the removal time following a + -- reference edge on RefSignal. + -- ActiveLow BOOLEAN A flag which indicates if TestSignal + -- is asserted when it is low - "0." + -- FALSE indicate that TestSignal is + -- asserted when it has a value "1." + -- CheckEnabled BOOLEAN The check in enabled when the value + -- is TRUE, otherwise the constraints + -- are not checked. + -- RefTransition VitalEdgeSymbolType + -- Reference edge specifier. Events on + -- RefSignal will match the edge + -- specified. + -- HeaderMsg STRING A header message that will accompany + -- any assertion message. + -- XOn BOOLEAN When TRUE, the output Violation is + -- set to "X." When FALSE, it is always + -- "0." + -- MsgOn BOOLEAN When TRUE, violation messages are + -- output. When FALSE, no messages are + -- generated. + -- MsgSeverity SEVERITY_LEVEL Severity level of the asserted + -- message. + -- EnableRecOnTest BOOLEAN If FALSE at the time that the + -- TestSignal signal changes, + -- no recovery check will be performed. + -- EnableRecOnRef BOOLEAN If FALSE at the time that the + -- RefSignal signal changes, + -- no recovery check will be performed. + -- EnableRemOnRef BOOLEAN If FALSE at the time that the + -- RefSignal signal changes, + -- no removal check will be performed. + -- EnableRemOnTest BOOLEAN If FALSE at the time that the + -- TestSignal signal changes, + -- no removal check will be performed. + -- + -- INOUT + -- TimingData VitalTimingDataType + -- VitalRecoveryRemovalCheck information + -- storage area. This is used + -- internally to detect reference edges + -- and record the time of the last edge. + -- OUT + -- Violation X01 This is the violation flag returned. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalRecoveryRemovalCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT Recovery : IN TIME := 0 ns; + CONSTANT Removal : IN TIME := 0 ns; + CONSTANT ActiveLow : IN BOOLEAN := TRUE; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT EnableRecOnTest : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableRecOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableRemOnRef : IN BOOLEAN := TRUE; --IR252 3/23/98 + CONSTANT EnableRemOnTest : IN BOOLEAN := TRUE --IR252 3/23/98 + ); + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalPeriodPulseCheck + -- + -- Description: VitalPeriodPulseCheck checks for minimum + -- periodicity and pulse width for "1" and "0" values of + -- the input test signal. The timing constraint is + -- specified through parameters representing the minimal + -- period between successive rising and falling edges of + -- the input test signal and the minimum pulse widths + -- associated with high and low values. + -- + -- VitalPeriodCheck's accepts rising and falling edges + -- from 1 and 0 as well as transitions to and from 'X.' + -- + -- _______________ __________ + -- ____________| |_______| + -- + -- |<--- pw_hi --->| + -- |<-------- period ----->| + -- -->| pw_lo |<-- + -- + -- Arguments: + -- IN Type Description + -- TestSignal std_ulogic Value of test signal + -- TestSignalName STRING Name of the test signal + -- TestDelay TIME Model's internal delay associated + -- with TestSignal + -- Period TIME Minimum period allowed between + -- consecutive rising ('P') or + -- falling ('F') transitions. + -- PulseWidthHigh TIME Minimum time allowed for a high + -- pulse ('1' or 'H') + -- PulseWidthLow TIME Minimum time allowed for a low + -- pulse ('0' or 'L') + -- CheckEnabled BOOLEAN Check performed if TRUE. + -- HeaderMsg STRING String that will accompany any + -- assertion messages produced. + -- XOn BOOLEAN If TRUE, Violation output parameter + -- is set to "X". Otherwise, Violation + -- is always set to "0". + -- XOnChecks is a global that allows for + -- only timing checks to be turned on. + -- MsgOn BOOLEAN If TRUE, period/pulse violation + -- message will be generated. + -- Otherwise, no messages are generated, + -- even though a violation is detected. + -- MsgOnChecks allows for only timing + -- check messages to be turned on. + -- MsgSeverity SEVERITY_LEVEL Severity level for the assertion. + -- + -- INOUT + -- PeriodData VitalPeriodDataType + -- VitalPeriodPulseCheck information + -- storage area. This is used + -- internally to detect reference edges + -- and record the pulse and period + -- times. + -- OUT + -- Violation X01 This is the violation flag returned. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------ + PROCEDURE VitalPeriodPulseCheck ( + VARIABLE Violation : OUT X01; + VARIABLE PeriodData : INOUT VitalPeriodDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + CONSTANT Period : IN TIME := 0 ns; + CONSTANT PulseWidthHigh : IN TIME := 0 ns; + CONSTANT PulseWidthLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ); + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalInPhaseSkewCheck + -- + -- Description: The VitalInPhaseSkewCheck procedure detects an in-phase + -- skew violation between input signals Signal1 and Signal2. + -- This is a timer based skew check in which a + -- violation is detected if Signal1 and Signal2 are in + -- different logic states longer than the specified skew + -- interval. + -- + -- The timing constraints are specified through parameters + -- representing the skew values for the different states + -- of Signal1 and Signal2. + -- + -- + -- Signal2 XXXXXXXXXXXX___________________________XXXXXXXXXXXXXXXXXXXXXX + -- : + -- : -->| |<-- + -- : Signal2 should go low in this region + -- : + -- + -- ____________ + -- Signal1 \_________________________________________________ + -- : | | + -- : |<-------- tskew -------->| + -- + -- Arguments: + -- + -- IN Type Description + -- Signal1 std_ulogic Value of first signal + -- Signal1Name STRING Name of first signal + -- Signal1Delay TIME Model's internal delay associated + -- with Signal1 + -- Signal2 std_ulogic Value of second signal + -- Signal2Name STRING Name of second signal + -- Signal2Delay TIME Model's internal delay associated + -- with Signal2 + -- SkewS1S2RiseRise TIME Absolute maximum time duration for + -- which Signal2 can remain at "0" + -- after Signal1 goes to the "1" state, + -- without causing a skew violation. + -- SkewS2S1RiseRise TIME Absolute maximum time duration for + -- which Signal1 can remain at "0" + -- after Signal2 goes to the "1" state, + -- without causing a skew violation. + -- SkewS1S2FallFall TIME Absolute maximum time duration for + -- which Signal2 can remain at "1" + -- after Signal1 goes to the "0" state, + -- without causing a skew violation. + -- SkewS2S1FallFall TIME Absolute maximum time duration for + -- which Signal1 can remain at "1" + -- after Signal2 goes to the "0" state, + -- without causing a skew violation. + -- CheckEnabled BOOLEAN Check performed if TRUE. + -- HeaderMsg STRING String that will accompany any + -- assertion messages produced. + -- XOn BOOLEAN If TRUE, Violation output parameter + -- is set to "X". Otherwise, Violation + -- is always set to "0." + -- MsgOn BOOLEAN If TRUE, skew timing violation + -- messages will be generated. + -- Otherwise, no messages are generated, + -- even upon violations. + -- MsgSeverity SEVERITY_LEVEL Severity level for the assertion. + -- + -- INOUT + -- SkewData VitalSkewDataType + -- VitalInPhaseSkewCheck information + -- storage area. This is used + -- internally to detect signal edges + -- and record the time of the last edge. + -- + -- + -- Trigger std_ulogic This signal is used to trigger the + -- process in which the timing check + -- occurs upon expiry of the skew + -- interval. + -- + -- OUT + -- Violation X01 This is the violation flag returned. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + + PROCEDURE VitalInPhaseSkewCheck ( + VARIABLE Violation : OUT X01; + VARIABLE SkewData : INOUT VitalSkewDataType; + SIGNAL Signal1 : IN std_ulogic; + CONSTANT Signal1Name : IN STRING := ""; + CONSTANT Signal1Delay : IN TIME := 0 ns; + SIGNAL Signal2 : IN std_ulogic; + CONSTANT Signal2Name : IN STRING := ""; + CONSTANT Signal2Delay : IN TIME := 0 ns; + CONSTANT SkewS1S2RiseRise : IN TIME := TIME'HIGH; + CONSTANT SkewS2S1RiseRise : IN TIME := TIME'HIGH; + CONSTANT SkewS1S2FallFall : IN TIME := TIME'HIGH; + CONSTANT SkewS2S1FallFall : IN TIME := TIME'HIGH; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT HeaderMsg : IN STRING := ""; + SIGNAL Trigger : INOUT std_ulogic + ); + + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalOutPhaseSkewCheck + -- + -- Description: The VitalOutPhaseSkewCheck procedure detects an + -- out-of-phase skew violation between input signals Signal1 + -- and Signal2. This is a timer based skew check in + -- which a violation is detected if Signal1 and Signal2 are + -- in the same logic state longer than the specified skew + -- interval. + -- + -- The timing constraints are specified through parameters + -- representing the skew values for the different states + -- of Signal1 and Signal2. + -- + -- + -- Signal2 XXXXXXXXXXXX___________________________XXXXXXXXXXXXXXXXXXXXXX + -- : + -- : -->| |<-- + -- : Signal2 should go high in this region + -- : + -- + -- ____________ + -- Signal1 \_________________________________________________ + -- : | | + -- : |<-------- tskew -------->| + -- + -- Arguments: + -- + -- IN Type Description + -- Signal1 std_ulogic Value of first signal + -- Signal1Name STRING Name of first signal + -- Signal1Delay TIME Model's internal delay associated + -- with Signal1 + -- Signal2 std_ulogic Value of second signal + -- Signal2Name STRING Name of second signal + -- Signal2Delay TIME Model's internal delay associated + -- with Signal2 + -- SkewS1S2RiseFall TIME Absolute maximum time duration for + -- which Signal2 can remain at "1" + -- after Signal1 goes to the "1" state, + -- without causing a skew violation. + -- SkewS2S1RiseFall TIME Absolute maximum time duration for + -- which Signal1 can remain at "1" + -- after Signal2 goes to the "1" state, + -- without causing a skew violation. + -- SkewS1S2FallRise TIME Absolute maximum time duration for + -- which Signal2 can remain at "0" + -- after Signal1 goes to the "0" state, + -- without causing a skew violation. + -- SkewS2S1FallRise TIME Absolute maximum time duration for + -- which Signal1 can remain at "0" + -- after Signal2 goes to the "0" state, + -- without causing a skew violation. + -- CheckEnabled BOOLEAN Check performed if TRUE. + -- HeaderMsg STRING String that will accompany any + -- assertion messages produced. + -- XOn BOOLEAN If TRUE, Violation output parameter + -- is set to "X". Otherwise, Violation + -- is always set to "0." + -- MsgOn BOOLEAN If TRUE, skew timing violation + -- messages will be generated. + -- Otherwise, no messages are generated, + -- even upon violations. + -- MsgSeverity SEVERITY_LEVEL Severity level for the assertion. + -- + -- INOUT + -- SkewData VitalSkewDataType + -- VitalInPhaseSkewCheck information + -- storage area. This is used + -- internally to detect signal edges + -- and record the time of the last edge. + -- + -- Trigger std_ulogic This signal is used to trigger the + -- process in which the timing check + -- occurs upon expiry of the skew + -- interval. + -- + -- OUT + -- Violation X01 This is the violation flag returned. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalOutPhaseSkewCheck ( + VARIABLE Violation : OUT X01; + VARIABLE SkewData : INOUT VitalSkewDataType; + SIGNAL Signal1 : IN std_ulogic; + CONSTANT Signal1Name : IN STRING := ""; + CONSTANT Signal1Delay : IN TIME := 0 ns; + SIGNAL Signal2 : IN std_ulogic; + CONSTANT Signal2Name : IN STRING := ""; + CONSTANT Signal2Delay : IN TIME := 0 ns; + CONSTANT SkewS1S2RiseFall : IN TIME := TIME'HIGH; + CONSTANT SkewS2S1RiseFall : IN TIME := TIME'HIGH; + CONSTANT SkewS1S2FallRise : IN TIME := TIME'HIGH; + CONSTANT SkewS2S1FallRise : IN TIME := TIME'HIGH; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT HeaderMsg : IN STRING := ""; + SIGNAL Trigger : INOUT std_ulogic + ); + + +END VITAL_Timing; diff --git a/libraries/vital95/vital_primitives.vhdl b/libraries/vital95/vital_primitives.vhdl new file mode 100644 index 000000000..d0da36ba0 --- /dev/null +++ b/libraries/vital95/vital_primitives.vhdl @@ -0,0 +1,1410 @@ +-- ----------------------------------------------------------------------------- +-- Title : Standard VITAL_Primitives Package +-- : $Revision: 597 $ +-- : +-- Library : This package shall be compiled into a library +-- : symbolically named IEEE. +-- : +-- Developers : IEEE DASC Timing Working Group (TWG), PAR 1076.4 +-- : +-- Purpose : This packages defines standard types, constants, functions +-- : and procedures for use in developing ASIC models. +-- : Specifically a set of logic primitives are defined. +-- : +-- Known Errors : +-- : +-- Note : No declarations or definitions shall be included in, +-- : or excluded from this package. The "package declaration" +-- : defines the objects (types, subtypes, constants, functions, +-- : procedures ... etc.) that can be used by a user. The package +-- : body shall be considered the formal definition of the +-- : semantics of this package. Tool developers may choose to +-- : implement the package body in the most efficient manner +-- : available to them. +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Acknowledgments: +-- This code was originally developed under the "VHDL Initiative Toward ASIC +-- Libraries" (VITAL), an industry sponsored initiative. Technical +-- Director: William Billowitch, VHDL Technology Group; U.S. Coordinator: +-- Steve Schultz; Steering Committee Members: Victor Berman, Cadence Design +-- Systems; Oz Levia, Synopsys Inc.; Ray Ryan, Ryan & Ryan; Herman van Beek, +-- Texas Instruments; Victor Martin, Hewlett-Packard Company. +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Modification History : +-- ---------------------------------------------------------------------------- +-- Version No:|Auth:| Mod.Date:| Changes Made: +-- v95.0 A | | 06/02/95 | Initial ballot draft 1995 +-- ---------------------------------------------------------------------------- +-- +LIBRARY IEEE; +USE IEEE.Std_Logic_1164.ALL; +USE IEEE.VITAL_Timing.ALL; + +PACKAGE VITAL_Primitives IS + -- ------------------------------------------------------------------------ + -- Type and Subtype Declarations + -- ------------------------------------------------------------------------ + + -- For Truth and State Tables + SUBTYPE VitalTruthSymbolType IS VitalTableSymbolType RANGE 'X' TO 'Z'; + SUBTYPE VitalStateSymbolType IS VitalTableSymbolType RANGE '/' TO 'S'; + + TYPE VitalTruthTableType IS ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> ) + OF VitalTruthSymbolType; + TYPE VitalStateTableType IS ARRAY ( NATURAL RANGE <>, NATURAL RANGE <> ) + OF VitalStateSymbolType; + + -- --------------------------------- + -- Default values used by primitives + -- --------------------------------- + CONSTANT VitalDefDelay01 : VitalDelayType01; -- Propagation delays + CONSTANT VitalDefDelay01Z : VitalDelayType01Z; + + -- ------------------------------------------------------------------------ + -- VITAL Primitives + -- + -- The primitives packages contains a collections of common gates, + -- including AND, OR, XOR, NAND, NOR, XNOR, BUF, INV, MUX and DECODER + -- functions. In addition, for sequential devices, a STATE TABLE construct + -- is provided. For complex functions a modeler may wish to use either + -- a collection of connected VITAL primitives, or a TRUTH TABLE construct. + -- + -- For each primitive a Function and Procedure is provided. The primitive + -- functions are provided to support behavioral modeling styles. The + -- primitive procedures are provided to support structural modeling styles. + -- + -- The procedures wait internally for an event on an input signal, compute + -- the new result, perform glitch handling, schedule transaction on the + -- output signals, and wait for future input events. All of the functional + -- (logic) input or output parameters of the primitive procedures are + -- signals. All the other parameters are constants. + -- + -- The procedure primitives are parameterized for separate path delays + -- from each input signal. All path delays default to 0 ns. + -- + -- The sequential primitive functions compute the defined function and + -- return a value of type std_ulogic or std_logic_vector. All parameters + -- of the primitive functions are constants of mode IN. + -- + -- The primitives are based on 1164 operators. The user may also elect to + -- express functions using the 1164 operators as well. These styles are + -- all equally acceptable methods for device modeling. + -- + -- ------------------------------------------------------------------------ + -- + -- Sequential + -- Primitive + -- Function Name: N-input logic device function calls: + -- VitalAND VitalOR VitalXOR + -- VitalNAND VitalNOR VitalXNOR + -- + -- Description: The function calls return the evaluated logic function + -- corresponding to the function name. + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_logic_vector The input signals for the n-bit + -- wide logic functions. + -- ResultMap VitalResultMapType The output signal strength + -- result map to modify default + -- result mapping. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_ulogic The evaluated logic function of + -- the n-bit wide primitives. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalAND ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNAND ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXNOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) RETURN std_ulogic; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: N-input logic device concurrent procedure calls. + -- VitalAND VitalOR VitalXOR + -- VitalNAND VitalNOR VitalXNOR + -- + -- Description: The procedure calls return the evaluated logic function + -- corresponding to the function name as a parameter to the + -- procedure. Propagation delay form data to q is a + -- a parameter to the procedure. A vector of delay values + -- for inputs to output are provided. It is noted that + -- limitations in SDF make the back annotation of the delay + -- array difficult. + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_logic_vector The input signals for the n- + -- bit wide logic functions. + -- tpd_data_q VitalDelayArrayType01 The propagation delay from + -- the data inputs to the output + -- q. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic The output signal of the + -- evaluated logic function. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalAND ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNAND ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXNOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + -- ------------------------------------------------------------------------- + -- + -- Sequential + -- Primitive + -- Function Name: 2,3 and 4 input logic device function calls. + -- + -- VitalAND2 VitalOR2 VitalXOR2 + -- VitalAND3 VitalOR3 VitalXOR3 + -- VitalAND4 VitalOR4 VitalXOR4 + -- + -- VitalNAND2 VitalNOR2 VitalXNOR2 + -- VitalNAND3 VitalNOR3 VitalXNOR3 + -- VitalNAND4 VitalNOR4 VitalXNOR4 + -- + -- Description: The function calls return the evaluated 2, 3 or 4 input + -- logic function corresponding to the function name. + -- + -- Arguments: + -- + -- IN Type Description + -- a, b, c, d std_ulogic 2 input devices have a and b as + -- inputs. 3 input devices have a, b + -- and c as inputs. 4 input devices + -- have a, b, c and d as inputs. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_ulogic The result of the evaluated logic + -- function. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalAND2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNAND2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXNOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalAND3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNAND3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXNOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalAND4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNAND4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalNOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalXNOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: 2, 3 and 4 input logic device concurrent procedure + -- calls. + -- + -- VitalAND2 VitalOR2 VitalXOR2 + -- VitalAND3 VitalOR3 VitalXOR3 + -- VitalAND4 VitalOR4 VitalXOR4 + -- + -- VitalNAND2 VitalNOR2 VitalXNOR2 + -- VitalNAND3 VitalNOR3 VitalXNOR3 + -- VitalNAND4 VitalNOR4 VitalXNOR4 + -- + -- Description: The procedure calls return the evaluated logic function + -- corresponding to the function name as a parameter to the + -- procedure. Propagation delays from a and b to q are + -- a parameter to the procedure. The default propagation + -- delay is 0 ns. + -- + -- Arguments: + -- + -- IN Type Description + -- a, b, c, d std_ulogic 2 input devices have a and b as + -- inputs. 3 input devices have a, b + -- and c as inputs. 4 input devices + -- have a, b, c and d as inputs. + -- tpd_a_q VitalDelayType01 The propagation delay from the a + -- input to output q for 2, 3 and 4 + -- input devices. + -- tpd_b_q VitalDelayType01 The propagation delay from the b + -- input to output q for 2, 3 and 4 + -- input devices. + -- tpd_c_q VitalDelayType01 The propagation delay from the c + -- input to output q for 3 and 4 input + -- devices. + -- tpd_d_q VitalDelayType01 The propagation delay from the d + -- input to output q for 4 input + -- devices. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic The output signal of the evaluated + -- logic function. + -- + -- Returns + -- none + -- ------------------------------------------------------------------------- + PROCEDURE VitalAND2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNAND2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXNOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalAND3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNAND3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXNOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalAND4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNAND4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalNOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalXNOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + -- ------------------------------------------------------------------------ + -- + -- Sequential + -- Primitive + -- Function Name: Buffer logic device concurrent procedure calls. + -- + -- Description: Four buffer sequential primitive function calls are + -- provided. One is a simple buffer and the others + -- offer high and low enables and the four permits + -- propagation of Z as shown below: + -- + -- VitalBUF Standard non-inverting buffer + -- VitalBUFIF0 Non-inverting buffer with Enable low + -- VitalBUFIF1 Non-inverting buffer with Enable high + -- VitalIDENT Pass buffer capable of propagating Z + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_ulogic Input to the buffers + -- Enable std_ulogic Enable for the enable high and low + -- buffers. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping for + -- simple buffer. + -- VitalResultZMapType The output signal strength result map + -- to modify default result mapping + -- which has high impedance capability + -- for the enable high, enable low and + -- identity buffers. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_ulogic The output signal of the evaluated + -- buffer function. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalBUF ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + FUNCTION VitalBUFIF0 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic; + FUNCTION VitalBUFIF1 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic; + FUNCTION VitalIDENT ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: Buffer device procedure calls. + -- + -- Description: Four buffer concurrent primitive procedure calls are + -- provided. One is a simple buffer and the others + -- offer high and low enables and the fourth permits + -- propagation of Z as shown below: + -- + -- VitalBUF Standard non-inverting buffer + -- VitalBUFIF0 Non-inverting buffer with Enable low + -- VitalBUFIF1 Non-inverting buffer with Enable high + -- VitalIDENT Pass buffer capable of propagating Z + -- + -- Arguments: + -- + -- IN Type Description + -- a std_ulogic Input signal to the buffers + -- Enable std_ulogic Enable signal for the enable high and + -- low buffers. + -- tpd_a_q VitalDelayType01 Propagation delay from input to + -- output for the simple buffer. + -- VitalDelayType01Z Propagation delay from input to + -- to output for the enable high and low + -- and identity buffers. + -- tpd_enable_q VitalDelayType01Z Propagation delay from enable to + -- output for the enable high and low + -- buffers. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping for + -- simple buffer. + -- VitalResultZMapType The output signal strength result map + -- to modify default result mapping + -- which has high impedance capability + -- for the enable high, enable low and + -- identity buffers. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic Output of the buffers. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalBUF ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalBUFIF0 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap); + + + PROCEDURE VitalBUFIF1 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap); + + PROCEDURE VitalIDENT ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap ); + + -- ------------------------------------------------------------------------ + -- + -- Sequential + -- Primitive + -- Function Name: VitalINV, VitalINVIF0, VitalINVIF1 + -- + -- Description: Inverter functions which return the inverted signal + -- value. Inverters with enable low and high are provided + -- which can drive high impedance when inactive. + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_ulogic Input to the inverter + -- Enable std_ulogic Enable to the enable high and low + -- inverters. + -- ResultMap VitalResultMap The output signal strength result map + -- to modify default result mapping for + -- simple inverter. + -- VitalResultZMapType The output signal strength result map + -- to modify default result mapping + -- which has high impedance capability + -- for the enable high, enable low + -- inverters. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_ulogic Output of the inverter + -- + -- ------------------------------------------------------------------------- + + FUNCTION VitalINV ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalINVIF0 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic; + + FUNCTION VitalINVIF1 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: VitalINV, VitalINVIF0, VitalINVIF1 + -- + -- Description: The concurrent primitive procedure calls implement a + -- signal inversion function. The output is a parameter to + -- the procedure. The path delay information is passed as + -- a parameter to the call. + -- + -- Arguments: + -- + -- IN Type Description + -- a std_ulogic Input signal for the simple inverter + -- Data std_ulogic Input signal for the enable high and + -- low inverters. + -- Enable std_ulogic Enable signal for the enable high and + -- low inverters. + -- tpd_a_q VitalDelayType01 Propagation delay from input a to + -- output q for the simple inverter. + -- tpd_data_q VitalDelayType01 Propagation delay from input data to + -- output q for the enable high and low + -- inverters. + -- tpd_enable_q VitalDelayType01Z Propagation delay from input enable + -- to output q for the enable high and + -- low inverters. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping for + -- simple inverter. + -- VitalResultZMapType The output signal strength result map + -- to modify default result mapping + -- which has high impedance capability + -- for the enable high, enable low + -- inverters. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic Output signal of the inverter. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalINV ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + PROCEDURE VitalINVIF0 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap); + + PROCEDURE VitalINVIF1 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap); + + -- ------------------------------------------------------------------------ + -- + -- Sequential + -- Primitive + -- Function Name: VitalMUX, VitalMUX2, VitalMUX4, VitalMUX8 + -- + -- Description: The VitalMUX functions return the selected data bit + -- based on the value of dSelect. For MUX2, the function + -- returns data0 when dselect is 0 and returns data1 when + -- dselect is 1. When dselect is X, result is X for MUX2 + -- when data0 /= data1. X propagation is reduced when the + -- dselect signal is X and both data signals are identical. + -- When this is the case, the result returned is the value + -- of the data signals. + -- + -- For the N input device: + -- + -- N must equal 2**(bits of dSelect) + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_logic_vector Input signal for the N-bit, 4-bit and + -- 8-bit mux. + -- Data1,Data0 std_ulogic Input signals for the 2-bit mux. + -- dSelect std_ulogic Select signal for 2-bit mux + -- std_logic_vector2 Select signal for 4-bit mux + -- std_logic_vector3 Select signal for 8-bit mux + -- std_logic_vector Select signal for N-Bit mux + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping for + -- all muxes. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_ulogic The value of the selected bit is + -- returned. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalMUX ( + CONSTANT Data : IN std_logic_vector; + CONSTANT dSelect : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalMUX2 ( + CONSTANT Data1, Data0 : IN std_ulogic; + CONSTANT dSelect : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalMUX4 ( + CONSTANT Data : IN std_logic_vector4; + CONSTANT dSelect : IN std_logic_vector2; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + FUNCTION VitalMUX8 ( + CONSTANT Data : IN std_logic_vector8; + CONSTANT dSelect : IN std_logic_vector3; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: VitalMUX, VitalMUX2, VitalMUX4, VitalMUX8 + -- + -- Description: The VitalMUX concurrent primitive procedures calls + -- return in the output q the value of the selected data + -- bit based on the value of dsel. For the two bit mux, + -- the data returned is either d0 or d1, the data input. + -- For 4, 8 and N-bit functions, data is the input and is + -- of type std_logic_vector. For the 2-bit mux, if d0 or + -- d1 are X, the output is X only when d0 do not equal d1. + -- When d0 and d1 are equal, the return value is this value + -- to reduce X propagation. + -- + -- Propagation delay information is passed as a parameter + -- to the procedure call for delays from data to output and + -- select to output. For 2-bit muxes, the propagation + -- delays from data are provided for d0 and d1 to output. + -- + -- + -- Arguments: + -- + -- IN Type Description + -- d1,d0 std_ulogic Input signals for the 2-bit mux. + -- Data std_logic_vector4 Input signals for the 4-bit mux. + -- std_logic_vector8 Input signals for the 8-bit mux. + -- std_logic_vector Input signals for the N-bit mux. + -- dsel std_ulogic Select signal for the 2-bit mux. + -- std_logic_vector2 Select signals for the 4-bit mux. + -- std_logic_vector3 Select signals for the 8-bit mux. + -- std_logic_vector Select signals for the N-bit mux. + -- tpd_d1_q VitalDelayType01 Propagation delay from input d1 to + -- output q for 2-bit mux. + -- tpd_d0_q VitalDelayType01 Propagation delay from input d0 to + -- output q for 2-bit mux. + -- tpd_data_q VitalDelayArrayType01 Propagation delay from input data + -- to output q for 4-bit, 8-bit and + -- N-bit muxes. + -- tpd_dsel_q VitalDelayType01 Propagation delay from input dsel + -- to output q for 2-bit mux. + -- VitalDelayArrayType01 Propagation delay from input dsel + -- to output q for 4-bit, 8-bit and + -- N-bit muxes. + -- ResultMap VitalResultMapType The output signal strength result + -- map to modify default result + -- mapping for all muxes. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic The value of the selected signal. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalMUX ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + SIGNAL dSel : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalMUX2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL d1, d0 : IN std_ulogic; + SIGNAL dSel : IN std_ulogic; + CONSTANT tpd_d1_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d0_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_dsel_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalMUX4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector4; + SIGNAL dSel : IN std_logic_vector2; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalMUX8 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector8; + SIGNAL dSel : IN std_logic_vector3; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + -- ------------------------------------------------------------------------ + -- + -- Sequential + -- Primitive + -- Function Name: VitalDECODER, VitalDECODER2, VitalDECODER4, + -- VitalDECODER8 + -- + -- Description: The VitalDECODER functions are the sequential primitive + -- calls for decoder logic. The functions are provided + -- for N, 2, 4 and 8-bit outputs. + -- + -- The N-bit decoder is (2**(bits of data)) wide. + -- + -- The VitalDECODER returns 0 if enable is 0. + -- The VitalDECODER returns the result bit set to 1 if + -- enable is 1. All other bits of returned result are + -- set to 0. + -- + -- The returned array is in descending order: + -- (n-1 downto 0). + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_ulogic Input signal for 2-bit decoder. + -- std_logic_vector2 Input signals for 4-bit decoder. + -- std_logic_vector3 Input signals for 8-bit decoder. + -- std_logic_vector Input signals for N-bit decoder. + -- Enable std_ulogic Enable input signal. The result is + -- output when enable is high. + -- ResultMap VitalResultMapType The output signal strength result map + -- to modify default result mapping for + -- all output signals of the decoders. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- std_logic_vector2 The output of the 2-bit decoder. + -- std_logic_vector4 The output of the 4-bit decoder. + -- std_logic_vector8 The output of the 8-bit decoder. + -- std_logic_vector The output of the n-bit decoder. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalDECODER ( + CONSTANT Data : IN std_logic_vector; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector; + + FUNCTION VitalDECODER2 ( + CONSTANT Data : IN std_ulogic; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector2; + + FUNCTION VitalDECODER4 ( + CONSTANT Data : IN std_logic_vector2; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector4; + + FUNCTION VitalDECODER8 ( + CONSTANT Data : IN std_logic_vector3; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector8; + + -- ------------------------------------------------------------------------- + -- + -- Concurrent + -- Primitive + -- Procedure Name: VitalDECODER, VitalDECODER2, VitalDECODER4, + -- VitalDECODER8 + -- + -- Description: The VitalDECODER procedures are the concurrent primitive + -- procedure calls for decoder functions. The procedures + -- are provided for N, 2, 4 and 8 outputs. + -- + -- The N-bit decoder is (2**(bits of data)) wide. + -- + -- The procedural form of the decoder is used for + -- distributed delay modeling. The delay information for + -- each path is passed as an argument to the procedure. + -- + -- Result is set to 0 if enable is 0. + -- The result bit represented by data is set to 1 if + -- enable is 1. All other bits of result are set to 0. + -- + -- The result array is in descending order: (n-1 downto 0). + -- + -- For the N-bit decoder, the delay path is a vector of + -- delays from inputs to outputs. + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_ulogic Input signal for 2-bit decoder. + -- std_logic_vector2 Input signals for 4-bit decoder. + -- std_logic_vector3 Input signals for 8-bit decoder. + -- std_logic_vector Input signals for N-bit decoder. + -- enable std_ulogic Enable input signal. The result is + -- output when enable is high. + -- tpd_data_q VitalDelayType01 Propagation delay from input data + -- to output q for 2-bit decoder. + -- VitalDelayArrayType01 Propagation delay from input data + -- to output q for 4, 8 and n-bit + -- decoders. + -- tpd_enable_q VitalDelayType01 Propagation delay from input enable + -- to output q for 2, 4, 8 and n-bit + -- decoders. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_logic_vector2 Output signals for 2-bit decoder. + -- std_logic_vector4 Output signals for 4-bit decoder. + -- std_logic_vector8 Output signals for 8-bit decoder. + -- std_logic_vector Output signals for n-bit decoder. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalDECODER ( + SIGNAL q : OUT std_logic_vector; + SIGNAL Data : IN std_logic_vector; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + PROCEDURE VitalDECODER2 ( + SIGNAL q : OUT std_logic_vector2; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + PROCEDURE VitalDECODER4 ( + SIGNAL q : OUT std_logic_vector4; + SIGNAL Data : IN std_logic_vector2; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + PROCEDURE VitalDECODER8 ( + SIGNAL q : OUT std_logic_vector8; + SIGNAL Data : IN std_logic_vector3; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap ); + + -- ------------------------------------------------------------------------- + -- Function Name: VitalTruthTable + -- + -- Description: VitalTruthTable implements a truth table. Given + -- a set of inputs, a sequential search is performed + -- to match the input. If a match is found, the output + -- is set based on the contents of the CONSTANT TruthTable. + -- If there is no match, all X's are returned. There is + -- no limit to the size of the table. + -- + -- There is a procedure and function for VitalTruthTable. + -- For each of these, a single value output (std_logic) and + -- a multi-value output (std_logic_vector) are provided. + -- + -- The first dimension of the table is for number of + -- entries in the truth table and second dimension is for + -- the number of elements in a row. The number of inputs + -- in the row should be Data'LENGTH plus result'LENGTH. + -- + -- Elements is a row will be interpreted as + -- Input(NumInputs - 1),.., Input(0), + -- Result(NumOutputs - 1),.., Result(0) + -- + -- All inputs will be mapped to the X01 subtype + -- + -- If the value of Result is not in the range 'X' to 'Z' + -- then an error will be reported. Also, the Result is + -- always given either as a 0, 1, X or Z value. + -- + -- Arguments: + -- + -- IN Type Description + -- TruthTable The input constant which defines the + -- behavior in truth table form. + -- DataIn The inputs to the truth table used to + -- perform input match to select + -- output(s) to value(s) to drive. + -- + -- INOUT + -- none + -- + -- OUT + -- Result std_logic Concurrent procedure version scalar + -- output. + -- std_logic_vector Concurrent procedure version vector + -- output. + -- + -- Returns + -- Result std_logic Function version scalar output. + -- std_logic_vector Function version vector output. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalTruthTable ( + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ) RETURN std_logic_vector; + + FUNCTION VitalTruthTable ( + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ) RETURN std_logic; + + PROCEDURE VitalTruthTable ( + SIGNAL Result : OUT std_logic_vector; + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ); + PROCEDURE VitalTruthTable ( + SIGNAL Result : OUT std_logic; + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ); + -- ------------------------------------------------------------------------- + -- + -- Function Name: VitalStateTable + -- + -- Description: VitalStateTable is a non-concurrent implementation of a + -- state machine (Moore Machine). It is used to model + -- sequential devices and devices with internal states. + -- + -- The procedure takes the value of the state table + -- data set and performs a sequential search of the + -- CONSTANT StateTable until a match is found. Once a + -- match is found, the result of that match is applied + -- to Result. If there is no match, all X's are returned. + -- The resultant output becomes the input for the next + -- state. + -- + -- The first dimension of the table is the number of + -- entries in the state table and second dimension is the + -- number of elements in a row of the table. The number of + -- inputs in the row should be DataIn'LENGTH. Result should + -- contain the current state (which will become the next + -- state) as well as the outputs + -- + -- Elements is a row of the table will be interpreted as + -- Input(NumInputs-1),.., Input(0), State(NumStates-1), + -- ..., State(0),Output(NumOutputs-1),.., Output(0) + -- + -- where State(numStates-1) DOWNTO State(0) represent the + -- present state and Output(NumOutputs - 1) DOWNTO + -- Outputs(NumOutputs - NumStates) represent the new + -- values of the state variables (i.e. the next state). + -- Also, Output(NumOutputs - NumStates - 1) + -- + -- This procedure returns the next state and the new + -- outputs when a match is made between the present state + -- and present inputs and the state table. A search is + -- made starting at the top of the state table and + -- terminates with the first match. If no match is found + -- then the next state and new outputs are set to all 'X's. + -- + -- (Asynchronous inputs (i.e. resets and clears) must be + -- handled by placing the corresponding entries at the top + -- of the table. ) + -- + -- All inputs will be mapped to the X01 subtype. + -- + -- NOTE: Edge transitions should not be used as values + -- for the state variables in the present state + -- portion of the state table. The only valid + -- values that can be used for the present state + -- portion of the state table are: + -- 'X', '0', '1', 'B', '-' + -- + -- Arguments: + -- + -- IN Type Description + -- StateTable VitalStateTableType The input constant which defines + -- the behavior in state table form. + -- DataIn std_logic_vector The current state inputs to the + -- state table used to perform input + -- matches and transition + -- calculations. + -- NumStates NATURAL Number of state variables + -- + -- INOUT + -- Result std_logic Output signal for scalar version of + -- the concurrent procedure call. + -- std_logic_vector Output signals for vector version + -- of the concurrent procedure call. + -- PreviousDataIn std_logic_vector The previous inputs and states used + -- in transition calculations and to + -- set outputs for steady state cases. + -- + -- OUT + -- none + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalStateTable ( + VARIABLE Result : INOUT std_logic_vector; + VARIABLE PreviousDataIn : INOUT std_logic_vector; + CONSTANT StateTable : IN VitalStateTableType; + CONSTANT DataIn : IN std_logic_vector; + CONSTANT NumStates : IN NATURAL + ); + + PROCEDURE VitalStateTable ( + VARIABLE Result : INOUT std_logic; + VARIABLE PreviousDataIn : INOUT std_logic_vector; + CONSTANT StateTable : IN VitalStateTableType; + CONSTANT DataIn : IN std_logic_vector + ); + + PROCEDURE VitalStateTable ( + SIGNAL Result : INOUT std_logic_vector; + CONSTANT StateTable : IN VitalStateTableType; + SIGNAL DataIn : IN std_logic_vector; + CONSTANT NumStates : IN NATURAL + ); + + PROCEDURE VitalStateTable ( + SIGNAL Result : INOUT std_logic; + CONSTANT StateTable : IN VitalStateTableType; + SIGNAL DataIn : IN std_logic_vector + ); + + -- ------------------------------------------------------------------------- + -- + -- Function Name: VitalResolve + -- + -- Description: VitalResolve takes a vector of signals and resolves + -- them to a std_ulogic value. This procedure can be used + -- to resolve multiple drivers in a single model. + -- + -- Arguments: + -- + -- IN Type Description + -- Data std_logic_vector Set of input signals which drive a + -- common signal. + -- + -- INOUT + -- none + -- + -- OUT + -- q std_ulogic Output signal which is the resolved + -- value being driven by the collection of + -- input signals. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalResolve ( + SIGNAL q : OUT std_ulogic; + CONSTANT Data : IN std_logic_vector); + +END VITAL_Primitives; diff --git a/libraries/vital95/vital_primitives_body.vhdl b/libraries/vital95/vital_primitives_body.vhdl new file mode 100644 index 000000000..25e834189 --- /dev/null +++ b/libraries/vital95/vital_primitives_body.vhdl @@ -0,0 +1,5614 @@ +------------------------------------------------------------------------------- +-- Title : Standard VITAL_Primitives Package +-- : $Revision: 597 $ +-- : +-- Library : VITAL +-- : +-- Developers : IEEE DASC Timing Working Group (TWG), PAR 1076.4 +-- : +-- Purpose : This packages defines standard types, constants, functions +-- : and procedures for use in developing ASIC models. +-- : Specifically a set of logic primitives are defined. +-- : +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Modification History : +-- ---------------------------------------------------------------------------- +-- Version No:|Auth:| Mod.Date:| Changes Made: +-- v95.0 A | | 06/02/95 | Initial ballot draft 1995 +-- v95.1 | | 08/31/95 | #204 - glitch detection prior to OutputMap +-- ---------------------------------------------------------------------------- + +LIBRARY STD; +USE STD.TEXTIO.ALL; + +PACKAGE BODY VITAL_Primitives IS + -- ------------------------------------------------------------------------ + -- Default values for Primitives + -- ------------------------------------------------------------------------ + -- default values for delay parameters + CONSTANT VitalDefDelay01 : VitalDelayType01 := VitalZeroDelay01; + CONSTANT VitalDefDelay01Z : VitalDelayType01Z := VitalZeroDelay01Z; + + TYPE VitalTimeArray IS ARRAY (NATURAL RANGE <>) OF TIME; + + -- default primitive model operation parameters + -- Glitch detection/reporting + TYPE VitalGlitchModeType IS ( MessagePlusX, MessageOnly, XOnly, NoGlitch); + CONSTANT PrimGlitchMode : VitalGlitchModeType := XOnly; + + -- ------------------------------------------------------------------------ + -- Local Type and Subtype Declarations + -- ------------------------------------------------------------------------ + --------------------------------------------------------------------------- + -- enumeration value representing the transition or level of the signal. + -- See function 'GetEdge' + --------------------------------------------------------------------------- + TYPE EdgeType IS ( 'U', -- Uninitialized level + 'X', -- Unknown level + '0', -- low level + '1', -- high level + '\', -- 1 to 0 falling edge + '/', -- 0 to 1 rising edge + 'F', -- * to 0 falling edge + 'R', -- * to 1 rising edge + 'f', -- rising to X edge + 'r', -- falling to X edge + 'x', -- Unknown edge (ie U->X) + 'V' -- Timing violation edge + ); + TYPE EdgeArray IS ARRAY ( NATURAL RANGE <> ) OF EdgeType; + + TYPE EdgeX1Table IS ARRAY ( EdgeType ) OF EdgeType; + TYPE EdgeX2Table IS ARRAY ( EdgeType, EdgeType ) OF EdgeType; + TYPE EdgeX3Table IS ARRAY ( EdgeType, EdgeType, EdgeType ) OF EdgeType; + TYPE EdgeX4Table IS ARRAY (EdgeType,EdgeType,EdgeType,EdgeType) OF EdgeType; + + TYPE LogicToEdgeT IS ARRAY(std_ulogic, std_ulogic) OF EdgeType; + TYPE LogicToLevelT IS ARRAY(std_ulogic ) OF EdgeType; + + TYPE GlitchDataType IS + RECORD + SchedTime : TIME; + GlitchTime : TIME; + SchedValue : std_ulogic; + CurrentValue : std_ulogic; + END RECORD; + TYPE GlitchDataArrayType IS ARRAY (NATURAL RANGE <>) + OF GlitchDataType; + + -- Enumerated type used in selection of output path delays + TYPE SchedType IS + RECORD + inp0 : TIME; -- time (abs) of output change due to input change to 0 + inp1 : TIME; -- time (abs) of output change due to input change to 1 + InpX : TIME; -- time (abs) of output change due to input change to X + Glch0 : TIME; -- time (abs) of output glitch due to input change to 0 + Glch1 : TIME; -- time (abs) of output glitch due to input change to 0 + END RECORD; + + TYPE SchedArray IS ARRAY ( NATURAL RANGE <> ) OF SchedType; + CONSTANT DefSchedType : SchedType := (TIME'HIGH, TIME'HIGH, 0 ns,0 ns,0 ns); + CONSTANT DefSchedAnd : SchedType := (TIME'HIGH, 0 ns,0 ns, TIME'HIGH,0 ns); + + -- Constrained array declarations (common sizes used by primitives) + SUBTYPE SchedArray2 IS SchedArray(1 DOWNTO 0); + SUBTYPE SchedArray3 IS SchedArray(2 DOWNTO 0); + SUBTYPE SchedArray4 IS SchedArray(3 DOWNTO 0); + SUBTYPE SchedArray8 IS SchedArray(7 DOWNTO 0); + + SUBTYPE TimeArray2 IS VitalTimeArray(1 DOWNTO 0); + SUBTYPE TimeArray3 IS VitalTimeArray(2 DOWNTO 0); + SUBTYPE TimeArray4 IS VitalTimeArray(3 DOWNTO 0); + SUBTYPE TimeArray8 IS VitalTimeArray(7 DOWNTO 0); + + SUBTYPE GlitchArray2 IS GlitchDataArrayType(1 DOWNTO 0); + SUBTYPE GlitchArray3 IS GlitchDataArrayType(2 DOWNTO 0); + SUBTYPE GlitchArray4 IS GlitchDataArrayType(3 DOWNTO 0); + SUBTYPE GlitchArray8 IS GlitchDataArrayType(7 DOWNTO 0); + + SUBTYPE EdgeArray2 IS EdgeArray(1 DOWNTO 0); + SUBTYPE EdgeArray3 IS EdgeArray(2 DOWNTO 0); + SUBTYPE EdgeArray4 IS EdgeArray(3 DOWNTO 0); + SUBTYPE EdgeArray8 IS EdgeArray(7 DOWNTO 0); + + CONSTANT DefSchedArray2 : SchedArray2 := + (OTHERS=> (0 ns, 0 ns, 0 ns, 0 ns, 0 ns)); + + TYPE stdlogic_table IS ARRAY(std_ulogic, std_ulogic) OF std_ulogic; + + CONSTANT InitialEdge : LogicToLevelT := ( + '1'|'H' => 'R', + '0'|'L' => 'F', + OTHERS => 'x' + ); + + CONSTANT LogicToEdge : LogicToEdgeT := ( -- previous, current + -- old \ new: U X 0 1 Z W L H - + 'U' => ( 'U', 'x', 'F', 'R', 'x', 'x', 'F', 'R', 'x' ), + 'X' => ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' ), + '0' => ( 'r', 'r', '0', '/', 'r', 'r', '0', '/', 'r' ), + '1' => ( 'f', 'f', '\', '1', 'f', 'f', '\', '1', 'f' ), + 'Z' => ( 'x', 'X', 'F', 'R', 'X', 'x', 'F', 'R', 'x' ), + 'W' => ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' ), + 'L' => ( 'r', 'r', '0', '/', 'r', 'r', '0', '/', 'r' ), + 'H' => ( 'f', 'f', '\', '1', 'f', 'f', '\', '1', 'f' ), + '-' => ( 'x', 'X', 'F', 'R', 'x', 'X', 'F', 'R', 'X' ) + ); + CONSTANT LogicToLevel : LogicToLevelT := ( + '1'|'H' => '1', + '0'|'L' => '0', + 'U' => 'U', + OTHERS => 'X' + ); + + -- ----------------------------------- + -- 3-state logic tables + -- ----------------------------------- + CONSTANT BufIf0_Table : stdlogic_table := + -- enable data value + ( '1'|'H' => ( OTHERS => 'Z' ), + '0'|'L' => ( '1'|'H' => '1', + '0'|'L' => '0', + 'U' => 'U', + OTHERS => 'X' ), + 'U' => ( OTHERS => 'U' ), + OTHERS => ( OTHERS => 'X' ) ); + CONSTANT BufIf1_Table : stdlogic_table := + -- enable data value + ( '0'|'L' => ( OTHERS => 'Z' ), + '1'|'H' => ( '1'|'H' => '1', + '0'|'L' => '0', + 'U' => 'U', + OTHERS => 'X' ), + 'U' => ( OTHERS => 'U' ), + OTHERS => ( OTHERS => 'X' ) ); + CONSTANT InvIf0_Table : stdlogic_table := + -- enable data value + ( '1'|'H' => ( OTHERS => 'Z' ), + '0'|'L' => ( '1'|'H' => '0', + '0'|'L' => '1', + 'U' => 'U', + OTHERS => 'X' ), + 'U' => ( OTHERS => 'U' ), + OTHERS => ( OTHERS => 'X' ) ); + CONSTANT InvIf1_Table : stdlogic_table := + -- enable data value + ( '0'|'L' => ( OTHERS => 'Z' ), + '1'|'H' => ( '1'|'H' => '0', + '0'|'L' => '1', + 'U' => 'U', + OTHERS => 'X' ), + 'U' => ( OTHERS => 'U' ), + OTHERS => ( OTHERS => 'X' ) ); + + + TYPE To_StateCharType IS ARRAY (VitalStateSymbolType) OF CHARACTER; + CONSTANT To_StateChar : To_StateCharType := + ( '/', '\', 'P', 'N', 'r', 'f', 'p', 'n', 'R', 'F', '^', 'v', + 'E', 'A', 'D', '*', 'X', '0', '1', '-', 'B', 'Z', 'S' ); + TYPE To_TruthCharType IS ARRAY (VitalTruthSymbolType) OF CHARACTER; + CONSTANT To_TruthChar : To_TruthCharType := + ( 'X', '0', '1', '-', 'B', 'Z' ); + + TYPE TruthTableOutMapType IS ARRAY (VitalTruthSymbolType) OF std_ulogic; + CONSTANT TruthTableOutMap : TruthTableOutMapType := + -- 'X', '0', '1', '-', 'B', 'Z' + ( 'X', '0', '1', 'X', '-', 'Z' ); + + TYPE StateTableOutMapType IS ARRAY (VitalStateSymbolType) OF std_ulogic; + -- does conversion to X01Z or '-' if invalid + CONSTANT StateTableOutMap : StateTableOutMapType := + -- '/' '\' 'P' 'N' 'r' 'f' 'p' 'n' 'R' 'F' '^' 'v' + -- 'E' 'A' 'D' '*' 'X' '0' '1' '-' 'B' 'Z' 'S' + ( '-','-','-','-','-','-','-','-','-','-','-','-', + '-','-','-','-','X','0','1','X','-','Z','W'); + + -- ------------------------------------------------------------------------ + TYPE ValidTruthTableInputType IS ARRAY (VitalTruthSymbolType) OF BOOLEAN; + -- checks if a symbol IS valid for the stimulus portion of a truth table + CONSTANT ValidTruthTableInput : ValidTruthTableInputType := + -- 'X' '0' '1' '-' 'B' 'Z' + ( TRUE, TRUE, TRUE, TRUE, TRUE, FALSE ); + + TYPE TruthTableMatchType IS ARRAY (X01, VitalTruthSymbolType) OF BOOLEAN; + -- checks if an input matches th corresponding truth table symbol + -- use: TruthTableMatch(input_converted_to_X01, truth_table_stimulus_symbol) + CONSTANT TruthTableMatch : TruthTableMatchType := ( + -- X, 0, 1, - B Z + ( TRUE, FALSE, FALSE, TRUE, FALSE, FALSE ), -- X + ( FALSE, TRUE, FALSE, TRUE, TRUE, FALSE ), -- 0 + ( FALSE, FALSE, TRUE, TRUE, TRUE, FALSE ) -- 1 + ); + + -- ------------------------------------------------------------------------ + TYPE ValidStateTableInputType IS ARRAY (VitalStateSymbolType) OF BOOLEAN; + CONSTANT ValidStateTableInput : ValidStateTableInputType := + -- '/', '\', 'P', 'N', 'r', 'f', + ( TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, + -- 'p', 'n', 'R', 'F', '^', 'v', + TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, + -- 'E', 'A', 'D', '*', + TRUE, TRUE, TRUE, TRUE, + -- 'X', '0', '1', '-', 'B', 'Z', + TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, + -- 'S' + TRUE ); + + CONSTANT ValidStateTableState : ValidStateTableInputType := + -- '/', '\', 'P', 'N', 'r', 'f', + ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + -- 'p', 'n', 'R', 'F', '^', 'v', + FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + -- 'E', 'A', 'D', '*', + FALSE, FALSE, FALSE, FALSE, + -- 'X', '0', '1', '-', 'B', 'Z', + TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, + -- 'S' + FALSE ); + + TYPE StateTableMatchType IS ARRAY (X01,X01,VitalStateSymbolType) OF BOOLEAN; + -- last value, present value, table symbol + CONSTANT StateTableMatch : StateTableMatchType := ( + ( -- X (lastvalue) + -- / \ P N r f + -- p n R F ^ v + -- E A D * + -- X 0 1 - B Z S + (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE, + TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE), + (FALSE,FALSE,FALSE,TRUE, FALSE,FALSE, + FALSE,FALSE,FALSE,TRUE, FALSE,TRUE, + TRUE, FALSE,TRUE, TRUE, + FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE), + (FALSE,FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,FALSE,TRUE, FALSE,TRUE, FALSE, + TRUE, TRUE, FALSE,TRUE, + FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE) + ), + + (-- 0 (lastvalue) + -- / \ P N r f + -- p n R F ^ v + -- E A D * + -- X 0 1 - B Z S + (FALSE,FALSE,FALSE,FALSE,TRUE, FALSE, + TRUE, FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,TRUE, FALSE,TRUE, + TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE), + (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE, + FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,TRUE ), + (TRUE, FALSE,TRUE, FALSE,FALSE,FALSE, + TRUE, FALSE,TRUE, FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,TRUE, + FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,FALSE) + ), + + (-- 1 (lastvalue) + -- / \ P N r f + -- p n R F ^ v + -- E A D * + -- X 0 1 - B Z S + (FALSE,FALSE,FALSE,FALSE,FALSE,TRUE , + FALSE,TRUE, FALSE,TRUE, FALSE,FALSE, + FALSE,FALSE,TRUE, TRUE, + TRUE, FALSE,FALSE,TRUE, FALSE,FALSE,FALSE), + (FALSE,TRUE, FALSE,TRUE, FALSE,FALSE, + FALSE,TRUE, FALSE,TRUE, FALSE,FALSE, + FALSE,FALSE,FALSE,TRUE, + FALSE,TRUE, FALSE,TRUE, TRUE, FALSE,FALSE), + (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,FALSE,FALSE, + FALSE,FALSE,TRUE, TRUE, TRUE, FALSE,TRUE ) + ) + ); + + TYPE Logic_UX01Z_Table IS ARRAY (std_ulogic) OF UX01Z; + ---------------------------------------------------------- + -- table name : cvt_to_x01z + -- parameters : std_ulogic -- some logic value + -- returns : UX01Z -- state value of logic value + -- purpose : to convert state-strength to state only + ---------------------------------------------------------- + CONSTANT cvt_to_ux01z : Logic_UX01Z_Table := + ('U','X','0','1','Z','X','0','1','X' ); + + TYPE LogicCvtTableType IS ARRAY (std_ulogic) OF CHARACTER; + CONSTANT LogicCvtTable : LogicCvtTableType + := ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-'); + + -------------------------------------------------------------------- + -- LOCAL Utilities + -------------------------------------------------------------------- + -- ------------------------------------------------------------------------ + -- FUNCTION NAME : MINIMUM + -- + -- PARAMETERS : in1, in2 - integer, time + -- + -- DESCRIPTION : return smaller of in1 and in2 + -- ------------------------------------------------------------------------ + FUNCTION Minimum ( + CONSTANT in1, in2 : INTEGER + ) RETURN INTEGER IS + BEGIN + IF (in1 < in2) THEN + RETURN in1; + END IF; + RETURN in2; + END; + -- ------------------------------------------------------------------------ + FUNCTION Minimum ( + CONSTANT t1,t2 : IN TIME + ) RETURN TIME IS + BEGIN + IF ( t1 < t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF; + END Minimum; + + -- ------------------------------------------------------------------------ + -- FUNCTION NAME : MAXIMUM + -- + -- PARAMETERS : in1, in2 - integer, time + -- + -- DESCRIPTION : return larger of in1 and in2 + -- ------------------------------------------------------------------------ + FUNCTION Maximum ( + CONSTANT in1, in2 : INTEGER + ) RETURN INTEGER IS + BEGIN + IF (in1 > in2) THEN + RETURN in1; + END IF; + RETURN in2; + END; + ----------------------------------------------------------------------- + FUNCTION Maximum ( + CONSTANT t1,t2 : IN TIME + ) RETURN TIME IS + BEGIN + IF ( t1 > t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF; + END Maximum; + + ----------------------------------------------------------------------- + FUNCTION GlitchMinTime ( + CONSTANT Time1, Time2 : IN TIME + ) RETURN TIME IS + BEGIN + IF ( Time1 >= NOW ) THEN + IF ( Time2 >= NOW ) THEN + RETURN Minimum ( Time1, Time2); + ELSE + RETURN Time1; + END IF; + ELSE + IF ( Time2 >= NOW ) THEN + RETURN Time2; + ELSE + RETURN 0 ns; + END IF; + END IF; + END; + + -------------------------------------------------------------------- + -- Error Message Types and Tables + -------------------------------------------------------------------- + TYPE VitalErrorType IS ( + ErrNegDel, + ErrInpSym, + ErrOutSym, + ErrStaSym, + ErrVctLng, + ErrTabWidSml, + ErrTabWidLrg, + ErrTabResSml, + ErrTabResLrg + ); + + TYPE VitalErrorSeverityType IS ARRAY (VitalErrorType) OF SEVERITY_LEVEL; + CONSTANT VitalErrorSeverity : VitalErrorSeverityType := ( + ErrNegDel => WARNING, + ErrInpSym => ERROR, + ErrOutSym => ERROR, + ErrStaSym => ERROR, + ErrVctLng => ERROR, + ErrTabWidSml => ERROR, + ErrTabWidLrg => WARNING, + ErrTabResSml => WARNING, + ErrTabResLrg => WARNING + ); + + CONSTANT MsgNegDel : STRING := + "Negative delay. New output value not scheduled. Output signal is: "; + CONSTANT MsgInpSym : STRING := + "Illegal symbol in the input portion of a Truth/State table."; + CONSTANT MsgOutSym : STRING := + "Illegal symbol in the output portion of a Truth/State table."; + CONSTANT MsgStaSym : STRING := + "Illegal symbol in the state portion of a State table."; + CONSTANT MsgVctLng : STRING := + "Vector (array) lengths not equal. "; + CONSTANT MsgTabWidSml : STRING := + "Width of the Truth/State table is too small."; + CONSTANT MsgTabWidLrg : STRING := + "Width of Truth/State table is too large. Extra elements are ignored."; + CONSTANT MsgTabResSml : STRING := + "Result of Truth/State table has too many elements."; + CONSTANT MsgTabResLrg : STRING := + "Result of Truth/State table has too few elements."; + + CONSTANT MsgUnknown : STRING := + "Unknown error message."; + + -------------------------------------------------------------------- + -- LOCAL Utilities + -------------------------------------------------------------------- + FUNCTION VitalMessage ( + CONSTANT ErrorId : IN VitalErrorType + ) RETURN STRING IS + BEGIN + CASE ErrorId IS + WHEN ErrNegDel => RETURN MsgNegDel; + WHEN ErrInpSym => RETURN MsgInpSym; + WHEN ErrOutSym => RETURN MsgOutSym; + WHEN ErrStaSym => RETURN MsgStaSym; + WHEN ErrVctLng => RETURN MsgVctLng; + WHEN ErrTabWidSml => RETURN MsgTabWidSml; + WHEN ErrTabWidLrg => RETURN MsgTabWidLrg; + WHEN ErrTabResSml => RETURN MsgTabResSml; + WHEN ErrTabResLrg => RETURN MsgTabResLrg; + WHEN OTHERS => RETURN MsgUnknown; + END CASE; + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) + SEVERITY VitalErrorSeverity(ErrorId); + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType; + CONSTANT Info : IN STRING + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) & Info + SEVERITY VitalErrorSeverity(ErrorId); + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType; + CONSTANT Info : IN CHARACTER + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) & Info + SEVERITY VitalErrorSeverity(ErrorId); + END; + + --------------------------------------------------------------------------- + PROCEDURE ReportGlitch ( + CONSTANT GlitchRoutine : IN STRING; + CONSTANT OutSignalName : IN STRING; + CONSTANT PreemptedTime : IN TIME; + CONSTANT PreemptedValue : IN std_ulogic; + CONSTANT NewTime : IN TIME; + CONSTANT NewValue : IN std_ulogic; + CONSTANT Index : IN INTEGER := 0; + CONSTANT IsArraySignal : IN BOOLEAN := FALSE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + VARIABLE StrPtr1, StrPtr2, StrPtr3, StrPtr4, StrPtr5 : LINE; + BEGIN + + Write (StrPtr1, PreemptedTime ); + Write (StrPtr2, NewTime); + Write (StrPtr3, LogicCvtTable(PreemptedValue)); + Write (StrPtr4, LogicCvtTable(NewValue)); + IF IsArraySignal THEN + Write (StrPtr5, STRING'( "(" ) ); + Write (StrPtr5, Index); + Write (StrPtr5, STRING'( ")" ) ); + ELSE + Write (StrPtr5, STRING'( " " ) ); + END IF; + + -- Issue Report only if Preemted value has not been + -- removed from event queue + ASSERT PreemptedTime > NewTime + REPORT GlitchRoutine & ": GLITCH Detected on port " & + OutSignalName & StrPtr5.ALL & + "; Preempted Future Value := " & StrPtr3.ALL & + " @ " & StrPtr1.ALL & + "; Newly Scheduled Value := " & StrPtr4.ALL & + " @ " & StrPtr2.ALL & + ";" + SEVERITY MsgSeverity; + + DEALLOCATE(StrPtr1); + DEALLOCATE(StrPtr2); + DEALLOCATE(StrPtr3); + DEALLOCATE(StrPtr4); + DEALLOCATE(StrPtr5); + RETURN; + END ReportGlitch; + + --------------------------------------------------------------------------- + -- Procedure : VitalGlitchOnEvent + -- : + -- Parameters : OutSignal ........ signal being driven + -- : OutSignalName..... name of the driven signal + -- : GlitchData........ internal data required by the procedure + -- : NewValue.......... new value being assigned + -- : NewDelay.......... Delay accompanying the assignment + -- : (Note: for vectors, this is an array) + -- : GlitchMode........ Glitch generation mode + -- : MessagePlusX, MessageOnly, + -- : XOnly, NoGlitch ) + -- : GlitchDelay....... if <= 0 ns , then there will be no Glitch + -- : if > NewDelay, then there is no Glitch, + -- : otherwise, this is the time when a FORCED + -- : generation of a glitch will occur. + ---------------------------------------------------------------------------- + PROCEDURE VitalGlitchOnEvent ( + SIGNAL OutSignal : OUT std_logic; + CONSTANT OutSignalName : IN STRING; + VARIABLE GlitchData : INOUT GlitchDataType; + CONSTANT NewValue : IN std_logic; + CONSTANT NewDelay : IN TIME := 0 ns; + CONSTANT GlitchMode : IN VitalGlitchModeType := MessagePlusX; + CONSTANT GlitchDelay : IN TIME := 0 ns; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + -- ------------------------------------------------------------------------ + VARIABLE NoGlitchDet : BOOLEAN := FALSE; + VARIABLE OldGlitch : BOOLEAN := FALSE; + VARIABLE Dly : TIME := NewDelay; + + BEGIN + -- If nothing to schedule, just return + IF NewDelay < 0 ns THEN + IF (NewValue /= GlitchData.SchedValue) THEN + VitalError ( "VitalGlitchOnEvent", ErrNegDel, OutSignalName ); + END IF; + + ELSE + -- If nothing currently scheduled + IF GlitchData.SchedTime <= NOW THEN + GlitchData.CurrentValue := GlitchData.SchedValue; + IF (GlitchDelay <= 0 ns) THEN + IF (NewValue = GlitchData.SchedValue) THEN RETURN; END IF; + NoGlitchDet := TRUE; + END IF; + + -- Transaction currently scheduled - if glitch already happened + ELSIF GlitchData.GlitchTime <= NOW THEN + GlitchData.CurrentValue := 'X'; + OldGlitch := TRUE; + IF (GlitchData.SchedValue = NewValue) THEN + dly := Minimum( GlitchData.SchedTime-NOW, NewDelay ); + END IF; + + -- Transaction currently scheduled (no glitch if same value) + ELSIF (GlitchData.SchedValue = NewValue) AND + (GlitchData.SchedTime = GlitchData.GlitchTime) AND + (GlitchDelay <= 0 ns) THEN + NoGlitchDet := TRUE; + Dly := Minimum( GlitchData.SchedTime-NOW, NewDelay ); + + END IF; + + GlitchData.SchedTime := NOW+Dly; + IF OldGlitch THEN + OutSignal <= NewValue AFTER Dly; + + ELSIF NoGlitchDet THEN + GlitchData.GlitchTime := NOW+Dly; + OutSignal <= NewValue AFTER Dly; + + ELSE -- new glitch + GlitchData.GlitchTime := GlitchMinTime ( GlitchData.GlitchTime, + NOW+GlitchDelay ); + + IF (GlitchMode = MessagePlusX) OR + (GlitchMode = MessageOnly) THEN + ReportGlitch ( "VitalGlitchOnEvent", OutSignalName, + GlitchData.GlitchTime, GlitchData.SchedValue, + (Dly + NOW), NewValue, + MsgSeverity=>MsgSeverity ); + END IF; + + IF (GlitchMode = MessagePlusX) OR (GlitchMode = XOnly) THEN + OutSignal <= 'X' AFTER GlitchData.GlitchTime-NOW; + OutSignal <= TRANSPORT NewValue AFTER Dly; + ELSE + OutSignal <= NewValue AFTER Dly; + END IF; + END IF; + + GlitchData.SchedValue := NewValue; + END IF; + + RETURN; + END; + + ---------------------------------------------------------------------------- + PROCEDURE VitalGlitchOnEvent ( + SIGNAL OutSignal : OUT std_logic_vector; + CONSTANT OutSignalName : IN STRING; + VARIABLE GlitchData : INOUT GlitchDataArrayType; + CONSTANT NewValue : IN std_logic_vector; + CONSTANT NewDelay : IN VitalTimeArray; + CONSTANT GlitchMode : IN VitalGlitchModeType := MessagePlusX; + CONSTANT GlitchDelay : IN VitalTimeArray; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + ALIAS GlDataAlias : GlitchDataArrayType(1 TO GlitchData'LENGTH) + IS GlitchData; + ALIAS NewValAlias : std_logic_vector(1 TO NewValue'LENGTH) IS NewValue; + ALIAS GlDelayAlias : VitalTimeArray(1 TO GlitchDelay'LENGTH) + IS GlitchDelay; + ALIAS NewDelAlias : VitalTimeArray(1 TO NewDelay'LENGTH) IS NewDelay; + + VARIABLE Index : INTEGER := OutSignal'LEFT; + VARIABLE Direction : INTEGER; + VARIABLE NoGlitchDet : BOOLEAN; + VARIABLE OldGlitch : BOOLEAN; + VARIABLE Dly, GlDly : TIME; + + BEGIN + IF (OutSignal'LEFT > OutSignal'RIGHT) THEN + Direction := -1; + ELSE + Direction := 1; + END IF; + + IF ( (OutSignal'LENGTH /= GlitchData'LENGTH) OR + (OutSignal'LENGTH /= NewValue'LENGTH) OR + (OutSignal'LENGTH /= NewDelay'LENGTH) OR + (OutSignal'LENGTH /= GlitchDelay'LENGTH) ) THEN + VitalError ( "VitalGlitchOnEvent", ErrVctLng, OutSignalName ); + RETURN; + END IF; + + -- a call to the scalar function cannot be made since the actual + -- name associated with a signal parameter must be locally static + FOR n IN 1 TO OutSignal'LENGTH LOOP + + NoGlitchDet := FALSE; + OldGlitch := FALSE; + Dly := NewDelAlias(n); + + -- If nothing to schedule, just skip to next loop iteration + IF NewDelAlias(n) < 0 ns THEN + IF (NewValAlias(n) /= GlDataAlias(n).SchedValue) THEN + VitalError ( "VitalGlitchOnEvent", ErrNegDel, OutSignalName ); + END IF; + ELSE + -- If nothing currently scheduled (i.e. last scheduled + -- transaction already occurred) + IF GlDataAlias(n).SchedTime <= NOW THEN + GlDataAlias(n).CurrentValue := GlDataAlias(n).SchedValue; + IF (GlDelayAlias(n) <= 0 ns) THEN + -- Next iteration if no change in value + IF (NewValAlias(n) = GlDataAlias(n).SchedValue) THEN + Index := Index + Direction; + NEXT; + END IF; + -- since last transaction already occurred there is no glitch + NoGlitchDet := TRUE; + END IF; + + -- Transaction currently scheduled - if glitch already happened + ELSIF GlDataAlias(n).GlitchTime <= NOW THEN + GlDataAlias(n).CurrentValue := 'X'; + OldGlitch := TRUE; + IF (GlDataAlias(n).SchedValue = NewValAlias(n)) THEN + dly := Minimum( GlDataAlias(n).SchedTime-NOW, + NewDelAlias(n) ); + END IF; + + -- Transaction currently scheduled + ELSIF (GlDataAlias(n).SchedValue = NewValAlias(n)) AND + (GlDataAlias(n).SchedTime = GlDataAlias(n).GlitchTime) AND + (GlDelayAlias(n) <= 0 ns) THEN + NoGlitchDet := TRUE; + Dly := Minimum( GlDataAlias(n).SchedTime-NOW, + NewDelAlias(n) ); + END IF; + + -- update last scheduled transaction + GlDataAlias(n).SchedTime := NOW+Dly; + + IF OldGlitch THEN + OutSignal(Index) <= NewValAlias(n) AFTER Dly; + ELSIF NoGlitchDet THEN + -- if no glitch then update last glitch time + -- and OutSignal(actual_index) + GlDataAlias(n).GlitchTime := NOW+Dly; + OutSignal(Index) <= NewValAlias(n) AFTER Dly; + ELSE -- new glitch + GlDataAlias(n).GlitchTime := GlitchMinTime ( + GlDataAlias(n).GlitchTime, + NOW+GlDelayAlias(n) ); + + IF (GlitchMode = MessagePlusX) OR + (GlitchMode = MessageOnly) THEN + ReportGlitch ( "VitalGlitchOnEvent", OutSignalName, + GlDataAlias(n).GlitchTime, + GlDataAlias(n).SchedValue, + (Dly + NOW), NewValAlias(n), + Index, TRUE, MsgSeverity ); + END IF; + + IF (GlitchMode = MessagePlusX) OR (GlitchMode = XOnly) THEN + GlDly := GlDataAlias(n).GlitchTime - NOW; + OutSignal(Index) <= 'X' AFTER GlDly; + OutSignal(Index) <= TRANSPORT NewValAlias(n) AFTER Dly; + ELSE + OutSignal(Index) <= NewValAlias(n) AFTER Dly; + END IF; + + END IF; -- glitch / no-glitch + GlDataAlias(n).SchedValue := NewValAlias(n); + + END IF; -- NewDelAlias(n) < 0 ns + Index := Index + Direction; + END LOOP; + + RETURN; + END; + + --------------------------------------------------------------------------- + -- ------------------------------------------------------------------------ + -- PROCEDURE NAME : TruthOutputX01Z + -- + -- PARAMETERS : table_out - output of table + -- X01Zout - output converted to X01Z + -- err - true if illegal character is encountered + -- + -- + -- DESCRIPTION : converts the output of a truth table to a valid + -- std_ulogic + -- ------------------------------------------------------------------------ + PROCEDURE TruthOutputX01Z ( + CONSTANT TableOut : IN VitalTruthSymbolType; + VARIABLE X01Zout : OUT std_ulogic; + VARIABLE Err : OUT BOOLEAN + ) IS + VARIABLE TempOut : std_ulogic; + BEGIN + Err := FALSE; + TempOut := TruthTableOutMap(TableOut); + IF (TempOut = '-') THEN + Err := TRUE; + TempOut := 'X'; + VitalError ( "VitalTruthTable", ErrOutSym, To_TruthChar(TableOut)); + END IF; + X01Zout := TempOut; + END; + + -- ------------------------------------------------------------------------ + -- PROCEDURE NAME : StateOutputX01Z + -- + -- PARAMETERS : table_out - output of table + -- prev_out - previous output value + -- X01Zout - output cojnverted to X01Z + -- err - true if illegal character is encountered + -- + -- DESCRIPTION : converts the output of a state table to a + -- valid std_ulogic + -- ------------------------------------------------------------------------ + PROCEDURE StateOutputX01Z ( + CONSTANT TableOut : IN VitalStateSymbolType; + CONSTANT PrevOut : IN std_ulogic; + VARIABLE X01Zout : OUT std_ulogic; + VARIABLE Err : OUT BOOLEAN + ) IS + VARIABLE TempOut : std_ulogic; + BEGIN + Err := FALSE; + TempOut := StateTableOutMap(TableOut); + IF (TempOut = '-') THEN + Err := TRUE; + TempOut := 'X'; + VitalError ( "VitalStateTable", ErrOutSym, To_StateChar(TableOut)); + ELSIF (TempOut = 'W') THEN + TempOut := To_X01Z(PrevOut); + END IF; + X01Zout := TempOut; + END; + + -- ------------------------------------------------------------------------ + -- PROCEDURE NAME: StateMatch + -- + -- PARAMETERS : symbol - symbol from state table + -- in2 - input from VitalStateTble procedure + -- to state table + -- in2LastValue - previous value of input + -- state - false if the symbol is from the input + -- portion of the table, + -- true if the symbol is from the state + -- portion of the table + -- Err - true if symbol is not a valid input symbol + -- ReturnValue - true if match occurred + -- + -- DESCRIPTION : This procedure sets ReturnValue to true if in2 matches + -- symbol (from the state table). If symbol is an edge + -- value edge is set to true and in2 and in2LastValue are + -- checked against symbol. Err is set to true if symbol + -- is an invalid value for the input portion of the state + -- table. + -- + -- ------------------------------------------------------------------------ + PROCEDURE StateMatch ( + CONSTANT Symbol : IN VitalStateSymbolType; + CONSTANT in2 : IN std_ulogic; + CONSTANT in2LastValue : IN std_ulogic; + CONSTANT State : IN BOOLEAN; + VARIABLE Err : OUT BOOLEAN; + VARIABLE ReturnValue : OUT BOOLEAN + ) IS + BEGIN + IF (State) THEN + IF (NOT ValidStateTableState(Symbol)) THEN + VitalError ( "VitalStateTable", ErrStaSym, To_StateChar(Symbol)); + Err := TRUE; + ReturnValue := FALSE; + ELSE + Err := FALSE; + ReturnValue := StateTableMatch(in2LastValue, in2, Symbol); + END IF; + ELSE + IF (NOT ValidStateTableInput(Symbol) ) THEN + VitalError ( "VitalStateTable", ErrInpSym, To_StateChar(Symbol)); + Err := TRUE; + ReturnValue := FALSE; + ELSE + ReturnValue := StateTableMatch(in2LastValue, in2, Symbol); + Err := FALSE; + END IF; + END IF; + END; + + -- ----------------------------------------------------------------------- + -- FUNCTION NAME: StateTableLookUp + -- + -- PARAMETERS : StateTable - state table + -- PresentDataIn - current inputs + -- PreviousDataIn - previous inputs and states + -- NumStates - number of state variables + -- PresentOutputs - current state and current outputs + -- + -- DESCRIPTION : This function is used to find the output of the + -- StateTable corresponding to a given set of inputs. + -- + -- ------------------------------------------------------------------------ + FUNCTION StateTableLookUp ( + CONSTANT StateTable : VitalStateTableType; + CONSTANT PresentDataIn : std_logic_vector; + CONSTANT PreviousDataIn : std_logic_vector; + CONSTANT NumStates : NATURAL; + CONSTANT PresentOutputs : std_logic_vector + ) RETURN std_logic_vector IS + + CONSTANT InputSize : INTEGER := PresentDataIn'LENGTH; + CONSTANT NumInputs : INTEGER := InputSize + NumStates - 1; + CONSTANT TableEntries : INTEGER := StateTable'LENGTH(1); + CONSTANT TableWidth : INTEGER := StateTable'LENGTH(2); + CONSTANT OutSize : INTEGER := TableWidth - InputSize - NumStates; + VARIABLE Inputs : std_logic_vector(0 TO NumInputs); + VARIABLE PrevInputs : std_logic_vector(0 TO NumInputs) + := (OTHERS => 'X'); + VARIABLE ReturnValue : std_logic_vector(0 TO (OutSize-1)) + := (OTHERS => 'X'); + VARIABLE Temp : std_ulogic; + VARIABLE Match : BOOLEAN; + VARIABLE Err : BOOLEAN := FALSE; + + -- This needs to be done since the TableLookup arrays must be + -- ascending starting with 0 + VARIABLE TableAlias : VitalStateTableType(0 TO TableEntries - 1, + 0 TO TableWidth - 1) + := StateTable; + + BEGIN + Inputs(0 TO InputSize-1) := PresentDataIn; + Inputs(InputSize TO NumInputs) := PresentOutputs(0 TO NumStates - 1); + PrevInputs(0 TO InputSize - 1) := PreviousDataIn(0 TO InputSize - 1); + + ColLoop: -- Compare each entry in the table + FOR i IN TableAlias'RANGE(1) LOOP + + RowLoop: -- Check each element of the entry + FOR j IN 0 TO InputSize + NumStates LOOP + + IF (j = InputSize + NumStates) THEN -- a match occurred + FOR k IN 0 TO Minimum(OutSize, PresentOutputs'LENGTH)-1 LOOP + StateOutputX01Z ( + TableAlias(i, TableWidth - k - 1), + PresentOutputs(PresentOutputs'LENGTH - k - 1), + Temp, Err); + ReturnValue(OutSize - k - 1) := Temp; + IF (Err) THEN + ReturnValue := (OTHERS => 'X'); + RETURN ReturnValue; + END IF; + END LOOP; + RETURN ReturnValue; + END IF; + + StateMatch ( TableAlias(i,j), + Inputs(j), PrevInputs(j), + j >= InputSize, Err, Match); + EXIT RowLoop WHEN NOT(Match); + EXIT ColLoop WHEN Err; + END LOOP RowLoop; + END LOOP ColLoop; + + ReturnValue := (OTHERS => 'X'); + RETURN ReturnValue; + END; + + -------------------------------------------------------------------- + -- to_ux01z + ------------------------------------------------------------------- + FUNCTION To_UX01Z ( s : std_ulogic + ) RETURN UX01Z IS + BEGIN + RETURN cvt_to_ux01z (s); + END; + + --------------------------------------------------------------------------- + -- Function : GetEdge + -- Purpose : Converts transitions on a given input signal into a + -- enumeration value representing the transition or level + -- of the signal. + -- + -- previous "value" current "value" := "edge" + -- --------------------------------------------------------- + -- '1' | 'H' '1' | 'H' '1' level, no edge + -- '0' | 'L' '1' | 'H' '/' rising edge + -- others '1' | 'H' 'R' rising from X + -- + -- '1' | 'H' '0' | 'L' '\' falling egde + -- '0' | 'L' '0' | 'L' '0' level, no edge + -- others '0' | 'L' 'F' falling from X + -- + -- 'X' | 'W' | '-' 'X' | 'W' | '-' 'X' unknown (X) level + -- 'Z' 'Z' 'X' unknown (X) level + -- 'U' 'U' 'U' 'U' level + -- + -- '1' | 'H' others 'f' falling to X + -- '0' | 'L' others 'r' rising to X + -- 'X' | 'W' | '-' 'U' | 'Z' 'x' unknown (X) edge + -- 'Z' 'X' | 'W' | '-' | 'U' 'x' unknown (X) edge + -- 'U' 'X' | 'W' | '-' | 'Z' 'x' unknown (X) edge + -- + --------------------------------------------------------------------------- + FUNCTION GetEdge ( + SIGNAL s : IN std_logic + ) RETURN EdgeType IS + BEGIN + IF (s'EVENT) + THEN RETURN LogicToEdge ( s'LAST_VALUE, s ); + ELSE RETURN LogicToLevel ( s ); + END IF; + END; + + --------------------------------------------------------------------------- + PROCEDURE GetEdge ( + SIGNAL s : IN std_logic_vector; + VARIABLE LastS : INOUT std_logic_vector; + VARIABLE Edge : OUT EdgeArray ) IS + + ALIAS sAlias : std_logic_vector ( 1 TO s'LENGTH ) IS s; + ALIAS LastSAlias : std_logic_vector ( 1 TO LastS'LENGTH ) IS LastS; + ALIAS EdgeAlias : EdgeArray ( 1 TO Edge'LENGTH ) IS Edge; + BEGIN + IF s'LENGTH /= LastS'LENGTH OR + s'LENGTH /= Edge'LENGTH THEN + VitalError ( "GetEdge", ErrVctLng, "s, LastS, Edge" ); + END IF; + + FOR n IN 1 TO s'LENGTH LOOP + EdgeAlias(n) := LogicToEdge( LastSAlias(n), sAlias(n) ); + LastSAlias(n) := sAlias(n); + END LOOP; + END; + + --------------------------------------------------------------------------- + FUNCTION ToEdge ( Value : IN std_logic + ) RETURN EdgeType IS + BEGIN + RETURN LogicToLevel( Value ); + END; + + -- Note: This function will likely be replaced by S'DRIVING_VALUE in VHDL'92 + ---------------------------------------------------------------------------- + FUNCTION CurValue ( + CONSTANT GlitchData : IN GlitchDataType + ) RETURN std_logic IS + BEGIN + IF NOW >= GlitchData.SchedTime THEN + RETURN GlitchData.SchedValue; + ELSIF NOW >= GlitchData.GlitchTime THEN + RETURN 'X'; + ELSE + RETURN GlitchData.CurrentValue; + END IF; + END; + --------------------------------------------------------------------------- + FUNCTION CurValue ( + CONSTANT GlitchData : IN GlitchDataArrayType + ) RETURN std_logic_vector IS + VARIABLE Result : std_logic_vector(GlitchData'RANGE); + BEGIN + FOR n IN GlitchData'RANGE LOOP + IF NOW >= GlitchData(n).SchedTime THEN + Result(n) := GlitchData(n).SchedValue; + ELSIF NOW >= GlitchData(n).GlitchTime THEN + Result(n) := 'X'; + ELSE + Result(n) := GlitchData(n).CurrentValue; + END IF; + END LOOP; + RETURN Result; + END; + + --------------------------------------------------------------------------- + -- function calculation utilities + --------------------------------------------------------------------------- + + --------------------------------------------------------------------------- + -- Function : VitalSame + -- Returns : VitalSame compares the state (UX01) of two logic value. A + -- value of 'X' is returned if the values are different. The + -- common value is returned if the values are equal. + -- Purpose : When the result of a logic model may be either of two + -- separate input values (eg. when the select on a MUX is 'X'), + -- VitalSame may be used to determine if the result needs to + -- be 'X'. + -- Arguments : See the declarations below... + --------------------------------------------------------------------------- + FUNCTION VitalSame ( + CONSTANT a, b : IN std_ulogic + ) RETURN std_ulogic IS + BEGIN + IF To_UX01(a) = To_UX01(b) + THEN RETURN To_UX01(a); + ELSE RETURN 'X'; + END IF; + END; + + --------------------------------------------------------------------------- + -- delay selection utilities + --------------------------------------------------------------------------- + + --------------------------------------------------------------------------- + -- Procedure : BufPath, InvPath + -- + -- Purpose : BufPath and InvPath compute output change times, based on + -- a change on an input port. The computed output change times + -- returned in the composite parameter 'schd'. + -- + -- BufPath and InpPath are used together with the delay path + -- selection functions (GetSchedDelay, VitalAND, VitalOR... ) + -- The 'schd' value from each of the input ports of a model are + -- combined by the delay selection functions (VitalAND, + -- VitalOR, ...). The GetSchedDelay procedure converts the + -- combined output changes times to the single delay (delta + -- time) value for scheduling the output change (passed to + -- VitalGlitchOnEvent). + -- + -- The values in 'schd' are: (absolute times) + -- inp0 : time of output change due to input change to 0 + -- inp1 : time of output change due to input change to 1 + -- inpX : time of output change due to input change to X + -- glch0 : time of output glitch due to input change to 0 + -- glch1 : time of output glitch due to input change to 1 + -- + -- The output times are computed from the model INPUT value + -- and not the final value. For this reason, 'BufPath' should + -- be used to compute the output times for a non-inverting + -- delay paths and 'InvPath' should be used to compute the + -- ouput times for inverting delay paths. Delay paths which + -- include both non-inverting and paths require usage of both + -- 'BufPath' and 'InvPath'. (IE this is needed for the + -- select->output path of a MUX -- See the VitalMUX model). + -- + -- + -- Parameters : schd....... Computed output result times. (INOUT parameter + -- modified only on input edges) + -- Iedg....... Input port edge/level value. + -- tpd....... Propagation delays from this input + -- + --------------------------------------------------------------------------- + + PROCEDURE BufPath ( + VARIABLE Schd : INOUT SchedType; + CONSTANT Iedg : IN EdgeType; + CONSTANT tpd : IN VitalDelayType01 + ) IS + BEGIN + CASE Iedg IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd.inp0 := TIME'HIGH; + Schd.inp1 := NOW + tpd(tr01); Schd.Glch1 := Schd.inp1; + Schd.InpX := Schd.inp1; + WHEN '\'|'F' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := NOW + tpd(tr10); Schd.Glch0 := Schd.inp0; + Schd.InpX := Schd.inp0; + WHEN 'r' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := TIME'HIGH; + Schd.InpX := NOW + tpd(tr01); + WHEN 'f' => Schd.inp0 := TIME'HIGH; + Schd.inp1 := TIME'HIGH; + Schd.InpX := NOW + tpd(tr10); + WHEN 'x' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := TIME'HIGH; + -- update for X->X change + Schd.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END; + + PROCEDURE BufPath ( + VARIABLE Schd : INOUT SchedArray; + CONSTANT Iedg : IN EdgeArray; + CONSTANT tpd : IN VitalDelayArrayType01 + ) IS + BEGIN + FOR n IN Schd'RANGE LOOP + CASE Iedg(n) IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd(n).inp0 := TIME'HIGH; + Schd(n).inp1 := NOW + tpd(n)(tr01); + Schd(n).Glch1 := Schd(n).inp1; + Schd(n).InpX := Schd(n).inp1; + WHEN '\'|'F' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := NOW + tpd(n)(tr10); + Schd(n).Glch0 := Schd(n).inp0; + Schd(n).InpX := Schd(n).inp0; + WHEN 'r' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := TIME'HIGH; + Schd(n).InpX := NOW + tpd(n)(tr01); + WHEN 'f' => Schd(n).inp0 := TIME'HIGH; + Schd(n).inp1 := TIME'HIGH; + Schd(n).InpX := NOW + tpd(n)(tr10); + WHEN 'x' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := TIME'HIGH; + -- update for X->X change + Schd(n).InpX := NOW + Minimum ( tpd(n)(tr10), + tpd(n)(tr01) ); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END LOOP; + END; + + PROCEDURE InvPath ( + VARIABLE Schd : INOUT SchedType; + CONSTANT Iedg : IN EdgeType; + CONSTANT tpd : IN VitalDelayType01 + ) IS + BEGIN + CASE Iedg IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd.inp0 := TIME'HIGH; + Schd.inp1 := NOW + tpd(tr10); Schd.Glch1 := Schd.inp1; + Schd.InpX := Schd.inp1; + WHEN '\'|'F' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := NOW + tpd(tr01); Schd.Glch0 := Schd.inp0; + Schd.InpX := Schd.inp0; + WHEN 'r' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := TIME'HIGH; + Schd.InpX := NOW + tpd(tr10); + WHEN 'f' => Schd.inp0 := TIME'HIGH; + Schd.inp1 := TIME'HIGH; + Schd.InpX := NOW + tpd(tr01); + WHEN 'x' => Schd.inp1 := TIME'HIGH; + Schd.inp0 := TIME'HIGH; + -- update for X->X change + Schd.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END; + + PROCEDURE InvPath ( + VARIABLE Schd : INOUT SchedArray; + CONSTANT Iedg : IN EdgeArray; + CONSTANT tpd : IN VitalDelayArrayType01 + ) IS + BEGIN + FOR n IN Schd'RANGE LOOP + CASE Iedg(n) IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd(n).inp0 := TIME'HIGH; + Schd(n).inp1 := NOW + tpd(n)(tr10); + Schd(n).Glch1 := Schd(n).inp1; + Schd(n).InpX := Schd(n).inp1; + WHEN '\'|'F' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := NOW + tpd(n)(tr01); + Schd(n).Glch0 := Schd(n).inp0; + Schd(n).InpX := Schd(n).inp0; + WHEN 'r' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := TIME'HIGH; + Schd(n).InpX := NOW + tpd(n)(tr10); + WHEN 'f' => Schd(n).inp0 := TIME'HIGH; + Schd(n).inp1 := TIME'HIGH; + Schd(n).InpX := NOW + tpd(n)(tr01); + WHEN 'x' => Schd(n).inp1 := TIME'HIGH; + Schd(n).inp0 := TIME'HIGH; + -- update for X->X change + Schd(n).InpX := NOW + Minimum ( tpd(n)(tr10), + tpd(n)(tr01) ); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END LOOP; + END; + + --------------------------------------------------------------------------- + -- Procedure : BufEnab, InvEnab + -- + -- Purpose : BufEnab and InvEnab compute output change times, from a + -- change on an input enable port for a 3-state driver. The + -- computed output change times are returned in the composite + -- parameters 'schd1', 'schd0'. + -- + -- BufEnab and InpEnab are used together with the delay path + -- selection functions (GetSchedDelay, VitalAND, VitalOR... ) + -- The 'schd' value from each of the non-enable input ports of + -- a model (See BufPath, InvPath) are combined using the delay + -- selection functions (VitalAND, VitalOR, ...). The + -- GetSchedDelay procedure combines the output times on the + -- enable path with the output times from the data path(s) and + -- computes the single delay (delta time) value for scheduling + -- the output change (passed to VitalGlitchOnEvent) + -- + -- The values in 'schd*' are: (absolute times) + -- inp0 : time of output change due to input change to 0 + -- inp1 : time of output change due to input change to 1 + -- inpX : time of output change due to input change to X + -- glch0 : time of output glitch due to input change to 0 + -- glch1 : time of output glitch due to input change to 1 + -- + -- 'schd1' contains output times for 1->Z, Z->1 transitions. + -- 'schd0' contains output times for 0->Z, Z->0 transitions. + -- + -- 'BufEnab' is used for computing the output times for an + -- high asserted enable (output 'Z' for enable='0'). + -- 'InvEnab' is used for computing the output times for an + -- low asserted enable (output 'Z' for enable='1'). + -- + -- Note: separate 'schd1', 'schd0' parameters are generated + -- so that the combination of the delay paths from + -- multiple enable signals may be combined using the + -- same functions/operators used in combining separate + -- data paths. (See exampe 2 below) + -- + -- + -- Parameters : schd1...... Computed output result times for 1->Z, Z->1 + -- transitions. This parameter is modified only on + -- input edge values (events). + -- schd0...... Computed output result times for 0->Z, 0->1 + -- transitions. This parameter is modified only on + -- input edge values (events). + -- Iedg....... Input port edge/level value. + -- tpd....... Propagation delays for the enable -> output path. + -- + --------------------------------------------------------------------------- + PROCEDURE BufEnab ( + VARIABLE Schd1 : INOUT SchedType; + VARIABLE Schd0 : INOUT SchedType; + CONSTANT Iedg : IN EdgeType; + CONSTANT tpd : IN VitalDelayType01Z + ) IS + BEGIN + CASE Iedg IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := NOW + tpd(trz1); + Schd1.Glch1 := Schd1.inp1; + Schd1.InpX := Schd1.inp1; + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := NOW + tpd(trz0); + Schd0.Glch1 := Schd0.inp1; + Schd0.InpX := Schd0.inp1; + WHEN '\'|'F' => Schd1.inp1 := TIME'HIGH; + Schd1.inp0 := NOW + tpd(tr1z); + Schd1.Glch0 := Schd1.inp0; + Schd1.InpX := Schd1.inp0; + Schd0.inp1 := TIME'HIGH; + Schd0.inp0 := NOW + tpd(tr0z); + Schd0.Glch0 := Schd0.inp0; + Schd0.InpX := Schd0.inp0; + WHEN 'r' => Schd1.inp1 := TIME'HIGH; + Schd1.inp0 := TIME'HIGH; + Schd1.InpX := NOW + tpd(trz1); + Schd0.inp1 := TIME'HIGH; + Schd0.inp0 := TIME'HIGH; + Schd0.InpX := NOW + tpd(trz0); + WHEN 'f' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := TIME'HIGH; + Schd1.InpX := NOW + tpd(tr1z); + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := TIME'HIGH; + Schd0.InpX := NOW + tpd(tr0z); + WHEN 'x' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := TIME'HIGH; + Schd1.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := TIME'HIGH; + Schd0.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END; + + PROCEDURE InvEnab ( + VARIABLE Schd1 : INOUT SchedType; + VARIABLE Schd0 : INOUT SchedType; + CONSTANT Iedg : IN EdgeType; + CONSTANT tpd : IN VitalDelayType01Z + ) IS + BEGIN + CASE Iedg IS + WHEN '0'|'1' => NULL; -- no edge: no timing update + WHEN '/'|'R' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := NOW + tpd(tr1z); + Schd1.Glch1 := Schd1.inp1; + Schd1.InpX := Schd1.inp1; + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := NOW + tpd(tr0z); + Schd0.Glch1 := Schd0.inp1; + Schd0.InpX := Schd0.inp1; + WHEN '\'|'F' => Schd1.inp1 := TIME'HIGH; + Schd1.inp0 := NOW + tpd(trz1); + Schd1.Glch0 := Schd1.inp0; + Schd1.InpX := Schd1.inp0; + Schd0.inp1 := TIME'HIGH; + Schd0.inp0 := NOW + tpd(trz0); + Schd0.Glch0 := Schd0.inp0; + Schd0.InpX := Schd0.inp0; + WHEN 'r' => Schd1.inp1 := TIME'HIGH; + Schd1.inp0 := TIME'HIGH; + Schd1.InpX := NOW + tpd(tr1z); + Schd0.inp1 := TIME'HIGH; + Schd0.inp0 := TIME'HIGH; + Schd0.InpX := NOW + tpd(tr0z); + WHEN 'f' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := TIME'HIGH; + Schd1.InpX := NOW + tpd(trz1); + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := TIME'HIGH; + Schd0.InpX := NOW + tpd(trz0); + WHEN 'x' => Schd1.inp0 := TIME'HIGH; + Schd1.inp1 := TIME'HIGH; + Schd1.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + Schd0.inp0 := TIME'HIGH; + Schd0.inp1 := TIME'HIGH; + Schd0.InpX := NOW + Minimum(tpd(tr10),tpd(tr01)); + WHEN OTHERS => NULL; -- no timing change + END CASE; + END; + + --------------------------------------------------------------------------- + -- Procedure : GetSchedDelay + -- + -- Purpose : GetSchedDelay computes the final delay (incremental) for + -- for scheduling an output signal. The delay is computed + -- from the absolute output times in the 'NewSched' parameter. + -- (See BufPath, InvPath). + -- + -- Computation of the output delay for non-3_state outputs + -- consists of selection the appropriate output time based + -- on the new output value 'NewValue' and subtracting 'NOW' + -- to convert to an incremental delay value. + -- + -- The Computation of the output delay for 3_state output + -- also includes combination of the enable path delay with + -- the date path delay. + -- + -- Parameters : NewDelay... Returned output delay value. + -- GlchDelay.. Returned output delay for the start of a glitch. + -- NewValue... New output value. + -- CurValue... Current value of the output. + -- NewSched... Composite containing the combined absolute + -- output times from the data inputs. + -- EnSched1... Composite containing the combined absolute + -- output times from the enable input(s). + -- (for a 3_state output transitions 1->Z, Z->1) + -- EnSched0... Composite containing the combined absolute + -- output times from the enable input(s). + -- (for a 3_state output transitions 0->Z, Z->0) + -- + --------------------------------------------------------------------------- + PROCEDURE GetSchedDelay ( + VARIABLE NewDelay : OUT TIME; + VARIABLE GlchDelay : OUT TIME; + CONSTANT NewValue : IN std_ulogic; + CONSTANT CurValue : IN std_ulogic; + CONSTANT NewSched : IN SchedType + ) IS + VARIABLE Tim, Glch : TIME; + BEGIN + + CASE To_UX01(NewValue) IS + WHEN '0' => Tim := NewSched.inp0; + Glch := NewSched.Glch1; + WHEN '1' => Tim := NewSched.inp1; + Glch := NewSched.Glch0; + WHEN OTHERS => Tim := NewSched.InpX; + Glch := -1 ns; + END CASE; + IF (CurValue /= NewValue) + THEN Glch := -1 ns; + END IF; + + NewDelay := Tim - NOW; + IF Glch < 0 ns + THEN GlchDelay := Glch; + ELSE GlchDelay := Glch - NOW; + END IF; -- glch < 0 ns + END; + + PROCEDURE GetSchedDelay ( + VARIABLE NewDelay : OUT VitalTimeArray; + VARIABLE GlchDelay : OUT VitalTimeArray; + CONSTANT NewValue : IN std_logic_vector; + CONSTANT CurValue : IN std_logic_vector; + CONSTANT NewSched : IN SchedArray + ) IS + VARIABLE Tim, Glch : TIME; + ALIAS NewDelayAlias : VitalTimeArray( NewDelay'LENGTH DOWNTO 1) + IS NewDelay; + ALIAS GlchDelayAlias : VitalTimeArray(GlchDelay'LENGTH DOWNTO 1) + IS GlchDelay; + ALIAS NewSchedAlias : SchedArray( NewSched'LENGTH DOWNTO 1) + IS NewSched; + ALIAS NewValueAlias : std_logic_vector ( NewValue'LENGTH DOWNTO 1 ) + IS NewValue; + ALIAS CurValueAlias : std_logic_vector ( CurValue'LENGTH DOWNTO 1 ) + IS CurValue; + BEGIN + FOR n IN NewDelay'LENGTH DOWNTO 1 LOOP + CASE To_UX01(NewValueAlias(n)) IS + WHEN '0' => Tim := NewSchedAlias(n).inp0; + Glch := NewSchedAlias(n).Glch1; + WHEN '1' => Tim := NewSchedAlias(n).inp1; + Glch := NewSchedAlias(n).Glch0; + WHEN OTHERS => Tim := NewSchedAlias(n).InpX; + Glch := -1 ns; + END CASE; + IF (CurValueAlias(n) /= NewValueAlias(n)) + THEN Glch := -1 ns; + END IF; + + NewDelayAlias(n) := Tim - NOW; + IF Glch < 0 ns + THEN GlchDelayAlias(n) := Glch; + ELSE GlchDelayAlias(n) := Glch - NOW; + END IF; -- glch < 0 ns + END LOOP; + RETURN; + END; + + PROCEDURE GetSchedDelay ( + VARIABLE NewDelay : OUT TIME; + VARIABLE GlchDelay : OUT TIME; + CONSTANT NewValue : IN std_ulogic; + CONSTANT CurValue : IN std_ulogic; + CONSTANT NewSched : IN SchedType; + CONSTANT EnSched1 : IN SchedType; + CONSTANT EnSched0 : IN SchedType + ) IS + SUBTYPE v2 IS std_logic_vector(0 TO 1); + VARIABLE Tim, Glch : TIME; + BEGIN + + CASE v2'(To_X01Z(CurValue) & To_X01Z(NewValue)) IS + WHEN "00" => Tim := Maximum (NewSched.inp0, EnSched0.inp1); + Glch := GlitchMinTime(NewSched.Glch1,EnSched0.Glch0); + WHEN "01" => Tim := Maximum (NewSched.inp1, EnSched1.inp1); + Glch := EnSched1.Glch0; + WHEN "0Z" => Tim := EnSched0.inp0; + Glch := NewSched.Glch1; + WHEN "0X" => Tim := Maximum (NewSched.InpX, EnSched1.InpX); + Glch := 0 ns; + WHEN "10" => Tim := Maximum (NewSched.inp0, EnSched0.inp1); + Glch := EnSched0.Glch0; + WHEN "11" => Tim := Maximum (NewSched.inp1, EnSched1.inp1); + Glch := GlitchMinTime(NewSched.Glch0,EnSched1.Glch0); + WHEN "1Z" => Tim := EnSched1.inp0; + Glch := NewSched.Glch0; + WHEN "1X" => Tim := Maximum (NewSched.InpX, EnSched0.InpX); + Glch := 0 ns; + WHEN "Z0" => Tim := Maximum (NewSched.inp0, EnSched0.inp1); + IF NewSched.Glch0 > NOW + THEN Glch := Maximum(NewSched.Glch1,EnSched1.inp1); + ELSE Glch := 0 ns; + END IF; + WHEN "Z1" => Tim := Maximum (NewSched.inp1, EnSched1.inp1); + IF NewSched.Glch1 > NOW + THEN Glch := Maximum(NewSched.Glch0,EnSched0.inp1); + ELSE Glch := 0 ns; + END IF; + WHEN "ZX" => Tim := Maximum (NewSched.InpX, EnSched1.InpX); + Glch := 0 ns; + WHEN "ZZ" => Tim := Maximum (EnSched1.InpX, EnSched0.InpX); + Glch := 0 ns; + WHEN "X0" => Tim := Maximum (NewSched.inp0, EnSched0.inp1); + Glch := 0 ns; + WHEN "X1" => Tim := Maximum (NewSched.inp1, EnSched1.inp1); + Glch := 0 ns; + WHEN "XZ" => Tim := Maximum (EnSched1.InpX, EnSched0.InpX); + Glch := 0 ns; + WHEN OTHERS => Tim := Maximum (NewSched.InpX, EnSched1.InpX); + Glch := 0 ns; + + END CASE; + NewDelay := Tim - NOW; + IF Glch < 0 ns + THEN GlchDelay := Glch; + ELSE GlchDelay := Glch - NOW; + END IF; -- glch < 0 ns + END; + + --------------------------------------------------------------------------- + -- Operators and Functions for combination (selection) of path delays + -- > These functions support selection of the "appripriate" path delay + -- dependent on the logic function. + -- > These functions only "select" from the possable output times. No + -- calculation (addition) of delays is performed. + -- > See description of 'BufPath', 'InvPath' and 'GetSchedDelay' + -- > See primitive PROCEDURE models for examples. + --------------------------------------------------------------------------- + + FUNCTION "not" ( + CONSTANT a : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + z.inp1 := a.inp0 ; + z.inp0 := a.inp1 ; + z.InpX := a.InpX ; + z.Glch1 := a.Glch0; + z.Glch0 := a.Glch1; + RETURN (z); + END; + + FUNCTION "and" ( + CONSTANT a, b : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + z.inp1 := Maximum ( a.inp1 , b.inp1 ); + z.inp0 := Minimum ( a.inp0 , b.inp0 ); + z.InpX := GlitchMinTime ( a.InpX , b.InpX ); + z.Glch1 := Maximum ( a.Glch1, b.Glch1 ); + z.Glch0 := GlitchMinTime ( a.Glch0, b.Glch0 ); + RETURN (z); + END; + + FUNCTION "or" ( + CONSTANT a, b : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + z.inp0 := Maximum ( a.inp0 , b.inp0 ); + z.inp1 := Minimum ( a.inp1 , b.inp1 ); + z.InpX := GlitchMinTime ( a.InpX , b.InpX ); + z.Glch0 := Maximum ( a.Glch0, b.Glch0 ); + z.Glch1 := GlitchMinTime ( a.Glch1, b.Glch1 ); + RETURN (z); + END; + + FUNCTION "nand" ( + CONSTANT a, b : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + z.inp0 := Maximum ( a.inp1 , b.inp1 ); + z.inp1 := Minimum ( a.inp0 , b.inp0 ); + z.InpX := GlitchMinTime ( a.InpX , b.InpX ); + z.Glch0 := Maximum ( a.Glch1, b.Glch1 ); + z.Glch1 := GlitchMinTime ( a.Glch0, b.Glch0 ); + RETURN (z); + END; + + FUNCTION "nor" ( + CONSTANT a, b : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + z.inp1 := Maximum ( a.inp0 , b.inp0 ); + z.inp0 := Minimum ( a.inp1 , b.inp1 ); + z.InpX := GlitchMinTime ( a.InpX , b.InpX ); + z.Glch1 := Maximum ( a.Glch0, b.Glch0 ); + z.Glch0 := GlitchMinTime ( a.Glch1, b.Glch1 ); + RETURN (z); + END; + + -- ------------------------------------------------------------------------ + -- Delay Calculation for 2-bit Logical gates. + -- ------------------------------------------------------------------------ + FUNCTION VitalXOR2 ( + CONSTANT ab,ai, bb,bi : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + -- z = (a AND b) NOR (a NOR b) + z.inp1 := Maximum ( Minimum (ai.inp0 , bi.inp0 ), + Minimum (ab.inp1 , bb.inp1 ) ); + z.inp0 := Minimum ( Maximum (ai.inp1 , bi.inp1 ), + Maximum (ab.inp0 , bb.inp0 ) ); + z.InpX := Maximum ( Maximum (ai.InpX , bi.InpX ), + Maximum (ab.InpX , bb.InpX ) ); + z.Glch1 := Maximum (GlitchMinTime (ai.Glch0, bi.Glch0), + GlitchMinTime (ab.Glch1, bb.Glch1) ); + z.Glch0 := GlitchMinTime ( Maximum (ai.Glch1, bi.Glch1), + Maximum (ab.Glch0, bb.Glch0) ); + RETURN (z); + END; + + FUNCTION VitalXNOR2 ( + CONSTANT ab,ai, bb,bi : IN SchedType + ) RETURN SchedType IS + VARIABLE z : SchedType; + BEGIN + -- z = (a AND b) OR (a NOR b) + z.inp0 := Maximum ( Minimum (ab.inp0 , bb.inp0 ), + Minimum (ai.inp1 , bi.inp1 ) ); + z.inp1 := Minimum ( Maximum (ab.inp1 , bb.inp1 ), + Maximum (ai.inp0 , bi.inp0 ) ); + z.InpX := Maximum ( Maximum (ab.InpX , bb.InpX ), + Maximum (ai.InpX , bi.InpX ) ); + z.Glch0 := Maximum (GlitchMinTime (ab.Glch0, bb.Glch0), + GlitchMinTime (ai.Glch1, bi.Glch1) ); + z.Glch1 := GlitchMinTime ( Maximum (ab.Glch1, bb.Glch1), + Maximum (ai.Glch0, bi.Glch0) ); + RETURN (z); + END; + + -- ------------------------------------------------------------------------ + -- Delay Calculation for 3-bit Logical gates. + -- ------------------------------------------------------------------------ + FUNCTION VitalXOR3 ( + CONSTANT ab,ai, bb,bi, cb,ci : IN SchedType ) + RETURN SchedType IS + BEGIN + RETURN VitalXOR2 ( VitalXOR2 (ab,ai, bb,bi), + VitalXOR2 (ai,ab, bi,bb), + cb, ci ); + END; + + FUNCTION VitalXNOR3 ( + CONSTANT ab,ai, bb,bi, cb,ci : IN SchedType ) + RETURN SchedType IS + BEGIN + RETURN VitalXNOR2 ( VitalXOR2 ( ab,ai, bb,bi ), + VitalXOR2 ( ai,ab, bi,bb ), + cb, ci ); + END; + + -- ------------------------------------------------------------------------ + -- Delay Calculation for 4-bit Logical gates. + -- ------------------------------------------------------------------------ + FUNCTION VitalXOR4 ( + CONSTANT ab,ai, bb,bi, cb,ci, db,di : IN SchedType ) + RETURN SchedType IS + BEGIN + RETURN VitalXOR2 ( VitalXOR2 ( ab,ai, bb,bi ), + VitalXOR2 ( ai,ab, bi,bb ), + VitalXOR2 ( cb,ci, db,di ), + VitalXOR2 ( ci,cb, di,db ) ); + END; + + FUNCTION VitalXNOR4 ( + CONSTANT ab,ai, bb,bi, cb,ci, db,di : IN SchedType ) + RETURN SchedType IS + BEGIN + RETURN VitalXNOR2 ( VitalXOR2 ( ab,ai, bb,bi ), + VitalXOR2 ( ai,ab, bi,bb ), + VitalXOR2 ( cb,ci, db,di ), + VitalXOR2 ( ci,cb, di,db ) ); + END; + + -- ------------------------------------------------------------------------ + -- Delay Calculation for N-bit Logical gates. + -- ------------------------------------------------------------------------ + -- Note: index range on datab,datai assumed to be 1 TO length. + -- This is enforced by internal only usage of this Function + FUNCTION VitalXOR ( + CONSTANT DataB, DataI : IN SchedArray + ) RETURN SchedType IS + CONSTANT Leng : INTEGER := DataB'LENGTH; + BEGIN + IF Leng = 2 THEN + RETURN VitalXOR2 ( DataB(1),DataI(1), DataB(2),DataI(2) ); + ELSE + RETURN VitalXOR2 ( VitalXOR ( DataB(1 TO Leng-1), + DataI(1 TO Leng-1) ), + VitalXOR ( DataI(1 TO Leng-1), + DataB(1 TO Leng-1) ), + DataB(Leng),DataI(Leng) ); + END IF; + END; + + -- Note: index range on datab,datai assumed to be 1 TO length. + -- This is enforced by internal only usage of this Function + FUNCTION VitalXNOR ( + CONSTANT DataB, DataI : IN SchedArray + ) RETURN SchedType IS + CONSTANT Leng : INTEGER := DataB'LENGTH; + BEGIN + IF Leng = 2 THEN + RETURN VitalXNOR2 ( DataB(1),DataI(1), DataB(2),DataI(2) ); + ELSE + RETURN VitalXNOR2 ( VitalXOR ( DataB(1 TO Leng-1), + DataI(1 TO Leng-1) ), + VitalXOR ( DataI(1 TO Leng-1), + DataB(1 TO Leng-1) ), + DataB(Leng),DataI(Leng) ); + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Multiplexor + -- MUX .......... result := data(dselect) + -- MUX2 .......... 2-input mux; result := data0 when (dselect = '0'), + -- data1 when (dselect = '1'), + -- 'X' when (dselect = 'X') and (data0 /= data1) + -- MUX4 .......... 4-input mux; result := data(dselect) + -- MUX8 .......... 8-input mux; result := data(dselect) + -- ------------------------------------------------------------------------ + FUNCTION VitalMUX2 ( + CONSTANT d1, d0 : IN SchedType; + CONSTANT sb, SI : IN SchedType + ) RETURN SchedType IS + BEGIN + RETURN (d1 AND sb) OR (d0 AND (NOT SI) ); + END; +-- + FUNCTION VitalMUX4 ( + CONSTANT Data : IN SchedArray4; + CONSTANT sb : IN SchedArray2; + CONSTANT SI : IN SchedArray2 + ) RETURN SchedType IS + BEGIN + RETURN ( sb(1) AND VitalMUX2(Data(3),Data(2), sb(0), SI(0)) ) + OR ( (NOT SI(1)) AND VitalMUX2(Data(1),Data(0), sb(0), SI(0)) ); + END; + + FUNCTION VitalMUX8 ( + CONSTANT Data : IN SchedArray8; + CONSTANT sb : IN SchedArray3; + CONSTANT SI : IN SchedArray3 + ) RETURN SchedType IS + BEGIN + RETURN ( ( sb(2)) AND VitalMUX4 (Data(7 DOWNTO 4), + sb(1 DOWNTO 0), SI(1 DOWNTO 0) ) ) + OR ( (NOT SI(2)) AND VitalMUX4 (Data(3 DOWNTO 0), + sb(1 DOWNTO 0), SI(1 DOWNTO 0) ) ); + END; +-- + FUNCTION VInterMux ( + CONSTANT Data : IN SchedArray; + CONSTANT sb : IN SchedArray; + CONSTANT SI : IN SchedArray + ) RETURN SchedType IS + CONSTANT sMsb : INTEGER := sb'LENGTH; + CONSTANT dMsbHigh : INTEGER := Data'LENGTH; + CONSTANT dMsbLow : INTEGER := Data'LENGTH/2; + BEGIN + IF sb'LENGTH = 1 THEN + RETURN VitalMUX2( Data(2), Data(1), sb(1), SI(1) ); + ELSIF sb'LENGTH = 2 THEN + RETURN VitalMUX4( Data, sb, SI ); + ELSIF sb'LENGTH = 3 THEN + RETURN VitalMUX8( Data, sb, SI ); + ELSIF sb'LENGTH > 3 THEN + RETURN (( sb(sMsb)) AND VInterMux( Data(dMsbLow DOWNTO 1), + sb(sMsb-1 DOWNTO 1), + SI(sMsb-1 DOWNTO 1) )) + OR ((NOT SI(sMsb)) AND VInterMux( Data(dMsbHigh DOWNTO dMsbLow+1), + sb(sMsb-1 DOWNTO 1), + SI(sMsb-1 DOWNTO 1) )); + ELSE + RETURN (0 ns, 0 ns, 0 ns, 0 ns, 0 ns); -- dselect'LENGTH < 1 + END IF; + END; +-- + FUNCTION VitalMUX ( + CONSTANT Data : IN SchedArray; + CONSTANT sb : IN SchedArray; + CONSTANT SI : IN SchedArray + ) RETURN SchedType IS + CONSTANT msb : INTEGER := 2**sb'LENGTH; + VARIABLE lDat : SchedArray(msb DOWNTO 1); + ALIAS DataAlias : SchedArray ( Data'LENGTH DOWNTO 1 ) IS Data; + ALIAS sbAlias : SchedArray ( sb'LENGTH DOWNTO 1 ) IS sb; + ALIAS siAlias : SchedArray ( SI'LENGTH DOWNTO 1 ) IS SI; + BEGIN + IF Data'LENGTH <= msb THEN + FOR i IN Data'LENGTH DOWNTO 1 LOOP + lDat(i) := DataAlias(i); + END LOOP; + FOR i IN msb DOWNTO Data'LENGTH+1 LOOP + lDat(i) := DefSchedAnd; + END LOOP; + ELSE + FOR i IN msb DOWNTO 1 LOOP + lDat(i) := DataAlias(i); + END LOOP; + END IF; + RETURN VInterMux( lDat, sbAlias, siAlias ); + END; + + -- ------------------------------------------------------------------------ + -- Decoder + -- General Algorithm : + -- (a) Result(...) := '0' when (enable = '0') + -- (b) Result(data) := '1'; all other subelements = '0' + -- ... Result array is decending (n-1 downto 0) + -- + -- DECODERn .......... n:2**n decoder + -- ------------------------------------------------------------------------ + FUNCTION VitalDECODER2 ( + CONSTANT DataB : IN SchedType; + CONSTANT DataI : IN SchedType; + CONSTANT Enable : IN SchedType + ) RETURN SchedArray IS + VARIABLE Result : SchedArray2; + BEGIN + Result(1) := Enable AND ( DataB); + Result(0) := Enable AND (NOT DataI); + RETURN Result; + END; + + FUNCTION VitalDECODER4 ( + CONSTANT DataB : IN SchedArray2; + CONSTANT DataI : IN SchedArray2; + CONSTANT Enable : IN SchedType + ) RETURN SchedArray IS + VARIABLE Result : SchedArray4; + BEGIN + Result(3) := Enable AND ( DataB(1)) AND ( DataB(0)); + Result(2) := Enable AND ( DataB(1)) AND (NOT DataI(0)); + Result(1) := Enable AND (NOT DataI(1)) AND ( DataB(0)); + Result(0) := Enable AND (NOT DataI(1)) AND (NOT DataI(0)); + RETURN Result; + END; + + FUNCTION VitalDECODER8 ( + CONSTANT DataB : IN SchedArray3; + CONSTANT DataI : IN SchedArray3; + CONSTANT Enable : IN SchedType + ) RETURN SchedArray IS + VARIABLE Result : SchedArray8; + BEGIN + Result(7):= Enable AND ( DataB(2))AND( DataB(1))AND( DataB(0)); + Result(6):= Enable AND ( DataB(2))AND( DataB(1))AND(NOT DataI(0)); + Result(5):= Enable AND ( DataB(2))AND(NOT DataI(1))AND( DataB(0)); + Result(4):= Enable AND ( DataB(2))AND(NOT DataI(1))AND(NOT DataI(0)); + Result(3):= Enable AND (NOT DataI(2))AND( DataB(1))AND( DataB(0)); + Result(2):= Enable AND (NOT DataI(2))AND( DataB(1))AND(NOT DataI(0)); + Result(1):= Enable AND (NOT DataI(2))AND(NOT DataI(1))AND( DataB(0)); + Result(0):= Enable AND (NOT DataI(2))AND(NOT DataI(1))AND(NOT DataI(0)); + RETURN Result; + END; + + + FUNCTION VitalDECODER ( + CONSTANT DataB : IN SchedArray; + CONSTANT DataI : IN SchedArray; + CONSTANT Enable : IN SchedType + ) RETURN SchedArray IS + CONSTANT DMsb : INTEGER := DataB'LENGTH - 1; + ALIAS DataBAlias : SchedArray ( DMsb DOWNTO 0 ) IS DataB; + ALIAS DataIAlias : SchedArray ( DMsb DOWNTO 0 ) IS DataI; + BEGIN + IF DataB'LENGTH = 1 THEN + RETURN VitalDECODER2 ( DataBAlias( 0 ), + DataIAlias( 0 ), Enable ); + ELSIF DataB'LENGTH = 2 THEN + RETURN VitalDECODER4 ( DataBAlias(1 DOWNTO 0), + DataIAlias(1 DOWNTO 0), Enable ); + ELSIF DataB'LENGTH = 3 THEN + RETURN VitalDECODER8 ( DataBAlias(2 DOWNTO 0), + DataIAlias(2 DOWNTO 0), Enable ); + ELSIF DataB'LENGTH > 3 THEN + RETURN VitalDECODER ( DataBAlias(DMsb-1 DOWNTO 0), + DataIAlias(DMsb-1 DOWNTO 0), + Enable AND ( DataBAlias(DMsb)) ) + & VitalDECODER ( DataBAlias(DMsb-1 DOWNTO 0), + DataIAlias(DMsb-1 DOWNTO 0), + Enable AND (NOT DataIAlias(DMsb)) ); + ELSE + RETURN DefSchedArray2; + END IF; + END; + + +------------------------------------------------------------------------------- +-- PRIMITIVES +------------------------------------------------------------------------------- + -- ------------------------------------------------------------------------ + -- N-bit wide Logical gates. + -- ------------------------------------------------------------------------ + FUNCTION VitalAND ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '1'; + FOR i IN Data'RANGE LOOP + Result := Result AND Data(i); + END LOOP; + RETURN ResultMap(Result); + END; +-- + FUNCTION VitalOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '0'; + FOR i IN Data'RANGE LOOP + Result := Result OR Data(i); + END LOOP; + RETURN ResultMap(Result); + END; +-- + FUNCTION VitalXOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '0'; + FOR i IN Data'RANGE LOOP + Result := Result XOR Data(i); + END LOOP; + RETURN ResultMap(Result); + END; +-- + FUNCTION VitalNAND ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '1'; + FOR i IN Data'RANGE LOOP + Result := Result AND Data(i); + END LOOP; + RETURN ResultMap(NOT Result); + END; +-- + FUNCTION VitalNOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '0'; + FOR i IN Data'RANGE LOOP + Result := Result OR Data(i); + END LOOP; + RETURN ResultMap(NOT Result); + END; +-- + FUNCTION VitalXNOR ( + CONSTANT Data : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + Result := '0'; + FOR i IN Data'RANGE LOOP + Result := Result XOR Data(i); + END LOOP; + RETURN ResultMap(NOT Result); + END; + + -- ------------------------------------------------------------------------ + -- Commonly used 2-bit Logical gates. + -- ------------------------------------------------------------------------ + FUNCTION VitalAND2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a AND b); + END; +-- + FUNCTION VitalOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a OR b); + END; +-- + FUNCTION VitalXOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a XOR b); + END; +-- + FUNCTION VitalNAND2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a NAND b); + END; +-- + FUNCTION VitalNOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a NOR b); + END; +-- + FUNCTION VitalXNOR2 ( + CONSTANT a, b : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a XOR b)); + END; +-- + -- ------------------------------------------------------------------------ + -- Commonly used 3-bit Logical gates. + -- ------------------------------------------------------------------------ + FUNCTION VitalAND3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a AND b AND c); + END; +-- + FUNCTION VitalOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a OR b OR c); + END; +-- + FUNCTION VitalXOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a XOR b XOR c); + END; +-- + FUNCTION VitalNAND3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a AND b AND c)); + END; +-- + FUNCTION VitalNOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a OR b OR c)); + END; +-- + FUNCTION VitalXNOR3 ( + CONSTANT a, b, c : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a XOR b XOR c)); + END; + + -- --------------------------------------------------------------------------- + -- Commonly used 4-bit Logical gates. + -- --------------------------------------------------------------------------- + FUNCTION VitalAND4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a AND b AND c AND d); + END; +-- + FUNCTION VitalOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a OR b OR c OR d); + END; +-- + FUNCTION VitalXOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(a XOR b XOR c XOR d); + END; +-- + FUNCTION VitalNAND4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a AND b AND c AND d)); + END; +-- + FUNCTION VitalNOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a OR b OR c OR d)); + END; +-- + FUNCTION VitalXNOR4 ( + CONSTANT a, b, c, d : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT (a XOR b XOR c XOR d)); + END; + + -- ------------------------------------------------------------------------ + -- Buffers + -- BUF ....... standard non-inverting buffer + -- BUFIF0 ....... non-inverting buffer Data passes thru if (Enable = '0') + -- BUFIF1 ....... non-inverting buffer Data passes thru if (Enable = '1') + -- ------------------------------------------------------------------------ + FUNCTION VitalBUF ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(To_UX01(Data)); + END; +-- + FUNCTION VitalBUFIF0 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(BufIf0_Table(Enable,Data)); + END; +-- + FUNCTION VitalBUFIF1 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(BufIf1_Table(Enable,Data)); + END; + FUNCTION VitalIDENT ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(To_UX01Z(Data)); + END; + + -- ------------------------------------------------------------------------ + -- Invertors + -- INV ......... standard inverting buffer + -- INVIF0 ......... inverting buffer Data passes thru if (Enable = '0') + -- INVIF1 ......... inverting buffer Data passes thru if (Enable = '1') + -- ------------------------------------------------------------------------ + FUNCTION VitalINV ( + CONSTANT Data : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(NOT Data); + END; +-- + FUNCTION VitalINVIF0 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(InvIf0_Table(Enable,Data)); + END; +-- + FUNCTION VitalINVIF1 ( + CONSTANT Data, Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) RETURN std_ulogic IS + BEGIN + RETURN ResultMap(InvIf1_Table(Enable,Data)); + END; + + -- ------------------------------------------------------------------------ + -- Multiplexor + -- MUX .......... result := data(dselect) + -- MUX2 .......... 2-input mux; result := data0 when (dselect = '0'), + -- data1 when (dselect = '1'), + -- 'X' when (dselect = 'X') and (data0 /= data1) + -- MUX4 .......... 4-input mux; result := data(dselect) + -- MUX8 .......... 8-input mux; result := data(dselect) + -- ------------------------------------------------------------------------ + FUNCTION VitalMUX2 ( + CONSTANT Data1, Data0 : IN std_ulogic; + CONSTANT dSelect : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + CASE To_X01(dSelect) IS + WHEN '0' => Result := To_UX01(Data0); + WHEN '1' => Result := To_UX01(Data1); + WHEN OTHERS => Result := VitalSame( Data1, Data0 ); + END CASE; + RETURN ResultMap(Result); + END; +-- + FUNCTION VitalMUX4 ( + CONSTANT Data : IN std_logic_vector4; + CONSTANT dSelect : IN std_logic_vector2; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Slct : std_logic_vector2; + VARIABLE Result : UX01; + BEGIN + Slct := To_X01(dSelect); + CASE Slct IS + WHEN "00" => Result := To_UX01(Data(0)); + WHEN "01" => Result := To_UX01(Data(1)); + WHEN "10" => Result := To_UX01(Data(2)); + WHEN "11" => Result := To_UX01(Data(3)); + WHEN "0X" => Result := VitalSame( Data(1), Data(0) ); + WHEN "1X" => Result := VitalSame( Data(2), Data(3) ); + WHEN "X0" => Result := VitalSame( Data(2), Data(0) ); + WHEN "X1" => Result := VitalSame( Data(3), Data(1) ); + WHEN OTHERS => Result := VitalSame( VitalSame(Data(3),Data(2)), + VitalSame(Data(1),Data(0))); + END CASE; + RETURN ResultMap(Result); + END; +-- + FUNCTION VitalMUX8 ( + CONSTANT Data : IN std_logic_vector8; + CONSTANT dSelect : IN std_logic_vector3; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + VARIABLE Result : UX01; + BEGIN + CASE To_X01(dSelect(2)) IS + WHEN '0' => Result := VitalMUX4( Data(3 DOWNTO 0), + dSelect(1 DOWNTO 0)); + WHEN '1' => Result := VitalMUX4( Data(7 DOWNTO 4), + dSelect(1 DOWNTO 0)); + WHEN OTHERS => Result := VitalSame( VitalMUX4( Data(3 DOWNTO 0), + dSelect(1 DOWNTO 0)), + VitalMUX4( Data(7 DOWNTO 4), + dSelect(1 DOWNTO 0))); + END CASE; + RETURN ResultMap(Result); + END; +-- + FUNCTION VInterMux ( + CONSTANT Data : IN std_logic_vector; + CONSTANT dSelect : IN std_logic_vector + ) RETURN std_ulogic IS + + CONSTANT sMsb : INTEGER := dSelect'LENGTH; + CONSTANT dMsbHigh : INTEGER := Data'LENGTH; + CONSTANT dMsbLow : INTEGER := Data'LENGTH/2; + ALIAS DataAlias : std_logic_vector ( Data'LENGTH DOWNTO 1) IS Data; + ALIAS dSelAlias : std_logic_vector (dSelect'LENGTH DOWNTO 1) IS dSelect; + + VARIABLE Result : UX01; + BEGIN + IF dSelect'LENGTH = 1 THEN + Result := VitalMUX2( DataAlias(2), DataAlias(1), dSelAlias(1) ); + ELSIF dSelect'LENGTH = 2 THEN + Result := VitalMUX4( DataAlias, dSelAlias ); + ELSIF dSelect'LENGTH > 2 THEN + CASE To_X01(dSelect(sMsb)) IS + WHEN '0' => + Result := VInterMux( DataAlias(dMsbLow DOWNTO 1), + dSelAlias(sMsb-1 DOWNTO 1) ); + WHEN '1' => + Result := VInterMux( DataAlias(dMsbHigh DOWNTO dMsbLow+1), + dSelAlias(sMsb-1 DOWNTO 1) ); + WHEN OTHERS => + Result := VitalSame( + VInterMux( DataAlias(dMsbLow DOWNTO 1), + dSelAlias(sMsb-1 DOWNTO 1) ), + VInterMux( DataAlias(dMsbHigh DOWNTO dMsbLow+1), + dSelAlias(sMsb-1 DOWNTO 1) ) + ); + END CASE; + ELSE + Result := 'X'; -- dselect'LENGTH < 1 + END IF; + RETURN Result; + END; +-- + FUNCTION VitalMUX ( + CONSTANT Data : IN std_logic_vector; + CONSTANT dSelect : IN std_logic_vector; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_ulogic IS + CONSTANT msb : INTEGER := 2**dSelect'LENGTH; + ALIAS DataAlias : std_logic_vector ( Data'LENGTH DOWNTO 1) IS Data; + ALIAS dSelAlias : std_logic_vector (dSelect'LENGTH DOWNTO 1) IS dSelect; + VARIABLE lDat : std_logic_vector(msb DOWNTO 1) := (OTHERS=>'X'); + VARIABLE Result : UX01; + BEGIN + IF Data'LENGTH <= msb THEN + FOR i IN Data'LENGTH DOWNTO 1 LOOP + lDat(i) := DataAlias(i); + END LOOP; + ELSE + FOR i IN msb DOWNTO 1 LOOP + lDat(i) := DataAlias(i); + END LOOP; + END IF; + Result := VInterMux( lDat, dSelAlias ); + RETURN ResultMap(Result); + END; + + -- ------------------------------------------------------------------------ + -- Decoder + -- General Algorithm : + -- (a) Result(...) := '0' when (enable = '0') + -- (b) Result(data) := '1'; all other subelements = '0' + -- ... Result array is decending (n-1 downto 0) + -- + -- DECODERn .......... n:2**n decoder + -- ------------------------------------------------------------------------ + FUNCTION VitalDECODER2 ( + CONSTANT Data : IN std_ulogic; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector2 IS + VARIABLE Result : std_logic_vector2; + BEGIN + Result(1) := ResultMap(Enable AND ( Data)); + Result(0) := ResultMap(Enable AND (NOT Data)); + RETURN Result; + END; +-- + FUNCTION VitalDECODER4 ( + CONSTANT Data : IN std_logic_vector2; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector4 IS + VARIABLE Result : std_logic_vector4; + BEGIN + Result(3) := ResultMap(Enable AND ( Data(1)) AND ( Data(0))); + Result(2) := ResultMap(Enable AND ( Data(1)) AND (NOT Data(0))); + Result(1) := ResultMap(Enable AND (NOT Data(1)) AND ( Data(0))); + Result(0) := ResultMap(Enable AND (NOT Data(1)) AND (NOT Data(0))); + RETURN Result; + END; +-- + FUNCTION VitalDECODER8 ( + CONSTANT Data : IN std_logic_vector3; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector8 IS + VARIABLE Result : std_logic_vector8; + BEGIN + Result(7) := ( Data(2)) AND ( Data(1)) AND ( Data(0)); + Result(6) := ( Data(2)) AND ( Data(1)) AND (NOT Data(0)); + Result(5) := ( Data(2)) AND (NOT Data(1)) AND ( Data(0)); + Result(4) := ( Data(2)) AND (NOT Data(1)) AND (NOT Data(0)); + Result(3) := (NOT Data(2)) AND ( Data(1)) AND ( Data(0)); + Result(2) := (NOT Data(2)) AND ( Data(1)) AND (NOT Data(0)); + Result(1) := (NOT Data(2)) AND (NOT Data(1)) AND ( Data(0)); + Result(0) := (NOT Data(2)) AND (NOT Data(1)) AND (NOT Data(0)); + + Result(0) := ResultMap ( Enable AND Result(0) ); + Result(1) := ResultMap ( Enable AND Result(1) ); + Result(2) := ResultMap ( Enable AND Result(2) ); + Result(3) := ResultMap ( Enable AND Result(3) ); + Result(4) := ResultMap ( Enable AND Result(4) ); + Result(5) := ResultMap ( Enable AND Result(5) ); + Result(6) := ResultMap ( Enable AND Result(6) ); + Result(7) := ResultMap ( Enable AND Result(7) ); + + RETURN Result; + END; +-- + FUNCTION VitalDECODER ( + CONSTANT Data : IN std_logic_vector; + CONSTANT Enable : IN std_ulogic; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) RETURN std_logic_vector IS + + CONSTANT DMsb : INTEGER := Data'LENGTH - 1; + ALIAS DataAlias : std_logic_vector ( DMsb DOWNTO 0 ) IS Data; + BEGIN + IF Data'LENGTH = 1 THEN + RETURN VitalDECODER2 (DataAlias( 0 ), Enable, ResultMap ); + ELSIF Data'LENGTH = 2 THEN + RETURN VitalDECODER4 (DataAlias(1 DOWNTO 0), Enable, ResultMap ); + ELSIF Data'LENGTH = 3 THEN + RETURN VitalDECODER8 (DataAlias(2 DOWNTO 0), Enable, ResultMap ); + ELSIF Data'LENGTH > 3 THEN + RETURN VitalDECODER (DataAlias(DMsb-1 DOWNTO 0), + Enable AND ( DataAlias(DMsb)), ResultMap ) + & VitalDECODER (DataAlias(DMsb-1 DOWNTO 0), + Enable AND (NOT DataAlias(DMsb)), ResultMap ); + ELSE RETURN "X"; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- N-bit wide Logical gates. + -- ------------------------------------------------------------------------ + PROCEDURE VitalAND ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE Data_Schd : SchedArray(Data'RANGE); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalAND(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := '1'; + new_schd := Data_Schd(Data_Schd'LEFT); + FOR i IN Data'RANGE LOOP + NewValue := NewValue AND Data(i); + new_schd := new_schd AND Data_Schd(i); + END LOOP; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; --SN + END; +-- + PROCEDURE VitalOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE Data_Schd : SchedArray(Data'RANGE); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalOR(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := '0'; + new_schd := Data_Schd(Data_Schd'LEFT); + FOR i IN Data'RANGE LOOP + NewValue := NewValue OR Data(i); + new_schd := new_schd OR Data_Schd(i); + END LOOP; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; --SN + END; +-- + PROCEDURE VitalXOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE DataB_Schd : SchedArray(1 TO Data'LENGTH); + VARIABLE DataI_Schd : SchedArray(1 TO Data'LENGTH); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + ALIAS ADataB_Schd : SchedArray(Data'RANGE) IS DataB_Schd; + ALIAS ADataI_Schd : SchedArray(Data'RANGE) IS DataI_Schd; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalXOR(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( ADataB_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + InvPath ( ADataI_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( DataB_Schd, Data_Edge, Atpd_data_q ); + InvPath ( DataI_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalXOR ( Data ); + new_schd := VitalXOR ( DataB_Schd, DataI_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; --SN + END; +-- + PROCEDURE VitalNAND ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE Data_Schd : SchedArray(Data'RANGE); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalNAND(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + InvPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + InvPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := '1'; + new_schd := Data_Schd(Data_Schd'LEFT); + FOR i IN Data'RANGE LOOP + NewValue := NewValue AND Data(i); + new_schd := new_schd AND Data_Schd(i); + END LOOP; + NewValue := NOT NewValue; + new_schd := NOT new_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE Data_Schd : SchedArray(Data'RANGE); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalNOR(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + InvPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + InvPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := '0'; + new_schd := Data_Schd(Data_Schd'LEFT); + FOR i IN Data'RANGE LOOP + NewValue := NewValue OR Data(i); + new_schd := new_schd OR Data_Schd(i); + END LOOP; + NewValue := NOT NewValue; + new_schd := NOT new_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; --SN + END; +-- + PROCEDURE VitalXNOR ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE DataB_Schd : SchedArray(1 TO Data'LENGTH); + VARIABLE DataI_Schd : SchedArray(1 TO Data'LENGTH); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + ALIAS ADataB_Schd : SchedArray(Data'RANGE) IS DataB_Schd; + ALIAS ADataI_Schd : SchedArray(Data'RANGE) IS DataI_Schd; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN LOOP + q <= VitalXNOR(Data, ResultMap); + WAIT ON Data; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( ADataB_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + InvPath ( ADataI_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( DataB_Schd, Data_Edge, Atpd_data_q ); + InvPath ( DataI_Schd, Data_Edge, Atpd_data_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalXNOR ( Data ); + new_schd := VitalXNOR ( DataB_Schd, DataI_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data; + END LOOP; + END IF; --SN + END; +-- + + -- ------------------------------------------------------------------------ + -- Commonly used 2-bit Logical gates. + -- ------------------------------------------------------------------------ + PROCEDURE VitalAND2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalAND2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a AND b; + new_schd := a_schd AND b_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalOR2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a OR b; + new_schd := a_schd OR b_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNAND2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNAND2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a NAND b; + new_schd := a_schd NAND b_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNOR2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a NOR b; + new_schd := a_schd NOR b_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd : SchedType; + VARIABLE ai_schd, bi_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXOR2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a XOR b; + new_schd := VitalXOR2 ( ab_schd,ai_schd, bb_schd,bi_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXNOR2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd : SchedType; + VARIABLE ai_schd, bi_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ((tpd_a_q = VitalZeroDelay01) AND (tpd_b_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXNOR2 ( a, b, ResultMap ); + WAIT ON a, b; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := NOT (a XOR b); + new_schd := VitalXNOR2 ( ab_schd,ai_schd, bb_schd,bi_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Commonly used 3-bit Logical gates. + -- ------------------------------------------------------------------------ + PROCEDURE VitalAND3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN +-- + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalAND3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + BufPath ( c_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + BufPath ( c_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a AND b AND c; + new_schd := a_schd AND b_schd AND c_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalOR3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + BufPath ( c_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + BufPath ( c_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a OR b OR c; + new_schd := a_schd OR b_schd OR c_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNAND3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNAND3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + InvPath ( c_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + InvPath ( c_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := (a AND b) NAND c; + new_schd := (a_schd AND b_schd) NAND c_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNOR3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + InvPath ( c_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + InvPath ( c_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := (a OR b) NOR c; + new_schd := (a_schd OR b_schd) NOR c_schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd, cb_schd : SchedType; + VARIABLE ai_schd, bi_schd, ci_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXOR3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + BufPath ( cb_schd, InitialEdge(c), tpd_c_q ); + InvPath ( ci_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + BufPath ( cb_schd, GetEdge(c), tpd_c_q ); + InvPath ( ci_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a XOR b XOR c; + new_schd := VitalXOR3 ( ab_schd,ai_schd, + bb_schd,bi_schd, + cb_schd,ci_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXNOR3 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd, cb_schd : SchedType; + VARIABLE ai_schd, bi_schd, ci_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXNOR3 ( a, b, c, ResultMap ); + WAIT ON a, b, c; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + BufPath ( cb_schd, InitialEdge(c), tpd_c_q ); + InvPath ( ci_schd, InitialEdge(c), tpd_c_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + BufPath ( cb_schd, GetEdge(c), tpd_c_q ); + InvPath ( ci_schd, GetEdge(c), tpd_c_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := NOT (a XOR b XOR c); + new_schd := VitalXNOR3 ( ab_schd, ai_schd, + bb_schd, bi_schd, + cb_schd, ci_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Commonly used 4-bit Logical gates. + -- ------------------------------------------------------------------------ + PROCEDURE VitalAND4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalAND4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + BufPath ( c_schd, InitialEdge(c), tpd_c_q ); + BufPath ( d_Schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + BufPath ( c_schd, GetEdge(c), tpd_c_q ); + BufPath ( d_Schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a AND b AND c AND d; + new_schd := a_schd AND b_schd AND c_schd AND d_Schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalOR4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( a_schd, InitialEdge(a), tpd_a_q ); + BufPath ( b_schd, InitialEdge(b), tpd_b_q ); + BufPath ( c_schd, InitialEdge(c), tpd_c_q ); + BufPath ( d_Schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( a_schd, GetEdge(a), tpd_a_q ); + BufPath ( b_schd, GetEdge(b), tpd_b_q ); + BufPath ( c_schd, GetEdge(c), tpd_c_q ); + BufPath ( d_Schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a OR b OR c OR d; + new_schd := a_schd OR b_schd OR c_schd OR d_Schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNAND4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNAND4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + InvPath ( c_schd, InitialEdge(c), tpd_c_q ); + InvPath ( d_Schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + InvPath ( c_schd, GetEdge(c), tpd_c_q ); + InvPath ( d_Schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := (a AND b) NAND (c AND d); + new_schd := (a_schd AND b_schd) NAND (c_schd AND d_Schd); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalNOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE a_schd, b_schd, c_schd, d_Schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalNOR4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( a_schd, InitialEdge(a), tpd_a_q ); + InvPath ( b_schd, InitialEdge(b), tpd_b_q ); + InvPath ( c_schd, InitialEdge(c), tpd_c_q ); + InvPath ( d_Schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( a_schd, GetEdge(a), tpd_a_q ); + InvPath ( b_schd, GetEdge(b), tpd_b_q ); + InvPath ( c_schd, GetEdge(c), tpd_c_q ); + InvPath ( d_Schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := (a OR b) NOR (c OR d); + new_schd := (a_schd OR b_schd) NOR (c_schd OR d_Schd); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd, cb_schd, DB_Schd : SchedType; + VARIABLE ai_schd, bi_schd, ci_schd, di_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXOR4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + + BufPath ( cb_schd, InitialEdge(c), tpd_c_q ); + InvPath ( ci_schd, InitialEdge(c), tpd_c_q ); + + BufPath ( DB_Schd, InitialEdge(d), tpd_d_q ); + InvPath ( di_schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + BufPath ( cb_schd, GetEdge(c), tpd_c_q ); + InvPath ( ci_schd, GetEdge(c), tpd_c_q ); + + BufPath ( DB_Schd, GetEdge(d), tpd_d_q ); + InvPath ( di_schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := a XOR b XOR c XOR d; + new_schd := VitalXOR4 ( ab_schd,ai_schd, bb_schd,bi_schd, + cb_schd,ci_schd, DB_Schd,di_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalXNOR4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL a, b, c, d : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_b_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_c_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE ab_schd, bb_schd, cb_schd, DB_Schd : SchedType; + VARIABLE ai_schd, bi_schd, ci_schd, di_schd : SchedType; + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_a_q = VitalZeroDelay01) + AND (tpd_b_q = VitalZeroDelay01) + AND (tpd_c_q = VitalZeroDelay01) + AND (tpd_d_q = VitalZeroDelay01)) THEN + LOOP + q <= VitalXNOR4 ( a, b, c, d, ResultMap ); + WAIT ON a, b, c, d; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( ab_schd, InitialEdge(a), tpd_a_q ); + InvPath ( ai_schd, InitialEdge(a), tpd_a_q ); + + BufPath ( bb_schd, InitialEdge(b), tpd_b_q ); + InvPath ( bi_schd, InitialEdge(b), tpd_b_q ); + + BufPath ( cb_schd, InitialEdge(c), tpd_c_q ); + InvPath ( ci_schd, InitialEdge(c), tpd_c_q ); + + BufPath ( DB_Schd, InitialEdge(d), tpd_d_q ); + InvPath ( di_schd, InitialEdge(d), tpd_d_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( ab_schd, GetEdge(a), tpd_a_q ); + InvPath ( ai_schd, GetEdge(a), tpd_a_q ); + + BufPath ( bb_schd, GetEdge(b), tpd_b_q ); + InvPath ( bi_schd, GetEdge(b), tpd_b_q ); + + BufPath ( cb_schd, GetEdge(c), tpd_c_q ); + InvPath ( ci_schd, GetEdge(c), tpd_c_q ); + + BufPath ( DB_Schd, GetEdge(d), tpd_d_q ); + InvPath ( di_schd, GetEdge(d), tpd_d_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := NOT (a XOR b XOR c XOR d); + new_schd := VitalXNOR4 ( ab_schd,ai_schd, bb_schd,bi_schd, + cb_schd,ci_schd, DB_Schd,di_schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON a, b, c, d; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Buffers + -- BUF ....... standard non-inverting buffer + -- BUFIF0 ....... non-inverting buffer Data passes thru if (Enable = '0') + -- BUFIF1 ....... non-inverting buffer Data passes thru if (Enable = '1') + -- ------------------------------------------------------------------------ + PROCEDURE VitalBUF ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_a_q = VitalZeroDelay01) THEN + LOOP + q <= ResultMap(To_UX01(a)); + WAIT ON a; + END LOOP; + + ELSE + LOOP + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := To_UX01(a); -- convert to forcing strengths + CASE EdgeType'(GetEdge(a)) IS + WHEN '1'|'/'|'R'|'r' => Dly := tpd_a_q(tr01); + WHEN '0'|'\'|'F'|'f' => Dly := tpd_a_q(tr10); + WHEN OTHERS => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10)); + END CASE; + + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode ); + + WAIT ON a; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalBUFIF1 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) IS + VARIABLE NewValue : UX01Z; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_data_q = VitalZeroDelay01 ) + AND (tpd_enable_q = VitalZeroDelay01Z)) THEN + LOOP + q <= VitalBUFIF1( Data, Enable, ResultMap ); + WAIT ON Data, Enable; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( d_Schd, InitialEdge(Data), tpd_data_q ); + BufEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( d_Schd, GetEdge(Data), tpd_data_q ); + BufEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalBUFIF1( Data, Enable ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), + d_Schd, e1_Schd, e0_Schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalBUFIF0 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) IS + VARIABLE NewValue : UX01Z; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType; + VARIABLE ne1_schd, ne0_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_data_q = VitalZeroDelay01 ) + AND (tpd_enable_q = VitalZeroDelay01Z)) THEN + LOOP + q <= VitalBUFIF0( Data, Enable, ResultMap ); + WAIT ON Data, Enable; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( d_Schd, InitialEdge(Data), tpd_data_q ); + InvEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( d_Schd, GetEdge(Data), tpd_data_q ); + InvEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalBUFIF0( Data, Enable ); + ne1_schd := NOT e1_Schd; + ne0_schd := NOT e0_Schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), + d_Schd, ne1_schd, ne0_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; + + PROCEDURE VitalIDENT ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) IS + SUBTYPE v2 IS std_logic_vector(0 TO 1); + VARIABLE NewValue : UX01Z; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_a_q = VitalZeroDelay01Z) THEN + LOOP + q <= ResultMap(To_UX01Z(a)); + WAIT ON a; + END LOOP; + + ELSE + LOOP + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + CASE v2'(To_X01Z(NewValue) & To_X01Z(a)) IS + WHEN "00" => Dly := tpd_a_q(tr10); + WHEN "01" => Dly := tpd_a_q(tr01); + WHEN "0Z" => Dly := tpd_a_q(tr0z); + WHEN "0X" => Dly := tpd_a_q(tr01); + WHEN "10" => Dly := tpd_a_q(tr10); + WHEN "11" => Dly := tpd_a_q(tr01); + WHEN "1Z" => Dly := tpd_a_q(tr1z); + WHEN "1X" => Dly := tpd_a_q(tr10); + WHEN "Z0" => Dly := tpd_a_q(trz0); + WHEN "Z1" => Dly := tpd_a_q(trz1); + WHEN "ZZ" => Dly := 0 ns; + WHEN "ZX" => Dly := Minimum (tpd_a_q(trz1), tpd_a_q(trz0)); + WHEN "X0" => Dly := tpd_a_q(tr10); + WHEN "X1" => Dly := tpd_a_q(tr01); + WHEN "XZ" => Dly := Minimum (tpd_a_q(tr0z), tpd_a_q(tr1z)); + WHEN OTHERS => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10)); + END CASE; + NewValue := To_UX01Z(a); + + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode ); + + WAIT ON a; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Invertors + -- INV ......... standard inverting buffer + -- INVIF0 ......... inverting buffer Data passes thru if (Enable = '0') + -- INVIF1 ......... inverting buffer Data passes thru if (Enable = '1') + -- ------------------------------------------------------------------------ + PROCEDURE VitalINV ( + SIGNAL q : OUT std_ulogic; + SIGNAL a : IN std_ulogic ; + CONSTANT tpd_a_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + IF (tpd_a_q = VitalZeroDelay01) THEN + LOOP + q <= ResultMap(NOT a); + WAIT ON a; + END LOOP; + + ELSE + LOOP + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := NOT a; + CASE EdgeType'(GetEdge(a)) IS + WHEN '1'|'/'|'R'|'r' => Dly := tpd_a_q(tr10); + WHEN '0'|'\'|'F'|'f' => Dly := tpd_a_q(tr01); + WHEN OTHERS => Dly := Minimum (tpd_a_q(tr01), tpd_a_q(tr10)); + END CASE; + + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode ); + + WAIT ON a; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalINVIF1 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) IS + VARIABLE NewValue : UX01Z; + VARIABLE new_schd : SchedType; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_data_q = VitalZeroDelay01 ) + AND (tpd_enable_q = VitalZeroDelay01Z)) THEN + LOOP + q <= VitalINVIF1( Data, Enable, ResultMap ); + WAIT ON Data, Enable; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( d_Schd, InitialEdge(Data), tpd_data_q ); + BufEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( d_Schd, GetEdge(Data), tpd_data_q ); + BufEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalINVIF1( Data, Enable ); + new_schd := NOT d_Schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), + new_schd, e1_Schd, e0_Schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalINVIF0 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01Z := VitalDefDelay01Z; + CONSTANT ResultMap : IN VitalResultZMapType + := VitalDefaultResultZMap + ) IS + VARIABLE NewValue : UX01Z; + VARIABLE new_schd : SchedType; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE d_Schd, e1_Schd, e0_Schd : SchedType; + VARIABLE ne1_schd, ne0_schd : SchedType := DefSchedType; + VARIABLE Dly, Glch : TIME; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_data_q = VitalZeroDelay01 ) + AND (tpd_enable_q = VitalZeroDelay01Z)) THEN + LOOP + q <= VitalINVIF0( Data, Enable, ResultMap ); + WAIT ON Data, Enable; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + InvPath ( d_Schd, InitialEdge(Data), tpd_data_q ); + InvEnab ( e1_Schd, e0_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + InvPath ( d_Schd, GetEdge(Data), tpd_data_q ); + InvEnab ( e1_Schd, e0_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delay + -- ------------------------------------ + NewValue := VitalINVIF0( Data, Enable ); + ne1_schd := NOT e1_Schd; + ne0_schd := NOT e0_Schd; + new_schd := NOT d_Schd; + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), + new_schd, ne1_schd, ne0_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + -- Multiplexor + -- MUX .......... result := data(dselect) + -- MUX2 .......... 2-input mux; result := data0 when (dselect = '0'), + -- data1 when (dselect = '1'), + -- 'X' when (dselect = 'X') and (data0 /= data1) + -- MUX4 .......... 4-input mux; result := data(dselect) + -- MUX8 .......... 8-input mux; result := data(dselect) + -- ------------------------------------------------------------------------ + PROCEDURE VitalMUX2 ( + SIGNAL q : OUT std_ulogic; + SIGNAL d1, d0 : IN std_ulogic; + SIGNAL dSel : IN std_ulogic; + CONSTANT tpd_d1_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_d0_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_dsel_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + VARIABLE d1_Schd, d0_Schd : SchedType; + VARIABLE dSel_bSchd, dSel_iSchd : SchedType; + VARIABLE d1_Edge, d0_Edge, dSel_Edge : EdgeType; + BEGIN + + -- ------------------------------------------------------------------------ + -- For ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF ( (tpd_d1_q = VitalZeroDelay01) + AND (tpd_d0_q = VitalZeroDelay01) + AND (tpd_dsel_q = VitalZeroDelay01) ) THEN + LOOP + q <= VitalMUX2 ( d1, d0, dSel, ResultMap ); + WAIT ON d1, d0, dSel; + END LOOP; + + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( d1_Schd, InitialEdge(d1), tpd_d1_q ); + BufPath ( d0_Schd, InitialEdge(d0), tpd_d0_q ); + BufPath ( dSel_bSchd, InitialEdge(dSel), tpd_dsel_q ); + InvPath ( dSel_iSchd, InitialEdge(dSel), tpd_dsel_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( d1_Schd, GetEdge(d1), tpd_d1_q ); + BufPath ( d0_Schd, GetEdge(d0), tpd_d0_q ); + BufPath ( dSel_bSchd, GetEdge(dSel), tpd_dsel_q ); + InvPath ( dSel_iSchd, GetEdge(dSel), tpd_dsel_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalMUX2 ( d1, d0, dSel ); + new_schd := VitalMUX2 ( d1_Schd, d0_Schd, dSel_bSchd, dSel_iSchd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON d1, d0, dSel; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalMUX4 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector4; + SIGNAL dSel : IN std_logic_vector2; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE LastdSel : std_logic_vector(dSel'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + VARIABLE Data_Schd : SchedArray4; + VARIABLE Data_Edge : EdgeArray4; + VARIABLE dSel_Edge : EdgeArray2; + VARIABLE dSel_bSchd : SchedArray2; + VARIABLE dSel_iSchd : SchedArray2; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN dSel'RANGE LOOP + IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + + IF (AllZeroDelay) THEN LOOP + q <= VitalMUX(Data, dSel, ResultMap); + WAIT ON Data, dSel; + END LOOP; + END IF; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + FOR n IN dSel'RANGE LOOP + BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + GetEdge ( dSel, LastdSel, dSel_Edge ); + BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q ); + InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalMUX4 ( Data, dSel ); + new_schd := VitalMUX4 ( Data_Schd, dSel_bSchd, dSel_iSchd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, dSel; + END LOOP; + END IF; --SN + END; + + PROCEDURE VitalMUX8 ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector8; + SIGNAL dSel : IN std_logic_vector3; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE LastdSel : std_logic_vector(dSel'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + VARIABLE Data_Schd : SchedArray8; + VARIABLE Data_Edge : EdgeArray8; + VARIABLE dSel_Edge : EdgeArray3; + VARIABLE dSel_bSchd : SchedArray3; + VARIABLE dSel_iSchd : SchedArray3; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN dSel'RANGE LOOP + IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + + IF (AllZeroDelay) THEN LOOP + q <= VitalMUX(Data, dSel, ResultMap); + WAIT ON Data, dSel; + END LOOP; + END IF; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + FOR n IN dSel'RANGE LOOP + BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + GetEdge ( dSel, LastdSel, dSel_Edge ); + BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q ); + InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalMUX8 ( Data, dSel ); + new_schd := VitalMUX8 ( Data_Schd, dSel_bSchd, dSel_iSchd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, dSel; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalMUX ( + SIGNAL q : OUT std_ulogic; + SIGNAL Data : IN std_logic_vector; + SIGNAL dSel : IN std_logic_vector; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_dsel_q : IN VitalDelayArrayType01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE LastdSel : std_logic_vector(dSel'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : UX01; + VARIABLE Glitch_Data : GlitchDataType; + VARIABLE new_schd : SchedType; + VARIABLE Dly, Glch : TIME; + VARIABLE Data_Schd : SchedArray(Data'RANGE); + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE dSel_Edge : EdgeArray(dSel'RANGE); + VARIABLE dSel_bSchd : SchedArray(dSel'RANGE); + VARIABLE dSel_iSchd : SchedArray(dSel'RANGE); + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + ALIAS Atpd_dsel_q : VitalDelayArrayType01(dSel'RANGE) IS tpd_dsel_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + FOR i IN dSel'RANGE LOOP + IF (Atpd_dsel_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + IF (AllZeroDelay) THEN + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + + IF (AllZeroDelay) THEN LOOP + q <= VitalMUX(Data, dSel, ResultMap); + WAIT ON Data, dSel; + END LOOP; + END IF; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_Schd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + FOR n IN dSel'RANGE LOOP + BufPath ( dSel_bSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + InvPath ( dSel_iSchd(n), InitialEdge(dSel(n)), Atpd_dsel_q(n) ); + END LOOP; + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_Schd, Data_Edge, Atpd_data_q ); + + GetEdge ( dSel, LastdSel, dSel_Edge ); + BufPath ( dSel_bSchd, dSel_Edge, Atpd_dsel_q ); + InvPath ( dSel_iSchd, dSel_Edge, Atpd_dsel_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalMUX ( Data, dSel ); + new_schd := VitalMUX ( Data_Schd, dSel_bSchd, dSel_iSchd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, ResultMap(NewValue), Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, dSel; + END LOOP; + END IF; --SN + END; + + -- ------------------------------------------------------------------------ + -- Decoder + -- General Algorithm : + -- (a) Result(...) := '0' when (enable = '0') + -- (b) Result(data) := '1'; all other subelements = '0' + -- ... Result array is decending (n-1 downto 0) + -- + -- DECODERn .......... n:2**n decoder + -- Caution: If 'ResultMap' defines other than strength mapping, the + -- delay selection is not defined. + -- ------------------------------------------------------------------------ + PROCEDURE VitalDECODER2 ( + SIGNAL q : OUT std_logic_vector2; + SIGNAL Data : IN std_ulogic; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE NewValue : std_logic_vector2; + VARIABLE Glitch_Data : GlitchArray2; + VARIABLE new_schd : SchedArray2; + VARIABLE Dly, Glch : TimeArray2; + VARIABLE Enable_Schd : SchedType := DefSchedType; + VARIABLE Data_BSchd, Data_ISchd : SchedType; + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_enable_q = VitalZeroDelay01) AND (tpd_data_q = VitalZeroDelay01) THEN + LOOP + q <= VitalDECODER2(Data, Enable, ResultMap); + WAIT ON Data, Enable; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + BufPath ( Data_BSchd, InitialEdge(Data), tpd_data_q ); + InvPath ( Data_ISchd, InitialEdge(Data), tpd_data_q ); + BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + BufPath ( Data_BSchd, GetEdge(Data), tpd_data_q ); + InvPath ( Data_ISchd, GetEdge(Data), tpd_data_q ); + + BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalDECODER2 ( Data, Enable, ResultMap ); + new_schd := VitalDECODER2 ( Data_BSchd, Data_ISchd, Enable_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; -- SN + END; +-- + PROCEDURE VitalDECODER4 ( + SIGNAL q : OUT std_logic_vector4; + SIGNAL Data : IN std_logic_vector2; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : std_logic_vector4; + VARIABLE Glitch_Data : GlitchArray4; + VARIABLE new_schd : SchedArray4; + VARIABLE Dly, Glch : TimeArray4; + VARIABLE Enable_Schd : SchedType; + VARIABLE Enable_Edge : EdgeType; + VARIABLE Data_Edge : EdgeArray2; + VARIABLE Data_BSchd, Data_ISchd : SchedArray2; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_enable_q /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + ELSE + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + END IF; + IF (AllZeroDelay) THEN LOOP + q <= VitalDECODER4(Data, Enable, ResultMap); + WAIT ON Data, Enable; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_BSchd, Data_Edge, Atpd_data_q ); + InvPath ( Data_ISchd, Data_Edge, Atpd_data_q ); + + BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalDECODER4 ( Data, Enable, ResultMap ); + new_schd := VitalDECODER4 ( Data_BSchd, Data_ISchd, Enable_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; +-- + PROCEDURE VitalDECODER8 ( + SIGNAL q : OUT std_logic_vector8; + SIGNAL Data : IN std_logic_vector3; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : std_logic_vector8; + VARIABLE Glitch_Data : GlitchArray8; + VARIABLE new_schd : SchedArray8; + VARIABLE Dly, Glch : TimeArray8; + VARIABLE Enable_Schd : SchedType; + VARIABLE Enable_Edge : EdgeType; + VARIABLE Data_Edge : EdgeArray3; + VARIABLE Data_BSchd, Data_ISchd : SchedArray3; + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; --SN + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_enable_q /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + ELSE + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + END IF; + IF (AllZeroDelay) THEN LOOP + q <= VitalDECODER(Data, Enable, ResultMap); + WAIT ON Data, Enable; + END LOOP; + ELSE + + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_BSchd, Data_Edge, Atpd_data_q ); + InvPath ( Data_ISchd, Data_Edge, Atpd_data_q ); + + BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalDECODER8 ( Data, Enable, ResultMap ); + new_schd := VitalDECODER8 ( Data_BSchd, Data_ISchd, Enable_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; --SN + END; +-- + PROCEDURE VitalDECODER ( + SIGNAL q : OUT std_logic_vector; + SIGNAL Data : IN std_logic_vector; + SIGNAL Enable : IN std_ulogic; + CONSTANT tpd_data_q : IN VitalDelayArrayType01; + CONSTANT tpd_enable_q : IN VitalDelayType01 := VitalDefDelay01; + CONSTANT ResultMap : IN VitalResultMapType + := VitalDefaultResultMap + ) IS + VARIABLE LastData : std_logic_vector(Data'RANGE) := (OTHERS=>'U'); + VARIABLE NewValue : std_logic_vector(q'RANGE); + VARIABLE Glitch_Data : GlitchDataArrayType(q'RANGE); + VARIABLE new_schd : SchedArray(q'RANGE); + VARIABLE Dly, Glch : VitalTimeArray(q'RANGE); + VARIABLE Enable_Schd : SchedType; + VARIABLE Enable_Edge : EdgeType; + VARIABLE Data_Edge : EdgeArray(Data'RANGE); + VARIABLE Data_BSchd, Data_ISchd : SchedArray(Data'RANGE); + ALIAS Atpd_data_q : VitalDelayArrayType01(Data'RANGE) IS tpd_data_q; + VARIABLE AllZeroDelay : BOOLEAN := TRUE; + BEGIN + -- ------------------------------------------------------------------------ + -- Check if ALL zero delay paths, use simple model + -- ( No delay selection, glitch detection required ) + -- ------------------------------------------------------------------------ + IF (tpd_enable_q /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + ELSE + FOR i IN Data'RANGE LOOP + IF (Atpd_data_q(i) /= VitalZeroDelay01) THEN + AllZeroDelay := FALSE; + EXIT; + END IF; + END LOOP; + END IF; + IF (AllZeroDelay) THEN LOOP + q <= VitalDECODER(Data, Enable, ResultMap); + WAIT ON Data, Enable; + END LOOP; + ELSE + -- -------------------------------------- + -- Initialize delay schedules + -- -------------------------------------- + FOR n IN Data'RANGE LOOP + BufPath ( Data_BSchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + InvPath ( Data_ISchd(n), InitialEdge(Data(n)), Atpd_data_q(n) ); + END LOOP; + BufPath ( Enable_Schd, InitialEdge(Enable), tpd_enable_q ); + + LOOP + -- -------------------------------------- + -- Process input signals + -- get edge values + -- re-evaluate output schedules + -- -------------------------------------- + GetEdge ( Data, LastData, Data_Edge ); + BufPath ( Data_BSchd, Data_Edge, Atpd_data_q ); + InvPath ( Data_ISchd, Data_Edge, Atpd_data_q ); + + BufPath ( Enable_Schd, GetEdge(Enable), tpd_enable_q ); + + -- ------------------------------------ + -- Compute function and propation delaq + -- ------------------------------------ + NewValue := VitalDECODER ( Data, Enable, ResultMap ); + new_schd := VitalDECODER ( Data_BSchd, Data_ISchd, Enable_Schd ); + + -- ------------------------------------------------------ + -- Assign Outputs + -- get delays to new value and possable glitch + -- schedule output change with On Event glitch detection + -- ------------------------------------------------------ + GetSchedDelay ( Dly, Glch, NewValue, CurValue(Glitch_Data), new_schd ); + VitalGlitchOnEvent ( q, "q", Glitch_Data, NewValue, Dly, + PrimGlitchMode, GlitchDelay=>Glch ); + + WAIT ON Data, Enable; + END LOOP; + END IF; + END; + + -- ------------------------------------------------------------------------ + FUNCTION VitalTruthTable ( + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ) RETURN std_logic_vector IS + + CONSTANT InputSize : INTEGER := DataIn'LENGTH; + CONSTANT OutSize : INTEGER := TruthTable'LENGTH(2) - InputSize; + VARIABLE ReturnValue : std_logic_vector(OutSize - 1 DOWNTO 0) + := (OTHERS => 'X'); + VARIABLE DataInAlias : std_logic_vector(0 TO InputSize - 1) + := To_X01(DataIn); + VARIABLE Index : INTEGER; + VARIABLE Err : BOOLEAN := FALSE; + + -- This needs to be done since the TableLookup arrays must be + -- ascending starting with 0 + VARIABLE TableAlias : VitalTruthTableType(0 TO (TruthTable'LENGTH(1)-1), + 0 TO (TruthTable'LENGTH(2)-1)) + := TruthTable; + + BEGIN + -- search through each row of the truth table + IF OutSize > 0 THEN + ColLoop: + FOR i IN TableAlias'RANGE(1) LOOP + + RowLoop: -- Check each input element of the entry + FOR j IN 0 TO InputSize LOOP + + IF (j = InputSize) THEN -- This entry matches + -- Return the Result + Index := 0; + FOR k IN TruthTable'LENGTH(2) - 1 DOWNTO InputSize LOOP + TruthOutputX01Z ( TableAlias(i,k), + ReturnValue(Index), Err); + EXIT WHEN Err; + Index := Index + 1; + END LOOP; + + IF Err THEN + ReturnValue := (OTHERS => 'X'); + END IF; + RETURN ReturnValue; + END IF; + IF NOT ValidTruthTableInput(TableAlias(i,j)) THEN + VitalError ( "VitalTruthTable", ErrInpSym, + To_TruthChar(TableAlias(i,j)) ); + EXIT ColLoop; + END IF; + EXIT RowLoop WHEN NOT ( TruthTableMatch( DataInAlias(j), + TableAlias(i, j))); + END LOOP RowLoop; + END LOOP ColLoop; + + ELSE + VitalError ( "VitalTruthTable", ErrTabWidSml ); + END IF; + RETURN ReturnValue; + END VitalTruthTable; + + FUNCTION VitalTruthTable ( + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ) RETURN std_logic IS + + CONSTANT InputSize : INTEGER := DataIn'LENGTH; + CONSTANT OutSize : INTEGER := TruthTable'LENGTH(2) - InputSize; + VARIABLE TempResult : std_logic_vector(OutSize - 1 DOWNTO 0) + := (OTHERS => 'X'); + BEGIN + IF (OutSize > 0) THEN + TempResult := VitalTruthTable(TruthTable, DataIn); + IF ( 1 > OutSize) THEN + VitalError ( "VitalTruthTable", ErrTabResSml ); + ELSIF ( 1 < OutSize) THEN + VitalError ( "VitalTruthTable", ErrTabResLrg ); + END IF; + RETURN (TempResult(0)); + ELSE + VitalError ( "VitalTruthTable", ErrTabWidSml ); + RETURN 'X'; + END IF; + END VitalTruthTable; + + PROCEDURE VitalTruthTable ( + SIGNAL Result : OUT std_logic_vector; + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ) IS + CONSTANT ResLeng : INTEGER := Result'LENGTH; + CONSTANT ActResLen : INTEGER := TruthTable'LENGTH(2) - DataIn'LENGTH; + CONSTANT FinalResLen : INTEGER := Minimum(ActResLen, ResLeng); + VARIABLE TempResult : std_logic_vector(ActResLen - 1 DOWNTO 0) + := (OTHERS => 'X'); + + BEGIN + TempResult := VitalTruthTable(TruthTable, DataIn); + + IF (ResLeng > ActResLen) THEN + VitalError ( "VitalTruthTable", ErrTabResSml ); + ELSIF (ResLeng < ActResLen) THEN + VitalError ( "VitalTruthTable", ErrTabResLrg ); + END IF; + TempResult(FinalResLen-1 DOWNTO 0) := TempResult(FinalResLen-1 DOWNTO 0); + Result <= TempResult; + + END VitalTruthTable; + + PROCEDURE VitalTruthTable ( + SIGNAL Result : OUT std_logic; + CONSTANT TruthTable : IN VitalTruthTableType; + CONSTANT DataIn : IN std_logic_vector + ) IS + + CONSTANT ActResLen : INTEGER := TruthTable'LENGTH(2) - DataIn'LENGTH; + VARIABLE TempResult : std_logic_vector(ActResLen - 1 DOWNTO 0) + := (OTHERS => 'X'); + + BEGIN + TempResult := VitalTruthTable(TruthTable, DataIn); + + IF ( 1 > ActResLen) THEN + VitalError ( "VitalTruthTable", ErrTabResSml ); + ELSIF ( 1 < ActResLen) THEN + VitalError ( "VitalTruthTable", ErrTabResLrg ); + END IF; + IF (ActResLen > 0) THEN + Result <= TempResult(0); + END IF; + + END VitalTruthTable; + + -- ------------------------------------------------------------------------ + PROCEDURE VitalStateTable ( + VARIABLE Result : INOUT std_logic_vector; + VARIABLE PreviousDataIn : INOUT std_logic_vector; + CONSTANT StateTable : IN VitalStateTableType; + CONSTANT DataIn : IN std_logic_vector; + CONSTANT NumStates : IN NATURAL + ) IS + + CONSTANT InputSize : INTEGER := DataIn'LENGTH; + CONSTANT OutSize : INTEGER + := StateTable'LENGTH(2) - InputSize - NumStates; + CONSTANT ResLeng : INTEGER := Result'LENGTH; + VARIABLE DataInAlias : std_logic_vector(0 TO DataIn'LENGTH-1) + := To_X01(DataIn); + VARIABLE PrevDataAlias : std_logic_vector(0 TO PreviousDataIn'LENGTH-1) + := To_X01(PreviousDataIn); + VARIABLE ResultAlias : std_logic_vector(0 TO ResLeng-1) + := To_X01(Result); + VARIABLE ExpResult : std_logic_vector(0 TO OutSize-1); + + BEGIN + IF (PreviousDataIn'LENGTH < DataIn'LENGTH) THEN + VitalError ( "VitalStateTable", ErrVctLng, "PreviousDataIn 'X'); + Result := ResultAlias; + + ELSIF (OutSize <= 0) THEN + VitalError ( "VitalStateTable", ErrTabWidSml ); + + ResultAlias := (OTHERS => 'X'); + Result := ResultAlias; + + ELSE + IF (ResLeng > OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResSml ); + ELSIF (ResLeng < OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResLrg ); + END IF; + + ExpResult := StateTableLookUp ( StateTable, DataInAlias, + PrevDataAlias, NumStates, + ResultAlias); + ResultAlias := (OTHERS => 'X'); + ResultAlias ( Maximum(0, ResLeng - OutSize) TO ResLeng - 1) + := ExpResult(Maximum(0, OutSize - ResLeng) TO OutSize-1); + + Result := ResultAlias; + PrevDataAlias(0 TO InputSize - 1) := DataInAlias; + PreviousDataIn := PrevDataAlias; + + END IF; + END VitalStateTable; + + + PROCEDURE VitalStateTable ( + VARIABLE Result : INOUT std_logic; -- states + VARIABLE PreviousDataIn : INOUT std_logic_vector; -- previous inputs and states + CONSTANT StateTable : IN VitalStateTableType; -- User's StateTable data + CONSTANT DataIn : IN std_logic_vector -- Inputs + ) IS + + VARIABLE ResultAlias : std_logic_vector(0 TO 0); + BEGIN + ResultAlias(0) := Result; + VitalStateTable ( StateTable => StateTable, + DataIn => DataIn, + NumStates => 1, + Result => ResultAlias, + PreviousDataIn => PreviousDataIn + ); + Result := ResultAlias(0); + + END VitalStateTable; + + PROCEDURE VitalStateTable ( + SIGNAL Result : INOUT std_logic_vector; + CONSTANT StateTable : IN VitalStateTableType; + SIGNAL DataIn : IN std_logic_vector; + CONSTANT NumStates : IN NATURAL + ) IS + + CONSTANT InputSize : INTEGER := DataIn'LENGTH; + CONSTANT OutSize : INTEGER + := StateTable'LENGTH(2) - InputSize - NumStates; + CONSTANT ResLeng : INTEGER := Result'LENGTH; + + VARIABLE PrevData : std_logic_vector(0 TO DataIn'LENGTH-1) + := (OTHERS => 'X'); + VARIABLE DataInAlias : std_logic_vector(0 TO DataIn'LENGTH-1); + VARIABLE ResultAlias : std_logic_vector(0 TO ResLeng-1); + VARIABLE ExpResult : std_logic_vector(0 TO OutSize-1); + + BEGIN + IF (OutSize <= 0) THEN + VitalError ( "VitalStateTable", ErrTabWidSml ); + + ResultAlias := (OTHERS => 'X'); + Result <= ResultAlias; + + ELSE + IF (ResLeng > OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResSml ); + ELSIF (ResLeng < OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResLrg ); + END IF; + + LOOP + DataInAlias := To_X01(DataIn); + ResultAlias := To_X01(Result); + ExpResult := StateTableLookUp ( StateTable, DataInAlias, + PrevData, NumStates, + ResultAlias); + ResultAlias := (OTHERS => 'X'); + ResultAlias(Maximum(0, ResLeng - OutSize) TO ResLeng-1) + := ExpResult(Maximum(0, OutSize - ResLeng) TO OutSize-1); + + Result <= ResultAlias; + PrevData := DataInAlias; + + WAIT ON DataIn; + END LOOP; + + END IF; + + END VitalStateTable; + + PROCEDURE VitalStateTable ( + SIGNAL Result : INOUT std_logic; + CONSTANT StateTable : IN VitalStateTableType; + SIGNAL DataIn : IN std_logic_vector + ) IS + + CONSTANT InputSize : INTEGER := DataIn'LENGTH; + CONSTANT OutSize : INTEGER := StateTable'LENGTH(2) - InputSize-1; + + VARIABLE PrevData : std_logic_vector(0 TO DataIn'LENGTH-1) + := (OTHERS => 'X'); + VARIABLE DataInAlias : std_logic_vector(0 TO DataIn'LENGTH-1); + VARIABLE ResultAlias : std_logic_vector(0 TO 0); + VARIABLE ExpResult : std_logic_vector(0 TO OutSize-1); + + BEGIN + IF (OutSize <= 0) THEN + VitalError ( "VitalStateTable", ErrTabWidSml ); + + Result <= 'X'; + + ELSE + IF ( 1 > OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResSml ); + ELSIF ( 1 < OutSize) THEN + VitalError ( "VitalStateTable", ErrTabResLrg ); + END IF; + + LOOP + ResultAlias(0) := To_X01(Result); + DataInAlias := To_X01(DataIn); + ExpResult := StateTableLookUp ( StateTable, DataInAlias, + PrevData, 1, ResultAlias); + + Result <= ExpResult(OutSize-1); + PrevData := DataInAlias; + + WAIT ON DataIn; + END LOOP; + END IF; + + END VitalStateTable; + + -- ------------------------------------------------------------------------ + -- std_logic resolution primitive + -- ------------------------------------------------------------------------ + PROCEDURE VitalResolve ( + SIGNAL q : OUT std_ulogic; + CONSTANT Data : IN std_logic_vector + ) IS + VARIABLE uData : std_ulogic_vector(Data'RANGE); + BEGIN + FOR i IN Data'RANGE LOOP + uData(i) := Data(i); + END LOOP; + q <= resolved(uData); + END; + +END VITAL_Primitives; diff --git a/libraries/vital95/vital_timing.vhdl b/libraries/vital95/vital_timing.vhdl new file mode 100644 index 000000000..1fe5a9e24 --- /dev/null +++ b/libraries/vital95/vital_timing.vhdl @@ -0,0 +1,880 @@ +------------------------------------------------------------------------------- +-- Title : Standard VITAL TIMING Package +-- : $Revision: 597 $ +-- : +-- Library : This package shall be compiled into a library +-- : symbolically named IEEE. +-- : +-- Developers : IEEE DASC Timing Working Group (TWG), PAR 1076.4 +-- : +-- Purpose : This packages defines standard types, attributes, constants, +-- : functions and procedures for use in developing ASIC models. +-- : +-- Known Errors : +-- : +-- Note : No declarations or definitions shall be included in, +-- : or excluded from this package. The "package declaration" +-- : defines the objects (types, subtypes, constants, functions, +-- : procedures ... etc.) that can be used by a user. The package +-- : body shall be considered the formal definition of the +-- : semantics of this package. Tool developers may choose to +-- : implement the package body in the most efficient manner +-- : available to them. +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Acknowledgments: +-- This code was originally developed under the "VHDL Initiative Toward ASIC +-- Libraries" (VITAL), an industry sponsored initiative. Technical +-- Director: William Billowitch, VHDL Technology Group; U.S. Coordinator: +-- Steve Schultz; Steering Committee Members: Victor Berman, Cadence Design +-- Systems; Oz Levia, Synopsys Inc.; Ray Ryan, Ryan & Ryan; Herman van Beek, +-- Texas Instruments; Victor Martin, Hewlett-Packard Company. +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Modification History : +-- ---------------------------------------------------------------------------- +-- Version No:|Auth:| Mod.Date:| Changes Made: +-- v95.0 A | | 06/02/95 | Initial ballot draft 1995 +-- v95.1 | | 08/31/95 | #203 - Timing violations at time 0 +-- #204 - Output mapping prior to glitch detection +-- ---------------------------------------------------------------------------- +LIBRARY IEEE; +USE IEEE.Std_Logic_1164.ALL; + +PACKAGE VITAL_Timing IS + TYPE VitalTransitionType IS ( tr01, tr10, tr0z, trz1, tr1z, trz0, + tr0X, trx1, tr1x, trx0, trxz, trzx); + + SUBTYPE VitalDelayType IS TIME; + TYPE VitalDelayType01 IS ARRAY (VitalTransitionType RANGE tr01 to tr10) + OF TIME; + TYPE VitalDelayType01Z IS ARRAY (VitalTransitionType RANGE tr01 to trz0) + OF TIME; + TYPE VitalDelayType01ZX IS ARRAY (VitalTransitionType RANGE tr01 to trzx) + OF TIME; + + TYPE VitalDelayArrayType IS ARRAY (NATURAL RANGE <>) OF VitalDelayType; + TYPE VitalDelayArrayType01 IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01; + TYPE VitalDelayArrayType01Z IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01Z; + TYPE VitalDelayArrayType01ZX IS ARRAY (NATURAL RANGE <>) OF VitalDelayType01ZX; + -- ---------------------------------------------------------------------- + -- ********************************************************************** + -- ---------------------------------------------------------------------- + + CONSTANT VitalZeroDelay : VitalDelayType := 0 ns; + CONSTANT VitalZeroDelay01 : VitalDelayType01 := ( 0 ns, 0 ns ); + CONSTANT VitalZeroDelay01Z : VitalDelayType01Z := ( OTHERS => 0 ns ); + CONSTANT VitalZeroDelay01ZX : VitalDelayType01ZX := ( OTHERS => 0 ns ); + + --------------------------------------------------------------------------- + -- examples of usage: + --------------------------------------------------------------------------- + -- tpd_CLK_Q : VitalDelayType := 5 ns; + -- tpd_CLK_Q : VitalDelayType01 := (tr01 => 2 ns, tr10 => 3 ns); + -- tpd_CLK_Q : VitalDelayType01Z := ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns ); + -- tpd_CLK_Q : VitalDelayArrayType(0 to 1) + -- := (0 => 5 ns, 1 => 6 ns); + -- tpd_CLK_Q : VitalDelayArrayType01(0 to 1) + -- := (0 => (tr01 => 2 ns, tr10 => 3 ns), + -- 1 => (tr01 => 2 ns, tr10 => 3 ns)); + -- tpd_CLK_Q : VitalDelayArrayType01Z(0 to 1) + -- := (0 => ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns ), + -- 1 => ( 1 ns, 2 ns, 3 ns, 4 ns, 5 ns, 6 ns )); + --------------------------------------------------------------------------- + + -- TRUE if the model is LEVEL0 | LEVEL1 compliant + ATTRIBUTE VITAL_Level0 : BOOLEAN; + ATTRIBUTE VITAL_Level1 : BOOLEAN; + + SUBTYPE std_logic_vector2 IS std_logic_vector(1 DOWNTO 0); + SUBTYPE std_logic_vector3 IS std_logic_vector(2 DOWNTO 0); + SUBTYPE std_logic_vector4 IS std_logic_vector(3 DOWNTO 0); + SUBTYPE std_logic_vector8 IS std_logic_vector(7 DOWNTO 0); + + -- Types for strength mapping of outputs + TYPE VitalOutputMapType IS ARRAY ( std_ulogic ) OF std_ulogic; + TYPE VitalResultMapType IS ARRAY ( UX01 ) OF std_ulogic; + TYPE VitalResultZMapType IS ARRAY ( UX01Z ) OF std_ulogic; + CONSTANT VitalDefaultOutputMap : VitalOutputMapType + := "UX01ZWLH-"; + CONSTANT VitalDefaultResultMap : VitalResultMapType + := ( 'U', 'X', '0', '1' ); + CONSTANT VitalDefaultResultZMap : VitalResultZMapType + := ( 'U', 'X', '0', '1', 'Z' ); + + -- Types for fields of VitalTimingDataType + TYPE VitalTimeArrayT IS ARRAY (INTEGER RANGE <>) OF TIME; + TYPE VitalTimeArrayPT IS ACCESS VitalTimeArrayT; + TYPE VitalBoolArrayT IS ARRAY (INTEGER RANGE <>) OF BOOLEAN; + TYPE VitalBoolArrayPT IS ACCESS VitalBoolArrayT; + TYPE VitalLogicArrayPT IS ACCESS std_logic_vector; + + TYPE VitalTimingDataType IS RECORD + NotFirstFlag : BOOLEAN; + RefLast : X01; + RefTime : TIME; + HoldEn : BOOLEAN; + TestLast : std_ulogic; + TestTime : TIME; + SetupEn : BOOLEAN; + TestLastA : VitalLogicArrayPT; + TestTimeA : VitalTimeArrayPT; + HoldEnA : VitalBoolArrayPT; + SetupEnA : VitalBoolArrayPT; + END RECORD; + + FUNCTION VitalTimingDataInit RETURN VitalTimingDataType; + + -- type for internal data of VitalPeriodPulseCheck + TYPE VitalPeriodDataType IS RECORD + Last : X01; + Rise : TIME; + Fall : TIME; + NotFirstFlag : BOOLEAN; + END RECORD; + CONSTANT VitalPeriodDataInit : VitalPeriodDataType + := ('X', 0 ns, 0 ns, FALSE ); + + -- Type for specifying the kind of Glitch handling to use + TYPE VitalGlitchKindType IS (OnEvent, + OnDetect, + VitalInertial, + VitalTransport); + + TYPE VitalGlitchDataType IS + RECORD + SchedTime : TIME; + GlitchTime : TIME; + SchedValue : std_ulogic; + LastValue : std_ulogic; + END RECORD; + TYPE VitalGlitchDataArrayType IS ARRAY (NATURAL RANGE <>) + OF VitalGlitchDataType; + + -- PathTypes: for handling simple PathDelay info + TYPE VitalPathType IS RECORD + InputChangeTime : TIME; -- timestamp for path input signal + PathDelay : VitalDelayType; -- delay for this path + PathCondition : BOOLEAN; -- path sensitize condition + END RECORD; + TYPE VitalPath01Type IS RECORD + InputChangeTime : TIME; -- timestamp for path input signal + PathDelay : VitalDelayType01; -- delay for this path + PathCondition : BOOLEAN; -- path sensitize condition + END RECORD; + TYPE VitalPath01ZType IS RECORD + InputChangeTime : TIME; -- timestamp for path input signal + PathDelay : VitalDelayType01Z;-- delay for this path + PathCondition : BOOLEAN; -- path sensitize condition + END RECORD; + + -- For representing multiple paths to an output + TYPE VitalPathArrayType IS ARRAY (NATURAL RANGE <> ) OF VitalPathType; + TYPE VitalPathArray01Type IS ARRAY (NATURAL RANGE <> ) OF VitalPath01Type; + TYPE VitalPathArray01ZType IS ARRAY (NATURAL RANGE <> ) OF VitalPath01ZType; + + TYPE VitalTableSymbolType IS ( + '/', -- 0 -> 1 + '\', -- 1 -> 0 + 'P', -- Union of '/' and '^' (any edge to 1) + 'N', -- Union of '\' and 'v' (any edge to 0) + 'r', -- 0 -> X + 'f', -- 1 -> X + 'p', -- Union of '/' and 'r' (any edge from 0) + 'n', -- Union of '\' and 'f' (any edge from 1) + 'R', -- Union of '^' and 'p' (any possible rising edge) + 'F', -- Union of 'v' and 'n' (any possible falling edge) + '^', -- X -> 1 + 'v', -- X -> 0 + 'E', -- Union of 'v' and '^' (any edge from X) + 'A', -- Union of 'r' and '^' (rising edge to or from 'X') + 'D', -- Union of 'f' and 'v' (falling edge to or from 'X') + '*', -- Union of 'R' and 'F' (any edge) + 'X', -- Unknown level + '0', -- low level + '1', -- high level + '-', -- don't care + 'B', -- 0 or 1 + 'Z', -- High Impedance + 'S' -- steady value + ); + + SUBTYPE VitalEdgeSymbolType IS VitalTableSymbolType RANGE '/' TO '*'; + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalExtendToFillDelay + -- + -- Description: A six element array of delay values of type + -- VitalDelayType01Z is returned when a 1, 2 or 6 + -- element array is given. This function will convert + -- VitalDelayType and VitalDelayType01 delay values into + -- a VitalDelayType01Z type following these rules: + -- + -- When a VitalDelayType is passed, all six transition + -- values are assigned the input value. When a + -- VitalDelayType01 is passed, the 01 transitions are + -- assigned to the 01, 0Z and Z1 transitions and the 10 + -- transitions are assigned to 10, 1Z and Z0 transition + -- values. When a VitalDelayType01Z is passed, the values + -- are kept as is. + -- + -- The function is overloaded based on input type. + -- + -- There is no function to fill a 12 value delay + -- type. + -- + -- Arguments: + -- + -- IN Type Description + -- Delay A one, two or six delay value Vital- + -- DelayType is passed and a six delay, + -- VitalDelayType01Z, item is returned. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- VitalDelayType01Z + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType + ) RETURN VitalDelayType01Z; + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType01 + ) RETURN VitalDelayType01Z; + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType01Z + ) RETURN VitalDelayType01Z; + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalCalcDelay + -- + -- Description: This function accepts a 1, 2 or 6 value delay and + -- chooses the correct delay time to delay the NewVal + -- signal. This function is overloaded based on the + -- delay type passed. The function returns a single value + -- of time. + -- + -- This function is provided for Level 0 models in order + -- to calculate the delay which should be applied + -- for the passed signal. The delay selection is performed + -- using the OldVal and the NewVal to determine the + -- transition to select. The default value of OldVal is X. + -- + -- This function cannot be used in a Level 1 model since + -- the VitalPathDelay routines perform the delay path + -- selection and output driving function. + -- + -- Arguments: + -- + -- IN Type Description + -- NewVal New value of the signal to be + -- assigned + -- OldVal Previous value of the signal. + -- Default value is 'X' + -- Delay The delay structure from which to + -- select the appropriate delay. The + -- function overload is based on the + -- type of delay passed. In the case of + -- the single delay, VitalDelayType, no + -- selection is performed, since there + -- is only one value to choose from. + -- For the other cases, the transition + -- from the old value to the new value + -- decide the value returned. + -- + -- INOUT + -- none + -- + -- OUT + -- none + -- + -- Returns + -- Time The time value selected from the + -- Delay INPUT is returned. + -- + -- ------------------------------------------------------------------------- + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType + ) RETURN TIME; + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType01 + ) RETURN TIME; + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType01Z + ) RETURN TIME; + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalPathDelay + -- + -- Description: VitalPathDelay is the Level 1 routine used to select + -- the propagation delay path and schedule a new output + -- value. + -- + -- For single and dual delay values, VitalDelayType and + -- VitalDelayType01 are used. The output value is + -- scheduled with a calculated delay without strength + -- modification. + -- + -- For the six delay value, VitalDelayType01Z, the output + -- value is scheduled with a calculated delay. The drive + -- strength can be modified to handle weak signal strengths + -- to model tri-state devices, pull-ups and pull-downs as + -- an example. + -- + -- The correspondence between the delay type and the + -- path delay function is as follows: + -- + -- Delay Type Path Type + -- + -- VitalDelayType VitalPathDelay + -- VitalDelayType01 VitalPathDelay01 + -- VitalDelayType01Z VitalPathDelay01Z + -- + -- For each of these routines, the following capabilities + -- is provided: + -- + -- o Transition dependent path delay selection + -- o User controlled glitch detection with the ability + -- to generate "X" on output and report the violation + -- o Control of the severity level for message generation + -- o Scheduling of the computed values on the specified + -- signal. + -- + -- Selection of the appropriate path delay begins with the + -- candidate paths. The candidate paths are selected by + -- identifying the paths for which the PathCondition is + -- true. If there is a single candidate path, then that + -- delay is selected. If there is more than one candidate + -- path, then the shortest delay is selected using + -- transition dependent delay selection. If there is no + -- candidate paths, then the delay specified by the + -- DefaultDelay parameter to the path delay is used. + -- + -- Once the delay is known, the output signal is then + -- scheduled with that delay. In the case of + -- VitalPathDelay01Z, an additional result mapping of + -- the output value is performed before scheduling. The + -- result mapping is performed after transition dependent + -- delay selection but before scheduling the final output. + -- + -- In order to perform glitch detection, the user is + -- obligated to provide a variable of VitalGlitchDataType + -- for the propagation delay functions to use. The user + -- cannot modify or use this information. + -- + -- Arguments: + -- + -- IN Type Description + -- OutSignalName string The name of the output signal + -- OutTemp std_logic The new output value to be driven + -- Paths VitalPathArrayType A list of paths of VitalPathArray + -- VitalPathArrayType01 type. The VitalPathDelay routine + -- VitalPathArrayType01Z is overloaded based on the type + -- of constant passed in. With + -- VitalPathArrayType01Z, the + -- resulting output strengths can be + -- mapped. + -- DefaultDelay VitalDelayType The default delay can be changed + -- VitalDelayType01 from zero-delay to another set of + -- VitalDelayType01Z values. + -- Mode VitalGlitchKindType The value of this constant + -- selects the type of glitch + -- detection. + -- OnEvent Glitch on transition event + -- | OnDetect Glitch immediate on detection + -- | VitalInertial No glitch, use INERTIAL + -- assignment + -- | VitalTransport No glitch, use TRANSPORT + -- assignment + -- XOn BOOLEAN Control for generation of 'X' on + -- glitch. When TRUE, 'X's are + -- scheduled for glitches, otherwise + -- no are generated. + -- MsgOn BOOLEAN Control for message generation on + -- glitch detect. When TRUE, + -- glitches are reported, otherwise + -- they are not reported. + -- MsgSeverity SEVERITY_LEVEL The level at which the message, + -- or assertion, will be reported. + -- OutputMap VitalOutputMapType For VitalPathDelay01Z, the output + -- can be mapped to alternate + -- strengths to model tri-state + -- devices, pull-ups and pull-downs. + -- + -- INOUT + -- GlitchData VitalGlitchDataType The internal data storage + -- variable required to detect + -- glitches. + -- + -- OUT + -- OutSignal std_logic The output signal to be driven + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalPathDelay ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArrayType; + CONSTANT DefaultDelay : IN VitalDelayType := VitalZeroDelay; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ); + PROCEDURE VitalPathDelay01 ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArray01Type; + CONSTANT DefaultDelay : IN VitalDelayType01 := VitalZeroDelay01; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ); + PROCEDURE VitalPathDelay01Z ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArray01ZType; + CONSTANT DefaultDelay : IN VitalDelayType01Z := VitalZeroDelay01Z; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT OutputMap : IN VitalOutputMapType + := VitalDefaultOutputMap + ); + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalWireDelay + -- + -- Description: VitalWireDelay is used to delay an input signal. + -- The delay is selected from the input parameter passed. + -- The function is useful for back annotation of actual + -- net delays. + -- + -- The function is overloaded to permit passing a delay + -- value for twire for VitalDelayType, VitalDelayType01 + -- and VitalDelayType01Z. twire is a generic which can + -- be back annotated and must be constructed to follow + -- the SDF to generic mapping rules. + -- + -- Arguments: + -- + -- IN Type Description + -- InSig std_ulogic The input signal (port) to be + -- delayed. + -- twire VitalDelayType The delay value for which the input + -- VitalDelayType01 signal should be delayed. For Vital- + -- VitalDelayType01Z DelayType, the value is single value + -- passed. For VitalDelayType01 and + -- VitalDelayType01Z, the appropriate + -- delay value is selected by VitalCalc- + -- Delay. + -- + -- INOUT + -- none + -- + -- OUT + -- OutSig std_ulogic The internal delayed signal + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType + ); + + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType01 + ); + + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType01Z + ); + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalSignalDelay + -- + -- Description: The VitalSignalDelay procedure is called in a signal + -- delay block in the architecture to delay the + -- appropriate test or reference signal in order to + -- accommodate negative constraint checks. + -- + -- The amount of delay is of type TIME and is a constant. + -- + -- Arguments: + -- + -- IN Type Description + -- InSig std_ulogic The signal to be delayed. + -- dly TIME The amount of time the signal is + -- delayed. + -- + -- INOUT + -- none + -- + -- OUT + -- OutSig std_ulogic The delayed signal + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalSignalDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT dly : IN TIME + ); + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalSetupHoldCheck + -- + -- Description: The VitalSetupHoldCheck procedure detects a setup or a + -- hold violation on the input test signal with respect + -- to the corresponding input reference signal. The timing + -- constraints are specified through parameters + -- representing the high and low values for the setup and + -- hold values for the setup and hold times. This + -- procedure assumes non-negative values for setup and hold + -- timing constraints. + -- + -- It is assumed that negative timing constraints + -- are handled by internally delaying the test or + -- reference signals. Negative setup times result in + -- a delayed reference signal. Negative hold times + -- result in a delayed test signal. Furthermore, the + -- delays and constraints associated with these and + -- other signals may need to be appropriately + -- adjusted so that all constraint intervals overlap + -- the delayed reference signals and all constraint + -- values (with respect to the delayed signals) are + -- non-negative. + -- + -- This function is overloaded based on the input + -- TestSignal. A vector and scalar form are provided. + -- + -- TestSignal XXXXXXXXXXXX____________________________XXXXXXXXXXXXXXXXXXXXXX + -- : + -- : -->| error region |<-- + -- : + -- _______________________________ + -- RefSignal \______________________________ + -- : | | | + -- : | -->| |<-- thold + -- : -->| tsetup |<-- + -- + -- Arguments: + -- + -- IN Type Description + -- TestSignal std_ulogic Value of test signal + -- std_logic_vector + -- TestSignalName STRING Name of test signal + -- TestDelay TIME Model's internal delay associated + -- with TestSignal + -- RefSignal std_ulogic Value of reference signal + -- RefSignalName STRING Name of reference signal + -- RefDelay TIME Model's internal delay associated + -- with RefSignal + -- SetupHigh TIME Absolute minimum time duration before + -- the transition of RefSignal for which + -- transitions of TestSignal are allowed + -- to proceed to the "1" state without + -- causing a setup violation. + -- SetupLow TIME Absolute minimum time duration before + -- the transition of RefSignal for which + -- transitions of TestSignal are allowed + -- to proceed to the "0" state without + -- causing a setup violation. + -- HoldHigh TIME Absolute minimum time duration after + -- the transition of RefSignal for which + -- transitions of TestSignal are allowed + -- to proceed to the "1" state without + -- causing a hold violation. + -- HoldLow TIME Absolute minimum time duration after + -- the transition of RefSignal for which + -- transitions of TestSignal are allowed + -- to proceed to the "0" state without + -- causing a hold violation. + -- CheckEnabled BOOLEAN Check performed if TRUE. + -- RefTransition VitalEdgeSymbolType + -- Reference edge specified. Events on + -- the RefSignal which match the edge + -- spec. are used as reference edges. + -- HeaderMsg STRING String that will accompany any + -- assertion messages produced. + -- XOn BOOLEAN If TRUE, Violation output parameter + -- is set to "X". Otherwise, Violation + -- is always set to "0." + -- MsgOn BOOLEAN If TRUE, set and hold violation + -- message will be generated. + -- Otherwise, no messages are generated, + -- even upon violations. + -- MsgSeverity SEVERITY_LEVEL Severity level for the assertion. + -- + -- INOUT + -- TimingData VitalTimingDataType + -- VitalSetupHoldCheck information + -- storage area. This is used + -- internally to detect reference edges + -- and record the time of the last edge. + -- + -- OUT + -- Violation X01 This is the violation flag returned. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalSetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ); + + PROCEDURE VitalSetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ); + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalRecoveryRemovalCheck + -- + -- Description: The VitalRecoveryRemovalCheck detects the presence of + -- a recovery or removal violation on the input test + -- signal with respect to the corresponding input reference + -- signal. It assumes non-negative values of setup and + -- hold timing constraints. The timing constraint is + -- specified through parameters representing the recovery + -- and removal times associated with a reference edge of + -- the reference signal. A flag indicates whether a test + -- signal is asserted when it is high or when it is low. + -- + -- It is assumed that negative timing constraints + -- are handled by internally delaying the test or + -- reference signals. Negative recovery times result in + -- a delayed reference signal. Negative removal times + -- result in a delayed test signal. Furthermore, the + -- delays and constraints associated with these and + -- other signals may need to be appropriately + -- adjusted so that all constraint intervals overlap + -- the delayed reference signals and all constraint + -- values (with respect to the delayed signals) are + -- non-negative. + -- + -- Arguments: + -- + -- IN Type Description + -- TestSignal std_ulogic Value of TestSignal. The routine is + -- TestSignalName STRING Name of TestSignal + -- TestDelay TIME Model internal delay associated with + -- the TestSignal + -- RefSignal std_ulogic Value of RefSignal + -- RefSignalName STRING Name of RefSignal + -- RefDelay TIME Model internal delay associated with + -- the RefSignal + -- Recovery TIME A change to an unasserted value on + -- the asynchronous TestSignal must + -- precede reference edge (on RefSignal) + -- by at least this time. + -- Removal TIME An asserted condition must be present + -- on the asynchronous TestSignal for at + -- least the removal time following a + -- reference edge on RefSignal. + -- ActiveLow BOOLEAN A flag which indicates if TestSignal + -- is asserted when it is low - "0." + -- FALSE indicate that TestSignal is + -- asserted when it has a value "1." + -- CheckEnabled BOOLEAN The check in enabled when the value + -- is TRUE, otherwise the constraints + -- are not checked. + -- RefTransition VitalEdgeSymbolType + -- Reference edge specifier. Events on + -- RefSignal will match the edge + -- specified. + -- HeaderMsg STRING A header message that will accompany + -- any assertion message. + -- XOn BOOLEAN When TRUE, the output Violation is + -- set to "X." When FALSE, it is always + -- "0." + -- MsgOn BOOLEAN When TRUE, violation messages are + -- output. When FALSE, no messages are + -- generated. + -- MsgSeverity SEVERITY_LEVEL Severity level of the asserted + -- message. + -- + -- INOUT + -- TimingData VitalTimingDataType + -- VitalRecoveryRemovalCheck information + -- storage area. This is used + -- internally to detect reference edges + -- and record the time of the last edge. + -- OUT + -- Violation X01 This is the violation flag returned. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------- + PROCEDURE VitalRecoveryRemovalCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT Recovery : IN TIME := 0 ns; + CONSTANT Removal : IN TIME := 0 ns; + CONSTANT ActiveLow : IN BOOLEAN := TRUE; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ); + + -- ------------------------------------------------------------------------ + -- + -- Function Name: VitalPeriodPulseCheck + -- + -- Description: VitalPeriodPulseCheck checks for minimum and maximum + -- periodicity and pulse width for "1" and "0" values of + -- the input test signal. The timing constraint is + -- specified through parameters representing the minimal + -- period between successive rising and falling edges of + -- the input test signal and the minimum pulse widths + -- associated with high and low values. + -- + -- VitalPeriodCheck's accepts rising and falling edges + -- from 1 and 0 as well as transitions to and from 'X.' + -- + -- _______________ __________ + -- ____________| |_______| + -- + -- |<--- pw_hi --->| + -- |<-------- period ----->| + -- -->| pw_lo |<-- + -- + -- Arguments: + -- IN Type Description + -- TestSignal std_ulogic Value of test signal + -- TestSignalName STRING Name of the test signal + -- TestDelay TIME Model's internal delay associated + -- with TestSignal + -- Period TIME Minimum period allowed between + -- consecutive rising ('P') or + -- falling ('F') transitions. + -- PulseWidthHigh TIME Minimum time allowed for a high + -- pulse ('1' or 'H') + -- PulseWidthLow TIME Minimum time allowed for a low + -- pulse ('0' or 'L') + -- CheckEnabled BOOLEAN Check performed if TRUE. + -- HeaderMsg STRING String that will accompany any + -- assertion messages produced. + -- XOn BOOLEAN If TRUE, Violation output parameter + -- is set to "X". Otherwise, Violation + -- is always set to "0." + -- MsgOn BOOLEAN If TRUE, period/pulse violation + -- message will be generated. + -- Otherwise, no messages are generated, + -- even though a violation is detected. + -- MsgSeverity SEVERITY_LEVEL Severity level for the assertion. + -- + -- INOUT + -- PeriodData VitalPeriodDataType + -- VitalPeriodPulseCheck information + -- storage area. This is used + -- internally to detect reference edges + -- and record the pulse and period + -- times. + -- OUT + -- Violation X01 This is the violation flag returned. + -- + -- Returns + -- none + -- + -- ------------------------------------------------------------------------ + PROCEDURE VitalPeriodPulseCheck ( + VARIABLE Violation : OUT X01; + VARIABLE PeriodData : INOUT VitalPeriodDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + CONSTANT Period : IN TIME := 0 ns; + CONSTANT PulseWidthHigh : IN TIME := 0 ns; + CONSTANT PulseWidthLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ); + +END VITAL_Timing; diff --git a/libraries/vital95/vital_timing_body.vhdl b/libraries/vital95/vital_timing_body.vhdl new file mode 100644 index 000000000..09eb75565 --- /dev/null +++ b/libraries/vital95/vital_timing_body.vhdl @@ -0,0 +1,1275 @@ +------------------------------------------------------------------------------- +-- Title : Standard VITAL TIMING Package +-- : $Revision: 597 $ +-- Library : VITAL +-- : +-- Developers : IEEE DASC Timing Working Group (TWG), PAR 1076.4 +-- : +-- Purpose : This packages defines standard types, attributes, constants, +-- : functions and procedures for use in developing ASIC models. +-- : This file contains the Package Body. +-- ---------------------------------------------------------------------------- +-- +-- ---------------------------------------------------------------------------- +-- Modification History : +-- ---------------------------------------------------------------------------- +-- Version No:|Auth:| Mod.Date:| Changes Made: +-- v95.0 A | | 06/08/95 | Initial ballot draft 1995 +-- v95.1 | | 08/31/95 | #203 - Timing violations at time 0 +-- #204 - Output mapping prior to glitch detection +-- ---------------------------------------------------------------------------- + +LIBRARY STD; +USE STD.TEXTIO.ALL; + +PACKAGE BODY VITAL_Timing IS + + -- -------------------------------------------------------------------- + -- Package Local Declarations + -- -------------------------------------------------------------------- + TYPE CheckType IS ( SetupCheck, HoldCheck, RecoveryCheck, RemovalCheck, + PulseWidCheck, PeriodCheck ); + + TYPE CheckInfoType IS RECORD + Violation : BOOLEAN; + CheckKind : CheckType; + ObsTime : TIME; + ExpTime : TIME; + DetTime : TIME; + State : X01; + END RECORD; + + TYPE LogicCvtTableType IS ARRAY (std_ulogic) OF CHARACTER; + TYPE HiLoStrType IS ARRAY (std_ulogic RANGE 'X' TO '1') OF STRING(1 TO 4); + + CONSTANT LogicCvtTable : LogicCvtTableType + := ( 'U', 'X', '0', '1', 'Z', 'W', 'L', 'H', '-'); + CONSTANT HiLoStr : HiLoStrType := (" X ", " Low", "High" ); + + TYPE EdgeSymbolMatchType IS ARRAY (X01,X01,VitalEdgeSymbolType) OF BOOLEAN; + -- last value, present value, edge symbol + CONSTANT EdgeSymbolMatch : EdgeSymbolMatchType := ( + 'X'=>('X'=>( OTHERS => FALSE), + '0'=>('N'|'F'|'v'|'E'|'D'|'*' => TRUE, OTHERS => FALSE ), + '1'=>('P'|'R'|'^'|'E'|'A'|'*' => TRUE, OTHERS => FALSE ) ), + '0'=>('X'=>( 'r'|'p'|'R'|'A'|'*' => TRUE, OTHERS => FALSE ), + '0'=>( OTHERS => FALSE ), + '1'=>( '/'|'P'|'p'|'R'|'*' => TRUE, OTHERS => FALSE ) ), + '1'=>('X'=>( 'f'|'n'|'F'|'D'|'*' => TRUE, OTHERS => FALSE ), + '0'=>( '\'|'N'|'n'|'F'|'*' => TRUE, OTHERS => FALSE ), + '1'=>( OTHERS => FALSE ) ) ); + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + -- Misc Utilities Local Utilities + --------------------------------------------------------------------------- + ----------------------------------------------------------------------- + FUNCTION Minimum ( CONSTANT t1,t2 : IN TIME ) RETURN TIME IS + BEGIN + IF ( t1 < t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF; + END Minimum; + ----------------------------------------------------------------------- + FUNCTION Maximum ( CONSTANT t1,t2 : IN TIME ) RETURN TIME IS + BEGIN + IF ( t1 > t2 ) THEN RETURN (t1); ELSE RETURN (t2); END IF; + END Maximum; + + -------------------------------------------------------------------- + -- Error Message Types and Tables + -------------------------------------------------------------------- + TYPE VitalErrorType IS ( + ErrVctLng , + ErrNoPath , + ErrNegPath , + ErrNegDel + ); + + TYPE VitalErrorSeverityType IS ARRAY (VitalErrorType) OF SEVERITY_LEVEL; + CONSTANT VitalErrorSeverity : VitalErrorSeverityType := ( + ErrVctLng => ERROR, + ErrNoPath => WARNING, + ErrNegPath => WARNING, + ErrNegDel => WARNING + ); + + CONSTANT MsgNoPath : STRING := + "No Delay Path Condition TRUE. 0-delay used. Output signal is: "; + CONSTANT MsgNegPath : STRING := + "Path Delay less than time since input. 0 delay used. Output signal is: "; + CONSTANT MsgNegDel : STRING := + "Negative delay. New output value not scheduled. Output signal is: "; + CONSTANT MsgVctLng : STRING := + "Vector (array) lengths not equal. "; + + CONSTANT MsgUnknown : STRING := + "Unknown error message."; + + FUNCTION VitalMessage ( + CONSTANT ErrorId : IN VitalErrorType + ) RETURN STRING IS + BEGIN + CASE ErrorId IS + WHEN ErrVctLng => RETURN MsgVctLng; + WHEN ErrNoPath => RETURN MsgNoPath; + WHEN ErrNegPath => RETURN MsgNegPath; + WHEN ErrNegDel => RETURN MsgNegDel; + WHEN OTHERS => RETURN MsgUnknown; + END CASE; + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) + SEVERITY VitalErrorSeverity(ErrorId); + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType; + CONSTANT Info : IN STRING + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) & Info + SEVERITY VitalErrorSeverity(ErrorId); + END; + + PROCEDURE VitalError ( + CONSTANT Routine : IN STRING; + CONSTANT ErrorId : IN VitalErrorType; + CONSTANT Info : IN CHARACTER + ) IS + BEGIN + ASSERT FALSE + REPORT Routine & ": " & VitalMessage(ErrorId) & Info + SEVERITY VitalErrorSeverity(ErrorId); + END; + + --------------------------------------------------------------------------- + -- Time Delay Assignment Subprograms + --------------------------------------------------------------------------- + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType + ) RETURN VitalDelayType01Z IS + BEGIN + RETURN (OTHERS => Delay); + END VitalExtendToFillDelay; + + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType01 + ) RETURN VitalDelayType01Z IS + VARIABLE Delay01Z : VitalDelayType01Z; + BEGIN + Delay01Z(tr01) := Delay(tr01); + Delay01Z(tr0z) := Delay(tr01); + Delay01Z(trz1) := Delay(tr01); + Delay01Z(tr10) := Delay(tr10); + Delay01Z(tr1z) := Delay(tr10); + Delay01Z(trz0) := Delay(tr10); + RETURN (Delay01Z); + END VitalExtendToFillDelay; + + FUNCTION VitalExtendToFillDelay ( + CONSTANT Delay : IN VitalDelayType01Z + ) RETURN VitalDelayType01Z IS + BEGIN + RETURN Delay; + END VitalExtendToFillDelay; + + --------------------------------------------------------------------------- + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType + ) RETURN TIME IS + BEGIN + RETURN delay; + END VitalCalcDelay; + + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType01 + ) RETURN TIME IS + VARIABLE Result : TIME; + BEGIN + CASE Newval IS + WHEN '0' | 'L' => Result := Delay(tr10); + WHEN '1' | 'H' => Result := Delay(tr01); + WHEN 'Z' => + CASE Oldval IS + WHEN '0' | 'L' => Result := Delay(tr01); + WHEN '1' | 'H' => Result := Delay(tr10); + WHEN OTHERS => Result := MAXIMUM(Delay(tr10), Delay(tr01)); + END CASE; + WHEN OTHERS => + CASE Oldval IS + WHEN '0' | 'L' => Result := Delay(tr01); + WHEN '1' | 'H' => Result := Delay(tr10); + WHEN 'Z' => Result := MINIMUM(Delay(tr10), Delay(tr01)); + WHEN OTHERS => Result := MAXIMUM(Delay(tr10), Delay(tr01)); + END CASE; + END CASE; + RETURN Result; + END VitalCalcDelay; + + FUNCTION VitalCalcDelay ( + CONSTANT NewVal : IN std_ulogic := 'X'; + CONSTANT OldVal : IN std_ulogic := 'X'; + CONSTANT Delay : IN VitalDelayType01Z + ) RETURN TIME IS + VARIABLE Result : TIME; + BEGIN + CASE Oldval IS + WHEN '0' | 'L' => + CASE Newval IS + WHEN '0' | 'L' => Result := Delay(tr10); + WHEN '1' | 'H' => Result := Delay(tr01); + WHEN 'Z' => Result := Delay(tr0z); + WHEN OTHERS => Result := MINIMUM(Delay(tr01), Delay(tr0z)); + END CASE; + WHEN '1' | 'H' => + CASE Newval IS + WHEN '0' | 'L' => Result := Delay(tr10); + WHEN '1' | 'H' => Result := Delay(tr01); + WHEN 'Z' => Result := Delay(tr1z); + WHEN OTHERS => Result := MINIMUM(Delay(tr10), Delay(tr1z)); + END CASE; + WHEN 'Z' => + CASE Newval IS + WHEN '0' | 'L' => Result := Delay(trz0); + WHEN '1' | 'H' => Result := Delay(trz1); + WHEN 'Z' => Result := MAXIMUM (Delay(tr0z), Delay(tr1z)); + WHEN OTHERS => Result := MINIMUM (Delay(trz1), Delay(trz0)); + END CASE; + WHEN 'U' | 'X' | 'W' | '-' => + CASE Newval IS + WHEN '0' | 'L' => Result := MAXIMUM(Delay(tr10), Delay(trz0)); + WHEN '1' | 'H' => Result := MAXIMUM(Delay(tr01), Delay(trz1)); + WHEN 'Z' => Result := MAXIMUM(Delay(tr1z), Delay(tr0z)); + WHEN OTHERS => Result := MAXIMUM(Delay(tr10), Delay(tr01)); + END CASE; + END CASE; + RETURN Result; + END VitalCalcDelay; + + --------------------------------------------------------------------------- + FUNCTION VitalSelectPathDelay ( + CONSTANT NewValue : IN std_logic; + CONSTANT OldValue : IN std_logic; + CONSTANT OutSignalName : IN string; + CONSTANT Paths : IN VitalPathArrayType; + CONSTANT DefaultDelay : IN VitalDelayType + ) RETURN TIME IS + + VARIABLE TmpDelay : TIME; + VARIABLE InputAge : TIME := TIME'HIGH; + VARIABLE PropDelay : TIME := TIME'HIGH; + BEGIN + -- for each delay path + FOR i IN Paths'RANGE LOOP + -- ignore the delay path if it is not enabled + NEXT WHEN NOT Paths(i).PathCondition; + -- ignore the delay path if a more recent input event has been seen + NEXT WHEN Paths(i).InputChangeTime > InputAge; + + -- This is the most recent input change (so far) + -- Get the transition dependent delay + TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay); + + -- If other inputs changed at the same time, + -- then use the minimum of their propagation delays, + -- else use the propagation delay from this input. + IF Paths(i).InputChangeTime < InputAge THEN + PropDelay := TmpDelay; + ELSE -- Simultaneous inputs change + IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF; + end if; + + InputAge := Paths(i).InputChangeTime; + END LOOP; + + -- If there were no paths (with an enabled condition), + -- use the default the delay + IF (PropDelay = TIME'HIGH ) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + + -- If the time since the most recent input event is greater than the + -- propagation delay from that input then + -- use the default the delay + ELSIF (InputAge > PropDelay) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + + -- Adjust the propagation delay by the time since the + -- the input event occurred (Usually 0 ns). + ELSE + PropDelay := PropDelay - InputAge; + END IF; + + RETURN PropDelay; + END; + + FUNCTION VitalSelectPathDelay ( + CONSTANT NewValue : IN std_logic; + CONSTANT OldValue : IN std_logic; + CONSTANT OutSignalName : IN string; + CONSTANT Paths : IN VitalPathArray01Type; + CONSTANT DefaultDelay : IN VitalDelayType01 + ) RETURN TIME IS + + VARIABLE TmpDelay : TIME; + VARIABLE InputAge : TIME := TIME'HIGH; + VARIABLE PropDelay : TIME := TIME'HIGH; + BEGIN + -- for each delay path + FOR i IN Paths'RANGE LOOP + -- ignore the delay path if it is not enabled + NEXT WHEN NOT Paths(i).PathCondition; + -- ignore the delay path if a more recent input event has been seen + NEXT WHEN Paths(i).InputChangeTime > InputAge; + + -- This is the most recent input change (so far) + -- Get the transition dependent delay + TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay); + + -- If other inputs changed at the same time, + -- then use the minimum of their propagation delays, + -- else use the propagation delay from this input. + IF Paths(i).InputChangeTime < InputAge THEN + PropDelay := TmpDelay; + ELSE -- Simultaneous inputs change + IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF; + end if; + + InputAge := Paths(i).InputChangeTime; + END LOOP; + + -- If there were no paths (with an enabled condition), + -- use the default the delay + IF (PropDelay = TIME'HIGH ) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + + -- If the time since the most recent input event is greater than the + -- propagation delay from that input then + -- use the default the delay + ELSIF (InputAge > PropDelay) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + + -- Adjust the propagation delay by the time since the + -- the input event occurred (Usually 0 ns). + ELSE + PropDelay := PropDelay - InputAge; + END IF; + + RETURN PropDelay; + END; + + FUNCTION VitalSelectPathDelay ( + CONSTANT NewValue : IN std_logic; + CONSTANT OldValue : IN std_logic; + CONSTANT OutSignalName : IN string; + CONSTANT Paths : IN VitalPathArray01ZType; + CONSTANT DefaultDelay : IN VitalDelayType01Z + ) RETURN TIME IS + + VARIABLE TmpDelay : TIME; + VARIABLE InputAge : TIME := TIME'HIGH; + VARIABLE PropDelay : TIME := TIME'HIGH; + BEGIN + -- for each delay path + FOR i IN Paths'RANGE LOOP + -- ignore the delay path if it is not enabled + NEXT WHEN NOT Paths(i).PathCondition; + -- ignore the delay path if a more recent input event has been seen + NEXT WHEN Paths(i).InputChangeTime > InputAge; + + -- This is the most recent input change (so far) + -- Get the transition dependent delay + TmpDelay := VitalCalcDelay(NewValue, OldValue, Paths(i).PathDelay); + + -- If other inputs changed at the same time, + -- then use the minimum of their propagation delays, + -- else use the propagation delay from this input. + IF Paths(i).InputChangeTime < InputAge THEN + PropDelay := TmpDelay; + ELSE -- Simultaneous inputs change + IF TmpDelay < PropDelay THEN PropDelay := TmpDelay; END IF; + end if; + + InputAge := Paths(i).InputChangeTime; + END LOOP; + + -- If there were no paths (with an enabled condition), + -- use the default the delay + IF (PropDelay = TIME'HIGH ) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + + -- If the time since the most recent input event is greater than the + -- propagation delay from that input then + -- use the default the delay + ELSIF (InputAge > PropDelay) THEN + PropDelay := VitalCalcDelay(NewValue, OldValue, DefaultDelay); + + -- Adjust the propagation delay by the time since the + -- the input event occurred (Usually 0 ns). + ELSE + PropDelay := PropDelay - InputAge; + END IF; + + RETURN PropDelay; + END; + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + -- Glitch Handlers + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + PROCEDURE ReportGlitch ( + CONSTANT GlitchRoutine : IN STRING; + CONSTANT OutSignalName : IN STRING; + CONSTANT PreemptedTime : IN TIME; + CONSTANT PreemptedValue : IN std_ulogic; + CONSTANT NewTime : IN TIME; + CONSTANT NewValue : IN std_ulogic; + CONSTANT Index : IN INTEGER := 0; + CONSTANT IsArraySignal : IN BOOLEAN := FALSE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + VARIABLE StrPtr1, StrPtr2, StrPtr3, StrPtr4, StrPtr5 : LINE; + BEGIN + + Write (StrPtr1, PreemptedTime ); + Write (StrPtr2, NewTime); + Write (StrPtr3, LogicCvtTable(PreemptedValue)); + Write (StrPtr4, LogicCvtTable(NewValue)); + IF IsArraySignal THEN + Write (StrPtr5, STRING'( "(" ) ); + Write (StrPtr5, Index); + Write (StrPtr5, STRING'( ")" ) ); + ELSE + Write (StrPtr5, STRING'( " " ) ); + END IF; + + -- Issue Report only if Preempted value has not been + -- removed from event queue + ASSERT PreemptedTime > NewTime + REPORT GlitchRoutine & ": GLITCH Detected on port " & + OutSignalName & StrPtr5.ALL & + "; Preempted Future Value := " & StrPtr3.ALL & + " @ " & StrPtr1.ALL & + "; Newly Scheduled Value := " & StrPtr4.ALL & + " @ " & StrPtr2.ALL & + ";" + SEVERITY MsgSeverity; + + DEALLOCATE(StrPtr1); + DEALLOCATE(StrPtr2); + DEALLOCATE(StrPtr3); + DEALLOCATE(StrPtr4); + DEALLOCATE(StrPtr5); + RETURN; + END ReportGlitch; + + --------------------------------------------------------------------------- + PROCEDURE VitalGlitch ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT NewValue : IN std_logic; + CONSTANT NewDelay : IN TIME := 0 ns; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := FALSE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + --------------------------------------------------------------------------- + VARIABLE NewGlitch : BOOLEAN := TRUE; + VARIABLE dly : TIME := NewDelay; + + BEGIN + -- If nothing to schedule, just return + IF NewDelay < 0 ns THEN + IF (NewValue /= GlitchData.SchedValue) THEN + VitalError ( "VitalGlitch", ErrNegDel, OutSignalName ); + END IF; + RETURN; + END IF; + + -- If simple signal assignment + -- perform the signal assignment + IF ( Mode = VitalInertial) THEN + OutSignal <= NewValue AFTER dly; + ELSIF ( Mode = VitalTransport ) THEN + OutSignal <= TRANSPORT NewValue AFTER dly; + ELSE + -- Glitch Processing --- + -- If nothing currently scheduled + IF GlitchData.SchedTime <= NOW THEN + -- Note: NewValue is always /= OldValue when called from VPPD + IF (NewValue = GlitchData.SchedValue) THEN RETURN; END IF; + -- No new glitch, save time for possable future glitch + NewGlitch := FALSE; + GlitchData.GlitchTime := NOW+dly; + + -- New value earlier than the earliest previous value scheduled + ELSIF (NOW+dly <= GlitchData.GlitchTime) + AND (NOW+dly <= GlitchData.SchedTime) THEN + -- No new glitch, save time for possible future glitch + NewGlitch := FALSE; + GlitchData.GlitchTime := NOW+dly; + + -- Transaction currently scheduled - if glitch already happened + ELSIF GlitchData.GlitchTime <= NOW THEN + IF (GlitchData.SchedValue = NewValue) THEN + dly := Minimum( GlitchData.SchedTime-NOW, NewDelay ); + END IF; + NewGlitch := FALSE; + + -- Transaction currently scheduled (no glitch if same value) + ELSIF (GlitchData.SchedValue = NewValue) + AND (GlitchData.SchedTime = GlitchData.GlitchTime) THEN + -- revise scheduled output time if new delay is sooner + dly := Minimum( GlitchData.SchedTime-NOW, NewDelay ); + -- No new glitch, save time for possable future glitch + NewGlitch := FALSE; + GlitchData.GlitchTime := NOW+dly; + + -- Transaction currently scheduled represents a glitch + ELSE + -- A new glitch has been detected + NewGlitch := TRUE; + END IF; + + IF NewGlitch THEN + -- If messages requested, report the glitch + IF MsgOn THEN + ReportGlitch ("VitalGlitch", OutSignalName, + GlitchData.GlitchTime, GlitchData.SchedValue, + (dly + NOW), NewValue, + MsgSeverity=>MsgSeverity ); + END IF; + + -- Force immediate glitch for "OnDetect" mode. + IF (Mode = OnDetect) THEN + GlitchData.GlitchTime := NOW; + END IF; + + -- If 'X' generation is requested, schedule the new value + -- preceeded by a glitch pulse. + -- Otherwise just schedule the new value (inertial mode). + IF XOn THEN + OutSignal <= 'X' AFTER GlitchData.GlitchTime-NOW; + OutSignal <= TRANSPORT NewValue AFTER dly; + ELSE + OutSignal <= NewValue AFTER dly; + END IF; + + -- If there no new glitch was detected, just schedule the new value. + ELSE + OutSignal <= NewValue AFTER dly; + END IF; + + END IF; + + -- Record the new value and time just scheduled. + GlitchData.SchedValue := NewValue; + GlitchData.SchedTime := NOW+dly; + RETURN; + END; + + --------------------------------------------------------------------------- + PROCEDURE VitalPathDelay ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArrayType; + CONSTANT DefaultDelay : IN VitalDelayType := VitalZeroDelay; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + VARIABLE PropDelay : TIME; + BEGIN + -- Check if the new value to be scheduled is different than the + -- previously scheduled value + IF (GlitchData.SchedTime <= NOW) AND + (GlitchData.SchedValue = OutTemp) + THEN RETURN; + END IF; + + -- Evaluate propagation delay paths + PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue, + OutSignalName, Paths, DefaultDelay); + GlitchData.LastValue := OutTemp; + + -- Schedule the output transactions - including glitch handling + VitalGlitch (OutSignal, GlitchData, OutSignalName, OutTemp, + PropDelay, Mode, XOn, MsgOn, MsgSeverity ); + + END VitalPathDelay; + + PROCEDURE VitalPathDelay01 ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArray01Type; + CONSTANT DefaultDelay : IN VitalDelayType01 := VitalZeroDelay01; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + VARIABLE PropDelay : TIME; + BEGIN + -- Check if the new value to be scheduled is different than the + -- previously scheduled value + IF (GlitchData.SchedTime <= NOW) AND + (GlitchData.SchedValue = OutTemp) + THEN RETURN; + END IF; + + -- Evaluate propagation delay paths + PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue, + OutSignalName, Paths, DefaultDelay); + GlitchData.LastValue := OutTemp; + + -- Schedule the output transactions - including glitch handling + VitalGlitch (OutSignal, GlitchData, OutSignalName, OutTemp, + PropDelay, Mode, XOn, MsgOn, MsgSeverity ); + + END VitalPathDelay01; + + PROCEDURE VitalPathDelay01Z ( + SIGNAL OutSignal : OUT std_logic; + VARIABLE GlitchData : INOUT VitalGlitchDataType; + CONSTANT OutSignalName : IN string; + CONSTANT OutTemp : IN std_logic; + CONSTANT Paths : IN VitalPathArray01ZType; + CONSTANT DefaultDelay : IN VitalDelayType01Z := VitalZeroDelay01Z; + CONSTANT Mode : IN VitalGlitchKindType := OnEvent; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING; + CONSTANT OutputMap : IN VitalOutputMapType + := VitalDefaultOutputMap + ) IS + + VARIABLE PropDelay : TIME; + BEGIN + -- Check if the new value to be scheduled is different than the + -- previously scheduled value + IF (GlitchData.SchedTime <= NOW) AND + (GlitchData.SchedValue = OutputMap(OutTemp) ) + THEN RETURN; + END IF; + + -- Evaluate propagation delay paths + PropDelay := VitalSelectPathDelay (OutTemp, GlitchData.LastValue, + OutSignalName, Paths, DefaultDelay); + GlitchData.LastValue := OutTemp; + + -- Schedule the output transactions - including glitch handling + VitalGlitch (OutSignal, GlitchData, OutSignalName, OutputMap(OutTemp), + PropDelay, Mode, XOn, MsgOn, MsgSeverity ); + + END VitalPathDelay01Z; + + ---------------------------------------------------------------------------- + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType + ) IS + BEGIN + OutSig <= TRANSPORT InSig AFTER twire; + END VitalWireDelay; + + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType01 + ) IS + VARIABLE Delay : TIME; + BEGIN + Delay := VitalCalcDelay( InSig, InSig'LAST_VALUE, twire ); + OutSig <= TRANSPORT InSig AFTER Delay; + END VitalWireDelay; + + PROCEDURE VitalWireDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT twire : IN VitalDelayType01Z + ) IS + VARIABLE Delay : TIME; + BEGIN + Delay := VitalCalcDelay( InSig, InSig'LAST_VALUE, twire ); + OutSig <= TRANSPORT InSig AFTER Delay; + END VitalWireDelay; + + ---------------------------------------------------------------------------- + PROCEDURE VitalSignalDelay ( + SIGNAL OutSig : OUT std_ulogic; + SIGNAL InSig : IN std_ulogic; + CONSTANT dly : IN TIME + ) IS + BEGIN + OutSig <= TRANSPORT InSig AFTER dly; + END; + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + -- Setup and Hold Time Check Routine + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + PROCEDURE ReportViolation ( + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT CheckInfo : IN CheckInfoType; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + VARIABLE Message : LINE; + BEGIN + IF NOT CheckInfo.Violation THEN RETURN; END IF; + + Write ( Message, HeaderMsg ); + Case CheckInfo.CheckKind IS + WHEN SetupCheck => Write ( Message, STRING'(" SETUP ") ); + WHEN HoldCheck => Write ( Message, STRING'(" HOLD ") ); + WHEN RecoveryCheck => Write ( Message, STRING'(" RECOVERY ") ); + WHEN RemovalCheck => Write ( Message, STRING'(" REMOVAL ") ); + WHEN PulseWidCheck => Write ( Message, STRING'(" PULSE WIDTH ")); + WHEN PeriodCheck => Write ( Message, STRING'(" PERIOD ") ); + END CASE; + Write ( Message, HiLoStr(CheckInfo.State) ); + Write ( Message, STRING'(" VIOLATION ON ") ); + Write ( Message, TestSignalName ); + IF (RefSignalName'LENGTH > 0) THEN + Write ( Message, STRING'(" WITH RESPECT TO ") ); + Write ( Message, RefSignalName ); + END IF; + Write ( Message, ';' & LF ); + Write ( Message, STRING'(" Expected := ") ); + Write ( Message, CheckInfo.ExpTime); + Write ( Message, STRING'("; Observed := ") ); + Write ( Message, CheckInfo.ObsTime); + Write ( Message, STRING'("; At : ") ); + Write ( Message, CheckInfo.DetTime); + + ASSERT FALSE REPORT Message.ALL SEVERITY MsgSeverity; + + DEALLOCATE (Message); + END ReportViolation; + + --------------------------------------------------------------------------- + -- Procedure : InternalTimingCheck + --------------------------------------------------------------------------- + PROCEDURE InternalTimingCheck ( + CONSTANT TestSignal : IN std_ulogic; + CONSTANT RefSignal : IN std_ulogic; + CONSTANT TestDelay : IN TIME := 0 ns; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + VARIABLE RefTime : IN TIME; + VARIABLE RefEdge : IN BOOLEAN; + VARIABLE TestTime : IN TIME; + VARIABLE TestEvent : IN BOOLEAN; + VARIABLE SetupEn : INOUT BOOLEAN; + VARIABLE HoldEn : INOUT BOOLEAN; + VARIABLE CheckInfo : INOUT CheckInfoType; + CONSTANT MsgOn : IN BOOLEAN + ) IS + VARIABLE bias, b2 : TIME; + BEGIN + -- Check SETUP constraint + IF RefEdge THEN + IF SetupEn THEN + CheckInfo.ObsTime := RefTime - TestTime; + CheckInfo.State := To_X01(TestSignal); + CASE CheckInfo.State IS + WHEN '0' => CheckInfo.ExpTime := SetupLow; + WHEN '1' => CheckInfo.ExpTime := SetupHigh; + WHEN 'X' => CheckInfo.ExpTime := Maximum(SetupHigh,SetupLow); + END CASE; + CheckInfo.Violation := CheckInfo.ObsTime < CheckInfo.ExpTime; + SetupEn := FALSE; + ELSE + CheckInfo.Violation := FALSE; + END IF; + + -- Check HOLD constraint + ELSIF TestEvent THEN + IF HoldEn THEN + CheckInfo.ObsTime := TestTime - RefTime; + CheckInfo.State := To_X01(TestSignal); + CASE CheckInfo.State IS + WHEN '0' => CheckInfo.ExpTime := HoldHigh; + WHEN '1' => CheckInfo.ExpTime := HoldLow; + WHEN 'X' => CheckInfo.ExpTime := Maximum(HoldHigh,HoldLow); + END CASE; + CheckInfo.Violation := CheckInfo.ObsTime < CheckInfo.ExpTime; + HoldEn := NOT CheckInfo.Violation; + ELSE + CheckInfo.Violation := FALSE; + END IF; + ELSE + CheckInfo.Violation := FALSE; + END IF; + + -- Adjust report values to account for internal model delays + -- Note: TestDelay, RefDelay, TestTime, RefTime and bias are non-negative + IF MsgOn AND CheckInfo.Violation THEN + bias := TestDelay - RefDelay; + IF TestTime - RefTime <= bias THEN + CheckInfo.CheckKind := SetupCheck; + b2 := TIME'HIGH - bias; + IF (CheckInfo.ObsTime <= b2) + THEN CheckInfo.ObsTime := CheckInfo.ObsTime + bias; + ELSE CheckInfo.ObsTime := Time'HIGH; + END IF; + IF (CheckInfo.ExpTime <= b2) + THEN CheckInfo.ExpTime := CheckInfo.ExpTime + bias; + ELSE CheckInfo.ExpTime := Time'HIGH; + END IF; + CheckInfo.DetTime := RefTime - RefDelay; + ELSE + CheckInfo.CheckKind := HoldCheck; + CheckInfo.ObsTime := CheckInfo.ObsTime - bias; + IF (CheckInfo.ExpTime >= 0 ns) THEN + CheckInfo.ExpTime := CheckInfo.ExpTime - bias; + END IF; + CheckInfo.DetTime := TestTime - TestDelay; + END IF; + END IF; + END InternalTimingCheck; + + --------------------------------------------------------------------------- + --------------------------------------------------------------------------- + FUNCTION VitalTimingDataInit + RETURN VitalTimingDataType IS + BEGIN + RETURN (FALSE,'X', 0 ns, FALSE, 'X', 0 ns, FALSE, NULL, NULL, NULL, NULL); + END; + + --------------------------------------------------------------------------- + -- Procedure : VitalSetupHoldCheck + --------------------------------------------------------------------------- + PROCEDURE VitalSetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge, TestEvent : BOOLEAN; + VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay); + VARIABLE RefDly : TIME := Maximum(0 ns, RefDelay); + VARIABLE bias : TIME; + BEGIN + + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLast := To_X01(TestSignal); + TimingData.RefLast := To_X01(RefSignal); + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal), + RefTransition); + TimingData.RefLast := To_X01(RefSignal); + IF RefEdge THEN + TimingData.RefTime := NOW; + TimingData.HoldEn := TRUE; + END IF; + + -- Detect test (data) changes and record the time of the last change + TestEvent := TimingData.TestLast /= To_X01Z(TestSignal); + TimingData.TestLast := To_X01Z(TestSignal); + IF TestEvent THEN + TimingData.TestTime := NOW; + TimingData.SetupEn := TRUE; + END IF; + + -- Perform timing checks (if enabled) + Violation := '0'; + IF (CheckEnabled) THEN + InternalTimingCheck ( + TestSignal => TestSignal, + RefSignal => RefSignal, + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHigh, + SetupLow => SetupLow, + HoldHigh => HoldHigh, + HoldLow => HoldLow, + RefTime => TimingData.RefTime, + RefEdge => RefEdge, + TestTime => TimingData.TestTime, + TestEvent => TestEvent, + SetupEn => TimingData.SetupEn, + HoldEn => TimingData.HoldEn, + CheckInfo => CheckInfo, + MsgOn => MsgOn ); + + -- Report any detected violations and set return violation flag + IF CheckInfo.Violation THEN + IF (MsgOn) THEN + ReportViolation (TestSignalName, RefSignalName, + HeaderMsg, CheckInfo, MsgSeverity ); + END IF; + IF (XOn) THEN Violation := 'X'; END IF; + END IF; + END IF; + + END VitalSetupHoldCheck; + + --------------------------------------------------------------------------- + PROCEDURE VitalSetupHoldCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_logic_vector; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT SetupHigh : IN TIME := 0 ns; + CONSTANT SetupLow : IN TIME := 0 ns; + CONSTANT HoldHigh : IN TIME := 0 ns; + CONSTANT HoldLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge : BOOLEAN; + VARIABLE TestEvent : VitalBoolArrayT(TestSignal'RANGE); + VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay); + VARIABLE RefDly : TIME := Maximum(0 ns, RefDelay); + VARIABLE bias : TIME; + VARIABLE ChangedAllAtOnce : BOOLEAN := TRUE; + VARIABLE StrPtr1 : LINE; + + BEGIN + -- Initialization of working area. + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLastA := NEW std_logic_vector(TestSignal'RANGE); + TimingData.TestTimeA := NEW VitalTimeArrayT(TestSignal'RANGE); + TimingData.HoldEnA := NEW VitalBoolArrayT(TestSignal'RANGE); + TimingData.SetupEnA := NEW VitalBoolArrayT(TestSignal'RANGE); + FOR i IN TestSignal'RANGE LOOP + TimingData.TestLastA(i) := To_X01(TestSignal(i)); + END LOOP; + TimingData.RefLast := To_X01(RefSignal); + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal), + RefTransition); + TimingData.RefLast := To_X01(RefSignal); + IF RefEdge THEN + TimingData.RefTime := NOW; + TimingData.HoldEnA.all := (TestSignal'RANGE=>TRUE); + END IF; + + -- Detect test (data) changes and record the time of the last change + FOR i IN TestSignal'RANGE LOOP + TestEvent(i) := TimingData.TestLastA(i) /= To_X01Z(TestSignal(i)); + TimingData.TestLastA(i) := To_X01Z(TestSignal(i)); + IF TestEvent(i) THEN + TimingData.TestTimeA(i) := NOW; + TimingData.SetupEnA(i) := TRUE; + TimingData.TestTime := NOW; + END IF; + END LOOP; + + -- Check to see if the Bus subelements changed all at the same time. + -- If so, then we can reduce the volume of error messages since we no + -- longer have to report every subelement individually + FOR i IN TestSignal'RANGE LOOP + IF TimingData.TestTimeA(i) /= TimingData.TestTime THEN + ChangedAllAtOnce := FALSE; + EXIT; + END IF; + END LOOP; + + -- Perform timing checks (if enabled) + Violation := '0'; + IF (CheckEnabled) THEN + FOR i IN TestSignal'RANGE LOOP + InternalTimingCheck ( + TestSignal => TestSignal(i), + RefSignal => RefSignal, + TestDelay => TestDly, + RefDelay => RefDly, + SetupHigh => SetupHigh, + SetupLow => SetupLow, + HoldHigh => HoldHigh, + HoldLow => HoldLow, + RefTime => TimingData.RefTime, + RefEdge => RefEdge, + TestTime => TimingData.TestTimeA(i), + TestEvent => TestEvent(i), + SetupEn => TimingData.SetupEnA(i), + HoldEn => TimingData.HoldEnA(i), + CheckInfo => CheckInfo, + MsgOn => MsgOn ); + + -- Report any detected violations and set return violation flag + IF CheckInfo.Violation THEN + IF (MsgOn) THEN + IF ( ChangedAllAtOnce AND (i = TestSignal'LEFT) ) THEN + ReportViolation (TestSignalName&"(...)", RefSignalName, + HeaderMsg, CheckInfo, MsgSeverity ); + ELSIF (NOT ChangedAllAtOnce) THEN + Write (StrPtr1, i); + ReportViolation (TestSignalName & "(" & StrPtr1.ALL & ")", + RefSignalName, + HeaderMsg, CheckInfo, MsgSeverity ); + DEALLOCATE (StrPtr1); + END IF; + END IF; + IF (XOn) THEN + Violation := 'X'; + END IF; + END IF; + END LOOP; + END IF; + + DEALLOCATE (StrPtr1); + + END VitalSetupHoldCheck; + + --------------------------------------------------------------------------- + -- Function : VitalRecoveryRemovalCheck + --------------------------------------------------------------------------- + PROCEDURE VitalRecoveryRemovalCheck ( + VARIABLE Violation : OUT X01; + VARIABLE TimingData : INOUT VitalTimingDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName: IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + SIGNAL RefSignal : IN std_ulogic; + CONSTANT RefSignalName : IN STRING := ""; + CONSTANT RefDelay : IN TIME := 0 ns; + CONSTANT Recovery : IN TIME := 0 ns; + CONSTANT Removal : IN TIME := 0 ns; + CONSTANT ActiveLow : IN BOOLEAN := TRUE; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT RefTransition : IN VitalEdgeSymbolType; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + VARIABLE CheckInfo : CheckInfoType; + VARIABLE RefEdge, TestEvent : BOOLEAN; + VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay); + VARIABLE RefDly : TIME := Maximum(0 ns, RefDelay); + VARIABLE bias : TIME; + BEGIN + + IF (TimingData.NotFirstFlag = FALSE) THEN + TimingData.TestLast := To_X01(TestSignal); + TimingData.RefLast := To_X01(RefSignal); + TimingData.NotFirstFlag := TRUE; + END IF; + + -- Detect reference edges and record the time of the last edge + RefEdge := EdgeSymbolMatch(TimingData.RefLast, To_X01(RefSignal), + RefTransition); + TimingData.RefLast := To_X01(RefSignal); + IF RefEdge THEN + TimingData.RefTime := NOW; + TimingData.HoldEn := TRUE; + END IF; + + -- Detect test (data) changes and record the time of the last change + TestEvent := TimingData.TestLast /= To_X01Z(TestSignal); + TimingData.TestLast := To_X01Z(TestSignal); + IF TestEvent THEN + TimingData.TestTime := NOW; + TimingData.SetupEn := TRUE; + END IF; + + -- Perform timing checks (if enabled) + Violation := '0'; + IF (CheckEnabled) THEN + + IF ActiveLow THEN + InternalTimingCheck ( + TestSignal, RefSignal, TestDly, RefDly, + Recovery, 0 ns, 0 ns, Removal, + TimingData.RefTime, RefEdge, + TimingData.TestTime, TestEvent, + TimingData.SetupEn, TimingData.HoldEn, + CheckInfo, MsgOn ); + ELSE + InternalTimingCheck ( + TestSignal, RefSignal, TestDly, RefDly, + 0 ns, Recovery, Removal, 0 ns, + TimingData.RefTime, RefEdge, + TimingData.TestTime, TestEvent, + TimingData.SetupEn, TimingData.HoldEn, + CheckInfo, MsgOn ); + END IF; + + + -- Report any detected violations and set return violation flag + IF CheckInfo.Violation THEN + IF CheckInfo.CheckKind = SetupCheck THEN + CheckInfo.CheckKind := RecoveryCheck; + ELSE + CheckInfo.CheckKind := RemovalCheck; + END IF; + IF (MsgOn) THEN + ReportViolation (TestSignalName, RefSignalName, + HeaderMsg, CheckInfo, MsgSeverity ); + END IF; + IF (XOn) THEN Violation := 'X'; END IF; + END IF; + END IF; + + END VitalRecoveryRemovalCheck; + + --------------------------------------------------------------------------- + PROCEDURE VitalPeriodPulseCheck ( + VARIABLE Violation : OUT X01; + VARIABLE PeriodData : INOUT VitalPeriodDataType; + SIGNAL TestSignal : IN std_ulogic; + CONSTANT TestSignalName : IN STRING := ""; + CONSTANT TestDelay : IN TIME := 0 ns; + CONSTANT Period : IN TIME := 0 ns; + CONSTANT PulseWidthHigh : IN TIME := 0 ns; + CONSTANT PulseWidthLow : IN TIME := 0 ns; + CONSTANT CheckEnabled : IN BOOLEAN := TRUE; + CONSTANT HeaderMsg : IN STRING := " "; + CONSTANT XOn : IN BOOLEAN := TRUE; + CONSTANT MsgOn : IN BOOLEAN := TRUE; + CONSTANT MsgSeverity : IN SEVERITY_LEVEL := WARNING + ) IS + + VARIABLE TestDly : TIME := Maximum(0 ns, TestDelay); + VARIABLE CheckInfo : CheckInfoType; + VARIABLE PeriodObs : TIME; + VARIABLE PulseTest, PeriodTest : BOOLEAN; + VARIABLE TestValue : X01 := To_X01(TestSignal); + BEGIN + + IF (PeriodData.NotFirstFlag = FALSE) THEN + PeriodData.Rise := + -maximum(Period, maximum(PulseWidthHigh, PulseWidthLow)); + PeriodData.Fall := + -maximum(Period, maximum(PulseWidthHigh, PulseWidthLow)); + PeriodData.Last := To_X01(TestSignal); + PeriodData.NotFirstFlag := TRUE; + END IF; + + -- Initialize for no violation + -- No violation possible if no test signal change + Violation := '0'; + IF (PeriodData.Last = TestValue) THEN + RETURN; + END IF; + + -- record starting pulse times + IF EdgeSymbolMatch(PeriodData.Last, TestValue, 'P') THEN + -- Compute period times, then record the High Rise Time + PeriodObs := NOW - PeriodData.Rise; + PeriodData.Rise := NOW; + PeriodTest := TRUE; + ELSIF EdgeSymbolMatch(PeriodData.Last, TestValue, 'N') THEN + -- Compute period times, then record the Low Fall Time + PeriodObs := NOW - PeriodData.Fall; + PeriodData.Fall := NOW; + PeriodTest := TRUE; + ELSE + PeriodTest := FALSE; + END IF; + + -- do checks on pulse ends + IF EdgeSymbolMatch(PeriodData.Last, TestValue, 'p') THEN + -- Compute pulse times + CheckInfo.ObsTime := NOW - PeriodData.Fall; + CheckInfo.ExpTime := PulseWidthLow; + PulseTest := TRUE; + ELSIF EdgeSymbolMatch(PeriodData.Last, TestValue, 'n') THEN + -- Compute pulse times + CheckInfo.ObsTime := NOW - PeriodData.Rise; + CheckInfo.ExpTime := PulseWidthHigh; + PulseTest := TRUE; + ELSE + PulseTest := FALSE; + END IF; + + IF PulseTest AND CheckEnabled THEN + -- Verify Pulse Width [ignore 1st edge] + IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN + IF (XOn) THEN Violation := 'X'; END IF; + IF (MsgOn) THEN + CheckInfo.Violation := TRUE; + CheckInfo.CheckKind := PulseWidCheck; + CheckInfo.DetTime := NOW - TestDly; + CheckInfo.State := PeriodData.Last; + ReportViolation (TestSignalName, "", + HeaderMsg, CheckInfo, MsgSeverity ); + END IF; -- MsgOn + END IF; + END IF; + + IF PeriodTest AND CheckEnabled THEN + -- Verify the Period [ignore 1st edge] + CheckInfo.ObsTime := PeriodObs; + CheckInfo.ExpTime := Period; + IF ( CheckInfo.ObsTime < CheckInfo.ExpTime ) THEN + IF (XOn) THEN Violation := 'X'; END IF; + IF (MsgOn) THEN + CheckInfo.Violation := TRUE; + CheckInfo.CheckKind := PeriodCheck; + CheckInfo.DetTime := NOW - TestDly; + CheckInfo.State := TestValue; + ReportViolation (TestSignalName, "", + HeaderMsg, CheckInfo, MsgSeverity ); + END IF; -- MsgOn + END IF; + END IF; + + PeriodData.Last := TestValue; + + END VitalPeriodPulseCheck; + +END VITAL_Timing; + diff --git a/lists.adb b/lists.adb new file mode 100644 index 000000000..dffbdc87e --- /dev/null +++ b/lists.adb @@ -0,0 +1,257 @@ +-- Lists data type. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with System; +with GNAT.Table; + +package body Lists is + type Node_Array_Fat is array (Natural) of Node_Type; + type Node_Array_Fat_Acc is access Node_Array_Fat; + + type List_Record is record + Max : Natural; + Nbr : Natural; + Next : List_Type; + Els : Node_Array_Fat_Acc; + end record; + + package Listt is new GNAT.Table + (Table_Component_Type => List_Record, + Table_Index_Type => List_Type, + Table_Low_Bound => 4, + Table_Initial => 128, + Table_Increment => 100); + + function Get_Max_Nbr_Elements (List : List_Type) return Natural; + pragma Inline (Get_Max_Nbr_Elements); + + procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural); + pragma Inline (Set_Max_Nbr_Elements); + + procedure List_Set_Nbr_Elements (List : List_Type; Nbr : Natural); + pragma Inline (List_Set_Nbr_Elements); + + function Get_Nbr_Elements (List: List_Type) return Natural is + begin + return Listt.Table (List).Nbr; + end Get_Nbr_Elements; + + procedure List_Set_Nbr_Elements (List : List_Type; Nbr : Natural) is + begin + Listt.Table (List).Nbr := Nbr; + end List_Set_Nbr_Elements; + + function Get_Max_Nbr_Elements (List : List_Type) return Natural is + begin + return Listt.Table (List).Max; + end Get_Max_Nbr_Elements; + + procedure Set_Max_Nbr_Elements (List : List_Type; Max : Natural) is + begin + Listt.Table (List).Max := Max; + end Set_Max_Nbr_Elements; + + function Get_Nth_Element (List: List_Type; N: Natural) + return Node_Type + is + begin + if N >= Listt.Table (List).Nbr then + return Null_Node; + end if; + return Listt.Table (List).Els (N); + end Get_Nth_Element; + + -- Replace an element selected by position. + procedure Replace_Nth_Element (List: List_Type; N: Natural; El: Node_Type) + is + begin + if N >= Listt.Table (List).Nbr then + raise Program_Error; + end if; + Listt.Table (List).Els (N) := El; + end Replace_Nth_Element; + + -- Be sure an element can be added to LIST. + -- It doesn't change the number of elements. + procedure List_Grow (List: List_Type) + is + L : List_Record renames Listt.Table (List); + + -- Be careful: size in bytes. + function Alloc (Size : Natural) return Node_Array_Fat_Acc; + pragma Import (C, Alloc, "malloc"); + + function Realloc (Ptr : Node_Array_Fat_Acc; Size : Natural) + return Node_Array_Fat_Acc; + pragma Import (C, Realloc, "realloc"); + + Tmp : Node_Array_Fat_Acc; + N : Natural; + begin + if L.Nbr < L.Max then + return; + end if; + if L.Max = 0 then + N := 8; + Tmp := Alloc (N * Node_Type'Size / System.Storage_Unit); + else + N := L.Max * 2; + Tmp := Realloc (L.Els, N * Node_Type'Size / System.Storage_Unit); + end if; + L.Els := Tmp; + L.Max := N; + end List_Grow; + + procedure Append_Element (List: List_Type; Element: Node_Type) + is + L : List_Record renames Listt.Table (List); + begin + if L.Nbr >= L.Max then + List_Grow (List); + end if; + L.Els (L.Nbr) := Element; + L.Nbr := L.Nbr + 1; + end Append_Element; + + -- Return the last element of the list, or null. + function Get_Last_Element (List: List_Type) return Node_Type + is + L : List_Record renames Listt.Table (List); + begin + if L.Nbr = 0 then + return Null_Node; + else + return L.Els (L.Nbr - 1); + end if; + end Get_Last_Element; + + -- Return the first element of the list, or null. + function Get_First_Element (List: List_Type) return Node_Type is + begin + if Listt.Table (List).Nbr = 0 then + return Null_Node; + else + return Listt.Table (List).Els (0); + end if; + end Get_First_Element; + + -- Add (append) an element only if it was not already present in the list. + procedure Add_Element (List: List_Type; El: Node_Type) + is + Nbr : Natural := Get_Nbr_Elements (List); + begin + for I in 0 .. Nbr - 1 loop + if Listt.Table (List).Els (I) = El then + return; + end if; + end loop; + + Append_Element (List, El); + end Add_Element; + + procedure Remove_Nth_Element (List: List_Type; N: Natural) + is + Nbr : Natural := Get_Nbr_Elements (List); + begin + if N >= Nbr then + raise Program_Error; + end if; + for I in N .. Nbr - 2 loop + Listt.Table (List).Els (I) := Listt.Table (List).Els (I + 1); + end loop; + Listt.Table (List).Nbr := Nbr - 1; + end Remove_Nth_Element; + + procedure Set_Nbr_Elements (List: List_Type; N: Natural) is + begin + if N > Get_Nbr_Elements (List) then + raise Program_Error; + end if; + List_Set_Nbr_Elements (List, N); + end Set_Nbr_Elements; + + -- Return the position of the last element. + -- Return -1 if the list is empty. + function Get_Last_Element_Position (List: List_Type) return Integer is + begin + return Get_Nbr_Elements (List) - 1; + end Get_Last_Element_Position; + + function Get_Nbr_Elements_Safe (List: List_Type) return Natural is + begin + if List = Null_List then + return 0; + else + return Get_Nbr_Elements (List); + end if; + end Get_Nbr_Elements_Safe; + + -- Empty the list + procedure Empty_List (List: List_Type) is + begin + Set_Nbr_Elements (List, 0); + end Empty_List; + + -- Chain of unused lists. + Free_Chain : List_Type := Null_List; + + function Create_List return List_Type + is + Res : List_Type; + begin + if Free_Chain = Null_List then + Listt.Increment_Last; + Res := Listt.Last; + else + Res := Free_Chain; + Free_Chain := Listt.Table (Res).Next; + end if; + Listt.Table (Res) := List_Record'(Max => 0, Nbr => 0, + Next => Null_List, Els => null); + return Res; + end Create_List; + + procedure Free (Ptr : Node_Array_Fat_Acc); + pragma Import (C, Free, "free"); + + procedure Destroy_List (List : in out List_Type) + is + begin + if List = Null_List then + return; + end if; + if Listt.Table (List).Max > 0 then + Free (Listt.Table (List).Els); + Listt.Table (List).Els := null; + end if; + Listt.Table (List).Next := Free_Chain; + Free_Chain := List; + List := Null_List; + end Destroy_List; + + procedure Initialize is + begin + for I in Listt.First .. Listt.Last loop + if Listt.Table (I).Els /= null then + Free (Listt.Table (I).Els); + end if; + end loop; + Listt.Free; + Listt.Init; + end Initialize; + +end Lists; diff --git a/lists.ads b/lists.ads new file mode 100644 index 000000000..bf3a89e49 --- /dev/null +++ b/lists.ads @@ -0,0 +1,123 @@ +-- Lists data type. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; +with Nodes; use Nodes; + +package Lists is + type List_Type is new Nat32; + for List_Type'Size use 32; + + Null_List : constant List_Type := 0; + + List_Others : constant List_Type := 1; + List_All : constant List_Type := 2; + + ----------- + -- Lists -- + ----------- + + -- Iir_Kinds_List + -- Lists of elements. + -- index is 0 .. nbr_elements - 1. + -- + -- Append an element to (the end of) the list. + -- procedure Append_Element (List: in Iir; Element: Iir); + -- + -- Get the N th element in list, starting from 0. + -- Return an access to the element or null_iir, if beyond bounds. + -- function Get_Nth_Element (List: in Iir; N: Natural) return Iir; + -- + -- Return the last element of the list, or null_iir. + -- function Get_Last_Element (List: in Iir) return Iir; + -- + -- Return the first element of the list, or null_iir. + -- function Get_First_Element (List: in Iir) return Iir; + -- + -- Replace an element selected by position. + -- procedure Replace_Nth_Element (List: in Iir_List; N: Natural; El:Iir); + -- + -- Add (append) an element only if it was not already present in the list. + -- Return its position. + -- procedure Add_Element (List: in Iir; El: Iir; Position: out integer); + -- procedure Add_Element (List: in Iir_List; El: Iir); + -- + -- Return the number of elements in the list. + -- This is also 1 + the position of the last element. + -- function Get_Nbr_Elements (List: in Iir_List) return Natural; + -- + -- Set the number of elements in the list. + -- Can be used only to shrink the list. + -- procedure Set_Nbr_Elements (List: in Iir_List; N: Natural); + -- + -- Remove an element from the list. + -- procedure remove_Nth_Element (List: in Iir_List; N: Natural); + -- + -- Return the position of the last element. + -- Return -1 if the list is empty. + -- function Get_Last_Element_Position (List: in Iir_List) return Integer; + -- + -- Empty the list. + -- This is also set_nbr_elements (list, 0); + -- procedure Empty_List (List: in Iir_List); + -- + -- Alias a list. TARGET must be empty. + -- procedure Alias_List (Target: in out Iir; Source: in Iir); + + procedure Append_Element (List: List_Type; Element: Node_Type); + + -- Get the N th element in list, starting from 0. + -- Return the element or null_iir, if beyond bounds. + function Get_Nth_Element (List: List_Type; N: Natural) return Node_Type; + + function Get_Last_Element (List: List_Type) return Node_Type; + + function Get_First_Element (List: List_Type) return Node_Type; + + procedure Replace_Nth_Element (List: List_Type; N: Natural; El: Node_Type); + + procedure Add_Element (List: List_Type; El: Node_Type); + + -- Return the number of elements in the list. + -- This is also 1 + the position of the last element. + function Get_Nbr_Elements (List: List_Type) return Natural; + pragma Inline (Get_Nbr_Elements); + + -- Same as get_nbr_elements but returns 0 if LIST is NULL_IIR. + function Get_Nbr_Elements_Safe (List : List_Type) return Natural; + + -- Set the number of elements in the list. + -- Can be used only to shrink the list. + procedure Set_Nbr_Elements (List: List_Type; N: Natural); + + procedure Remove_Nth_Element (List : List_Type; N: Natural); + + function Get_Last_Element_Position (List: List_Type) return Integer; + + -- Clear the list. + procedure Empty_List (List: List_Type); + + -- Create a list. + function Create_List return List_Type; + + -- Destroy a list. + procedure Destroy_List (List : in out List_Type); + + -- Free all the lists and reset to initial state. + -- Must be used to free the memory used by the lists. + procedure Initialize; +end Lists; diff --git a/name_table.adb b/name_table.adb new file mode 100644 index 000000000..dd1f78f2c --- /dev/null +++ b/name_table.adb @@ -0,0 +1,358 @@ +-- Name table. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Text_IO; use Ada.Text_IO; +with GNAT.Table; + +package body Name_Table is + -- A flag that creates verbosity. + Debug_Name_Table: constant Boolean := False; + + First_Character_Name_Id : constant Name_Id := 1; + + type Hash_Value_Type is mod 2**32; + + -- An entry in the name table. + type Identifier is record + Hash: Hash_Value_Type; + Next: Name_Id; + + -- FIXME: to be removed (compute from name of next identifier). + Length: Natural; + + -- Index in strings_table. + Name: Natural; + + -- User infos. + Info: Int32; + end record; + + -- Hash table. + -- Number of entry points. + Hash_Table_Size: constant Hash_Value_Type := 1024; + Hash_Table: array (0 .. Hash_Table_Size - 1) of Name_Id; + + -- The table to store all the strings. + package Strings_Table is new GNAT.Table + (Table_Index_Type => Natural, + Table_Component_Type => Character, + Table_Low_Bound => Natural'First, + Table_Initial => 4096, + Table_Increment => 100); + + -- A NUL character is stored after each word in the strings_table. + -- This is used for compatibility with C. + NUL: constant Character := Character'Val (0); + + -- Allocate place in the strings_table, and store the name_buffer into it. + -- Also append a NUL. + function Store return Natural is + Res: Natural; + begin + Res := Strings_Table.Allocate (Name_Length + 1); + Strings_Table.Table (Res .. Res + Name_Length - 1) := + Strings_Table.Table_Type (Name_Buffer (1 .. Name_Length)); + Strings_Table.Table (Res + Name_Length) := NUL; + return Res; + end Store; + + package Names_Table is new GNAT.Table + (Table_Index_Type => Name_Id, + Table_Component_Type => Identifier, + Table_Low_Bound => Name_Id'First, + Table_Initial => 1024, + Table_Increment => 100); + + -- Initialize this package + -- This must be called once and only once before any use. + procedure Initialize is + Pos: Natural; + Id: Name_Id; + begin + Strings_Table.Init; + Names_Table.Init; + -- Reserve entry 0. + if Names_Table.Allocate /= Null_Identifier then + raise Program_Error; + end if; + Names_Table.Table (Null_Identifier) := (Length => 0, + Hash => 0, + Name => 0, + Next => Null_Identifier, + Info => 0); + -- Store characters. + for C in Character loop + Pos := Strings_Table.Allocate; + Strings_Table.Table (Pos) := C; + Id := Names_Table.Allocate; + Names_Table.Table (Id) := (Length => 1, + Hash => 0, + Name => Pos, + Next => Null_Identifier, + Info => 0); + end loop; + Hash_Table := (others => Null_Identifier); + end Initialize; + + -- Compute the hash value of a string. + function Hash return Hash_Value_Type is + Res: Hash_Value_Type := 0; + begin + for I in 1 .. Name_Length loop + Res := Res * 7 + Character'Pos(Name_Buffer(I)); + Res := Res + Res / 2**28; + end loop; + return Res; + end Hash; + + -- Get the string associed to an identifier. + function Image (Id: Name_Id) return String is + Name_Entry: Identifier renames Names_Table.Table(Id); + subtype Result_Type is String (1 .. Name_Entry.Length); + begin + if Is_Character (Id) then + return ''' & Strings_Table.Table (Name_Entry.Name) & '''; + else + return Result_Type + (Strings_Table.Table + (Name_Entry.Name .. Name_Entry.Name + Name_Entry.Length - 1)); + end if; + end Image; + + procedure Image (Id : Name_Id) + is + Name_Entry: Identifier renames Names_Table.Table(Id); + begin + if Is_Character (Id) then + Name_Buffer (1) := Get_Character (Id); + Name_Length := 1; + else + Name_Length := Name_Entry.Length; + Name_Buffer (1 .. Name_Entry.Length) := String + (Strings_Table.Table + (Name_Entry.Name .. Name_Entry.Name + Name_Entry.Length - 1)); + end if; + end Image; + + -- Get the address of the first character of ID. + -- The string is NUL-terminated (this is done by get_identifier). + function Get_Address (Id: Name_Id) return System.Address is + Name_Entry: Identifier renames Names_Table.Table(Id); + begin + return Strings_Table.Table (Name_Entry.Name)'Address; + end Get_Address; + + function Get_Name_Length (Id: Name_Id) return Natural is + begin + return Names_Table.Table(Id).Length; + end Get_Name_Length; + + function Is_Character (Id: Name_Id) return Boolean is + begin + return Id >= First_Character_Name_Id and then + Id <= First_Character_Name_Id + Character'Pos (Character'Last); + end Is_Character; + + -- Get the character associed to an identifier. + function Get_Character (Id: Name_Id) return Character is + begin + pragma Assert (Is_Character (Id)); + return Character'Val (Id - First_Character_Name_Id); + end Get_Character; + + -- Get and set the info field associated with each identifier. + -- Used to store interpretations of the name. + function Get_Info (Id: Name_Id) return Int32 is + begin + return Names_Table.Table (Id).Info; + end Get_Info; + + procedure Set_Info (Id: Name_Id; Info: Int32) is + begin + Names_Table.Table (Id).Info := Info; + end Set_Info; + + function Compare_Name_Buffer_With_Name (Id : Name_Id) return Boolean + is + Ne: Identifier renames Names_Table.Table(Id); + begin + return String (Strings_Table.Table (Ne.Name .. Ne.Name + Ne.Length - 1)) + = Name_Buffer (1 .. Name_Length); + end Compare_Name_Buffer_With_Name; + + -- Get or create an entry in the name table. + -- The string is taken from NAME_BUFFER and NAME_LENGTH. + function Get_Identifier return Name_Id + is + Hash_Value, Hash_Index: Hash_Value_Type; + Res: Name_Id; + begin + Hash_Value := Hash; + Hash_Index := Hash_Value mod Hash_Table_Size; + + if Debug_Name_Table then + Put_Line ("get_identifier " & Name_Buffer (1 .. Name_Length)); + end if; + + Res := Hash_Table (Hash_Index); + while Res /= Null_Identifier loop + --Put_Line ("compare with " & Get_String (Res)); + if Names_Table.Table (Res).Hash = Hash_Value + and then Names_Table.Table (Res).Length = Name_Length + and then Compare_Name_Buffer_With_Name (Res) + then + --Put_Line ("found"); + return Res; + end if; + Res := Names_Table.Table (Res).Next; + end loop; + Res := Names_Table.Allocate; + Names_Table.Table (Res) := (Length => Name_Length, + Hash => Hash_Value, + Name => Store, + Next => Hash_Table (Hash_Index), + Info => 0); + Hash_Table (Hash_Index) := Res; + --Put_Line ("created"); + return Res; + end Get_Identifier; + + function Get_Identifier_No_Create return Name_Id + is + Hash_Value, Hash_Index: Hash_Value_Type; + Res: Name_Id; + begin + Hash_Value := Hash; + Hash_Index := Hash_Value mod Hash_Table_Size; + + Res := Hash_Table (Hash_Index); + while Res /= Null_Identifier loop + if Names_Table.Table (Res).Hash = Hash_Value + and then Names_Table.Table (Res).Length = Name_Length + and then Compare_Name_Buffer_With_Name (Res) + then + return Res; + end if; + Res := Names_Table.Table (Res).Next; + end loop; + return Null_Identifier; + end Get_Identifier_No_Create; + + -- Get or create an entry in the name table. + function Get_Identifier (Str: String) return Name_Id is + begin + Name_Length := Str'Length; + Name_Buffer (1 .. Name_Length) := Str; + return Get_Identifier; + end Get_Identifier; + + function Get_Identifier (Char: Character) return Name_Id is + begin + return First_Character_Name_Id + Character'Pos (Char); + end Get_Identifier; + + -- Be sure all info fields have their default value. + procedure Assert_No_Infos is + Err: Boolean := False; + begin + for I in Names_Table.First .. Names_Table.Last loop + if Get_Info (I) /= 0 then + Err := True; + Put_Line ("still infos in" & Name_Id'Image (I) & ", ie: " + & Image (I) & ", info =" + & Int32'Image (Names_Table.Table (I).Info)); + end if; + end loop; + if Err then + raise Program_Error; + end if; + end Assert_No_Infos; + + -- Return the latest name_id used. + -- kludge, use only for debugging. + function Last_Name_Id return Name_Id is + begin + return Names_Table.Last; + end Last_Name_Id; + + -- Used to debug. + -- Disp the strings table, one word per line. + procedure Dump; + pragma Unreferenced (Dump); + + procedure Dump + is + First: Natural; + begin + Put_Line ("strings_table:"); + First := 0; + for I in 0 .. Strings_Table.Last loop + if Strings_Table.Table(I) = NUL then + Put_Line (Natural'Image (First) & ": " + & String (Strings_Table.Table (First .. I - 1))); + First := I + 1; + end if; + end loop; + end Dump; + + function Get_Hash_Entry_Length (H : Hash_Value_Type) return Natural + is + Res : Natural := 0; + N : Name_Id; + begin + N := Hash_Table (H); + while N /= Null_Identifier loop + Res := Res + 1; + N := Names_Table.Table (N).Next; + end loop; + return Res; + end Get_Hash_Entry_Length; + + procedure Disp_Stats + is + Min : Natural; + Max : Natural; + N : Natural; + begin + Put_Line ("Name table statistics:"); + Put_Line (" number of identifiers: " & Name_Id'Image (Last_Name_Id)); + Put_Line (" size of strings: " & Natural'Image (Strings_Table.Last)); + Put_Line (" hash distribution (number of entries per length):"); + Min := Natural'Last; + Max := Natural'First; + for I in Hash_Table'Range loop + N := Get_Hash_Entry_Length (I); + Min := Natural'Min (Min, N); + Max := Natural'Max (Max, N); + end loop; + declare + type Nat_Array is array (Min .. Max) of Natural; + S : Nat_Array := (others => 0); + begin + for I in Hash_Table'Range loop + N := Get_Hash_Entry_Length (I); + S (N) := S (N) + 1; + end loop; + for I in S'Range loop + if S (I) /= 0 then + Put_Line (" " & Natural'Image (I) + & ":" & Natural'Image (S (I))); + end if; + end loop; + end; + end Disp_Stats; +end Name_Table; diff --git a/name_table.ads b/name_table.ads new file mode 100644 index 000000000..5659a89a4 --- /dev/null +++ b/name_table.ads @@ -0,0 +1,98 @@ +-- Name table. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with System; +with Types; use Types; + +-- A very simple name table. +-- This is an hash table, such as id1=id2 <=> get_string(id1)=get_string(id2). + +package Name_Table is + -- Initialize the package, ie create tables. + procedure Initialize; + + -- Get an entry in the name table. + -- (entries for characters are already built). + function Get_Identifier (Char: Character) return Name_Id; + pragma Inline (Get_Identifier); + + -- Get or create an entry in the name table. + -- If an entry is created, its token value is tok_identifier. + -- Note: + -- an identifier is represented in all lower case letter, + -- an extended identifier is represented in backslashes, double internal + -- backslashes are simplified, + -- a string is represented by its contents (without the quotation + -- characters, and simplified), + -- a bit string is represented by its raw contents (no simplification). + function Get_Identifier (Str: String) return Name_Id; + + -- Get the string associed to a name. + -- If the name is a character, then single quote are added. + function Image (Id: Name_Id) return String; + + -- Get the address of the first character of ID. + -- The string is NUL-terminated (this is done by get_identifier). + function Get_Address (Id: Name_Id) return System.Address; + + -- Get the length of ID. + function Get_Name_Length (Id: Name_Id) return Natural; + pragma Inline (Get_Name_Length); + + -- Get the character associed to a name. + function Get_Character (Id: Name_Id) return Character; + pragma Inline (Get_Character); + + -- Return TRUE iff ID is a character. + function Is_Character (Id: Name_Id) return Boolean; + pragma Inline (Is_Character); + + -- Get or create an entry in the name table, use NAME_BUFFER/NAME_LENGTH. + function Get_Identifier return Name_Id; + + -- Like GET_IDENTIFIER, but return NULL_IDENTIFIER if the identifier + -- is not found (and do not create an entry for it). + function Get_Identifier_No_Create return Name_Id; + + -- Set NAME_BUFFER/NAME_LENGTH with the image of ID. + procedure Image (Id : Name_Id); + + -- Get and set the info field associated with each identifier. + -- Used to store interpretations of the name. + function Get_Info (Id: Name_Id) return Int32; + pragma Inline (Get_Info); + procedure Set_Info (Id: Name_Id; Info: Int32); + pragma Inline (Set_Info); + + -- Return the latest name_id used. + -- kludge, use only for debugging. + function Last_Name_Id return Name_Id; + + -- Be sure all info fields have their default value. + procedure Assert_No_Infos; + + -- This buffer is used by get_token to set the name. + -- This can be seen as a copy buffer but this is necessary for two reasons: + -- names case must be 'normalized', because VHDL is case insensitive. + Name_Buffer : String (1 .. 1024); + -- The length of the name string. + Name_Length: Natural; + + -- Disp statistics. + -- Used for debugging. + procedure Disp_Stats; +end Name_Table; diff --git a/nodes.adb b/nodes.adb new file mode 100644 index 000000000..4537d6f64 --- /dev/null +++ b/nodes.adb @@ -0,0 +1,412 @@ +-- Internal node type and operations. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with GNAT.Table; + +package body Nodes is + -- Suppress the access check of the table base. This is really safe to + -- suppress this check because the table base cannot be null. + pragma Suppress (Access_Check); + + -- Suppress the index check on the table. + -- Could be done during non-debug, since this may catch errors (reading + -- Null_Node or Error_Node). + --pragma Suppress (Index_Check); + + -- Suppress discriminant checks on the table. Relatively safe, since + -- iirs do their own checks. + pragma Suppress (Discriminant_Check); + + package Nodet is new GNAT.Table + (Table_Component_Type => Node_Record, + Table_Index_Type => Node_Type, + Table_Low_Bound => 2, + Table_Initial => 1024, + Table_Increment => 100); + + function Get_Last_Node return Node_Type is + begin + return Nodet.Last; + end Get_Last_Node; + + Free_Chain : Node_Type := Null_Node; + + Init_Short : Node_Record (Format_Short); + Init_Medium : Node_Record (Format_Medium); + Init_Fp : Node_Record (Format_Fp); + Init_Int : Node_Record (Format_Int); + + function Create_Node (Format : Format_Type) return Node_Type + is + Res : Node_Type; + begin + if Format = Format_Medium then + -- Allocate a first node. + Nodet.Increment_Last; + Res := Nodet.Last; + -- Check alignment. + if Res mod 2 = 1 then + Set_Field1 (Res, Free_Chain); + Free_Chain := Res; + Nodet.Increment_Last; + Res := Nodet.Last; + end if; + -- Allocate the second node. + Nodet.Increment_Last; + Nodet.Table (Res) := Init_Medium; + Nodet.Table (Res + 1) := Init_Medium; + else + -- Check from free pool + if Free_Chain = Null_Node then + Nodet.Increment_Last; + Res := Nodet.Last; + else + Res := Free_Chain; + Free_Chain := Get_Field1 (Res); + end if; + case Format is + when Format_Short => + Nodet.Table (Res) := Init_Short; + when Format_Medium => + raise Program_Error; + when Format_Fp => + Nodet.Table (Res) := Init_Fp; + when Format_Int => + Nodet.Table (Res) := Init_Int; + end case; + end if; + return Res; + end Create_Node; + + procedure Free_Node (N : Node_Type) + is + begin + if N /= Null_Node then + Set_Nkind (N, 0); + Set_Field1 (N, Free_Chain); + Free_Chain := N; + if Nodet.Table (N).Format = Format_Medium then + Set_Field1 (N + 1, Free_Chain); + Free_Chain := N + 1; + end if; + end if; + end Free_Node; + + function Get_Nkind (N : Node_Type) return Kind_Type is + begin + return Nodet.Table (N).Kind; + end Get_Nkind; + + procedure Set_Nkind (N : Node_Type; Kind : Kind_Type) is + begin + Nodet.Table (N).Kind := Kind; + end Set_Nkind; + + + procedure Set_Location (N : Node_Type; Location: Location_Type) is + begin + Nodet.Table (N).Location := Location; + end Set_Location; + + function Get_Location (N: Node_Type) return Location_Type is + begin + return Nodet.Table (N).Location; + end Get_Location; + + + procedure Set_Field0 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field0 := V; + end Set_Field0; + + function Get_Field0 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field0; + end Get_Field0; + + + function Get_Field1 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field1; + end Get_Field1; + + procedure Set_Field1 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field1 := V; + end Set_Field1; + + function Get_Field2 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field2; + end Get_Field2; + + procedure Set_Field2 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field2 := V; + end Set_Field2; + + function Get_Field3 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field3; + end Get_Field3; + + procedure Set_Field3 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field3 := V; + end Set_Field3; + + function Get_Field4 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field4; + end Get_Field4; + + procedure Set_Field4 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field4 := V; + end Set_Field4; + + function Get_Field5 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field5; + end Get_Field5; + + procedure Set_Field5 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field5 := V; + end Set_Field5; + + function Get_Field6 (N: Node_Type) return Node_Type is + begin + return Node_Type (Nodet.Table (N + 1).Location); + end Get_Field6; + + procedure Set_Field6 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Location := Location_Type (Val); + end Set_Field6; + + function Get_Field7 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field0; + end Get_Field7; + + procedure Set_Field7 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field0 := Val; + end Set_Field7; + + function Get_Field8 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field1; + end Get_Field8; + + procedure Set_Field8 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field1 := Val; + end Set_Field8; + + function Get_Field9 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field2; + end Get_Field9; + + procedure Set_Field9 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field2 := Val; + end Set_Field9; + + function Get_Field10 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field3; + end Get_Field10; + + procedure Set_Field10 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field3 := Val; + end Set_Field10; + + function Get_Field11 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field4; + end Get_Field11; + + procedure Set_Field11 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field4 := Val; + end Set_Field11; + + function Get_Field12 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field5; + end Get_Field12; + + procedure Set_Field12 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field5 := Val; + end Set_Field12; + + + function Get_Flag1 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag1; + end Get_Flag1; + + procedure Set_Flag1 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag1 := V; + end Set_Flag1; + + function Get_Flag2 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag2; + end Get_Flag2; + + procedure Set_Flag2 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag2 := V; + end Set_Flag2; + + function Get_Flag3 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag3; + end Get_Flag3; + + procedure Set_Flag3 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag3 := V; + end Set_Flag3; + + function Get_Flag4 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag4; + end Get_Flag4; + + procedure Set_Flag4 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag4 := V; + end Set_Flag4; + + function Get_Flag5 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag5; + end Get_Flag5; + + procedure Set_Flag5 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag5 := V; + end Set_Flag5; + + function Get_Flag6 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag6; + end Get_Flag6; + + procedure Set_Flag6 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag6 := V; + end Set_Flag6; + + + function Get_State1 (N : Node_Type) return Bit2_Type is + begin + return Nodet.Table (N).State1; + end Get_State1; + + procedure Set_State1 (N : Node_Type; V : Bit2_Type) is + begin + Nodet.Table (N).State1 := V; + end Set_State1; + + function Get_State2 (N : Node_Type) return Bit2_Type is + begin + return Nodet.Table (N).State2; + end Get_State2; + + procedure Set_State2 (N : Node_Type; V : Bit2_Type) is + begin + Nodet.Table (N).State2 := V; + end Set_State2; + + function Get_State3 (N : Node_Type) return Bit2_Type is + begin + return Nodet.Table (N).State3; + end Get_State3; + + procedure Set_State3 (N : Node_Type; V : Bit2_Type) is + begin + Nodet.Table (N).State3 := V; + end Set_State3; + + function Get_State4 (N : Node_Type) return Bit2_Type is + begin + return Nodet.Table (N).State4; + end Get_State4; + + procedure Set_State4 (N : Node_Type; V : Bit2_Type) is + begin + Nodet.Table (N).State4 := V; + end Set_State4; + + + function Get_Odigit1 (N : Node_Type) return Bit3_Type is + begin + return Nodet.Table (N).Odigit1; + end Get_Odigit1; + + procedure Set_Odigit1 (N : Node_Type; V : Bit3_Type) is + begin + Nodet.Table (N).Odigit1 := V; + end Set_Odigit1; + + function Get_Odigit2 (N : Node_Type) return Bit3_Type is + begin + return Nodet.Table (N).Odigit2; + end Get_Odigit2; + + procedure Set_Odigit2 (N : Node_Type; V : Bit3_Type) is + begin + Nodet.Table (N).Odigit2 := V; + end Set_Odigit2; + + + function Get_Fp64 (N : Node_Type) return Iir_Fp64 is + begin + return Nodet.Table (N).Fp64; + end Get_Fp64; + + procedure Set_Fp64 (N : Node_Type; V : Iir_Fp64) is + begin + Nodet.Table (N).Fp64 := V; + end Set_Fp64; + + + function Get_Int64 (N : Node_Type) return Iir_Int64 is + begin + return Nodet.Table (N).Int64; + end Get_Int64; + + procedure Set_Int64 (N : Node_Type; V : Iir_Int64) is + begin + Nodet.Table (N).Int64 := V; + end Set_Int64; + + procedure Initialize is + begin + Nodet.Free; + Nodet.Init; + end Initialize; +end Nodes; diff --git a/nodes.ads b/nodes.ads new file mode 100644 index 000000000..4fc3f1398 --- /dev/null +++ b/nodes.ads @@ -0,0 +1,862 @@ +-- Internal node type and operations. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Types; use Types; + +package Nodes is + type Node_Type is new Int32; + for Node_Type'Size use 32; + + Null_Node : constant Node_Type := 0; + Error_Node : constant Node_Type := 1; + + -- A simple type that needs only 2 bits. + type Bit2_Type is range 0 .. 2 ** 2 - 1; + type Bit3_Type is range 0 .. 2 ** 3 - 1; + + type Kind_Type is range 0 .. 255; + + -- Format of a node. + type Format_Type is + ( + Format_Short, + Format_Medium, + Format_Fp, + Format_Int + ); + + -- Future layout: (rem) + -- Format: 0 bits 32 + -- Nkind: 16 bits 16 + -- Flags: 8*1 bits 8 + -- State: 2*2 bits 4 + -- Odigit is to be removed. + + -- Future layout (2):(rem) + -- Format: 2 bits 30 + -- Nkind: 8 bits 22 (vhdl: 216 nodes) + -- Flags: 8*1 bits 14 + -- State: 2*2 bits 10 + -- Lang: 2 bits 8 + -- Odigit: 1*3 bits 5 + + -- Common fields are: + -- Flag1 : Boolean + -- Flag2 : Boolean + -- Flag3 : Boolean + -- Flag4 : Boolean + -- Flag5 : Boolean + -- Flag6 : Boolean + -- Nkind : Kind_Type + -- State1 : Bit2_Type + -- State2 : Bit2_Type + -- Location : Location_Type + -- Field0 : Iir + -- Field1 : Iir + -- Field2 : Iir + -- Field3 : Iir + + -- Fields of Format_Fp: + -- Fp64 : Iir_Fp64 + + -- Fields of Format_Int: + -- Int64 : Iir_Int64 + + -- Fields of Format_Short: + -- Field4 : Iir + -- Field5 : Iir + + -- Fields of Format_Medium: + -- Odigit1 : Bit3_Type + -- Odigit2 : Bit3_Type + -- State3 : Bit2_Type + -- State4 : Bit2_Type + -- Field4 : Iir + -- Field5 : Iir + -- Field6 : Iir (location) + -- Field7 : Iir (field0) + -- Field8 : Iir (field1) + -- Field9 : Iir (field2) + -- Field10 : Iir (field3) + -- Field11 : Iir (field4) + -- Field12 : Iir (field5) + + function Create_Node (Format : Format_Type) return Node_Type; + procedure Free_Node (N : Node_Type); + + function Get_Nkind (N : Node_Type) return Kind_Type; + pragma Inline (Get_Nkind); + procedure Set_Nkind (N : Node_Type; Kind : Kind_Type); + pragma Inline (Set_Nkind); + + function Get_Location (N: Node_Type) return Location_Type; + pragma Inline (Get_Location); + procedure Set_Location (N : Node_Type; Location: Location_Type); + pragma Inline (Set_Location); + + function Get_Field0 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field0); + procedure Set_Field0 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field0); + + function Get_Field1 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field1); + procedure Set_Field1 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field1); + + function Get_Field2 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field2); + procedure Set_Field2 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field2); + + function Get_Field3 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field3); + procedure Set_Field3 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field3); + + function Get_Field4 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field4); + procedure Set_Field4 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field4); + + + function Get_Field5 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field5); + procedure Set_Field5 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field5); + + function Get_Field6 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field6); + procedure Set_Field6 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field6); + + function Get_Field7 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field7); + procedure Set_Field7 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field7); + + function Get_Field8 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field8); + procedure Set_Field8 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field8); + + function Get_Field9 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field9); + procedure Set_Field9 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field9); + + function Get_Field10 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field10); + procedure Set_Field10 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field10); + + function Get_Field11 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field11); + procedure Set_Field11 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field11); + + function Get_Field12 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field12); + procedure Set_Field12 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field12); + + + function Get_Flag1 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag1); + procedure Set_Flag1 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag1); + + function Get_Flag2 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag2); + procedure Set_Flag2 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag2); + + function Get_Flag3 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag3); + procedure Set_Flag3 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag3); + + function Get_Flag4 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag4); + procedure Set_Flag4 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag4); + + function Get_Flag5 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag5); + procedure Set_Flag5 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag5); + + function Get_Flag6 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag6); + procedure Set_Flag6 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag6); + + + function Get_State1 (N : Node_Type) return Bit2_Type; + pragma Inline (Get_State1); + procedure Set_State1 (N : Node_Type; V : Bit2_Type); + pragma Inline (Set_State1); + + function Get_State2 (N : Node_Type) return Bit2_Type; + pragma Inline (Get_State2); + procedure Set_State2 (N : Node_Type; V : Bit2_Type); + pragma Inline (Set_State2); + + function Get_State3 (N : Node_Type) return Bit2_Type; + pragma Inline (Get_State3); + procedure Set_State3 (N : Node_Type; V : Bit2_Type); + pragma Inline (Set_State3); + + function Get_State4 (N : Node_Type) return Bit2_Type; + pragma Inline (Get_State4); + procedure Set_State4 (N : Node_Type; V : Bit2_Type); + pragma Inline (Set_State4); + + + function Get_Odigit1 (N : Node_Type) return Bit3_Type; + pragma Inline (Get_Odigit1); + procedure Set_Odigit1 (N : Node_Type; V : Bit3_Type); + pragma Inline (Set_Odigit1); + + function Get_Odigit2 (N : Node_Type) return Bit3_Type; + pragma Inline (Get_Odigit2); + procedure Set_Odigit2 (N : Node_Type; V : Bit3_Type); + pragma Inline (Set_Odigit2); + + + function Get_Fp64 (N : Node_Type) return Iir_Fp64; + pragma Inline (Get_Fp64); + procedure Set_Fp64 (N : Node_Type; V : Iir_Fp64); + pragma Inline (Set_Fp64); + + function Get_Int64 (N : Node_Type) return Iir_Int64; + pragma Inline (Get_Int64); + procedure Set_Int64 (N : Node_Type; V : Iir_Int64); + pragma Inline (Set_Int64); + + -- Get the last node allocated. + function Get_Last_Node return Node_Type; + pragma Inline (Get_Last_Node); + + -- Free all and reinit. + procedure Initialize; +private + type Node_Record (Format : Format_Type := Format_Short) is record + + -- Usages of Flag1: + -- seen_flag for iir_kind_process_statement + -- seen_flag for iir_kind_sensitized_process_statement + -- seen_flag for iir_kinds_procedure_specification + -- seen_flag for iir_kinds_function_specification + -- seen_flag for iir_kind_design_file + -- deferred_declaration_flag for iir_kind_constant_declaration + -- loaded_flag for iir_kind_design_unit + -- resolved_flag for iir_kinds_type_definition + -- need_body for iir_kind_package_declaration + -- whole_association_flag for iir_kind_association_element_by_expression + -- has_disconnect_flag for iir_kind_signal_declaration + Flag1 : Boolean := False; + + -- Usages of Flag2: + -- pure_flag for iir_kinds_function_specification + -- passive_flag for iir_kinds_process_statement + -- shared_flag for iir_kind_variable_declaration + -- aggr_others_flag for iir_kind_aggregate_info + -- signal_type_flag for iir_kinds_type_definition + Flag2 : Boolean := False; + + -- Usages of Flag3: + -- (postponed_flag for iir_kinds_process_statement) + -- elab_flag for iir_kind_design_file + -- elab_flag for iir_kind_design_unit + -- dynamic_flag for iir_kind_aggregate_info + -- text_file_flag for iir_kind_file_type_definition + -- foreign_flag for iir_kind_architecture_declaration + -- foreign_flag for iir_kinds_function_specification + -- foreign_flag for iir_kinds_procedure_specification + Flag3 : Boolean := False; + + -- Usages of Flag4: + -- visible_flag for iir_kind_type_declaration + -- aggr_named_flag for iir_kind_aggregate_info + Flag4 : Boolean := False; + + -- Usages of Flag5: + -- is_within_flag for named entities + Flag5 : Boolean := False; + + -- Usages of Flag6: + Flag6 : Boolean := False; + + -- Kind field use 8 bits. + -- So, on 32 bits systems, there are 24 bits left. + -- + 8 (8 * 1) + -- + 10 (5 * 2) + -- + 6 (2 * 3) + -- = 24 + + Kind : Kind_Type; + + -- expr_staticness for iir_kind_string_literal + -- expr_staticness for iir_kind_bit_string_literal + -- expr_staticness for iir_kind_integer_literal + -- expr_staticness for iir_kind_floating_point_literal + -- expr_staticness for iir_kind_physical_int_literal + -- expr_staticness for iir_kind_physical_fp_literal + -- expr_staticness for iir_kind_enumeration_literal + -- expr_staticness for iir_kind_monadic_operator + -- expr_staticness for iir_kind_dyadic_operator + -- expr_staticness for iir_kinds_name + -- expr_staticness for iir_kinds_alias_declaration + -- expr_staticness for iir_kind_constant_declaration + -- expr_staticness for iir_kind_iterator_declaration + -- expr_staticness for iir_kind_constant_interface_declaration + -- expr_staticness for iir_kind_aggregate + -- expr_staticness for iir_kind_qualified_expression + -- expr_staticness for iir_kind_type_conversion + -- expr_staticness for iir_kind_length_array_attribute + -- expr_staticness for iir_kind_low_type_attribute + -- expr_staticness for iir_kind_high_type_attribute + -- expr_staticness for iir_kind_left_type_attribute + -- expr_staticness for iir_kind_right_type_attribute + -- expr_staticness for iir_kind_pos_attribute + -- expr_staticness for iir_kind_val_attribute + -- expr_staticness for iir_kind_event_attribute + -- expr_staticness for iir_kind_last_value_attribute + -- expr_staticness for iir_kind_last_active_attribute + -- expr_staticness for iir_kind_active_attribute + -- expr_staticness for iir_kind_range_expression + -- expr_staticness for iir_kind_selected_element + -- expr_staticness for iir_kind_function_call + -- expr_staticness for iir_kind_attribute_value + -- expr_staticness for iir_kind_signal_declaration + -- expr_staticness for iir_kind_guard_signal_declaration + -- expr_staticness for iir_kind_variable_declaration + -- expr_staticness for iir_kind_file_declaration + -- expr_staticness for iir_kinds_discrete_type_attribute + -- type_staticness for iir_kinds_type_and_subtype_definition + State1 : Bit2_Type := 0; + + -- name_staticness for iir_kinds_name + -- name_staticness for iir_kind_object_alias_declaration + -- name_staticness for iir_kind_selected_element + -- name_staticness for iir_kind_selected_by_all_name + -- choice_staticness for iir_kind_choice_by_range + -- choice_staticness for iir_kind_choice_by_expression + State2 : Bit2_Type := 0; + + -- Usages of State3: + -- purity_state for iir_kind_process_statement + -- purity_state for iir_kind_sensitized_process_statement + -- purity_state for iir_kinds_procedure_specification + -- purity_state for iir_kinds_function_specification + State3 : Bit2_Type := 0; + + -- Usages of State4: + -- wait_state for iir_kind_process_statement + -- wait_state for iir_kind_sensitized_process_statement + -- wait_state for iir_kinds_procedure_specification + -- wait_state for iir_kinds_function_specification + State4 : Bit2_Type := 0; + + -- 2bits fields (4 -> 8 bits) + -- Usages of State5: + -- passive_state for iir_kind_process_statement + -- passive_state for iir_kind_sensitized_process_statement + -- passive_state for iir_kinds_procedure_specification + -- passive_state for iir_kinds_function_specification + -- signal_kind for iir_kind_signal_declaration + -- signal_kind for iir_kind_guard_signal_declaration + -- signal_kind for iir_kind_signal_interface_declaration + -- direction for iir_kind_range_expression + -- direction for iir_kind_file_declaration + -- guarded_target_flag for iir_kind_concurrent_conditional_signal_assign + -- guarded_target_flag for iir_kind_selected_conditional_signal_assign + -- guarded_target_flag for iir_kind_signal_assignment_statement + Unused_State5 : Bit2_Type := 0; + + -- 3bits fields (1 -> 3 bits) + -- Usages of odigit1: + -- lexical_layout for iir_kinds_interface_declaration + Odigit1 : Bit3_Type := 0; + + -- Usage of odigit2: + -- iir_mode for iir_kind_signal_interface_declaration + -- iir_mode for iir_kind_constant_interface_declaration + -- iir_mode for iir_kind_variable_interface_declaration + -- iir_mode for iir_kind_file_interface_declaration + Odigit2 : Bit3_Type := 0; + + -- Location. + Location: Location_Type := Location_Nil; + + -- The parent node. + -- parent for iir_kind_if_statement + -- parent for iir_kind_elsif_statement + -- parent for iir_kind_for_loop_statement + -- parent for iir_kind_while_loop_statement + -- parent for iir_kind_case_statement + -- parent for iir_kind_exit_statement + -- parent for iir_kind_next_statement + -- parent (library_declaration) for iir_kind_design_file + -- parent (design_unit_list) for iir_kind_design_file + -- interface_parent for iir_kind_signal_interface_declaration + -- interface_parent for iir_kind_constant_interface_declaration + -- interface_parent for iir_kind_variable_interface_declaration + -- interface_parent for iir_kind_file_interface_declaration + Field0 : Node_Type := Null_Node; + + -- usages of field1: + -- type for iir_kind_character_literal + -- type for iir_kind_type_computed_literal + -- type for iir_kind_integer_literal + -- type for iir_kind_floating_point_literal + -- type for iir_type_declaration. + -- type for iir_subtype_declaration. + -- type for iir_kind_identifier + -- type for iir_kind_string_literal + -- type for iir_kind_bit_string_literal + -- type for iir_kind_base_attribute + -- list_element for iir_kinds_list + -- port_chain for iir_kind_entity_declaration + -- port_chain for iir_kind_component_declaration + -- port_chain for iir_kind_block_header + -- entity for iir_kind_architecture_declaration + -- entity for iir_kind_configuration_declaration + -- entity for iir_kind_entity_aspect_entity + -- package for iir_kind_package_body + -- primary_units(iir_library_unit_list) for iir_kind_library_declaration + -- selected_name for iir_kind_use_clause + -- type_declaration for iir_kinds_type_definition + -- type_definition for iir_kind_signal_declaration + -- type_definition for iir_kind_guard_signal_declaration + -- type_definition for iir_kind_signal_interface_declaration. + -- type_definition for iir_kind_variable_declaration + -- type_definition for iir_kind_variable_interface_declaration. + -- type_definition for iir_kind_constant_declaration + -- type_definition for iir_kind_iterator_declaration + -- type_definition for iir_kind_constant_interface_declaration. + -- type_definition for iir_kind_file_declaration + -- type_definition for iir_kind_file_interface_declaration. + -- type_definition for iir_kind_enumeration_literal + -- type_definition for iir_kind_unit_declaration + -- type_definition for iir_kind_component_port + -- type_definition for iir_kind_element_declaration + -- type_definition for iir_kinds_attribute_declaration + -- type_definition for iir_kinds_attribute + -- type_definition for iir_kinds_name + -- type_definition for iir_kind_return_statement + -- type_definition for iir_kind_aggregate + -- type_definition for iir_kind_physical_int_literal + -- type_definition for iir_kind_physical_fp_literal + -- type_definition for iir_kind_object_alias_declaration + -- type_definition for iir_kind_null_literal + -- type_definition for iir_kind_qualified_expression + -- type_definition for iir_kind_type_conversion + -- type_definition for iir_kind_function_call + -- type_definition for iir_kind_allocator_by_expression + -- type_definition for iir_kind_allocator_by_subtype + -- type_definition for iir_kind_attribute_value + -- type_definition for iir_kind_selected_element + -- type_definition for iir_kind_implicit_dereference. + -- type_definition for iir_kind_disconnection_specification + -- type_definition for iir_kinds_monadic_operator + -- type_definition for iir_kinds_dyadic_operator + -- null_iir for iir_kind_signal_assignment_statement + -- null_iir for iir_kind_variable_assignment_statement + -- we_value for iir_kind_waveform_element + -- condition for iir_kind_conditional_waveform + -- condition for iir_kind_if_statement + -- condition for iir_kind_elsif + -- condition for iir_kind_while_loop_statement + -- condition for iir_kind_next_statement + -- condition for iir_kind_exit_statement + -- design_unit_chain for iir_kind_design_file + -- formal for iir_kinds_association_element + -- iterator_scheme for iir_kind_for_loop_statement + -- associated for iir_kinds_association_by_choice + -- context_items for iir_kind_design_unit + -- design_file_chain for iir_kind_library_declaration + -- proxy for iir_kind_proxy + -- selected_waveform_l for iir_kind_concurrent_selected_signal_assignment + -- block_specification for iir_kind_block_configuration + -- instantiation_list for iir_kind_component_configuration + -- instantiation_list for iir_kind_configuration_specification + -- component_configuration for iir_kind_component_instantiation_statement + -- configuration for iir_kind_entity_aspect_configuration + -- guard_decl for iir_kind_block_statement + -- entity_class_entry_chain for iir_kind_group_template_declaration + -- group_constituent_chain for iir_kind_group_declaration + -- entity_name_list for iir_kind_attribute_specification + -- generate_block_configuration for iir_kind_generate_statement + -- type_declarator for Iir_Kind_Enumeration_Type_Definition + -- type_declarator for Iir_Kind_Enumeration_Subtype_Definition + -- type_declarator for Iir_Kind_Integer_Type_Definition + -- type_declarator for Iir_Kind_Integer_Subtype_Definition + -- type_declarator for Iir_Kind_Floating_Type_Definition + -- type_declarator for Iir_Kind_Floating_Subtype_Definition + -- type_declarator for Iir_Kind_Physical_Type_Definition + -- type_declarator for Iir_Kind_Physical_Subtype_Definition + -- type_declarator for Iir_Kind_Record_Type_Definition + -- type_declarator for Iir_Kind_Record_Subtype_Definition + -- type_declarator for Iir_Kind_Array_Type_Definition + -- type_declarator for Iir_Kind_Array_Subtype_Definition + -- type_declarator for Iir_Kind_Unconstrained_Array_Subtype_Definition + -- type_declarator for Iir_Kind_Access_Type_Definition + -- type_declarator for Iir_Kind_Access_Subtype_Definition + -- type_declarator for Iir_Kind_Incomplete_Type_Definition + -- type_declarator for Iir_Kind_File_Type_Definition + -- return_type for iir_kind_function_specification + -- return_type for iir_kind_function_spec_body + -- return_type for iir_kind_implicit_function_declaration + -- default_entity_aspect for iir_kind_binding_indication + -- sub_aggregate_info for iir_kind_aggregate_info + Field1: Node_Type := Null_Node; + + -- usages of field2: + -- concurrent_statement_list for iir_kind_architecture_declaration + -- concurrent_statement_list for iir_kind_block_statement + -- concurrent_statement_list for iir_kind_entity_declaration + -- concurrent_statement_list for iir_kind_generate_statement + -- block_configuration for iir_kind_configuration_declaration + -- block_configuration for iir_kind_component_configuration + -- subprogram_body for iir_kind_function_specification + -- subprogram_body for iir_kind_procedure_specification + -- range_constraint for iir_kind_integer_subtype_definition + -- range_constraint for iir_kind_floating_subtype_definition + -- range_constraint for iir_kind_subtype_definition + -- range_constraint for iir_kind_enumeration_subtype_definition + -- range_constraint for iir_kind_physical_subtype_definition + -- range_constraint for iir_kind_enumeration_type_definition + -- left_limit for iir_kind_range_expression + -- designated_type for iir_kind_access_type_definition + -- index_subtype for iir_array_type_definition + -- index_subtype for iir_array_subtype_definition + -- suffix for iir_kinds_attribute + -- suffix for iir_kind_user_attribute + -- suffix for iir_kind_slice_name + -- selected_element for iir_kind_selected_element + -- parameter for iir_kind_val_attribute + -- parameter for iir_kind_pos_attribute + -- parameter for iir_kind_delayed_attribute + -- parameter for iir_kind_stable_attribute + -- parameter for iir_kind_quiet_attribute + -- parameter for iir_kind_attribute + -- index_list for iir_kind_indexed_name + -- index_list for iir_kind_array_type_definition + -- index_list for iir_kind_array_subtype_definition + -- target for iir_kind_signal_assignment_statement + -- target for iir_kind_variable_assignment_statement + -- time for iir_kind_waveform_element + -- target for iir_kind_concurrent_conditional_signal_assignment + -- target for iir_kind_concurrent_selected_signal_assignment + -- assertion_condition for iir_kind_concurrent_assertion_statement + -- assertion_condition for iir_kind_assertion_statement + -- null_iir for iir_kind_conditional_waveform + -- sequential_statement_chain for iir_kind_if_statement + -- sequential_statement_chain for iir_kind_elsif + -- sequential_statement_chain for iir_kind_sensitized_process_statement + -- sequential_statement_chain for iir_kind_process_statement + -- sequential_statement_chain for iir_kind_for_loop_statement + -- sequential_statement_chain for iir_kind_while_loop_statement + -- sequential_statement_chain for iir_kind_function_Body + -- sequential_statement_chain for iir_kind_function_Spec_Body + -- sequential_statement_chain for iir_kind_procedure_Body + -- sequential_statement_chain for iir_kind_procedure_Spec_Body + -- name for iir_kind_object_alias_declaration + -- name for iir_kind_physical_int_literal + -- name for iir_kind_physical_fp_literal + -- name for iir_kind_association_choice_by_name + -- name for iir_kind_group_declaration + -- default_value for iir_kind_signal_declaration + -- default_value for iir_kind_guard_signal_declaration + -- default_value for iir_kind_variable_declaration + -- default_value for iir_kind_constant_declaration + -- default_value for iir_kind_signal_interface_declaration + -- default_value for iir_kind_variable_interface_declaration + -- default_value for iir_kind_constant_interface_declaration + -- default_value for iir_kind_file_interface_declaration + -- guard_expression for iir_kind_guard_signal_declaration + -- operand for iir_kinds_monadic_operator + -- left for iir_kinds_dyadic_operator + -- actual for iir_kind_association_element_by_expression + -- instantiated_unit for Iir_Kind_Component_Instantiation_Statement + -- parameter_association_chain for iir_kind_function_call + -- parameter_association_chain for iir_kind_procedure_call + -- parameter_association_chain for iir_kind_concurrent_procedure_call_st. + -- library_unit for iir_kind_design_unit + -- multiplier for iir_kind_unit_declaration + -- primary_unit for iir_kind_physical_type_definition + -- condition_clause for iir_kind_wait_statement + -- element_declaration_list for iir_kind_record_type_definition + -- loop for iir_kind_exit_statement + -- loop for iir_kind_next_statement + -- file_logical_name for iir_kind_file_declaration + -- configuration_item_chain for iir_kind_block_configuration + -- architecture for iir_kind_entity_aspect_entity + -- library_declaration for iir_kind_library_clause + -- attribute_designator for iir_kind_attribute_specification + -- attribute_specification for iir_kind_attribute_value + -- signal_list for iir_kind_disconnection_specification + -- generation_scheme for iir_kind_generate_statement + -- incomplete_type_List for iir_kind_incomplete_type_definition + -- file_time_stamp for iir_kind_design_file + -- default_generic_map_aspect_list for iir_kind_binding_indication + -- aggr_low_limit for iir_kind_aggregate_info + -- enumeration_decl for iir_kind_enumeration_literal + -- simple_aggregate_list for iir_kind_simple_aggregate + Field2: Node_Type := Null_Node; + + -- Usages of field3: + -- dependence_list for iir_kind_design_unit + -- block_statement for iir_kind_signal_declaration + -- block_statement for iir_kind_guard_signal_declaration + -- subprogram_declaration for iir_kind_function_Spec_Body + -- subprogram_declaration for iir_kind_function_Body + -- subprogram_declaration for iir_kind_Procedure_Spec_Body + -- subprogram_declaration for iir_kind_Procedure_Body + -- body for iir_kind_function_specification + -- body for iir_kind_procedure_specification + -- declaration_list for iir_kind_entity_declaration + -- declaration_list for iir_kind_architecture_declaration + -- declaration_list for iir_kind_configuration_declaration + -- declaration_list for iir_kind_block_statement + -- declaration_list for iir_kind_package_declaration + -- declaration_list for iir_kind_package_body + -- declaration_list for iir_kind_sensitized_process_statement + -- declaration_list for iir_kind_process_statement + -- declaration_list for iir_kind_block_configuration + -- declaration_list for iir_kind_generate_statement + -- enumeration_literal_list for iir_enumeration_type_definition + -- right_limit for iir_kind_range_expression + -- element_subtype for iir_array_type_definition + -- element_subtype for iir_array_subtype_definition + -- report_expression for iir_kind_concurrent_assertion_statement + -- report_expression for iir_kind_assertion_statement + -- report_expression for iir_kind_report_statement + -- waveform_chain for iir_kind_signal_assignment_statement + -- conditional_waveform_chain for iir_kind_conc_conditional_signal_assign + -- waveform_chain for iir_kind_conditional_waveform + -- else_clause for iir_kind_if_statement + -- else_clause for iir_kind_elsif + -- expression of iir_kind_concurrent_selected_signal_assignment + -- expression of iir_kind_variable_assignment_statement + -- prefix for iir_kinds_attribute + -- prefix for iir_kind_indexed_name + -- prefix for iir_kind_slice_name + -- prefix for iir_kind_selected_name + -- prefix for iir_kind_selected_by_all_name + -- prefix for iir_kind_parenthesis_name + -- prefix for iir_kind_selected_element + -- prefix for iir_kind_implicit_dereference + -- port_map_aspect for Iir_Kind_Component_Instantiation_Statement + -- port_map_aspect for Iir_Kind_binding_indication + -- port_map_aspect for Iir_Kind_block_header + -- binding_indication for iir_kind_Component_configuration + -- binding_indication for Iir_Kind_Configuration_specifiation + -- expression for iir_kind_return_statement + -- expression for iir_kind_association_choice_by_expression + -- expression for iir_kind_case_statement + -- expression for iir_kind_qualified_expression + -- expression for iir_kind_type_conversion + -- expression for iir_kind_allocator_by_expression + -- expression for iir_kind_allocator_by_subtype + -- expression for iir_kind_attribute_specification + -- expression for iir_kind_disconnection_specification + -- unit_chain for iir_kind_physical_type_definition + -- timeout_clause for iir_kind_wait_statement + -- file_open_kind for iir_kind_file_declaration + -- designated_entity for iir_kind_attribute_value + -- associated_formal for iir_kinds_association_element + -- deferred_declaration for iir_kind_constant_declaration + -- literal_origin for iir_kind_character_literal + -- literal_origin for iir_kind_string_literal + -- literal_origin for iir_kind_bit_string_literal + -- literal_origin for iir_kind_integer_literal + -- literal_origin for iir_kind_floating_point_literal + -- literal_origin for iir_kind_physical_int_literal + -- literal_origin for iir_kind_physical_fp_literal + -- literal_origin for iir_kind_enumeration_literal + -- analysis_time_stamp for iir_kind_design_file + -- aggr_high_limit for iir_kind_aggregate_info + -- aggregate_info for iir_kind_aggregate + -- implementation for iir_kind_function_call + -- implementation for iir_kind_procedure_call + -- implementation for iir_kind_concurrent_procedure_call_statement + -- implementation for iir_kind_dyadic_operator + -- implementation for iir_kind_monadic_operator + Field3: Node_Type := Null_Node; + + -- Usages of field4: + -- design_file for iir_kind_design_unit + -- generic_chain for iir_kind_entity_declaration + -- generic_chain for iir_kind_component_declaration + -- generic_chain for iir_kind_block_header + -- base_type for iir_kind_integer_type_definition + -- base_type for iir_kind_integer_subtype_definition + -- base_type for iir_kind_floating_type_definition + -- base_type for iir_kind_floating_subtype_definition + -- base_type for iir_kind_subtype_definition + -- base_type for iir_kind_enumeration_type_definition + -- base_type for iir_kind_enumeration_subtype_definition + -- base_type for iir_kind_array_type_definition + -- base_type for iir_kind_array_subtype_definition + -- base_type for iir_kind_unconstrained_array_subtype_definition + -- base_type for iir_kind_range_attribute + -- base_type for iir_kind_physical_type_definition + -- base_type for iir_kind_physical_subtype_definition + -- base_type for iir_kind_record_type_definition + -- base_type for iir_kind_record_subtype_definition + -- base_type for iir_kind_access_type_definition + -- base_type for iir_kind_access_subtype_definition + -- base_type for iir_kind_incomplete_type_definition + -- base_type for iir_kind_file_type_definition + -- severity_expression for iir_kind_concurrent_assertion_statement + -- severity_expression for iir_kind_assertion_statement + -- severity_expression for iir_kind_report_statement + -- sensitivity_list for iir_kind_sensitized_process_statement + -- sensitivity_list for iir_kind_wait_statement + -- name_value of iir_kind_simple_name + -- association_chain for iir_kind_association_element_by_individual + -- association_chain for iir_kind_parenthesis_name + -- association_choices_list for iir_kind_aggregate + -- association_choices_list for iir_kind_case_statement + -- guard for iir_kind_concurrent_conditional_signal_assignment + -- guard for iir_kind_concurrent_selected_signal_assignment + -- entity_aspect for iir_kind_binding_indication + -- default_binding_indicat for iir_kind_component_instantiation_statement + -- component_name for iir_kind_component_configuration + -- component_name for iir_kind_configuration_specification + -- prev_block_configuration for iir_kind_block_configuration + -- interface_declaration for iir_kind_function_Specification + -- interface_declaration for iir_kind_function_Spec_Body + -- interface_declaration for iir_kind_procedure_Specification + -- interface_declaration for iir_kind_procedure_Spec_Body + -- interface_declaration for iir_kind_implicit_function_declaration + -- interface_declaration for iir_kind_implicit_procedure_declaration + -- subprogram_specification for iir_kind_function_Body + -- subprogram_specification for iir_kind_procedure_Body + -- in_conversion for iir_kind_association_element_by_expression + -- default_configuration for iir_kind_architecture_declaration + -- bit_string_0 for iir_kind_bit_string_literal + -- base_name for iir_kind_object_alias_declaration + -- base_name for iir_kind_signal_declaration + -- base_name for iir_kind_guard_signal_declaration + -- base_name for iir_kind_variable_declaration + -- base_name for iir_kind_file_declaration + -- base_name for iir_kind_constant_declaration + -- base_name for iir_kind_iterator_declaration + -- base_name for iir_kind_slice_name + -- base_name for iir_kind_indexed_name + -- base_name for iir_kind_selected_element + -- base_name for iir_kind_selected_by_all_name + -- base_name for iir_kind_implicit_dereference + -- base_name for iir_kind_attribute_value + -- base_name for iir_kind_function_call + -- block_block_configuration for iir_kind_block_statement + -- right for iir_kinds_dyadic_operator + --Field4: Node_Type := Null_Node; + + -- Usages of field5 (aka nbr1). + -- driver_list for iir_kind_sensitized_process_statement + -- driver_list for iir_kind_process_statement + -- driver_list for iir_kinds_function_specification + -- driver_list for iir_kinds_procedure_specification + -- guard_sensitivity_list for iir_kind_guard_signal_declaration + -- signal_driver for iir_kind_signal_declaration + -- reject_time for iir_kind_concurrent_selected_signal_assignment + -- reject_time for iir_kind_concurrent_conditionnal_signal_assignment + -- reject_time for iir_kind_signal_assignment_statement + -- resolution_function for iir_kind_integer_subtype_definition + -- resolution_function for iir_kind_floating_subtype_definition + -- resolution_function for iir_kind_enumeration_subtype_definition + -- resolution_function for iir_kind_physical_subtype_definition + -- resolution_function for iir_kind_array_subtype_definition + -- resolution_function for iir_kind_unconstrained_array_subtype_definit. + -- resolution_function for iir_kind_record_subtype_definition + -- date for iir_kind_library_declaration + -- date for iir_kind_design_unit + -- generic_map_aspect for Iir_Kind_Component_Instantiation_Statement + -- generic_map_aspect for Iir_Kind_block_header + -- generic_map_aspect for Iir_Kind_binding_indication + -- generation_scheme for iir_kind_generate_statement + -- design_unit for iir_kind_constant_declaration + -- design_unit for iir_kind_entity_declaration + -- design_unit for iir_kind_configuration_declaration + -- design_unit for iir_kind_package_declaration + -- design_unit for iir_kind_body_declaration + -- design_unit for iir_kind_architecture_declaration + -- out_conversion for iir_kind_association_element_by_expression + -- bit_string_1 for iir_kind_bit_string_literal + --Field5: Node_Type := Null_Node; + + -- Usages of Field6: + -- offset for iir_kind_design_unit + -- number of element for iir_kinds_list + -- base for iir_kind_bit_string_literal + -- element_position for iir_kind_element_declaration + -- type_mark for iir_kind_qualified_expression + -- type_mark for iir_kind_file_type_definition + -- type_mark for iir_kind_integer_subtype_definition + -- type_mark for iir_kind_floating_subtype_definition + -- type_mark for iir_kind_enumeration_subtype_definition + -- type_mark for iir_kind_physical_subtype_definition + -- type_mark for iir_kind_access_subtype_definition + -- type_mark for iir_kind_record_subtype_definition + -- type_mark for iir_kind_unconstrained_array_subtype_definition + -- bit_string_base for iir_kind_bit_string_literal + -- default_port_map_aspect_list for iir_kind_binding_indication + + -- Usages of nbr3/field7: + -- line for iir_kind_design_unit + -- max number of elements for iir_kinds_list + -- implicit_definition for iir_kind_implicit_function_declaration + -- implicit_definition for iir_kind_implicit_procedure_declaration + -- block_header for iir_kind_block_statement + -- delay_mechanism for iir_kind_concurrent_selected_signal_assignment + -- delay_mechanism for iir_kind_concurrent_conditionnal_signal_assignment + -- delay_mechanism for iir_kind_signal_assignment_statement + -- value for iir_kind_integer_literal + -- value for iir_kind_enumeration_literal + -- value for iir_kind_unit_declaration + -- value for iir_kind_physical_int_literal + -- fp_value for iir_kind_physical_fp_literal + -- fp_value for iir_kind_floating_point_literal + -- entity_kind for iir_kind_entity_class + -- entity_kind for iir_kind_attribute_specification + -- callees_list for iir_kind_process_declaration + -- callees_list for iir_kind_sensitized_process_declaration + -- library_directory for iir_kind_library_declaration + -- filename for iir_kind_design_file + -- directory for iir_kind_design_file + -- aggr_max_length for iir_kind_aggregate_info + case Format is + when Format_Short + | Format_Medium => + Field4: Node_Type := Null_Node; + Field5: Node_Type := Null_Node; + when Format_Fp => + Fp64 : Iir_Fp64; + when Format_Int => + Int64 : Iir_Int64; + end case; + end record; + + pragma Pack (Node_Record); + for Node_Record'Size use 8*32; + for Node_Record'Alignment use 4; +end Nodes; diff --git a/ortho/Makefile.inc b/ortho/Makefile.inc new file mode 100644 index 000000000..683600017 --- /dev/null +++ b/ortho/Makefile.inc @@ -0,0 +1,41 @@ +# Common -*- Makefile -*- for ortho implementations. +# Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +# Software Foundation, 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# Variable to be defined: +# SED: sed the stream editor +# ORTHO_BASENAME + +$(ORTHO_BASENAME).ads: $(ortho_srcdir)/ortho_nodes.common.ads \ + $(ORTHO_BASENAME).private.ads + $(SED) -e '/^package/,$$d' \ + < $(ORTHO_BASENAME).private.ads \ + > tmp.prv.hdr + $(SED) -e '1,/^private/d' -e '/^end/d' \ + < $(ORTHO_BASENAME).private.ads \ + > tmp.prv.dcl + $(SED) -e '1,/^package/d' -e '/^private/,$$d' \ + < $(ORTHO_BASENAME).private.ads \ + > tmp.prv.pub + $(SED) \ + -e '/^ --- PRIVATE/r tmp.prv.dcl' \ + -e '/^--- PRIVATE CONTEXT CLAUSES/r tmp.prv.hdr' \ + -e '/^ --- PUBLIC DECLARATIONS/r tmp.prv.pub' \ + -e '/--- PRIVATE/d' \ + -e 's/ORTHO_NODES/$(ORTHO_PACKAGE)/g' < $< > $@ + $(RM) -f tmp.prv.dcl tmp.prv.hdr tmp.prv.pub + diff --git a/ortho/agcc/Makefile.inc b/ortho/agcc/Makefile.inc new file mode 100644 index 000000000..b5da6f088 --- /dev/null +++ b/ortho/agcc/Makefile.inc @@ -0,0 +1,112 @@ +# -*- Makefile -*- for agcc, the Ada binding for GCC internals. +# Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +# Software Foundation, 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. + +# Variable used: +# AGCC_GCCSRC_DIR: the gcc source base directory (ie gcc-X.Y.Z-objs/) +# AGCC_GCCOBJ_DIR: the gcc objects base directory +# agcc_srcdir: the agcc source directory +# agcc_objdir: the agcc object directory + +AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \ + -I$(AGCC_GCCSRC_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/gcc/config +AGCC_CFLAGS=-g -DIN_GCC $(AGCC_INC_FLAGS) + +AGCC_LOCAL_OBJS=agcc-bindings.o agcc-version.o + +AGCC_DEPS := $(agcc_srcdir)/agcc-trees.ads \ + $(agcc_srcdir)/agcc-hwint.ads \ + $(agcc_srcdir)/agcc-hconfig.ads \ + $(agcc_srcdir)/agcc-real.ads \ + $(agcc_srcdir)/agcc-machmode.ads \ + $(agcc_srcdir)/agcc-tm.ads \ + $(agcc_srcdir)/agcc-options.ads \ + $(AGCC_LOCAL_OBJS) +AGCC_OBJS := $(AGCC_LOCAL_OBJS) \ + $(AGCC_GCCOBJ_DIR)/gcc/toplev.o \ + $(AGCC_GCCOBJ_DIR)/gcc/c-convert.o \ + $(AGCC_GCCOBJ_DIR)/gcc/libbackend.a \ + $(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a + +# Set rights to prevent editing. +GENERATE_VIA_GEN_TREE=\ + $(RM) -f $@ && \ + $(agcc_objdir)/gen_tree -C $(AGCC_GCCOBJ_DIR)/gcc - < $< > $@ && \ + chmod a-w $@ + +$(agcc_srcdir)/agcc-trees.ads: $(agcc_srcdir)/agcc-trees.ads.in \ + $(agcc_objdir)/gen_tree + $(GENERATE_VIA_GEN_TREE) + +$(agcc_srcdir)/agcc-hwint.ads: $(agcc_srcdir)/agcc-hwint.ads.in \ + $(agcc_objdir)/gen_tree + $(GENERATE_VIA_GEN_TREE) + +$(agcc_srcdir)/agcc-hconfig.ads: $(agcc_srcdir)/agcc-hconfig.ads.in \ + $(agcc_objdir)/gen_tree + $(GENERATE_VIA_GEN_TREE) + +$(agcc_srcdir)/agcc-real.ads: $(agcc_srcdir)/agcc-real.ads.in \ + $(agcc_objdir)/gen_tree + $(GENERATE_VIA_GEN_TREE) + +$(agcc_srcdir)/agcc-machmode.ads: $(agcc_srcdir)/agcc-machmode.ads.in \ + $(agcc_objdir)/gen_tree \ + $(AGCC_GCCOBJ_DIR)/gcc/insn-modes.h + $(GENERATE_VIA_GEN_TREE) + +$(agcc_srcdir)/agcc-tm.ads: $(agcc_srcdir)/agcc-tm.ads.in \ + $(agcc_objdir)/gen_tree + $(GENERATE_VIA_GEN_TREE) + +$(agcc_srcdir)/agcc-options.ads: $(agcc_srcdir)/agcc-options.ads.in \ + $(agcc_objdir)/gen_tree \ + $(AGCC_GCCOBJ_DIR)/gcc/options.h + $(GENERATE_VIA_GEN_TREE) + +$(agcc_objdir)/gen_tree: $(agcc_objdir)/gen_tree.o + $(CC) -o $@ $< + +$(agcc_objdir)/gen_tree.o: $(agcc_srcdir)/gen_tree.c \ + $(AGCC_GCCSRC_DIR)/gcc/tree.def $(AGCC_GCCSRC_DIR)/gcc/tree.h \ + $(AGCC_GCCOBJ_DIR)/gcc/tree-check.h + $(CC) -c -o $@ $< $(AGCC_CFLAGS) + +agcc-bindings.o: $(agcc_srcdir)/agcc-bindings.c \ + $(AGCC_GCCOBJ_DIR)/gcc/gtype-vhdl.h \ + $(AGCC_GCCOBJ_DIR)/gcc/gt-vhdl-agcc-bindings.h + $(CC) -c -o $@ $< $(AGCC_CFLAGS) + +agcc-version.c: $(AGCC_GCCSRC_DIR)/gcc/version.c + -$(RM) -f $@ + echo '#include "version.h"' > $@ + sed -n -e '/version_string/ s/";/ (ghdl)";/p' < $< >> $@ + echo 'const char bug_report_url[] = "";' >> $@ + +agcc-version.o: agcc-version.c + $(CC) -c -o $@ $< $(AGCC_CFLAGS) + +agcc-clean: force + $(RM) -f $(agcc_objdir)/gen_tree $(agcc_objdir)/gen_tree.o + $(RM) -f $(agcc_objdir)/*.o + $(RM) -f $(agcc_srcdir)/*~ + +agcc-maintainer-clean: force + $(RM) -f $(AGCC_DEPS) + + +.PHONY: agcc-clean agcc-maintainer-clean diff --git a/ortho/agcc/agcc-autils.adb b/ortho/agcc/agcc-autils.adb new file mode 100644 index 000000000..30eb1e622 --- /dev/null +++ b/ortho/agcc/agcc-autils.adb @@ -0,0 +1,93 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Unchecked_Conversion; +with Agcc.Hconfig; use Agcc.Hconfig; +with Agcc.Machmode; use Agcc.Machmode; + +package body Agcc.Autils is + Arr_Len : constant Natural := Unsigned_64'Size / HOST_WIDE_INT'Size; + type Arr_Conv is array (Natural range 0 .. Arr_Len - 1) of HOST_WIDE_INT; + + subtype Assert_Type is Boolean range True .. True; + Assert_Arr_Len_Is_1_Or_2 : constant Assert_Type := + Arr_Len = 1 or Arr_Len = 2; + pragma Unreferenced (Assert_Arr_Len_Is_1_Or_2); + + procedure To_Host_Wide_Int (V : Unsigned_64; L, H : out HOST_WIDE_INT) is + function Unchecked_Conversion is new Ada.Unchecked_Conversion + (Source => Unsigned_64, Target => Arr_Conv); + Res : Arr_Conv; + begin + Res := Unchecked_Conversion (V); + if Arr_Len = 1 then + H := 0; + L := Res (0); + else + if HOST_WORDS_BIG_ENDIAN then + L := Res (1); + H := Res (0); + else + L := Res (0); + H := Res (1); + end if; + end if; + end To_Host_Wide_Int; + + procedure To_Host_Wide_Int (V : Integer_64; L, H : out HOST_WIDE_INT) is + function Unchecked_Conversion is new Ada.Unchecked_Conversion + (Source => Integer_64, Target => Arr_Conv); + Res : Arr_Conv; + begin + Res := Unchecked_Conversion (V); + if Arr_Len = 1 then + if V < 0 then + H := -1; + else + H := 0; + end if; + L := Res (0); + else + if HOST_WORDS_BIG_ENDIAN then + L := Res (1); + H := Res (0); + else + L := Res (0); + H := Res (1); + end if; + end if; + end To_Host_Wide_Int; + + function To_Real_Value_Type (V : IEEE_Float_64) return REAL_VALUE_TYPE + is + Mant_Size : constant Natural := 60; + Rfract : IEEE_Float_64; + Fract : Integer_64; + Exp : Integer; + L, H : HOST_WIDE_INT; + Mantisse : REAL_VALUE_TYPE; + begin + -- Note: this works only when REAL_ARITHMETIC is defined!!! + Exp := IEEE_Float_64'Exponent (V); + Rfract := IEEE_Float_64'Fraction (V); + Rfract := IEEE_Float_64'Scaling (Rfract, Mant_Size); + Fract := Integer_64 (Rfract); + To_Host_Wide_Int (Fract, L, H); + REAL_VALUE_FROM_INT (Mantisse'Address, L, H, DFmode); + return REAL_VALUE_LDEXP (Mantisse, Exp - Mant_Size); + end To_Real_Value_Type; +end Agcc.Autils; diff --git a/ortho/agcc/agcc-autils.ads b/ortho/agcc/agcc-autils.ads new file mode 100644 index 000000000..8ca7da446 --- /dev/null +++ b/ortho/agcc/agcc-autils.ads @@ -0,0 +1,28 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Agcc.Hwint; use Agcc.Hwint; +with Agcc.Real; use Agcc.Real; +with Interfaces; use Interfaces; + +-- Additional utils. +package Agcc.Autils is + procedure To_Host_Wide_Int (V : Unsigned_64; L, H : out HOST_WIDE_INT); + procedure To_Host_Wide_Int (V : Integer_64; L, H : out HOST_WIDE_INT); + function To_Real_Value_Type (V : IEEE_Float_64) return REAL_VALUE_TYPE; +end Agcc.Autils; + diff --git a/ortho/agcc/agcc-bindings.c b/ortho/agcc/agcc-bindings.c new file mode 100644 index 000000000..2dbe33b21 --- /dev/null +++ b/ortho/agcc/agcc-bindings.c @@ -0,0 +1,738 @@ +/* Ada bindings for GCC internals - Bindings for Ada. + Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free + Software Foundation, 59 Temple Place - Suite 330, Boston, MA + 02111-1307, USA. +*/ +#include +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tm.h" +#include "tree.h" +#include "tm_p.h" +#include "defaults.h" +#include "ggc.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "langhooks-def.h" +#include "real.h" +#include "toplev.h" + +enum tree_code +get_tree_code (tree t) +{ + return TREE_CODE (t); +} + +void +set_tree_constant (tree t, int flag) +{ + TREE_CONSTANT (t) = flag; +} + +int +get_tree_constant (tree t) +{ + return TREE_CONSTANT (t); +} + +void +set_tree_public (tree t, int flag) +{ + TREE_PUBLIC (t) = flag; +} + +void +set_tree_static (tree t, int flag) +{ + TREE_STATIC (t) = flag; +} + +void +set_tree_type (tree t, tree val) +{ + TREE_TYPE (t) = val; +} + +tree +get_tree_type (tree t) +{ + return TREE_TYPE (t); +} + +void +set_tree_chain (tree t, tree chain) +{ + TREE_CHAIN (t) = chain; +} + +tree +get_tree_chain (tree t) +{ + return TREE_CHAIN (t); +} + +void +set_tree_unsigned (tree t, int flag) +{ + TREE_UNSIGNED (t) = flag; +} + +int +get_tree_unsigned (tree t) +{ + return TREE_UNSIGNED (t); +} + +void +set_tree_addressable (tree t, int flag) +{ + TREE_ADDRESSABLE (t) = flag; +} + +int +get_tree_addressable (tree t) +{ + return TREE_ADDRESSABLE (t); +} + +void +set_tree_side_effects (tree t, int flag) +{ + TREE_SIDE_EFFECTS (t) = flag; +} + +void +set_tree_readonly (tree t, int flag) +{ + TREE_READONLY (t) = flag; +} + +void +set_tree_operand (tree t, unsigned int n, tree val) +{ + TREE_OPERAND (t, n) = val; +} + +tree +get_tree_operand (tree t, unsigned int n) +{ + return TREE_OPERAND (t, n); +} + +int +get_tree_this_volatile (tree t) +{ + return TREE_THIS_VOLATILE (t); +} + +int +set_tree_this_volatile (tree t, int val) +{ + TREE_THIS_VOLATILE (t) = val; +} + +tree +get_tree_purpose (tree l) +{ + return TREE_PURPOSE (l); +} + +tree +get_tree_value (tree l) +{ + return TREE_VALUE (l); +} + +int +get_tree_used (tree n) +{ + return TREE_USED (n); +} + +void +set_tree_used (tree n, int flag) +{ + TREE_USED (n) = flag; +} + +HOST_WIDE_INT +get_tree_int_cst_low (tree node) +{ + return TREE_INT_CST_LOW (node); +} + +HOST_WIDE_INT +get_tree_int_cst_high (tree node) +{ + return TREE_INT_CST_HIGH (node); +} + +tree +get_constructor_elts (tree c) +{ + return CONSTRUCTOR_ELTS (c); +} + +tree +(build_int_2) (HOST_WIDE_INT lo, HOST_WIDE_INT hi) +{ + return build_int_2 (lo, hi); +} + +void +set_decl_arg_type (tree decl, tree val) +{ + DECL_ARG_TYPE (decl) = val; +} + +void +set_decl_external (tree decl, int val) +{ + DECL_EXTERNAL (decl) = val; +} + +int +get_decl_external (tree decl) +{ + return DECL_EXTERNAL (decl); +} + +void +set_decl_arguments (tree decl, tree args) +{ + DECL_ARGUMENTS (decl) = args; +} + +tree +get_decl_arguments (tree decl) +{ + return DECL_ARGUMENTS (decl); +} + +void +set_decl_result (tree decl, tree res) +{ + DECL_RESULT (decl) = res; +} + +tree +get_decl_result (tree decl) +{ + return DECL_RESULT (decl); +} + +void +set_decl_context (tree decl, tree context) +{ + DECL_CONTEXT (decl) = context; +} + +tree +get_decl_context (tree decl) +{ + return DECL_CONTEXT (decl); +} + +void +set_decl_initial (tree decl, tree res) +{ + DECL_INITIAL (decl) = res; +} + +tree +get_decl_initial (tree decl) +{ + return DECL_INITIAL (decl); +} + +tree +get_decl_name (tree decl) +{ + return DECL_NAME (decl); +} + +tree +get_decl_assembler_name (tree decl) +{ + return DECL_ASSEMBLER_NAME (decl); +} + +void +set_DECL_ASSEMBLER_NAME (tree decl, tree name) +{ + SET_DECL_ASSEMBLER_NAME (decl, name); +} + +void +set_decl_built_in_class (tree decl, enum built_in_class class) +{ + DECL_BUILT_IN_CLASS (decl) = class; +} + +void +set_decl_function_code (tree decl, int code) +{ + DECL_FUNCTION_CODE (decl) = code; +} + +tree +get_decl_field_offset (tree decl) +{ + return DECL_FIELD_OFFSET (decl); +} + +tree +get_decl_field_bit_offset (tree decl) +{ + return DECL_FIELD_BIT_OFFSET (decl); +} + +int +integral_type_p (tree type) +{ + return INTEGRAL_TYPE_P (type); +} + +void +set_type_values (tree type, tree values) +{ + TYPE_VALUES (type) = values; +} + +void +set_type_name (tree type, tree name) +{ + TYPE_NAME (type) = name; +} + +tree +get_type_name (tree type) +{ + return TYPE_NAME (type); +} + +void +set_type_min_value (tree type, tree val) +{ + TYPE_MIN_VALUE (type) = val; +} + +tree +get_type_min_value (tree type) +{ + return TYPE_MIN_VALUE (type); +} + +void +set_type_max_value (tree type, tree val) +{ + TYPE_MAX_VALUE (type) = val; +} + +tree +get_type_max_value (tree type) +{ + return TYPE_MAX_VALUE (type); +} + +void +set_type_size (tree type, tree size) +{ + TYPE_SIZE (type) = size; +} + +tree +get_type_size (tree type) +{ + return TYPE_SIZE (type); +} + +void +set_type_precision (tree type, int precision) +{ + TYPE_PRECISION (type) = precision; +} + +int +get_type_precision (tree type) +{ + return TYPE_PRECISION (type); +} + +void +set_type_fields (tree type, tree fields) +{ + TYPE_FIELDS (type) = fields; +} + +tree +get_type_fields (tree type) +{ + return TYPE_FIELDS (type); +} + +void +set_type_stub_decl (tree type, tree decl) +{ + TYPE_STUB_DECL (type) = decl; +} + +tree +get_type_domain (tree type) +{ + return TYPE_DOMAIN (type); +} + +void +set_type_domain (tree type, tree domain) +{ + TYPE_DOMAIN (type) = domain; +} + +void * +get_type_lang_specific (tree node) +{ + return TYPE_LANG_SPECIFIC (node); +} + +void +set_type_lang_specific (tree node, void *val) +{ + TYPE_LANG_SPECIFIC (node) = val; +} + +int +get_type_is_sizetype (tree node) +{ + return TYPE_IS_SIZETYPE (node); +} + +void +set_type_pointer_to (tree node, tree dnode) +{ + TYPE_POINTER_TO (node) = dnode; +} + +tree +get_type_pointer_to (tree node) +{ + return TYPE_POINTER_TO (node); +} + +enum machine_mode +get_type_mode (tree node) +{ + return TYPE_MODE (node); +} + +void +set_type_mode (tree node, enum machine_mode mode) +{ + TYPE_MODE (node) = mode; +} + +void +set_current_function_decl (tree decl) +{ + current_function_decl = decl; +} + +tree +get_current_function_decl (void) +{ + return current_function_decl; +} + +int +double_type_size (void) +{ + return DOUBLE_TYPE_SIZE; +} + +int +bits_per_unit (void) +{ + return BITS_PER_UNIT; +} + +tree +(size_int) (HOST_WIDE_INT number) +{ + return size_int (number); +} + +tree +get_type_size_unit (tree node) +{ + return TYPE_SIZE_UNIT (node); +} + +/* For agcc.real: */ +REAL_VALUE_TYPE +get_REAL_VALUE_ATOF (const char *s, enum machine_mode mode) +{ + return REAL_VALUE_ATOF (s, mode); +} + +REAL_VALUE_TYPE +get_REAL_VALUE_LDEXP (REAL_VALUE_TYPE x, int n) +{ + REAL_VALUE_TYPE res; + real_ldexp (&res, &x, n); + return res; +} + +void +get_REAL_VALUE_FROM_INT (REAL_VALUE_TYPE *d, HOST_WIDE_INT l, HOST_WIDE_INT h, + enum machine_mode mode) +{ + REAL_VALUE_FROM_INT (*d, l, h, mode); +} + +int +get_identifier_length (tree node) +{ + return IDENTIFIER_LENGTH (node); +} + +const char * +get_identifier_pointer (tree node) +{ + return IDENTIFIER_POINTER (node); +} + +tree +get_block_supercontext (tree node) +{ + return BLOCK_SUPERCONTEXT (node); +} + +void +set_block_supercontext (tree block, tree sc) +{ + BLOCK_SUPERCONTEXT (block) = sc; +} + +void +set_block_vars (tree block, tree vars) +{ + BLOCK_VARS (block) = vars; +} + +const int tree_identifier_size = sizeof (struct tree_identifier); + +#if 0 +static void +ggc_mark_tree_ptr (void *elt) +{ + ggc_mark_tree (*(tree *) elt); +} +#endif + +#undef ggc_mark_tree +void +ggc_mark_tree (tree expr) +{ + gt_ggc_m_9tree_node (expr); +} + +#if 0 +void +ggc_add_tree_root (void *base, int nelt) +{ + ggc_add_root (base, nelt, sizeof (tree), ggc_mark_tree_ptr); +} +#endif + +int +get_mode_bitsize (enum machine_mode mode) +{ + return GET_MODE_BITSIZE (mode); +} + +int +get_errorcount (void) +{ + return errorcount; +} + +void +set_errorcount (int c) +{ + errorcount = c; +} + + +/* Defined in agcc.fe */ +extern const char language_name[]; +extern bool lang_init (void); +extern void lang_finish (void); +extern unsigned int lang_init_options (unsigned int argc, const char **argv); +extern int lang_handle_option (size_t code, const char *argc, int value); +extern bool lang_post_options (const char **); +extern HOST_WIDE_INT lang_get_alias_set (tree t); +extern bool mark_addressable (tree t); + +extern int global_bindings_p (void); +extern int kept_level_p (void); +extern tree getdecls (void); +extern void pushlevel (int); +extern tree poplevel (int, int, int); +extern void insert_block (tree); +extern void set_block (tree); +extern tree pushdecl (tree); + +extern tree type_for_mode (enum machine_mode, int); +extern tree type_for_size (unsigned int, int); +extern tree unsigned_type (tree); +extern tree signed_type (tree); +extern tree signed_or_unsigned_type (int, tree); +extern tree truthvalue_conversion (tree); +extern void lang_parse_file (int); + +#undef LANG_HOOKS_NAME +#define LANG_HOOKS_NAME language_name +#undef LANG_HOOKS_IDENTIFIER_SIZE +#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier) +#undef LANG_HOOKS_INIT +#define LANG_HOOKS_INIT lang_init +#undef LANG_HOOKS_FINISH +#define LANG_HOOKS_FINISH lang_finish +#undef LANG_HOOKS_INIT_OPTIONS +#define LANG_HOOKS_INIT_OPTIONS lang_init_options +#undef LANG_HOOKS_HANDLE_OPTION +#define LANG_HOOKS_HANDLE_OPTION lang_handle_option +#undef LANG_HOOKS_POST_OPTIONS +#define LANG_HOOKS_POST_OPTIONS lang_post_options +#undef LANG_HOOKS_GET_ALIAS_SET +#define LANG_HOOKS_GET_ALIAS_SET lang_get_alias_set +#undef LANG_HOOKS_HONOR_READONLY +#define LANG_HOOKS_HONOR_READONLY true +#undef LANG_HOOKS_TRUTHVALUE_CONVERSION +#define LANG_HOOKS_TRUTHVALUE_CONVERSION truthvalue_conversion +#undef LANG_HOOKS_MARK_ADDRESSABLE +#define LANG_HOOKS_MARK_ADDRESSABLE mark_addressable + +#undef LANG_HOOKS_TYPE_FOR_MODE +#define LANG_HOOKS_TYPE_FOR_MODE type_for_mode +#undef LANG_HOOKS_TYPE_FOR_SIZE +#define LANG_HOOKS_TYPE_FOR_SIZE type_for_size +#undef LANG_HOOKS_SIGNED_TYPE +#define LANG_HOOKS_SIGNED_TYPE signed_type +#undef LANG_HOOKS_UNSIGNED_TYPE +#define LANG_HOOKS_UNSIGNED_TYPE unsigned_type +#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE +#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE signed_or_unsigned_type +#undef LANG_HOOKS_PARSE_FILE +#define LANG_HOOKS_PARSE_FILE lang_parse_file + +const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; + +/* Tree code classes. */ + +#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE, + +const char tree_code_type[] = { +#include "tree.def" + 'x' +}; +#undef DEFTREECODE + +/* Table indexed by tree code giving number of expression + operands beyond the fixed part of the node structure. + Not used for types or decls. */ + +#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH, + +const unsigned char tree_code_length[] = { +#include "tree.def" + 0 +}; +#undef DEFTREECODE + +#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) NAME, +const char * const tree_code_name[] = { +#include "tree.def" + "@@dummy" +}; +#undef DEFTREECODE + +union lang_tree_node + GTY((desc ("0"), + chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)"))) +{ + union tree_node GTY ((tag ("0"), + desc ("tree_node_structure (&%h)"))) + generic; +}; + +struct lang_decl GTY(()) +{ +}; + +struct lang_type GTY (()) +{ +}; + +struct language_function GTY (()) +{ +}; + +tree +c_common_truthvalue_conversion (tree expr) +{ + if (TREE_CODE (TREE_TYPE (expr)) == BOOLEAN_TYPE) + return expr; + if (TREE_CODE (expr) == INTEGER_CST) + return integer_zerop (expr) ? integer_zero_node : integer_one_node; + + abort (); +} + +int +get_PROMOTE_PROTOTYPES (void) +{ + return PROMOTE_PROTOTYPES; +} + +struct binding_level GTY(()) +{ + tree names; + tree blocks; + tree block_created_by_back_end; + struct binding_level *level_chain; +}; + +extern GTY(()) struct binding_level *current_binding_level; +extern GTY((deletable (""))) struct binding_level *old_binding_level; + +struct binding_level * +alloc_binding_level (void) +{ + return (struct binding_level *)ggc_alloc (sizeof (struct binding_level)); +} + +#ifndef MAX_BITS_PER_WORD +#define MAX_BITS_PER_WORD BITS_PER_WORD +#endif + +extern GTY(()) tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2]; + +#include "debug.h" +#include "gt-vhdl-agcc-bindings.h" +#include "gtype-vhdl.h" + diff --git a/ortho/agcc/agcc-convert.ads b/ortho/agcc/agcc-convert.ads new file mode 100644 index 000000000..964dd81a6 --- /dev/null +++ b/ortho/agcc/agcc-convert.ads @@ -0,0 +1,26 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Agcc.Trees; use Agcc.Trees; + +package Agcc.Convert is + function Convert_To_Integer (Atype : Tree; Expr : Tree) return Tree; + function Convert_To_Pointer (Atype : Tree; Expr : Tree) return Tree; +private + pragma Import (C, Convert_To_Integer); + pragma Import (C, Convert_To_Pointer); +end Agcc.Convert; diff --git a/ortho/agcc/agcc-diagnostic.ads b/ortho/agcc/agcc-diagnostic.ads new file mode 100644 index 000000000..4558896a6 --- /dev/null +++ b/ortho/agcc/agcc-diagnostic.ads @@ -0,0 +1,24 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +package Agcc.Diagnostic is + function Get_Errorcount return Integer; + procedure Set_Errorcount (Cnt : Integer); +private + pragma Import (C, Get_Errorcount); + pragma Import (C, Set_Errorcount); +end Agcc.Diagnostic; diff --git a/ortho/agcc/agcc-fe.ads b/ortho/agcc/agcc-fe.ads new file mode 100644 index 000000000..7c2b11001 --- /dev/null +++ b/ortho/agcc/agcc-fe.ads @@ -0,0 +1,238 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Agcc.Trees; use Agcc.Trees; +with Agcc.Machmode; use Agcc.Machmode; +with Agcc.Hwint; use Agcc.Hwint; +with Agcc.Options; use Agcc.Options; +with Interfaces.C_Streams; use Interfaces.C_Streams; +with C; use C; + +package Agcc.Fe is + -- Subprograms that must be defined by the front-end. + + -- Defined in langhooks.h + function Lang_Init_Options (Argc : Integer; Argv : C_String_Array) + return Integer; + + -- Front-end function expected by GCC. + function Lang_Handle_Option (Code : Opt_Code; + Arg : C_String; + Value : Integer) + return Integer; + + type C_String_Acc is access C_String; + pragma Convention (C, C_String_Acc); + + function Lang_Post_Options (Filename : C_String_Acc) return C_Bool; + + function Lang_Init return C_Bool; + + procedure Lang_Finish; + + --procedure Lang_Clear_Binding_Stack; + + -- Return the typed-based alias set for T, which may be an expression + -- or a type. Return -1 if we don't do anything special. + -- O means can alias everything. + function Lang_Get_Alias_Set (T : Tree) return HOST_WIDE_INT; + + --function Lang_Expand_Constant (N : Tree) return Tree; + + --function Lang_Safe_From_P (Target : Rtx; Exp : Tree) return C_Bool; + + procedure Lang_Parse_File (Debug : C_Bool); + + -- Called by the back-end or by the front-end when the address of EXP + -- must be taken. + -- This function should found the base object (if any), and mark it as + -- addressable (via TREE_ADDRESSABLE). It may emit a warning if this + -- object cannot be addressable (front-end restriction). + -- Returns TRUE in case of success, FALSE in case of failure. + -- Note that the status is never checked by the back-end. + function Mark_Addressable (Exp : Tree) return C_Bool; + + -- Possibly apply default attributes to function FUNC represented by + -- a FUNCTION_DECL. + procedure Insert_Default_Attributes (Func : Tree); + + -- Lexical scopes. + -- Roughly speaking, it is used to mark declarations regions. + + -- Enter in a new lexical scope. INSIDE should be FALSE (TRUE iff called + -- from the inside of the front end, ie from gcc internal code). + procedure Pushlevel (Inside : C_Bool); + + -- Add a declaration to the current scope. + -- Note: GCC backend expect PUSHDECL to return its argument; however, + -- it is only seldom used. Both forms exist and are aliased with a third + -- one which is exported under the C name. + -- (Unfortunatly, it is not possible to export the function and to import + -- the procedure). + procedure Pushdecl (Decl : Tree); + function Pushdecl (Decl : Tree) return Tree; + + -- This function has to be defined. + function Exported_Pushdecl (Decl : Tree) return Tree; + + -- Get the declarations of the current scope. + function Getdecls return Tree; + + procedure Set_Block (Block : Tree); + + -- Return non-zero if we are currently in the global binding level. + function Global_Bindings_P return Integer; + + -- Insert BLOCK at the end of the list of subblocks of the + -- current binding level. This is used when a BIND_EXPR is expanded, + -- to handle the BLOCK node inside the BIND_EXPR. + procedure Insert_Block (Block : Tree); + + -- Exit the current scope. + -- FUNCTIONBODY is TRUE iff the scope corresponds to a subprogram scope. + -- Used forms (both imported). + procedure Poplevel (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool); + function Poplevel (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool) + return Tree; + + -- Exported form. + function Exported_Poplevel + (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool) + return Tree; + + -- Perform all the initialization steps that are language-specific. + --procedure Lang_Init; + + -- Perform all the finalization steps that are language-specific. + --procedure Lang_Finish; + + -- Return an integer type with the number of bits of precision given by + -- PRECISION. UNSIGNEDP is nonzero if the type is unsigned; otherwise + -- it is a signed type. + function Type_For_Size (Precision : Natural; Unsignedp : C_Bool) + return Tree; + + -- Return a data type that has machine mode MODE. UNSIGNEDP selects + -- an unsigned type; otherwise a signed type is returned. + function Type_For_Mode (Mode : Machine_Mode; Unsignedp : C_Bool) + return Tree; + + -- Return the unsigned version of a TYPE_NODE, a scalar type. + function Unsigned_Type (Type_Node : Tree) return Tree; + + -- Return the signed version of a TYPE_NODE, a scalar type. + function Signed_Type (Type_Node : Tree) return Tree; + + -- Return a type the same as TYPE except unsigned or signed according to + -- UNSIGNEDP. + function Signed_Or_Unsigned_Type (Unsignedp : C_Bool; Atype : Tree) + return Tree; + + -- Return a definition for a builtin function named NAME and whose data + -- type is TYPE. TYPE should be a function type with argument types. + -- FUNCTION_CODE tells later passes how to compile calls to this function. + -- See tree.h for its possible values. + -- + -- If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME, + -- the name to be called if we can't opencode the function. + function Builtin_Function + (Name: System.Address; + Ftype : Tree; + Function_Code : Built_In_Function; + Class : Built_In_Class; + Library_Name : System.Address) + return Tree; + + -- Set debug flag of the parser. + procedure Set_Yydebug (Flag : C_Bool); + + + -- Hooks for print-tree.c: + procedure Print_Lang_Decl (File : FILEs; Node : Tree; Indent : natural); + procedure Print_Lang_Type (File : FILEs; Node : Tree; Indent : Natural); + procedure Print_Lang_Identifier + (File : FILEs; Node : Tree; Indent : Natural); + procedure Lang_Print_Xnode (File : FILEs; Node : Tree; Indent : Natural); + + -- Print any language-specific compilation statistics. + procedure Print_Lang_Statistics; + + + -- Finish to copy a ..._DECL node (the LANG_DECL_SPECIFIC field). + procedure Copy_Lang_Decl (Node : Tree); + + -- Normalize boolean value EXPR. + function Truthvalue_Conversion (Expr : Tree) return Tree; + + -- Procedure called in case of sizeof applied to an incomplete type. + procedure Incomplete_Type_Error (Value : Tree; Atype : Tree); + + -- This function must be defined in the language-specific files. + -- expand_expr calls it to build the cleanup-expression for a TARGET_EXPR. + function Maybe_Build_Cleanup (Decl : Tree) return Tree; + + --Language_String : constant Chars; + Flag_Traditional : Integer := 0; +private + pragma Export (C, Lang_Init_Options); + pragma Export (C, Lang_Handle_Option); + pragma Export (C, Lang_Post_Options); + pragma Export (C, Lang_Init); + pragma Export (C, Lang_Finish); + pragma Export (C, Lang_Get_Alias_Set); + + pragma Export (C, Lang_Parse_File); + + pragma Export (C, Mark_Addressable); + pragma Export (C, Insert_Default_Attributes); + + pragma Import (C, Pushdecl); + pragma Export (C, Exported_Pushdecl, "pushdecl"); + pragma Export (C, Pushlevel); + pragma Export (C, Set_Block); + pragma Export (C, Insert_Block); + pragma Export (C, Global_Bindings_P); + pragma Import (C, Poplevel); + pragma Export (C, Exported_Poplevel, "poplevel"); + pragma Export (C, Getdecls); + + pragma Export (C, Type_For_Size); + pragma Export (C, Type_For_Mode); + pragma Export (C, Unsigned_Type); + pragma Export (C, Signed_Type); + pragma Export (C, Signed_Or_Unsigned_Type); + + pragma Export (C, Builtin_Function); + + + pragma Export (C, Set_Yydebug); + + pragma Export (C, Print_Lang_Decl); + pragma Export (C, Print_Lang_Type); + pragma Export (C, Print_Lang_Identifier); + pragma Export (C, Lang_Print_Xnode); + + pragma Export (C, Print_Lang_Statistics); + pragma Export (C, Copy_Lang_Decl); + + pragma Export (C, Truthvalue_Conversion); + pragma Export (C, Incomplete_Type_Error); + pragma Export (C, Maybe_Build_Cleanup); + + pragma Export (C, Flag_Traditional); +end Agcc.Fe; + diff --git a/ortho/agcc/agcc-ggc.ads b/ortho/agcc/agcc-ggc.ads new file mode 100644 index 000000000..4892d59b3 --- /dev/null +++ b/ortho/agcc/agcc-ggc.ads @@ -0,0 +1,33 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Agcc.Trees; use Agcc.Trees; + +package Agcc.Ggc is + procedure Ggc_Add_Root (Base : System.Address; + Nelt : Natural; + Size : Natural; + Func : System.Address); + + procedure Ggc_Add_Tree_Root (Base : System.Address; Nelt : Natural); + + procedure Ggc_Mark_Tree (Expr : Tree); +private + pragma Import (C, Ggc_Add_Root); + pragma Import (C, Ggc_Mark_Tree); + pragma Import (C, Ggc_Add_Tree_Root); +end Agcc.Ggc; diff --git a/ortho/agcc/agcc-ghdl.c b/ortho/agcc/agcc-ghdl.c new file mode 100644 index 000000000..211d5e093 --- /dev/null +++ b/ortho/agcc/agcc-ghdl.c @@ -0,0 +1,658 @@ +/* Ada bindings for GCC internals. + Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free + Software Foundation, 59 Temple Place - Suite 330, Boston, MA + 02111-1307, USA. +*/ +#include "config.h" +#include "system.h" +#include "tree.h" +#include "flags.h" +#include + +#if 0 +const char *const language_string = "ghdl"; +int flag_traditional; +#endif + +/* Convertion from a C string to the corresponding cannonical + Ada (GNAT) String. */ +struct str_template +{ + int first; + int last; +}; + +struct str_fatptr +{ + const char *array; + struct str_template *tpl; +}; + +#if 0 +/* Called by toplev.c, to initialize the parser. */ +const char * +init_parse (const char *filename) +{ + struct str_template temp1 = {1, strlen (filename)}; + struct str_fatptr fp = {filename, &temp1}; + + ghdl1__init_parse (fp); + return filename; +} +#endif + +void +lang_init_options (void) +{ + extern int gnat_argc; + extern const char **gnat_argv; + extern const char *progname; + + /* Initialize ada.command_line. */ + gnat_argc = 1; + gnat_argv = &progname; + + adainit (); +} + +#if 0 +/* Decode all the language specific options that cannot be decoded by GCC. The + option decoding phase of GCC calls this routine on the flags that it cannot + decode. Return 1 if successful, otherwise return 0. */ + +int +lang_decode_option (argc, argv) + int argc; + char **argv; +{ + return 0; +} + +void +lang_print_xnode(file, t, i) + FILE *file; + tree t; + int i; +{ + return; +} + +/* Routines Expected by gcc: */ + +/* These are used to build types for various sizes. The code below + is a simplified version of that of GNAT. */ + +#ifndef MAX_BITS_PER_WORD +#define MAX_BITS_PER_WORD BITS_PER_WORD +#endif + +/* This variable keeps a table for types for each precision so that we only + allocate each of them once. Signed and unsigned types are kept separate. */ +static tree signed_and_unsigned_types[MAX_BITS_PER_WORD + 1][2]; + +/* Return an integer type with the number of bits of precision given by + PRECISION. UNSIGNEDP is nonzero if the type is unsigned; otherwise + it is a signed type. */ + +tree +type_for_size (precision, unsignedp) + unsigned precision; + int unsignedp; +{ + tree t; + + if (precision <= MAX_BITS_PER_WORD + && signed_and_unsigned_types[precision][unsignedp] != 0) + return signed_and_unsigned_types[precision][unsignedp]; + + if (unsignedp) + t = signed_and_unsigned_types[precision][1] + = make_unsigned_type (precision); + else + t = signed_and_unsigned_types[precision][0] + = make_signed_type (precision); + + return t; +} + + +/* Return a data type that has machine mode MODE. UNSIGNEDP selects + an unsigned type; otherwise a signed type is returned. */ + +tree +type_for_mode (mode, unsignedp) + enum machine_mode mode; + int unsignedp; +{ + return type_for_size (GET_MODE_BITSIZE (mode), unsignedp); +} + +/* Return the unsigned version of a TYPE_NODE, a scalar type. */ + +tree +unsigned_type (type_node) + tree type_node; +{ + return type_for_size (TYPE_PRECISION (type_node), 1); +} + +/* Return the signed version of a TYPE_NODE, a scalar type. */ + +tree +signed_type (type_node) + tree type_node; +{ + return type_for_size (TYPE_PRECISION (type_node), 0); +} + +/* Return a type the same as TYPE except unsigned or signed according to + UNSIGNEDP. */ + +tree +signed_or_unsigned_type (unsignedp, type) + int unsignedp; + tree type; +{ + if (! INTEGRAL_TYPE_P (type) || TREE_UNSIGNED (type) == unsignedp) + return type; + else + return type_for_size (TYPE_PRECISION (type), unsignedp); +} + +void +init_type_for_size (void) +{ + ggc_add_tree_root (signed_and_unsigned_types, + sizeof (signed_and_unsigned_types) / sizeof (tree)); +} +#endif + + +#if 0 +/* These functions and variables deal with binding contours. We only + need these functions for the list of PARM_DECLs, but we leave the + functions more general; these are a simplified version of the + functions from GNAT. */ + +/* For each binding contour we allocate a binding_level structure which records + the entities defined or declared in that contour. Contours include: + + the global one + one for each subprogram definition + one for each compound statement (declare block) + + Binding contours are used to create GCC tree BLOCK nodes. */ + +struct binding_level +{ + /* A chain of ..._DECL nodes for all variables, constants, functions, + parameters and type declarations. These ..._DECL nodes are chained + through the TREE_CHAIN field. Note that these ..._DECL nodes are stored + in the reverse of the order supplied to be compatible with the + back-end. */ + tree names; + /* For each level (except the global one), a chain of BLOCK nodes for all + the levels that were entered and exited one level down from this one. */ + tree blocks; + /* The back end may need, for its own internal processing, to create a BLOCK + node. This field is set aside for this purpose. If this field is non-null + when the level is popped, i.e. when poplevel is invoked, we will use such + block instead of creating a new one from the 'names' field, that is the + ..._DECL nodes accumulated so far. Typically the routine 'pushlevel' + will be called before setting this field, so that if the front-end had + inserted ..._DECL nodes in the current block they will not be lost. */ + tree block_created_by_back_end; + /* The binding level containing this one (the enclosing binding level). */ + struct binding_level *level_chain; +}; + +/* The binding level currently in effect. */ +static struct binding_level *current_binding_level = NULL; + +/* The outermost binding level. This binding level is created when the + compiler is started and it will exist through the entire compilation. */ +static struct binding_level *global_binding_level; + +/* Binding level structures are initialized by copying this one. */ +static struct binding_level clear_binding_level = {NULL, NULL, NULL, NULL}; + +/* Return non-zero if we are currently in the global binding level. */ + +int +global_bindings_p () +{ + return current_binding_level == global_binding_level ? -1 : 0; +} + +/* Return the list of declarations in the current level. Note that this list + is in reverse order (it has to be so for back-end compatibility). */ + +tree +getdecls () +{ + return current_binding_level->names; +} + +/* Nonzero if the current level needs to have a BLOCK made. */ + +int +kept_level_p () +{ + return (current_binding_level->names != 0); +} + +/* Enter a new binding level. The input parameter is ignored, but has to be + specified for back-end compatibility. */ + +void +pushlevel (ignore) + int ignore; +{ + struct binding_level *newlevel + = (struct binding_level *) xmalloc (sizeof (struct binding_level)); + + *newlevel = clear_binding_level; + + /* Add this level to the front of the chain (stack) of levels that are + active. */ + newlevel->level_chain = current_binding_level; + current_binding_level = newlevel; +} + +/* Exit a binding level. + Pop the level off, and restore the state of the identifier-decl mappings + that were in effect when this level was entered. + + If KEEP is nonzero, this level had explicit declarations, so + and create a "block" (a BLOCK node) for the level + to record its declarations and subblocks for symbol table output. + + If FUNCTIONBODY is nonzero, this level is the body of a function, + so create a block as if KEEP were set and also clear out all + label names. + + If REVERSE is nonzero, reverse the order of decls before putting + them into the BLOCK. */ + +tree +poplevel (keep, reverse, functionbody) + int keep; + int reverse; + int functionbody; +{ + /* Points to a BLOCK tree node. This is the BLOCK node construted for the + binding level that we are about to exit and which is returned by this + routine. */ + tree block_node = NULL_TREE; + tree decl_chain; + tree decl_node; + tree subblock_chain = current_binding_level->blocks; + tree subblock_node; + tree block_created_by_back_end; + + /* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL + nodes chained through the `names' field of current_binding_level are in + reverse order except for PARM_DECL node, which are explicitely stored in + the right order. */ + decl_chain = (reverse) ? nreverse (current_binding_level->names) + : current_binding_level->names; + + block_created_by_back_end = current_binding_level->block_created_by_back_end; + if (block_created_by_back_end != 0) + { + block_node = block_created_by_back_end; + + /* Check if we are about to discard some information that was gathered + by the front-end. Nameley check if the back-end created a new block + without calling pushlevel first. To understand why things are lost + just look at the next case (i.e. no block created by back-end. */ + if ((keep || functionbody) && (decl_chain || subblock_chain)) + abort (); + } + + /* If there were any declarations in the current binding level, or if this + binding level is a function body, or if there are any nested blocks then + create a BLOCK node to record them for the life of this function. */ + else if (keep || functionbody) + block_node = build_block (keep ? decl_chain : 0, 0, subblock_chain, 0, 0); + + /* Record the BLOCK node just built as the subblock its enclosing scope. */ + for (subblock_node = subblock_chain; subblock_node; + subblock_node = TREE_CHAIN (subblock_node)) + BLOCK_SUPERCONTEXT (subblock_node) = block_node; + + /* Clear out the meanings of the local variables of this level. */ + + for (subblock_node = decl_chain; subblock_node; + subblock_node = TREE_CHAIN (subblock_node)) + if (DECL_NAME (subblock_node) != 0) + /* If the identifier was used or addressed via a local extern decl, + don't forget that fact. */ + if (DECL_EXTERNAL (subblock_node)) + { + if (TREE_USED (subblock_node)) + TREE_USED (DECL_NAME (subblock_node)) = 1; + if (TREE_ADDRESSABLE (subblock_node)) + TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1; + } + + /* Pop the current level. */ + current_binding_level = current_binding_level->level_chain; + + if (functionbody) + { + /* This is the top level block of a function. The ..._DECL chain stored + in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't + leave them in the BLOCK because they are found in the FUNCTION_DECL + instead. */ + DECL_INITIAL (current_function_decl) = block_node; + BLOCK_VARS (block_node) = 0; + } + else if (block_node) + { + if (block_created_by_back_end == NULL) + current_binding_level->blocks + = chainon (current_binding_level->blocks, block_node); + } + + /* If we did not make a block for the level just exited, any blocks made for + inner levels (since they cannot be recorded as subblocks in that level) + must be carried forward so they will later become subblocks of something + else. */ + else if (subblock_chain) + current_binding_level->blocks + = chainon (current_binding_level->blocks, subblock_chain); + if (block_node) + TREE_USED (block_node) = 1; + + return block_node; +} + +/* Insert BLOCK at the end of the list of subblocks of the + current binding level. This is used when a BIND_EXPR is expanded, + to handle the BLOCK node inside the BIND_EXPR. */ + +void +insert_block (block) + tree block; +{ + TREE_USED (block) = 1; + current_binding_level->blocks + = chainon (current_binding_level->blocks, block); +} + +/* Set the BLOCK node for the innermost scope + (the one we are currently in). */ + +void +set_block (block) + tree block; +{ + current_binding_level->block_created_by_back_end = block; +} + +/* Records a ..._DECL node DECL as belonging to the current lexical scope. + Returns the ..._DECL node. */ + +tree +pushdecl (decl) + tree decl; +{ + /* External objects aren't nested, other objects may be. */ + if (DECL_EXTERNAL (decl)) + DECL_CONTEXT (decl) = 0; + else + DECL_CONTEXT (decl) = current_function_decl; + + /* Put the declaration on the list. The list of declarations is in reverse + order. The list will be reversed later if necessary. This needs to be + this way for compatibility with the back-end. */ + + TREE_CHAIN (decl) = current_binding_level->names; + current_binding_level->names = decl; + + /* For the declaration of a type, set its name if it is not already set. */ + + if (TREE_CODE (decl) == TYPE_DECL + && TYPE_NAME (TREE_TYPE (decl)) == 0) + TYPE_NAME (TREE_TYPE (decl)) = decl; /* DECL_NAME (decl); */ + + return decl; +} +#endif + +#ifndef CHAR_TYPE_SIZE +#define CHAR_TYPE_SIZE BITS_PER_UNIT +#endif + +#ifndef INT_TYPE_SIZE +#define INT_TYPE_SIZE BITS_PER_WORD +#endif + +#undef SIZE_TYPE +#define SIZE_TYPE "long unsigned int" + +#if 0 +/* Create the predefined scalar types such as `integer_type_node' needed + in the gcc back-end and initialize the global binding level. */ + +void +init_decl_processing () +{ + tree endlink; + + error_mark_node = make_node (ERROR_MARK); + TREE_TYPE (error_mark_node) = error_mark_node; + + initialize_sizetypes (); + + /* The structure `tree_identifier' is the GCC tree data structure that holds + IDENTIFIER_NODE nodes. We need to call `set_identifier_size' to tell GCC + that we have not added any language specific fields to IDENTIFIER_NODE + nodes. */ + set_identifier_size (sizeof (struct tree_identifier)); + lineno = 0; + + /* Make the binding_level structure for global names. */ + pushlevel (0); + global_binding_level = current_binding_level; + + build_common_tree_nodes (0); + pushdecl (build_decl (TYPE_DECL, get_identifier ("int"), + integer_type_node)); + pushdecl (build_decl (TYPE_DECL, get_identifier ("char"), + char_type_node)); + set_sizetype (unsigned_type_node); + build_common_tree_nodes_2 (0); + +} +#endif + + +#if 0 +/* Perform all the initialization steps that are language-specific. */ + +void +lang_init () +{} + +/* Perform all the finalization steps that are language-specific. */ + +void +lang_finish () +{} + +/* Return a short string identifying this language to the debugger. */ + +const char * +lang_identify () +{ + return "vhdl"; +} + +/* If DECL has a cleanup, build and return that cleanup here. + This is a callback called by expand_expr. */ + +tree +maybe_build_cleanup (decl) + tree decl; +{ return NULL_TREE; } + +/* Print an error message for invalid use of an incomplete type. */ + +void +incomplete_type_error (dont_care_1, dont_care_2) + tree dont_care_1, dont_care_2; +{ abort (); } + +tree +truthvalue_conversion (expr) + tree expr; +{ return expr;} + +int +mark_addressable (expr) + tree expr; +{return 0;} +#endif + +#if 0 +/* Print any language-specific compilation statistics. */ + +void +print_lang_statistics () +{} + +/* Since we don't use the DECL_LANG_SPECIFIC field, this is a no-op. */ + +void +copy_lang_decl (node) + tree node; +{} + +/* Hooks for print-tree.c: */ + +void +print_lang_decl (file, node, indent) + FILE *file; + tree node; + int indent; +{} + +void +print_lang_type (file, node, indent) + FILE *file; + tree node; + int indent; +{} + +void +print_lang_identifier (file, node, indent) + FILE *file; + tree node; + int indent; +{} +#endif + +#if 0 +/* Performs whatever initialization steps are needed by the language-dependent + lexical analyzer. */ + +void +init_lex () +{} + + +/* Sets some debug flags for the parser. It does nothing here. */ + +void +set_yydebug (value) + int value; +{} +#endif + +#if 0 +/* Routine to print parse error message. */ +void +yyerror (str) + char *str; +{ + fprintf (stderr, "%s\n", str); +} +#endif + +#if 0 +/* Return the typed-based alias set for T, which may be an expression + or a type. Return -1 if we don't do anything special. */ + +HOST_WIDE_INT +lang_get_alias_set (t) + tree t ATTRIBUTE_UNUSED; +{ + return -1; +} +#endif + +#if 0 +/* Return a definition for a builtin function named NAME and whose data type + is TYPE. TYPE should be a function type with argument types. + FUNCTION_CODE tells later passes how to compile calls to this function. + See tree.h for its possible values. + + If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME, + the name to be called if we can't opencode the function. */ + +tree +builtin_function (name, type, function_code, class, library_name) + const char *name; + tree type; + int function_code; + enum built_in_class class; + const char *library_name; +{ + tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); + DECL_EXTERNAL (decl) = 1; + TREE_PUBLIC (decl) = 1; + if (library_name) + DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name); + make_decl_rtl (decl, NULL_PTR, 1); + pushdecl (decl); + DECL_BUILT_IN_CLASS (decl) = class; + DECL_FUNCTION_CODE (decl) = function_code; + return decl; +} +#endif + +#if 0 +/* Mark language-specific parts of T for garbage-collection. */ + +void +lang_mark_tree (t) + tree t ATTRIBUTE_UNUSED; +{ +} +#endif + +void +print_chain (tree t) +{ + while (t != NULL) + { + print_node_brief (stdout, "", t, 0); + fprintf (stdout, "\n"); + t = TREE_CHAIN (t); + } +} diff --git a/ortho/agcc/agcc-hconfig.ads.in b/ortho/agcc/agcc-hconfig.ads.in new file mode 100644 index 000000000..3662c953c --- /dev/null +++ b/ortho/agcc/agcc-hconfig.ads.in @@ -0,0 +1,21 @@ +-- Ada bindings for GCC internals. -*- Ada -*- +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +package Agcc.Hconfig is +@host_big_endian +end Agcc.Hconfig; diff --git a/ortho/agcc/agcc-hwint.ads.in b/ortho/agcc/agcc-hwint.ads.in new file mode 100644 index 000000000..245f211dc --- /dev/null +++ b/ortho/agcc/agcc-hwint.ads.in @@ -0,0 +1,23 @@ +-- Ada bindings for GCC internals. -*- Ada -*- +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Interfaces; + +package Agcc.Hwint is + pragma Preelaborate (Agcc.Hwint); +@host_wide_int +end Agcc.Hwint; diff --git a/ortho/agcc/agcc-input.ads b/ortho/agcc/agcc-input.ads new file mode 100644 index 000000000..d7ff5ec5a --- /dev/null +++ b/ortho/agcc/agcc-input.ads @@ -0,0 +1,29 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +package Agcc.Input is + type Location_T is record + File : Chars; + Line : Integer; + end record; + pragma Convention (C_Pass_By_Copy, Location_T); + + Input_Location : Location_T; + pragma Import (C, Input_Location); +end Agcc.Input; + + diff --git a/ortho/agcc/agcc-libiberty.ads b/ortho/agcc/agcc-libiberty.ads new file mode 100644 index 000000000..89784b7e0 --- /dev/null +++ b/ortho/agcc/agcc-libiberty.ads @@ -0,0 +1,21 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +package Agcc.Libiberty is + function Xmalloc (Size : Size_T) return Chars; + pragma Import (C, Xmalloc); +end Agcc.Libiberty; diff --git a/ortho/agcc/agcc-machmode.ads.in b/ortho/agcc/agcc-machmode.ads.in new file mode 100644 index 000000000..ccc6980ab --- /dev/null +++ b/ortho/agcc/agcc-machmode.ads.in @@ -0,0 +1,35 @@ +-- Ada bindings for GCC internals. -*- Ada -*- +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +package Agcc.Machmode is + pragma Preelaborate (Agcc.Machmode); + + type Machine_Mode is + ( +@machmode + ); + pragma Convention (C, Machine_Mode); + + function GET_MODE_BITSIZE (Mode : Machine_Mode) return Natural; + Ptr_Mode : Machine_Mode; + +private + pragma Import (C, GET_MODE_BITSIZE); + pragma Import (C, Ptr_Mode); +end Agcc.Machmode; + diff --git a/ortho/agcc/agcc-options.ads.in b/ortho/agcc/agcc-options.ads.in new file mode 100644 index 000000000..8931edde4 --- /dev/null +++ b/ortho/agcc/agcc-options.ads.in @@ -0,0 +1,31 @@ +-- Ada bindings for GCC internals. -*- Ada -*- +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- This file is preprocessed by gen_tree to create agcc-options.ads + +package Agcc.Options is + +@options_CL + + type Opt_Code is + ( +@options_OPTs + ); + + pragma Convention (C, Opt_Code); +end Agcc.Options; diff --git a/ortho/agcc/agcc-output.ads b/ortho/agcc/agcc-output.ads new file mode 100644 index 000000000..6ecab6e33 --- /dev/null +++ b/ortho/agcc/agcc-output.ads @@ -0,0 +1,24 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Agcc.Trees; use Agcc.Trees; + +package Agcc.Output is + procedure Make_Function_Rtl (Func : Tree); +private + pragma Import (C, Make_Function_Rtl); +end Agcc.Output; diff --git a/ortho/agcc/agcc-real.ads.in b/ortho/agcc/agcc-real.ads.in new file mode 100644 index 000000000..ec6b080bd --- /dev/null +++ b/ortho/agcc/agcc-real.ads.in @@ -0,0 +1,42 @@ +-- Ada bindings for GCC internals. -*- Ada -*- +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Agcc.Hwint; use Agcc.Hwint; +with Agcc.Machmode; use Agcc.Machmode; + +package Agcc.Real is + pragma Preelaborate (Agcc.Real); + + type REAL_VALUE_TYPE is private; + + function REAL_VALUE_ATOF (S : System.Address; M : Machine_Mode) + return REAL_VALUE_TYPE; + + function REAL_VALUE_LDEXP (X : REAL_VALUE_TYPE; N : Integer) + return REAL_VALUE_TYPE; + + procedure REAL_VALUE_FROM_INT (D : System.Address; + Lo, Hi : HOST_WIDE_INT; + Mode : Machine_Mode); +private +@real + -- FIXME: check about the convention on other machines. + pragma Convention (C_Pass_By_Copy, REAL_VALUE_TYPE); + pragma Import (C, REAL_VALUE_ATOF, "get_REAL_VALUE_ATOF"); + pragma Import (C, REAL_VALUE_LDEXP, "get_REAL_VALUE_LDEXP"); + pragma Import (C, REAL_VALUE_FROM_INT, "get_REAL_VALUE_FROM_INT"); +end Agcc.Real; diff --git a/ortho/agcc/agcc-rtl.ads b/ortho/agcc/agcc-rtl.ads new file mode 100644 index 000000000..e45143a8f --- /dev/null +++ b/ortho/agcc/agcc-rtl.ads @@ -0,0 +1,31 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Agcc.Input; use Agcc.Input; +with System; + +package Agcc.Rtl is + -- Defines RTX as an opaque type. + type Rtx is new System.Address; + + procedure Emit_Line_Note (Loc : Location_T); + function Emit_Line_Note (Loc : Location_T) return Rtx; + procedure Emit_Nop; +private + pragma Import (C, Emit_Line_Note); + pragma Import (C, Emit_Nop); +end Agcc.Rtl; diff --git a/ortho/agcc/agcc-stor_layout.ads b/ortho/agcc/agcc-stor_layout.ads new file mode 100644 index 000000000..aeaa4d74e --- /dev/null +++ b/ortho/agcc/agcc-stor_layout.ads @@ -0,0 +1,24 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Agcc.Trees; use Agcc.Trees; + +package Agcc.Stor_Layout is + procedure Fixup_Unsigned_Type (Atype : Tree); +private + pragma Import (C, Fixup_Unsigned_Type); +end Agcc.Stor_Layout; diff --git a/ortho/agcc/agcc-tm.ads.in b/ortho/agcc/agcc-tm.ads.in new file mode 100644 index 000000000..7fea03cd2 --- /dev/null +++ b/ortho/agcc/agcc-tm.ads.in @@ -0,0 +1,37 @@ +-- Ada bindings for GCC internals. -*- Ada -*- +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- Definitions about target machine. + +package Agcc.Tm is + pragma Preelaborate (Agcc.Tm); + + function DOUBLE_TYPE_SIZE return Natural; + function LONG_DOUBLE_TYPE_SIZE return Natural; + function BITS_PER_UNIT return Natural; + function BITS_PER_WORD return Natural; + function PROMOTE_PROTOTYPES return C_Bool; +@tm +private + pragma Import (C, DOUBLE_TYPE_SIZE); + pragma Import (C, LONG_DOUBLE_TYPE_SIZE); + pragma Import (C, BITS_PER_UNIT); + pragma Import (C, BITS_PER_WORD); + pragma Import (C, PROMOTE_PROTOTYPES, "get_PROMOTE_PROTOTYPES"); +end Agcc.Tm; + diff --git a/ortho/agcc/agcc-toplev.ads b/ortho/agcc/agcc-toplev.ads new file mode 100644 index 000000000..a816f54f2 --- /dev/null +++ b/ortho/agcc/agcc-toplev.ads @@ -0,0 +1,51 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Agcc.Trees; use Agcc.Trees; +with System; +with Agcc.Hwint; use Agcc.Hwint; + +package Agcc.Toplev is + procedure Rest_Of_Decl_Compilation (Decl : Tree; + Asmspec : System.Address; + Top_Level : C_Bool; + At_End : C_Bool); + procedure Rest_Of_Type_Compilation (Decl : Tree; Toplevel : C_Bool); + procedure Rest_Of_Compilation (Decl : Tree); + + function Exact_Log2_Wide (X : HOST_WIDE_INT) return Integer; + function Floor_Log2_Wide (X : HOST_WIDE_INT) return Integer; + + procedure Error (Msg : System.Address); + + procedure Announce_Function (Func : Tree); + + function Toplev_Main (Argc : Integer; Argv : System.Address) + return Integer; +private + pragma Import (C, Rest_Of_Decl_Compilation); + pragma Import (C, Rest_Of_Type_Compilation); + pragma Import (C, Rest_Of_Compilation); + + pragma Import (C, Exact_Log2_Wide); + pragma Import (C, Floor_Log2_Wide); + + pragma Import (C, Error); + + pragma Import (C, Announce_Function); + pragma Import (C, Toplev_Main); +end Agcc.Toplev; diff --git a/ortho/agcc/agcc-trees.adb b/ortho/agcc/agcc-trees.adb new file mode 100644 index 000000000..a13aba346 --- /dev/null +++ b/ortho/agcc/agcc-trees.adb @@ -0,0 +1,33 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +package body Agcc.Trees is + function Build_Int (Low : HOST_WIDE_INT) return Tree is + begin + if Low < 0 then + return Build_Int_2_Wide (Low, -1); + else + return Build_Int_2_Wide (Low, 0); + end if; + end Build_Int; + + procedure Expand_Start_Bindings (Flags : Integer) is + begin + Expand_Start_Bindings_And_Block (Flags, NULL_TREE); + end Expand_Start_Bindings; + +end Agcc.Trees; diff --git a/ortho/agcc/agcc-trees.ads.in b/ortho/agcc/agcc-trees.ads.in new file mode 100644 index 000000000..5eb2d5844 --- /dev/null +++ b/ortho/agcc/agcc-trees.ads.in @@ -0,0 +1,514 @@ +-- Ada bindings for GCC internals. -*- Ada -*- +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- This file is preprocessed by gen_tree to create agcc-trees.ads +-- gen_tree adds enumerations from GCC C files. + +with System; use System; +with Agcc.Hwint; use Agcc.Hwint; +with Agcc.Real; use Agcc.Real; +with Agcc.Machmode; use Agcc.Machmode; + +package Agcc.Trees is + --pragma No_Elaboration_Code (Agcc.Trees); + + type Tree is new System.Address; + + NULL_TREE : constant Tree; + + type Tree_Code is + ( +@tree_code + ); + pragma Convention (C, Tree_Code); + + type Built_In_Class is + (NOT_BUILT_IN, BUILT_IN_FRONTEND, BUILT_IN_MD, BUILT_IN_NORMAL); + pragma Convention (C, Built_In_Class); + + type Built_In_Function is + ( +@built_in_function + ); + pragma Convention (C, Built_In_Function); + + type Tree_Index is + ( +@tree_index + ); + + type Type_Qual_Type is new Integer; +@type_qual + + type Global_Trees_Array is array (Tree_Index) of Tree; + pragma Convention (C, Global_Trees_Array); + Global_Trees : Global_Trees_Array; + pragma Import (C, Global_Trees); + + Error_Mark_Node : Tree renames Global_Trees (TI_ERROR_MARK); + Void_Type_Node : Tree renames Global_Trees (TI_VOID_TYPE); + Ptr_Type_Node : Tree renames Global_Trees (TI_PTR_TYPE); + Const_Ptr_Type_Node : Tree renames Global_Trees (TI_CONST_PTR_TYPE); + Integer_Zero_Node : Tree renames Global_Trees (TI_INTEGER_ZERO); + Integer_One_Node : Tree renames Global_Trees (TI_INTEGER_ONE); + Size_Zero_Node : Tree renames Global_Trees (TI_SIZE_ZERO); + + type Size_Type_Kind is + ( +@size_type_kind + ); + + type Sizetype_Tab_Array is array (Size_Type_Kind) of Tree; + pragma Convention (C, Sizetype_Tab_Array); + Sizetype_Tab : Sizetype_Tab_Array; + pragma Import (C, Sizetype_Tab); + + Bitsizetype : Tree renames Sizetype_Tab (TK_BITSIZETYPE); + Sizetype : Tree renames Sizetype_Tab (TK_SIZETYPE); + + type Integer_Types_Kind is + ( +@integer_types + ); + + type Integer_Types_Array is array (Integer_Types_Kind) of Tree; + pragma Convention (C, Integer_Types_Array); + Integer_Types : Integer_Types_Array; + pragma Import (C, Integer_Types); + + Integer_Type_Node : Tree renames Integer_Types (itk_int); + Unsigned_Type_Node : Tree renames Integer_Types (itk_unsigned_int); + Char_Type_Node : Tree renames Integer_Types (itk_char); + + function Build (Code: Tree_Code; T: Tree; O0, O1: Tree) return Tree; + function Build (Code: Tree_Code; T: Tree; O0, O1, O2: Tree) return Tree; + function Build1 (Code: Tree_Code; T: Tree; O: Tree) return Tree; + function Build_Constructor (T : Tree; V : Tree) return Tree; + function Build_Block (Vars : Tree; + Tags : Tree; + Subblocks : Tree; + Supercontext : Tree; + Chain : Tree) + return Tree; + function Build_Decl (Code : Tree_Code; T1 : Tree; T2: Tree) return Tree; + function Build_Int_2 (Low, Hi: HOST_WIDE_INT) return Tree; + function Build_Int_2_Wide (Low, Hi: HOST_WIDE_INT) return Tree; + function Build_Real (Rtype : Tree; D : REAL_VALUE_TYPE) return Tree; + function Build_Function_Type (Value_Type : Tree; Arg_Type : Tree) + return Tree; + function Build_Pointer_Type (Atype : Tree) return Tree; + function Get_Identifier (Str : System.Address) return Tree; + function Build_String (Len : Integer; Str : System.Address) return Tree; + function Build_Index_Type (Max : Tree) return Tree; + function Build_Range_Type (Basetype : Tree; Low : Tree; High : Tree) + return Tree; + function Build_Array_Type (El_Type : Tree; Domain : Tree) return Tree; + function Make_Node (Code : Tree_Code) return Tree; + function Build_Qualified_Type (Atype : Tree; Qual : Type_Qual_Type) + return Tree; + + function Build_Save_Expr (Expr : Tree) return Tree; + + function Make_Signed_Type (Precision : Natural) return Tree; + function Make_Unsigned_Type (Precision : Natural) return Tree; + procedure Initialize_Sizetypes; + procedure Set_Sizetype (Atype : Tree); + + function Host_Integerp (T : Tree; Pos : Integer) return Integer; + + function Chainon (Op1, Op2 : Tree) return Tree; + function Listify (Node : Tree) return Tree; + function Tree_Cons (Purpose : Tree; Value : Tree; Chain : Tree) + return Tree; + function Nreverse (Chain : Tree) return Tree; + function Build_Tree_List (Purpose : Tree; Value : Tree) return Tree; + + function Size_In_Bytes (Decl : Tree) return Tree; + procedure Set_Identifier_Size (Size : Natural); + + function Get_Inner_Reference + (Exp : Tree; + Pbitsize : Address; -- HOST_WIDE_INT pointer + Pbitpos : Address; -- HOST_WIDE_INT pointer + Poffset : Address; -- Tree pointer + Pmode : Address; -- MACHINE_MODE pointer + Punsignedp : Address; -- int pointer + Pvolatilep : Address) -- int pointer + return Tree; + + Current_Function_Decl : Tree; + + function Integer_Zerop (Expr : Tree) return C_Bool; + function Integer_Onep (Expr : Tree) return C_Bool; + function Real_Zerop (Expr : Tree) return C_Bool; + + procedure Layout_Type (Atype : Tree); + procedure Layout_Decl (Decl : Tree; Align : Natural); + + procedure Expand_Start_Bindings_And_Block (Flags : Integer; Block : Tree); + procedure Expand_Start_Bindings (Flags : Integer); + procedure Expand_End_Bindings + (Vars : Tree; Mark_Ends: C_Bool; Dont_Jump_In : C_Bool); + + procedure Init_Function_Start + (Subr : Tree; Filename : Chars; Line : Integer); + procedure Expand_Function_Start + (Subr : Tree; Parms_Have_Cleanups : C_Bool); + procedure Expand_Function_End + (Filename : Chars; Line : Integer; End_Bindings : C_Bool); + procedure Push_Function_Context; + procedure Pop_Function_Context; + procedure Put_Var_Into_Stack (Expr : Tree; Rescan : C_Bool); + procedure Expand_Null_Return; + procedure Expand_Return (Expr : Tree); + procedure Expand_Expr_Stmt (Expr : Tree); + procedure Expand_Decl (Decl : Tree); + procedure Expand_Decl_Init (Decl : Tree); + + function Expand_Exit_Something return Integer; + + -- Conditions (IF). + procedure Expand_Start_Cond (Cond : Tree; Has_Exit : C_Bool); + procedure Expand_Start_Elseif (Cond : Tree); + procedure Expand_Start_Else; + procedure Expand_End_Cond; + + -- Loops (FOR, WHILE, DO-WHILE, CONTINUE, EXIT ...) + type Nesting is private; + Nesting_Null : constant Nesting; + function Expand_Start_Loop (Exit_Flag : C_Bool) return Nesting; + procedure Expand_Continue_Loop (Which_Loop: Nesting); + procedure Expand_End_Loop; + function Expand_Start_Loop_Continue_Elsewhere (Exit_Flag : C_Bool) + return Nesting; + procedure Expand_Loop_Continue_Here; + procedure Expand_Exit_Loop (Which_Loop : Nesting); + function Expand_Exit_Loop_If_False (Which_Loop : Nesting; Cond : Tree) + return Integer; + + -- multibranch (SWITCH). + procedure Expand_Start_Case + (Exit_Flag : C_Bool; Expr : Tree; Etype : Tree; Printname : Chars); + function Pushcase + (Value : Tree; Converter : Address; Label : Tree; Duplicate : Address) + return Integer; + function Pushcase_Range + (Low, High : Tree; Converter : Address; Label : Tree; Duplicate : Address) + return Integer; + function Add_Case_Node (Low, High : Tree; Label : Tree; Duplicate : Address) + return Integer; + procedure Expand_End_Case_Type (Orig_Index : Tree; Orig_Type : Tree); + + procedure Debug_Tree (T: Tree); + + function Fold (Atree : Tree) return Tree; + function Size_Binop (Code : Tree_Code; arg0, Arg1 : Tree) return Tree; + function Size_Int (Number : HOST_WIDE_INT) return Tree; + + function Convert (Atype : Tree; Expr : Tree) return Tree; + + -- Create an INTEGER_CST whose value is LOW signed extended to + -- 2 HOST_WIDE_INT. + function Build_Int (Low : HOST_WIDE_INT) return Tree; + + function Get_TREE_CODE (T : Tree) return Tree_Code; + procedure Set_TREE_CONSTANT (T : Tree; Val : C_Bool); + function Get_TREE_CONSTANT (T : Tree) return C_Bool; + procedure Set_TREE_PUBLIC (Decl: Tree; Val : C_Bool); + procedure Set_TREE_STATIC (Decl : Tree; Val : C_Bool); + procedure Set_TREE_TYPE (Decl : Tree; T : Tree); + function Get_TREE_TYPE (Decl : Tree) return Tree; + procedure Set_TREE_CHAIN (Decl : Tree; Chain : Tree); + function Get_TREE_CHAIN (Decl : Tree) return Tree; + procedure Set_TREE_UNSIGNED (Decl : Tree; Val: C_Bool); + function Get_TREE_UNSIGNED (Decl : Tree) return C_Bool; + procedure Set_TREE_ADDRESSABLE (Decl : Tree; Val: C_Bool); + function Get_TREE_ADDRESSABLE (Decl : Tree) return C_Bool; + procedure Set_TREE_SIDE_EFFECTS (Decl : Tree; Val: C_Bool); + procedure Set_TREE_READONLY (Decl : Tree; Val: C_Bool); + procedure Set_TREE_OPERAND (T : Tree; N : Natural; Val : Tree); + function Get_TREE_OPERAND (T : Tree; N : Natural) return Tree; + procedure Set_TREE_THIS_VOLATILE (T : Tree; Val : C_Bool); + function Get_TREE_THIS_VOLATILE (T : Tree) return C_Bool; + function Get_TREE_VALUE (Decl : Tree) return Tree; + function Get_TREE_PURPOSE (Decl : Tree) return Tree; + function Get_TREE_USED (Decl : Tree) return C_Bool; + procedure Set_TREE_USED (Decl : Tree; Flag : C_Bool); + + function Get_TREE_INT_CST_LOW (Node : Tree) return HOST_WIDE_INT; + function Get_TREE_INT_CST_HIGH (Node : Tree) return HOST_WIDE_INT; + + function Get_CONSTRUCTOR_ELTS (Cons : Tree) return Tree; + + procedure Set_DECL_ARG_TYPE (Decl : Tree; Val : Tree); + procedure Set_DECL_EXTERNAL (Decl : Tree; Val : C_Bool); + function Get_DECL_EXTERNAL (Decl : Tree) return C_Bool; + procedure Set_DECL_ARGUMENTS (Decl : Tree; Args : Tree); + function Get_DECL_ARGUMENTS (Decl : Tree) return Tree; + procedure Set_DECL_RESULT (Decl : Tree; Res : Tree); + function Get_DECL_RESULT (Decl : Tree) return Tree; + procedure Set_DECL_CONTEXT (Decl : Tree; Context : Tree); + function Get_DECL_CONTEXT (Decl : Tree) return Tree; + function Get_DECL_INITIAL (Decl : Tree) return Tree; + procedure Set_DECL_INITIAL (Decl : Tree; Init : Tree); + function Get_DECL_NAME (Decl : Tree) return Tree; + function Get_DECL_ASSEMBLER_NAME (Decl : Tree) return Tree; + procedure Set_DECL_ASSEMBLER_NAME (Decl : Tree; Name : Tree); + procedure Set_DECL_BUILT_IN_CLASS (Decl : Tree; Class : Built_In_Class); + procedure Set_DECL_FUNCTION_CODE (Decl : Tree; Code : Built_In_Function); + function Get_DECL_FIELD_OFFSET (Decl : Tree) return Tree; + function Get_DECL_FIELD_BIT_OFFSET (Decl : Tree) return Tree; + + procedure Set_TYPE_VALUES (Atype : Tree; Values: Tree); + procedure Set_TYPE_NAME (Atype : Tree; Name: Tree); + function Get_TYPE_NAME (Atype : Tree) return Tree; + procedure Set_TYPE_MIN_VALUE (Atype : Tree; Val: Tree); + function Get_TYPE_MIN_VALUE (Atype : Tree) return Tree; + procedure Set_TYPE_MAX_VALUE (Atype : Tree; Val: Tree); + function Get_TYPE_MAX_VALUE (Atype : Tree) return Tree; + procedure Set_TYPE_SIZE (Atype : Tree; Size: Tree); + function Get_TYPE_SIZE (Atype : Tree) return Tree; + procedure Set_TYPE_PRECISION (Atype : Tree; Precision : Integer); + function Get_TYPE_PRECISION (Atype : Tree) return Integer; + procedure Set_TYPE_FIELDS (Atype : Tree; Fields : Tree); + function Get_TYPE_FIELDS (Atype : Tree) return Tree; + procedure Set_TYPE_STUB_DECL (Atype : Tree; Decl : Tree); + procedure Set_TYPE_LANG_SPECIFIC (Atype : Tree; Val : System.Address); + function Get_TYPE_LANG_SPECIFIC (Atype : Tree) return System.Address; + function Get_TYPE_IS_SIZETYPE (Atype : Tree) return C_Bool; + function Get_TYPE_DOMAIN (Atype : Tree) return Tree; + procedure Set_TYPE_DOMAIN (Atype : Tree; Domain : Tree); + function Get_TYPE_SIZE_UNIT (Atype : Tree) return Tree; + function Get_TYPE_POINTER_TO (Atype : Tree) return Tree; + procedure Set_TYPE_POINTER_TO (Atype : Tree; Dtype : Tree); + function INTEGRAL_TYPE_P (Atype : Tree) return C_Bool; + procedure Set_TYPE_MODE (Atype : Tree; Mode : Machine_Mode); + function Get_TYPE_MODE (Atype : Tree) return Machine_Mode; + + function Get_BLOCK_SUPERCONTEXT (Ablock : Tree) return Tree; + procedure Set_BLOCK_SUPERCONTEXT (Ablock : Tree; Sc : Tree); + procedure Set_BLOCK_VARS (Ablock : Tree; Vars : Tree); + + function Get_IDENTIFIER_LENGTH (N : Tree) return Integer; + function Get_IDENTIFIER_POINTER (N : Tree) return Chars; + + procedure Build_Common_Tree_Nodes (Signed_Char : C_Bool); + procedure Build_Common_Tree_Nodes_2 (Short_Double : C_Bool); + + -- Points to the name of the input file from which the current input + -- being parsed originally came (before it went into cpp). + Input_Filename : Chars; + + Main_Input_Filename : Chars; + + -- Current line number in input file. + Lineno : Integer; + + -- sizeof (struct tree_identifier). + Tree_Identifier_Size : Natural; + + -- Create DECL_RTL for a declaration for a static or external variable or + -- static or external function. + procedure Make_Decl_Rtl (Decl : Tree; Asmspec : Chars; Top_Level : C_Bool); + +private + NULL_TREE : constant Tree := Tree (System.Null_Address); + + type Nesting is new System.Address; + Nesting_Null : constant Nesting := Nesting (Null_Address); + + pragma Import (C, Current_Function_Decl); + pragma Import (C, Set_Identifier_Size); + + pragma Import (C, Build); + pragma Import (C, Build1); + pragma Import (C, Build_Constructor); + pragma Import (C, Build_Block); + pragma Import (C, Build_Decl); + pragma Import (C, Build_Int_2); + pragma Import (C, Build_Int_2_Wide); + pragma Import (C, Build_Real); + pragma Import (C, Build_Function_Type); + pragma Import (C, Build_Pointer_Type); + pragma Import (C, Get_Identifier); + pragma Import (C, Build_String); + pragma Import (C, Make_Node); + pragma Import (C, Build_Index_Type); + pragma Import (C, Build_Range_Type); + pragma Import (C, Build_Array_Type); + pragma Import (C, Build_Qualified_Type); + pragma Import (C, Build_Save_Expr, "save_expr"); + + pragma Import (C, Make_Signed_Type); + pragma Import (C, Make_Unsigned_Type); + pragma Import (C, Initialize_Sizetypes); + pragma Import (C, Set_Sizetype); + pragma Import (C, Host_Integerp); + + pragma Import (C, Chainon); + pragma Import (C, Listify); + pragma Import (C, Tree_Cons); + pragma Import (C, Nreverse); + pragma Import (C, Build_Tree_List); + + pragma Import (C, Size_In_Bytes); + pragma Import (C, Get_Inner_Reference); + + pragma Import (C, Integer_Zerop); + pragma Import (C, Integer_Onep); + pragma Import (C, Real_Zerop); + + pragma Import (C, Layout_Type); + pragma Import (C, Layout_Decl); + + pragma Import (C, Expand_Start_Bindings_And_Block); + pragma Import (C, Expand_End_Bindings); + + pragma Import (C, Init_Function_Start); + pragma Import (C, Expand_Function_Start); + pragma Import (C, Expand_Function_End); + pragma Import (C, Push_Function_Context); + pragma Import (C, Pop_Function_Context); + pragma Import (C, Put_Var_Into_Stack); + + pragma Import (C, Expand_Null_Return); + pragma Import (C, Expand_Return); + pragma Import (C, Expand_Expr_Stmt); + pragma Import (C, Expand_Decl); + pragma Import (C, Expand_Decl_Init); + + pragma Import (C, Expand_Exit_Something); + + pragma Import (C, Expand_Start_Cond); + pragma Import (C, Expand_Start_Elseif); + pragma Import (C, Expand_Start_Else); + pragma Import (C, Expand_End_Cond); + + pragma Import (C, Expand_Start_Loop); + pragma Import (C, Expand_Continue_Loop); + pragma Import (C, Expand_End_Loop); + pragma Import (C, Expand_Start_Loop_Continue_Elsewhere); + pragma Import (C, Expand_Loop_Continue_Here); + pragma Import (C, Expand_Exit_Loop); + pragma Import (C, Expand_Exit_Loop_If_False); + + pragma Import (C, Expand_Start_Case); + pragma Import (C, Pushcase); + pragma Import (C, Pushcase_Range); + pragma Import (C, Add_Case_Node); + pragma Import (C, Expand_End_Case_Type); + + pragma Import (C, Debug_Tree); + + pragma Import (C, Fold); + pragma Import (C, Size_Binop); + pragma Import (C, Size_Int); + pragma Import (C, Convert); + + -- Import pragma clauses for C MACROs. + pragma Import (C, Get_TREE_CODE); + pragma Import (C, Set_TREE_CONSTANT); + pragma Import (C, Get_TREE_CONSTANT); + pragma Import (C, Set_TREE_PUBLIC); + pragma Import (C, Set_TREE_STATIC); + pragma Import (C, Set_TREE_TYPE); + pragma Import (C, Get_TREE_TYPE); + pragma Import (C, Set_TREE_CHAIN); + pragma Import (C, Get_TREE_CHAIN); + pragma Import (C, Set_TREE_UNSIGNED); + pragma Import (C, Get_TREE_UNSIGNED); + pragma Import (C, Set_TREE_ADDRESSABLE); + pragma Import (C, Get_TREE_ADDRESSABLE); + pragma Import (C, Set_TREE_SIDE_EFFECTS); + pragma Import (C, Set_TREE_READONLY); + pragma Import (C, Get_TREE_OPERAND); + pragma Import (C, Set_TREE_OPERAND); + pragma Import (C, Get_TREE_THIS_VOLATILE); + pragma Import (C, Set_TREE_THIS_VOLATILE); + pragma Import (C, Get_TREE_PURPOSE); + pragma Import (C, Get_TREE_VALUE); + pragma Import (C, Get_TREE_USED); + pragma Import (C, Set_TREE_USED); + + pragma Import (C, Get_TREE_INT_CST_LOW); + pragma Import (C, Get_TREE_INT_CST_HIGH); + + pragma Import (C, Get_CONSTRUCTOR_ELTS); + pragma Import (C, Set_TYPE_VALUES); + pragma Import (C, Set_TYPE_NAME); + pragma Import (C, Get_TYPE_NAME); + pragma Import (C, Set_TYPE_MIN_VALUE); + pragma Import (C, Get_TYPE_MIN_VALUE); + pragma Import (C, Set_TYPE_MAX_VALUE); + pragma Import (C, Get_TYPE_MAX_VALUE); + pragma Import (C, Set_TYPE_SIZE); + pragma Import (C, Get_TYPE_SIZE); + pragma Import (C, Set_TYPE_PRECISION); + pragma Import (C, Get_TYPE_PRECISION); + pragma Import (C, Set_TYPE_FIELDS); + pragma Import (C, Get_TYPE_FIELDS); + pragma Import (C, Set_TYPE_STUB_DECL); + pragma Import (C, Set_TYPE_LANG_SPECIFIC); + pragma Import (C, Get_TYPE_LANG_SPECIFIC); + pragma Import (C, Get_TYPE_IS_SIZETYPE); + pragma Import (C, Get_TYPE_DOMAIN); + pragma Import (C, Set_TYPE_DOMAIN); + pragma Import (C, Get_TYPE_POINTER_TO); + pragma Import (C, Set_TYPE_POINTER_TO); + pragma Import (C, Get_TYPE_SIZE_UNIT); + pragma Import (C, INTEGRAL_TYPE_P); + pragma Import (C, Set_TYPE_MODE); + pragma Import (C, Get_TYPE_MODE); + + pragma Import (C, Set_DECL_ARG_TYPE); + pragma Import (C, Set_DECL_EXTERNAL); + pragma Import (C, Get_DECL_EXTERNAL); + pragma Import (C, Set_DECL_ARGUMENTS); + pragma Import (C, Get_DECL_ARGUMENTS); + pragma Import (C, Set_DECL_RESULT); + pragma Import (C, Get_DECL_RESULT); + pragma Import (C, Set_DECL_CONTEXT); + pragma Import (C, Get_DECL_CONTEXT); + pragma Import (C, Get_DECL_INITIAL); + pragma Import (C, Set_DECL_INITIAL); + pragma Import (C, Get_DECL_NAME); + pragma Import (C, Set_DECL_ASSEMBLER_NAME, "set_DECL_ASSEMBLER_NAME"); + pragma Import (C, Get_DECL_ASSEMBLER_NAME); + pragma Import (C, Set_DECL_BUILT_IN_CLASS); + pragma Import (C, Set_DECL_FUNCTION_CODE); + pragma Import (C, Get_DECL_FIELD_OFFSET); + pragma Import (C, Get_DECL_FIELD_BIT_OFFSET); + + pragma Import (C, Get_BLOCK_SUPERCONTEXT); + pragma Import (C, Set_BLOCK_SUPERCONTEXT); + pragma Import (C, Set_BLOCK_VARS); + + pragma Import (C, Get_IDENTIFIER_LENGTH); + pragma Import (C, Get_IDENTIFIER_POINTER); + + pragma Import (C, Build_Common_Tree_Nodes); + pragma Import (C, Build_Common_Tree_Nodes_2); + + pragma Import (C, Input_Filename); + pragma Import (C, Main_Input_Filename); + pragma Import (C, Lineno); + + pragma Import (C, Tree_Identifier_Size); + + pragma Import (C, Make_Decl_Rtl); +end Agcc.Trees; diff --git a/ortho/agcc/agcc.adb b/ortho/agcc/agcc.adb new file mode 100644 index 000000000..da2fe437e --- /dev/null +++ b/ortho/agcc/agcc.adb @@ -0,0 +1,23 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +package body Agcc is + function "+" (B : C_Bool) return Boolean is + begin + return B /= C_False; + end "+"; +end Agcc; diff --git a/ortho/agcc/agcc.ads b/ortho/agcc/agcc.ads new file mode 100644 index 000000000..c21745c03 --- /dev/null +++ b/ortho/agcc/agcc.ads @@ -0,0 +1,45 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with System; +with Interfaces.C; + +package Agcc is + pragma Pure (Agcc); + + subtype Chars is System.Address; + NULL_Chars : Chars renames System.Null_Address; + + Nul : constant Character := Character'Val (0); + + -- Names size_t. + type Size_T is new Interfaces.C.size_t; + + -- Ada representation of boolean type in C. + -- Never compare with C_TRUE, since in C any value different from 0 is + -- considered as true. + type C_Bool is new Integer; + pragma Convention (C, C_Bool); + + subtype C_Boolean is C_Bool range 0 .. 1; + + C_False : constant C_Bool := 0; + C_True : constant C_Bool := 1; + + function "+" (B : C_Bool) return Boolean; + pragma Inline ("+"); +end Agcc; diff --git a/ortho/agcc/agcc.sed b/ortho/agcc/agcc.sed new file mode 100644 index 000000000..9252e4a45 --- /dev/null +++ b/ortho/agcc/agcc.sed @@ -0,0 +1,23 @@ +# SED script used to extract lines enclosed in /* BEGIN ... END */ of a +# gnatbind C generated files. +# Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold + +# If the current line starts with /* BEGIN, read next line and go to keep. +\@/* BEGIN@ { + n + b keep +} +# The current line is discarded, and a the cycle is restarted. +d + +# keep the lines. +: keep +# If the current line starts with END, then it is removed and a new cycle is +# started. +\@ END@ d +# Print the current line +p +# Read the next line +n +# Go to keep. +b keep diff --git a/ortho/agcc/c.adb b/ortho/agcc/c.adb new file mode 100644 index 000000000..1b8863600 --- /dev/null +++ b/ortho/agcc/c.adb @@ -0,0 +1,55 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Unchecked_Conversion; +with System; + +package body C is + function C_String_Len (Str : C_String) return Natural is + begin + if Str = null then + return 0; + end if; + for I in Str'Range loop + if Str (I) = Character'Val (0) then + return I - 1; + end if; + end loop; + raise Program_Error; + end C_String_Len; + + function Image (Str : C_Str_Len) return String is + begin + if Str.Str = null then + return ''' & Character'Val (Str.Len) & '''; + else + return Str.Str (1 .. Str.Len); + end if; + end Image; + + function To_C_String (Acc : access String) return C_String + is + function Unchecked_Conversion is new Ada.Unchecked_Conversion + (Source => System.Address, Target => C_String); + begin + -- Check ACC is nul-terminated. + if Acc (Acc.all'Last) /= Character'Val (0) then + raise Program_Error; + end if; + return Unchecked_Conversion (Acc (Acc.all'First)'Address); + end To_C_String; +end C; diff --git a/ortho/agcc/c.ads b/ortho/agcc/c.ads new file mode 100644 index 000000000..01ff03078 --- /dev/null +++ b/ortho/agcc/c.ads @@ -0,0 +1,64 @@ +-- Ada bindings for GCC internals. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Unchecked_Conversion; +with System; + +package C is + pragma Preelaborate (C); + + -- Representation of a C String: this is an access to a bounded string. + -- Therefore, with GNAT, such an access is a thin pointer. + subtype Fat_C_String is String (Positive); + type C_String is access all Fat_C_String; + pragma Convention (C, C_String); + + -- Convert an address to a C_STRING. + function To_C_String is new Ada.Unchecked_Conversion + (Source => System.Address, Target => C_String); + + -- NULL for a string. + C_String_Null : constant C_String; + + -- Convert an Ada access string to a C_String. + -- This simply takes the address of the first character of ACC. This + -- is unchecked, so be careful with the life of ACC. + -- The last element of the string designated by ACC must be the NUL-char. + -- This is a little bit more restrictive than being only NUL-terminated. + function To_C_String (Acc : access String) return C_String; + + -- Return the length of a C String (ie, the number of characters before + -- the Nul). + function C_String_Len (Str : C_String) return Natural; + + -- An (very large) array of C String. This is the type of ARGV. + type C_String_Array is array (Natural) of C_String; + pragma Convention (C, C_String_Array); + + -- A structure for a string (len and address). + type C_Str_Len is record + Len : Natural; + Str : C_String; + end record; + pragma Convention (C_Pass_By_Copy, C_Str_Len); + + type C_Str_Len_Acc is access C_Str_Len; + + function Image (Str : C_Str_Len) return String; +private + C_String_Null : constant C_String := null; +end C; diff --git a/ortho/agcc/gen_tree.c b/ortho/agcc/gen_tree.c new file mode 100644 index 000000000..ff826b408 --- /dev/null +++ b/ortho/agcc/gen_tree.c @@ -0,0 +1,575 @@ +/* Ada bindings for GCC internals - generate Ada files. + Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free + Software Foundation, 59 Temple Place - Suite 330, Boston, MA + 02111-1307, USA. +*/ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tm.h" +#include "flags.h" +#include "tree.h" +#include "real.h" +#include "options.h" +#undef abort + +static const char *progname; + +/* Taken from tree.h. */ + + +#define XSTR(X) #X +#define STR(X) XSTR(X) +static const char *treecode_sym[] = +{ +#define DEFTREECODE(SYM, STRING, TYPE, NARGS) #SYM, +#include "tree.def" +#undef DEFTREECODE + NULL +}; + +static const char *treecode_string[] = +{ +#define DEFTREECODE(SYM, STRING, TYPE, NARGS) STRING, +#include "tree.def" +#undef DEFTREECODE + NULL +}; + +void +gen_tree_code (void) +{ + int i, j; + size_t len; + const size_t indent = 24; + + for (i = 0; treecode_sym[i] != NULL; i++) + { + len = strlen (treecode_sym[i]); + printf (" %s, ", treecode_sym[i]); + for (j = len; j < indent; j++) + putchar (' '); + printf ("-- %s\n", treecode_string[i]); + } + printf (" LAST_AND_UNUSED_TREE_CODE\n"); +} + +static const char *built_in_function_sym[] = +{ +#if 0 +#define DEF_BUILTIN(x) #x, +#else +#define DEF_BUILTIN(ENUM, N, C, T, LT, B, F, NA, ATTR, IMP) #ENUM, +#endif +#include "builtins.def" +#undef DEF_BUILTIN + NULL +}; + +static void +print_underscore (const char *sym) +{ + for (; *sym != 0; sym++) + { + if (sym[0] == '_' && (sym[1] == '_' || sym[1] == 0)) + fputs ("_u", stdout); + else + fputc (sym[0], stdout); + } +} + +void +gen_built_in_function (void) +{ + int i; + + for (i = 0; built_in_function_sym[i] != NULL; i++) + { + fputs (" ", stdout); + print_underscore (built_in_function_sym[i]); + fputs (",\n", stdout); + } + + printf (" END_BUILTINS\n"); +} + +#if 0 +static const char *machmode_sym[] = +{ +#if 0 +#define DEF_MACHMODE(SYM, NAME, TYPE, BITSIZE, SIZE, UNIT, WIDER) #SYM, +#else +#define DEF_MACHMODE(SYM, NAME, TYPE, BITSIZE, SIZE, UNIT, WIDER, INNER) \ + #SYM, +#endif +#include "machmode.def" +#undef DEF_MACHMODE + NULL +}; +#endif + +static void +gen_machmode (void) +{ + int i; + char line[128]; + FILE *f; + int do_emit; + char *p; + + f = fopen ("insn-modes.h", "r"); + if (f == NULL) + { + fprintf (stderr, "cannot open insn-modes\n"); + exit (1); + } + + do_emit = 0; + while (1) + { + if (fgets (line, sizeof (line), f) == NULL) + break; + if (!do_emit) + { + if (strncmp (line, "enum machine_mode", 17) == 0) + do_emit = 1; + } + else if (memcmp (line, " MAX_MACHINE_MODE,", 19) == 0) + { + fclose (f); + break; + } + else + { + /* Search for " [A-Z0-9_]*mode,". */ + p = line; + if (p[0] != ' ' || p[1] != ' ') + continue; + p += 2; + while ((*p >= 'A' && *p <= 'Z') + || (*p >= '0' && *p <= '9') + || (*p == '_')) + p++; + if (memcmp (p, "mode,", 5) == 0) + { + p[4] = 0; + printf (" %s,\n", line + 2); + } + } + + } + printf (" MAX_MACHINE_MODE\n"); +} + +static void +gen_options_CL (void) +{ + printf (" CL_C : constant Integer := %d;\n", CL_C); + printf (" CL_vhdl : constant Integer := %d;\n", CL_vhdl); +} + +static void +gen_options_OPTs (void) +{ + char line[128]; + FILE *f; + int do_emit; + char *p; + + f = fopen ("options.h", "r"); + if (f == NULL) + { + fprintf (stderr, "cannot open options.h\n"); + exit (1); + } + + do_emit = 0; + while (1) + { + if (fgets (line, sizeof (line), f) == NULL) + break; + if (!do_emit) + { + if (strncmp (line, "enum opt_code", 13) == 0) + do_emit = 1; + } + else if (memcmp (line, " N_OPTS", 9) == 0) + { + fclose (f); + break; + } + else + { + /* Search for " [A-Z0-9]*mode,". */ + p = line; + if (memcmp (p, " OPT_", 6) != 0) + continue; + printf (" OPT"); + for (p = line + 5; *p != ','; p++) + { + if (p[0] == '_' && (p[1] == ',' || p[1] == '_')) + fputs ("_U", stdout); + else + { + if (p[0] >= 'A' && p[0] <= 'Z') + putchar ('U'); + putchar (p[0]); + } + } + printf (",\n"); + } + + } + printf (" N_OPTS\n"); +} + +struct xtab_t +{ + int val; + const char *name; +}; + +void +gen_enumeration (const struct xtab_t *xtab, int max, const char *max_name) +{ + int i; + + for (i = 0; i < max; i++) + { + const struct xtab_t *t; + + for (t = xtab; t->name; t++) + if (t->val == i) + break; + + if (t->name == NULL) + { + fprintf (stderr, "gen_enumeration: kind %d unknown (max is %s)\n", + i, max_name); + exit (1); + } + + printf (" %s,\n", t->name); + } + printf (" %s\n", max_name); +} + +const struct xtab_t size_type_names[] = +{ + { SIZETYPE, "TK_SIZETYPE" }, + { SSIZETYPE, "TK_SSIZETYPE" }, + { USIZETYPE, "TK_USIZETYPE" }, + { BITSIZETYPE, "TK_BITSIZETYPE" }, + { SBITSIZETYPE, "TK_SBITSIZETYPE" }, + { UBITSIZETYPE, "TK_UBITSIZETYPE" }, + { 0, NULL} +}; + +static void +gen_size_type (void) +{ + gen_enumeration (size_type_names, TYPE_KIND_LAST, "TYPE_KIND_LAST"); +} + + +const struct xtab_t type_qual_tab[] = +{ + { TYPE_UNQUALIFIED, "TYPE_UNQUALIFIED" }, + { TYPE_QUAL_CONST, "TYPE_QUAL_CONST" }, + { TYPE_QUAL_VOLATILE, "TYPE_QUAL_VOLATILE" }, + { TYPE_QUAL_RESTRICT, "TYPE_QUAL_RESTRICT" }, + { 0, NULL} +}; + +void +gen_type_qual (void) +{ + const struct xtab_t *t; + for (t = type_qual_tab; t->name; t++) + printf (" %s : constant Type_Qual_Type := %d;\n", t->name, t->val); +} + +const struct xtab_t tree_index_tab[] = +{ + /* Defined in tree.h */ + { TI_ERROR_MARK, "TI_ERROR_MARK" }, + { TI_INTQI_TYPE, "TI_INTQI_TYPE" }, + { TI_INTHI_TYPE, "TI_INTHI_TYPE" }, + { TI_INTSI_TYPE, "TI_INTSI_TYPE" }, + { TI_INTDI_TYPE, "TI_INTDI_TYPE" }, + { TI_INTTI_TYPE, "TI_INTTI_TYPE" }, + + { TI_UINTQI_TYPE, "TI_UINTQI_TYPE" }, + { TI_UINTHI_TYPE, "TI_UINTHI_TYPE" }, + { TI_UINTSI_TYPE, "TI_UINTSI_TYPE" }, + { TI_UINTDI_TYPE, "TI_UINTDI_TYPE" }, + { TI_UINTTI_TYPE, "TI_UINTTI_TYPE" }, + + { TI_INTEGER_ZERO, "TI_INTEGER_ZERO" }, + { TI_INTEGER_ONE, "TI_INTEGER_ONE" }, + { TI_INTEGER_MINUS_ONE, "TI_INTEGER_MINUS_ONE" }, + { TI_NULL_POINTER, "TI_NULL_POINTER" }, + + { TI_SIZE_ZERO, "TI_SIZE_ZERO" }, + { TI_SIZE_ONE, "TI_SIZE_ONE" }, + + { TI_BITSIZE_ZERO, "TI_BITSIZE_ZERO" }, + { TI_BITSIZE_ONE, "TI_BITSIZE_ONE" }, + { TI_BITSIZE_UNIT, "TI_BITSIZE_UNIT" }, + + { TI_PUBLIC, "TI_PUBLIC" }, + { TI_PROTECTED, "TI_PROTECTED" }, + { TI_PRIVATE, "TI_PRIVATE" }, + + { TI_BOOLEAN_FALSE, "TI_BOOLEAN_FALSE" }, + { TI_BOOLEAN_TRUE, "TI_BOOLEAN_TRUE" }, + + { TI_COMPLEX_INTEGER_TYPE, "TI_COMPLEX_INTEGER_TYPE" }, + { TI_COMPLEX_FLOAT_TYPE, "TI_COMPLEX_FLOAT_TYPE" }, + { TI_COMPLEX_DOUBLE_TYPE, "TI_COMPLEX_DOUBLE_TYPE" }, + { TI_COMPLEX_LONG_DOUBLE_TYPE, "TI_COMPLEX_LONG_DOUBLE_TYPE" }, + + { TI_FLOAT_TYPE, "TI_FLOAT_TYPE" }, + { TI_DOUBLE_TYPE, "TI_DOUBLE_TYPE" }, + { TI_LONG_DOUBLE_TYPE, "TI_LONG_DOUBLE_TYPE" }, + + { TI_FLOAT_PTR_TYPE, "TI_FLOAT_PTR_TYPE" }, + { TI_DOUBLE_PTR_TYPE, "TI_DOUBLE_PTR_TYPE" }, + { TI_LONG_DOUBLE_PTR_TYPE, "TI_LONG_DOUBLE_PTR_TYPE" }, + { TI_INTEGER_PTR_TYPE, "TI_INTEGER_PTR_TYPE" }, + + { TI_VOID_TYPE, "TI_VOID_TYPE" }, + { TI_PTR_TYPE, "TI_PTR_TYPE" }, + { TI_CONST_PTR_TYPE, "TI_CONST_PTR_TYPE" }, + { TI_SIZE_TYPE, "TI_SIZE_TYPE" }, + { TI_PTRDIFF_TYPE, "TI_PTRDIFF_TYPE" }, + { TI_VA_LIST_TYPE, "TI_VA_LIST_TYPE" }, + { TI_BOOLEAN_TYPE, "TI_BOOLEAN_TYPE" }, + + { TI_VOID_LIST_NODE, "TI_VOID_LIST_NODE" }, + + { TI_UV4SF_TYPE, "TI_UV4SF_TYPE" }, + { TI_UV4SI_TYPE, "TI_UV4SI_TYPE" }, + { TI_UV8HI_TYPE, "TI_UV8HI_TYPE" }, + { TI_UV8QI_TYPE, "TI_UV8QI_TYPE" }, + { TI_UV4HI_TYPE, "TI_UV4HI_TYPE" }, + { TI_UV2HI_TYPE, "TI_UV2HI_TYPE" }, + { TI_UV2SI_TYPE, "TI_UV2SI_TYPE" }, + { TI_UV2SF_TYPE, "TI_UV2SF_TYPE" }, + { TI_UV2DI_TYPE, "TI_UV2DI_TYPE" }, + { TI_UV1DI_TYPE, "TI_UV1DI_TYPE" }, + { TI_UV16QI_TYPE, "TI_UV16QI_TYPE" }, + + { TI_V4SF_TYPE, "TI_V4SF_TYPE" }, + { TI_V16SF_TYPE, "TI_V16SF_TYPE" }, + { TI_V4SI_TYPE, "TI_V4SI_TYPE" }, + { TI_V8HI_TYPE, "TI_V8HI_TYPE" }, + { TI_V8QI_TYPE, "TI_V8QI_TYPE" }, + { TI_V4HI_TYPE, "TI_V4HI_TYPE" }, + { TI_V2HI_TYPE, "TI_V2HI_TYPE" }, + { TI_V2SI_TYPE, "TI_V2SI_TYPE" }, + { TI_V2SF_TYPE, "TI_V2SF_TYPE" }, + { TI_V2DF_TYPE, "TI_V2DF_TYPE" }, + { TI_V2DI_TYPE, "TI_V2DI_TYPE" }, + { TI_V1DI_TYPE, "TI_V1DI_TYPE" }, + { TI_V16QI_TYPE, "TI_V16QI_TYPE" }, + { TI_V4DF_TYPE, "TI_V4DF_TYPE" }, + + { TI_MAIN_IDENTIFIER, "TI_MAIN_IDENTIFIER" }, + + { 0, NULL } +}; + +const struct xtab_t integer_types_tab[] = +{ + { itk_char, "itk_char" }, + { itk_signed_char, "itk_signed_char" }, + { itk_unsigned_char, "itk_unsigned_char" }, + { itk_short, "itk_short" }, + { itk_unsigned_short, "itk_unsigned_short" }, + { itk_int, "itk_int" }, + { itk_unsigned_int, "itk_unsigned_int" }, + { itk_long, "itk_long" }, + { itk_unsigned_long, "itk_unsigned_long" }, + { itk_long_long, "itk_long_long" }, + { itk_unsigned_long_long, "itk_unsigned_long_long" }, + { 0, NULL } +}; + + +void +gen_tree_index (void) +{ + gen_enumeration (tree_index_tab, TI_MAX, "TI_MAX"); +} + +void +gen_integer_types (void) +{ + gen_enumeration (integer_types_tab, itk_none, "itk_none"); +} + +static void +gen_host_wide_int_decl (void) +{ + int l; + switch (sizeof (HOST_WIDE_INT)) + { + case 4: + l = 32; + break; + case 8: + l = 64; + break; + default: + fprintf (stderr, "%s: cannot handle sizeof (HOST_WIDE_INT) %d\n", + progname, sizeof (HOST_WIDE_INT)); + exit (1); + } + printf (" type HOST_WIDE_INT is new Interfaces.Integer_%d;\n", l); + printf (" type UNSIGNED_HOST_WIDE_INT is new Interfaces.Unsigned_%d;\n", + l); +} + +static void +gen_host_big_endian (void) +{ +#ifdef HOST_WORDS_BIG_ENDIAN + printf (" HOST_WORDS_BIG_ENDIAN : constant Boolean := True;\n"); +#else + printf (" HOST_WORDS_BIG_ENDIAN : constant Boolean := False;\n"); +#endif +} + +static void +gen_real (void) +{ + printf (" type Real_Value_Type_Arr is array (0 .. %d) of HOST_WIDE_INT;\n", + (sizeof (REAL_VALUE_TYPE) / sizeof (HOST_WIDE_INT)) - 1); + printf (" type REAL_VALUE_TYPE is record\n" + " r : Real_Value_Type_Arr;\n" + " end record;\n"); +} + +static void +gen_tm (void) +{ +#ifndef MAX_BITS_PER_WORD +#define MAX_BITS_PER_WORD BITS_PER_WORD +#endif + /* This is a constant. */ + printf (" MAX_BITS_PER_WORD : constant Natural := %d;\n", + MAX_BITS_PER_WORD); +} + +int +main (int argc, char *argv[]) +{ + FILE *infile; + char line[2048]; + const char *filename; + int c; + + progname = argv[0]; + + while ((c = getopt (argc, argv, "C:")) != -1) + switch (c) + { + case 'C': + chdir (optarg); + break; + case '?': + fprintf (stderr, "%s: unknown option '%s'\n", progname, optopt); + exit (1); + default: + abort (); + } + + if (argc - optind != 1) + { + fprintf (stderr, "usage: %s FILENAME\n", progname); + exit (1); + } + filename = argv[optind]; + if (strcmp (filename, "-") == 0) + infile = stdin; + else + infile = fopen (filename, "r"); + if (infile == NULL) + { + fprintf (stderr, "%s: cannot open %s (%s)\n", progname, filename, + strerror (errno)); + exit (1); + } +#if 0 +#ifdef REAL_IS_NOT_DOUBLE + printf ("-- REAL_IS_NOT_DOUBLE is not yet implemented\n"); + printf ("You loose\n"); + return 1; +#endif +#endif + printf ("-- Automatically generated by %s\n", progname); + printf ("-- from %s\n", filename); + printf ("-- DO NOT EDIT THIS FILE\n"); + + while (fgets (line, sizeof (line), infile) != NULL) + { + if (line[0] != '@') + fputs (line, stdout); + else + { + char *p; + + for (p = line + 1; isalpha (*p) || *p == '_'; p++) + ; + *p = 0; + + if (!strcmp (line, "@tree_code")) + gen_tree_code (); + else if (!strcmp (line, "@built_in_function")) + gen_built_in_function (); + else if (!strcmp (line, "@size_type_kind")) + gen_size_type (); + else if (!strcmp (line, "@type_qual")) + gen_type_qual (); + else if (!strcmp (line, "@host_wide_int")) + gen_host_wide_int_decl (); + else if (!strcmp (line, "@tree_index")) + gen_tree_index (); + else if (!strcmp (line, "@integer_types")) + gen_integer_types (); + else if (!strcmp (line, "@host_big_endian")) + gen_host_big_endian (); + else if (!strcmp (line, "@real")) + gen_real (); + else if (!strcmp (line, "@machmode")) + gen_machmode (); + else if (!strcmp (line, "@tm")) + gen_tm (); + else if (!strcmp (line, "@options_CL")) + gen_options_CL (); + else if (!strcmp (line, "@options_OPTs")) + gen_options_OPTs (); + else + { + fprintf (stderr, "unknown code `%s'\n", line); + exit (1); + } + } + } + return 0; +} diff --git a/ortho/gcc/Makefile b/ortho/gcc/Makefile new file mode 100644 index 000000000..9f8b327a8 --- /dev/null +++ b/ortho/gcc/Makefile @@ -0,0 +1,50 @@ +# Makefile of ortho implementation for GCC. +# Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +# Software Foundation, 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. +ortho_srcdir=.. +orthobe_srcdir=$(ortho_srcdir)/gcc +agcc_srcdir=$(ortho_srcdir)/agcc +agcc_objdir=. +AGCC_GCCSRC_DIR:=$(HOME)/dist/gcc-3.4.3 +AGCC_GCCOBJ_DIR:=$(AGCC_GCCSRC_DIR)-objs +SED=sed + +all: $(ortho_exec) + +include $(agcc_srcdir)/Makefile.inc + +ORTHO_BASENAME=$(orthobe_srcdir)/ortho_gcc +ORTHO_PACKAGE=Ortho_Gcc + +include $(ortho_srcdir)/Makefile.inc + +$(ortho_exec): $(AGCC_DEPS) $(ORTHO_BASENAME).ads force + gnatmake -m -o $@ -g -aI$(agcc_srcdir) -aI$(ortho_srcdir) \ + -aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \ + -bargs -E -largs $(AGCC_OBJS) #-static + +clean: agcc-clean + $(RM) -f *.o *.ali ortho_nodes-main + $(RM) b~*.ad? *~ + +distclean: clean agcc-clean + + +force: + +.PHONY: force all clean + diff --git a/ortho/gcc/agcc-fe.adb b/ortho/gcc/agcc-fe.adb new file mode 100644 index 000000000..75ba79549 --- /dev/null +++ b/ortho/gcc/agcc-fe.adb @@ -0,0 +1,776 @@ +-- Ortho implementation for GCC. +-- Copyright (C) 2002, 2003, 2004, 2005 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 COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Unchecked_Deallocation; +--with Agcc.Ggc; use Agcc.Ggc; +with Agcc.Tm; use Agcc.Tm; +with Agcc.Machmode; use Agcc.Machmode; +with Agcc.Diagnostic; +with Agcc.Input; use Agcc.Input; +with Agcc.Options; use Agcc.Options; +with Ortho_Gcc; +with Ortho_Gcc_Front; use Ortho_Gcc_Front; + +package body Agcc.Fe is + File_Name : String_Acc; + + Stdin_Filename : String_Acc := new String'("*stdin*" & Nul); + + function Lang_Init_Options (Argc : Integer; Argv : C_String_Array) + return Integer + is + pragma Unreferenced (Argc); + pragma Unreferenced (Argv); + begin + return CL_vhdl; + end Lang_Init_Options; + + function Lang_Handle_Option (Code : Opt_Code; + Arg : C_String; + Value : Integer) + return Integer + is + pragma Unreferenced (Value); + --type String_Acc_Array_Acc is access String_Acc_Array; + + procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation + (Name => String_Acc, Object => String); + --procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation + -- (Name => String_Acc_Array_Acc, Object => String_Acc_Array); + + --C_Opt : C_String := Argv (0); + --C_Arg : C_String; + --Opt : String := C_Opt (1 .. C_String_Len (C_Opt)); + Res : Natural; + Opt : String_Acc; + Opt_Arg : String_Acc; + Len : Natural; + begin + if Arg /= C_String_Null then + Len := C_String_Len (Arg); + else + Len := 0; + end if; + Opt_Arg := null; + case Code is + when OPT_U_std_U => + Opt := new String'("--std=" & Arg (1 .. Len)); + when OPT_U_compile_standard => + Opt := new String'("--compile-standard"); + when OPT_U_bootstrap => + Opt := new String'("--bootstrap"); + when OPT_U_work_U => + Opt := new String'("--work=" & Arg (1 .. Len)); + when OPT_U_workdir_U => + Opt := new String'("--workdir=" & Arg (1 .. Len)); + when OPT_UP => + Opt := new String'("-P" & Arg (1 .. Len)); + when OPT_U_elab => + Opt := new String'("--elab"); + Opt_Arg := new String'(Arg (1 .. Len)); + when OPT_U_anaelab => + Opt := new String'("--anaelab"); + Opt_Arg := new String'(Arg (1 .. Len)); + when OPT_l => + Opt := new String'("-l"); + Opt_Arg := new String'(Arg (1 .. Len)); + when OPT_c => + Opt := new String'("-c"); + Opt_Arg := new String'(Arg (1 .. Len)); + when OPT_U_ghdl => + Opt := new String'(Arg (1 .. Len)); + when OPT_U_warn_U => + Opt := new String'("--warn-" & Arg (1 .. Len)); + when OPT_U_expect_failure => + Opt := new String'("--expect-failure"); + when OPT_U_no_vital_checks => + Opt := new String'("--no-vital-checks"); + when OPT_U_vital_checks => + Opt := new String'("--vital-checks"); + when OPT_fexplicit => + Opt := new String'("-fexplicit"); + when OPT_v => + Opt := new String'("-v"); + when others => + return 0; + end case; + Res := Ortho_Gcc_Front.Decode_Option (Opt, Opt_Arg); + Unchecked_Deallocation (Opt); + Unchecked_Deallocation (Opt_Arg); + return Res; + end Lang_Handle_Option; + + function Lang_Post_Options (Filename : C_String_Acc) return C_Bool + is + Filename_Len : Natural; + begin + if Filename.all = C_String_Null then + File_Name := null; + Filename.all := To_C_String (Stdin_Filename); + else + Filename_Len := C_String_Len (Filename.all); + File_Name := new String'(Filename.all (1 .. Filename_Len)); + end if; + + -- Run the back-end. + return C_False; + end Lang_Post_Options; + + + procedure Lang_Parse_File (Debug : C_Bool) + is + pragma Unreferenced (Debug); + begin + if not Ortho_Gcc_Front.Parse (File_Name) then + Agcc.Diagnostic.Set_Errorcount (1); + end if; + end Lang_Parse_File; + + function Lang_Get_Alias_Set (T : Tree) return HOST_WIDE_INT + is + pragma Unreferenced (T); + begin + return -1; + end Lang_Get_Alias_Set; + + --function Lang_Safe_From_P (Target : Rtx; Exp : Tree) return Boolean; + + function Mark_Addressable (Exp : Tree) return C_Bool + is + N : Tree; + Code : Tree_Code; + begin + N := Exp; + loop + Code := Get_TREE_CODE (N); + case Code is + when VAR_DECL + | CONST_DECL + | PARM_DECL + | RESULT_DECL => + Put_Var_Into_Stack (N, C_True); + Set_TREE_ADDRESSABLE (N, C_True); + return C_True; + + when COMPONENT_REF + | ARRAY_REF => + N := Get_TREE_OPERAND (N, 0); + + when FUNCTION_DECL + | CONSTRUCTOR => + Set_TREE_ADDRESSABLE (N, C_True); + return C_True; + + when INDIRECT_REF => + return C_True; + + when others => + raise Program_Error; + end case; + end loop; + end Mark_Addressable; + + procedure Insert_Default_Attributes (Func : Tree) + is + pragma Unreferenced (Func); + begin + null; + end Insert_Default_Attributes; + + -- These functions and variables deal with binding contours. + + -- For each binding contour we allocate a binding_level structure which + -- records the entities defined or declared in that contour. + -- Contours include: + -- + -- the global one + -- one for each subprogram definition + -- one for each compound statement (declare block) + -- + -- Binding contours are used to create GCC tree BLOCK nodes. + + -- BE CAREFUL: this structure is also declared in agcc-bindings.c + type Binding_Level; + type Binding_Level_Acc is access Binding_Level; + type Binding_Level is record + -- A chain of ..._DECL nodes for all variables, constants, functions, + -- parameters and type declarations. These ..._DECL nodes are chained + -- through the TREE_CHAIN field. Note that these ..._DECL nodes are + -- stored in the reverse of the order supplied to be compatible with + -- the back-end. + Names : Tree; + + -- For each level (except the global one), a chain of BLOCK nodes for + -- all the levels that were entered and exited one level down from this + -- one. + Blocks : Tree; + + -- The back end may need, for its own internal processing, to create a + -- BLOCK node. This field is set aside for this purpose. If this field + -- is non-null when the level is popped, i.e. when poplevel is invoked, + -- we will use such block instead of creating a new one from the + -- 'names' field, that is the ..._DECL nodes accumulated so far. + -- Typically the routine 'pushlevel' will be called before setting this + -- field, so that if the front-end had inserted ..._DECL nodes in the + -- current block they will not be lost. + Block_Created_By_Back_End : Tree; + + -- The binding level containing this one (the enclosing binding level). + Level_Chain : Binding_Level_Acc; + end record; + pragma Convention (C, Binding_Level_Acc); + pragma Convention (C, Binding_Level); + + -- The binding level currently in effect. + Current_Binding_Level : Binding_Level_Acc := null; + pragma Export (C, Current_Binding_Level); + + -- The outermost binding level. This binding level is created when the + -- compiler is started and it will exist through the entire compilation. + Global_Binding_Level : Binding_Level_Acc; + + -- Chain of unused binding levels, since they are never deallocated. + Old_Binding_Level : Binding_Level_Acc := null; + pragma Export (C, Old_Binding_Level); + + function Alloc_Binding_Level return Binding_Level_Acc; + pragma Import (C, Alloc_Binding_Level); + + -- Binding level structures are initialized by copying this one. + Clear_Binding_Level : constant Binding_Level := + (Names => NULL_TREE, + Blocks => NULL_TREE, + Block_Created_By_Back_End => NULL_TREE, + Level_Chain => null); + + -- Return non-zero if we are currently in the global binding level. + function Global_Bindings_P return Integer is + begin + if Current_Binding_Level = Global_Binding_Level then + return 1; + else + return 0; + end if; + end Global_Bindings_P; + + -- Return the list of declarations in the current level. Note that this + -- list is in reverse order (it has to be so for back-end compatibility). + function Getdecls return Tree is + begin + return Current_Binding_Level.Names; + end Getdecls; + + -- Nonzero if the current level needs to have a BLOCK made. +-- function Kept_Level_P return Boolean is +-- begin +-- return Current_Binding_Level.Names /= NULL_TREE; +-- end Kept_Level_P; + + -- Enter a new binding level. The input parameter is ignored, but has to + -- be specified for back-end compatibility. + procedure Pushlevel (Inside : C_Bool) + is + pragma Unreferenced (Inside); + Newlevel : Binding_Level_Acc; + + begin + if Old_Binding_Level /= null then + Newlevel := Old_Binding_Level; + Old_Binding_Level := Old_Binding_Level.Level_Chain; + else + Newlevel := Alloc_Binding_Level; + end if; + Newlevel.all := Clear_Binding_Level; + + -- Add this level to the front of the chain (stack) of levels that are + -- active. + Newlevel.Level_Chain := Current_Binding_Level; + Current_Binding_Level := Newlevel; + end Pushlevel; + + -- Exit a binding level. + -- Pop the level off, and restore the state of the identifier-decl mappings + -- that were in effect when this level was entered. + -- + -- If KEEP is nonzero, this level had explicit declarations, so + -- and create a "block" (a BLOCK node) for the level + -- to record its declarations and subblocks for symbol table output. + -- + -- If FUNCTIONBODY is nonzero, this level is the body of a function, + -- so create a block as if KEEP were set and also clear out all + -- label names. + -- + -- If REVERSE is nonzero, reverse the order of decls before putting + -- them into the BLOCK. + function Exported_Poplevel + (Keep : C_Bool; Revers : C_Bool; Functionbody : C_Bool) + return Tree + is + -- Points to a BLOCK tree node. This is the BLOCK node construted for + -- the binding level that we are about to exit and which is returned + -- by this routine. + Block_Node : Tree := NULL_TREE; + + Decl_Chain : Tree; + Subblock_Chain : Tree; + Subblock_Node : Tree; + Block_Created_By_Back_End : Tree; + + N : Tree; + Tmp : Binding_Level_Acc; + begin + Decl_Chain := Current_Binding_Level.Names; + Block_Created_By_Back_End := + Current_Binding_Level.Block_Created_By_Back_End; + Subblock_Chain := Current_Binding_Level.Blocks; + + -- Pop the current level, and save it on the chain of old binding + -- levels. + Tmp := Current_Binding_Level; + Current_Binding_Level := Tmp.Level_Chain; + Tmp.Level_Chain := Old_Binding_Level; + Old_Binding_Level := Tmp; + + -- Reverse the list of XXXX_DECL nodes if desired. Note that + -- the ..._DECL nodes chained through the `names' field of + -- current_binding_level are in reverse order except for PARM_DECL node, + -- which are explicitely stored in the right order. + if Revers /= C_False then + Decl_Chain := Nreverse (Decl_Chain); + end if; + + if Block_Created_By_Back_End /= NULL_TREE then + Block_Node := Block_Created_By_Back_End; + + -- Check if we are about to discard some information that was + -- gathered by the front-end. Nameley check if the back-end created + -- a new block without calling pushlevel first. To understand why + -- things are lost just look at the next case (i.e. no block + -- created by back-end. */ + if (Keep /= C_False or Functionbody /= C_False) + and then (Decl_Chain /= NULL_TREE or Subblock_Chain /= NULL_TREE) + then + raise Program_Error; + end if; + elsif Keep /= C_False or Functionbody /= C_False then + -- If there were any declarations in the current binding level, or if + -- this binding level is a function body, or if there are any nested + -- blocks then create a BLOCK node to record them for the life of + -- this function. + if Keep /= C_False then + N := Decl_Chain; + else + N := NULL_TREE; + end if; + Block_Node := Build_Block + (N, NULL_TREE, Subblock_Chain, NULL_TREE, NULL_TREE); + end if; + + -- Record the BLOCK node just built as the subblock its enclosing scope. + Subblock_Node := Subblock_Chain; + while Subblock_Node /= NULL_TREE loop + Set_BLOCK_SUPERCONTEXT (Subblock_Node, Block_Node); + Subblock_Node := Get_TREE_CHAIN (Subblock_Node); + end loop; + + -- Clear out the meanings of the local variables of this level. + Subblock_Node := Decl_Chain; + while Subblock_Node /= NULL_TREE loop + + if Get_DECL_NAME (Subblock_Node) /= NULL_TREE then + -- If the identifier was used or addressed via a local + -- extern decl, don't forget that fact. + if Get_DECL_EXTERNAL (Subblock_Node) /= C_False then + if Get_TREE_USED (Subblock_Node) /= C_False then + Set_TREE_USED (Get_DECL_NAME (Subblock_Node), C_True); + end if; + if Get_TREE_ADDRESSABLE (Subblock_Node) /= C_False then + Set_TREE_ADDRESSABLE + (Get_DECL_ASSEMBLER_NAME (Subblock_Node), C_True); + end if; + end if; + end if; + Subblock_Node := Get_TREE_CHAIN (Subblock_Node); + end loop; + + if Functionbody /= C_False then + -- This is the top level block of a function. The ..._DECL chain + -- stored in BLOCK_VARS are the function's parameters (PARM_DECL + -- nodes). Don't leave them in the BLOCK because they are found + -- in the FUNCTION_DECL instead. + Set_DECL_INITIAL (Current_Function_Decl, Block_Node); + Set_BLOCK_VARS (Block_Node, NULL_TREE); + elsif Block_Node /= NULL_TREE then + if Block_Created_By_Back_End = NULL_TREE then + Current_Binding_Level.Blocks + := Chainon (Current_Binding_Level.Blocks, Block_Node); + end if; + elsif Subblock_Chain /= NULL_TREE then + -- If we did not make a block for the level just exited, any blocks + -- made for inner levels (since they cannot be recorded as subblocks + -- in that level) must be carried forward so they will later become + -- subblocks of something else. + Current_Binding_Level.Blocks + := Chainon (Current_Binding_Level.Blocks, Subblock_Chain); + end if; + + if Block_Node /= NULL_TREE then + Set_TREE_USED (Block_Node, C_True); + end if; + + return Block_Node; + end Exported_Poplevel; + + -- Insert BLOCK at the end of the list of subblocks of the + -- current binding level. This is used when a BIND_EXPR is expanded, + -- to handle the BLOCK node inside the BIND_EXPR. + procedure Insert_Block (Block : Tree) is + begin + Set_TREE_USED (Block, C_True); + Current_Binding_Level.Blocks + := Chainon (Current_Binding_Level.Blocks, Block); + end Insert_Block; + + -- Set the BLOCK node for the innermost scope (the one we are + -- currently in). + procedure Set_Block (Block : Tree) is + begin + Current_Binding_Level.Block_Created_By_Back_End := Block; + end Set_Block; + + -- Records a ..._DECL node DECL as belonging to the current lexical scope. + -- Returns the ..._DECL node. + function Exported_Pushdecl (Decl : Tree) return Tree + is + begin + -- External objects aren't nested, other objects may be. + if Get_DECL_EXTERNAL (Decl) /= C_False then + Set_DECL_CONTEXT (Decl, NULL_TREE); + else + Set_DECL_CONTEXT (Decl, Current_Function_Decl); + end if; + + -- Put the declaration on the list. The list of declarations is in + -- reverse order. The list will be reversed later if necessary. This + -- needs to be this way for compatibility with the back-end. + Set_TREE_CHAIN (Decl, Current_Binding_Level.Names); + Current_Binding_Level.Names := Decl; + + -- For the declaration of a type, set its name if it is not already set. + if Get_TREE_CODE (Decl) = TYPE_DECL + and then Get_TYPE_NAME (Get_TREE_TYPE (Decl)) = NULL_TREE + then + Set_TYPE_NAME (Get_TREE_TYPE (Decl), Decl); -- DECL_NAME (decl); + end if; + + return Decl; + end Exported_Pushdecl; + + -- This variable keeps a table for types for each precision so that we only + -- allocate each of them once. Signed and unsigned types are kept separate. + type Signed_And_Unsigned_Types_Array_Type is + array (Natural range 0 .. MAX_BITS_PER_WORD, C_Boolean) of Tree; + Signed_And_Unsigned_Types : Signed_And_Unsigned_Types_Array_Type := + (others => (others => NULL_TREE)); + pragma Export (C, Signed_And_Unsigned_Types); + + -- Return an integer type with the number of bits of precision given by + -- PRECISION. UNSIGNEDP is nonzero if the type is unsigned; otherwise + -- it is a signed type. + function Type_For_Size (Precision : Natural; Unsignedp : C_Bool) + return Tree + is + T : Tree; + begin + if Precision <= MAX_BITS_PER_WORD + and then Signed_And_Unsigned_Types (Precision, Unsignedp) /= NULL_TREE + then + return Signed_And_Unsigned_Types (Precision, Unsignedp); + end if; + + if Unsignedp /= C_False then + T := Make_Unsigned_Type (Precision); + else + T := Make_Signed_Type (Precision); + end if; + if Precision <= MAX_BITS_PER_WORD then + Signed_And_Unsigned_Types (Precision, Unsignedp) := T; + end if; + return T; + end Type_For_Size; + + -- Return a data type that has machine mode MODE. UNSIGNEDP selects + -- an unsigned type; otherwise a signed type is returned. + function Type_For_Mode (Mode : Machine_Mode; Unsignedp : C_Bool) + return Tree + is + begin + return Type_For_Size (GET_MODE_BITSIZE (Mode), Unsignedp); + end Type_For_Mode; + + -- Return the unsigned version of a TYPE_NODE, a scalar type. + function Unsigned_Type (Type_Node : Tree) return Tree + is + begin + return Type_For_Size (Get_TYPE_PRECISION (Type_Node), C_True); + end Unsigned_Type; + + -- Return the signed version of a TYPE_NODE, a scalar type. + function Signed_Type (Type_Node : Tree) return Tree + is + begin + return Type_For_Size (Get_TYPE_PRECISION (Type_Node), C_False); + end Signed_Type; + + -- Return a type the same as TYPE except unsigned or signed according to + -- UNSIGNEDP. + function Signed_Or_Unsigned_Type (Unsignedp : C_Bool; Atype : Tree) + return Tree + is + begin + if INTEGRAL_TYPE_P (Atype) = C_False + or else Get_TREE_UNSIGNED (Atype) = Unsignedp + then + return Atype; + else + return Type_For_Size (Get_TYPE_PRECISION (Atype), Unsignedp); + end if; + end Signed_Or_Unsigned_Type; + + + --procedure Init_Type_For_Size; + --pragma Import (C, Init_Type_For_Size); + + Int_Str : constant String := "int" & Nul; + Char_Str : constant String := "char" & Nul; + + Builtin_Alloca_Str : constant String := "__builtin_alloca" & Nul; + + function Lang_Init return C_Bool + is + --File : String renames Filename (1 .. Filename_Len); + Ptr_Ftype_Sizetype : Tree; + Alloca_Function : Tree; + begin + --Error_Mark_Node := Make_Node (ERROR_MARK); + --Set_TREE_TYPE (Error_Mark_Node, Error_Mark_Node); + + --Initialize_Sizetypes; + + -- The structure `tree_identifier' is the GCC tree data structure that + -- holds IDENTIFIER_NODE nodes. We need to call `set_identifier_size' + -- to tell GCC that we have not added any language specific fields to + -- IDENTIFIER_NODE nodes. + --Set_Identifier_Size (Tree_Identifier_Size); + Input_Location.Line := 0; + + -- Make the binding_level structure for global names. + Pushlevel (C_False); + Global_Binding_Level := Current_Binding_Level; + + Build_Common_Tree_Nodes (C_False); + Pushdecl (Build_Decl (TYPE_DECL, Get_Identifier (Int_Str'Address), + Integer_Type_Node)); + Pushdecl (Build_Decl (TYPE_DECL, Get_Identifier (Char_Str'Address), + Char_Type_Node)); + Set_Sizetype (Unsigned_Type_Node); + Build_Common_Tree_Nodes_2 (C_False); + + --Init_Type_For_Size; + + -- Create alloc builtin. + Ptr_Ftype_Sizetype := Build_Function_Type + (Ptr_Type_Node, + Tree_Cons (NULL_TREE, Get_TYPE_DOMAIN (Sizetype), NULL_TREE)); + Alloca_Function := Builtin_Function + (Builtin_Alloca_Str'Address, Ptr_Ftype_Sizetype, + BUILT_IN_ALLOCA, BUILT_IN_NORMAL, System.Null_Address); + Ortho_Gcc.Alloca_Function_Ptr := Build1 + (ADDR_EXPR, Build_Pointer_Type (Ptr_Ftype_Sizetype), Alloca_Function); +-- Ggc_Add_Tree_Root (Ortho_Gcc.Alloca_Function_Ptr'Address, 1); + + Ortho_Gcc.Init; + + -- Continue. + return C_True; + end Lang_Init; + + procedure Lang_Finish is + begin + null; + end Lang_Finish; + + -- Return a definition for a builtin function named NAME and whose data + -- type is TYPE. TYPE should be a function type with argument types. + -- FUNCTION_CODE tells later passes how to compile calls to this function. + -- See tree.h for its possible values. + -- + -- If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME, + -- the name to be called if we can't opencode the function. + function Builtin_Function + (Name: System.Address; + Ftype : Tree; + Function_Code : Built_In_Function; + Class : Built_In_Class; + Library_Name : System.Address) + return Tree + is + use System; + Decl : Tree; + begin + Decl := Build_Decl (FUNCTION_DECL, Get_Identifier (Name), Ftype); + Set_DECL_EXTERNAL (Decl, C_True); + Set_TREE_PUBLIC (Decl, C_True); + if Library_Name /= Null_Address then + Set_DECL_ASSEMBLER_NAME (Decl, Get_Identifier (Library_Name)); + end if; + Make_Decl_Rtl (Decl, NULL_Chars, C_True); + Pushdecl (Decl); + Set_DECL_BUILT_IN_CLASS (Decl, Class); + Set_DECL_FUNCTION_CODE (Decl, Function_Code); + return Decl; + end Builtin_Function; + + procedure Set_Yydebug (Flag : C_Bool) + is + pragma Unreferenced (Flag); + begin + null; + end Set_Yydebug; + + procedure Print_Lang_Decl (File : FILEs; Node : Tree; Indent : natural) + is + pragma Unreferenced (File); + pragma Unreferenced (Node); + pragma Unreferenced (Indent); + begin + null; + end Print_Lang_Decl; + + procedure Print_Lang_Type (File : FILEs; Node : Tree; Indent : Natural) + is + pragma Unreferenced (File); + pragma Unreferenced (Node); + pragma Unreferenced (Indent); + begin + null; + end Print_Lang_Type; + + procedure Print_Lang_Identifier + (File : FILEs; Node : Tree; Indent : Natural) + is + pragma Unreferenced (File); + pragma Unreferenced (Node); + pragma Unreferenced (Indent); + begin + null; + end Print_Lang_Identifier; + + procedure Lang_Print_Xnode (File : FILEs; Node : Tree; Indent : Natural) + is + pragma Unreferenced (File); + pragma Unreferenced (Node); + pragma Unreferenced (Indent); + begin + -- There is no X nodes. + raise Program_Error; + end Lang_Print_Xnode; + + procedure Print_Lang_Statistics is + begin + null; + end Print_Lang_Statistics; + + procedure Copy_Lang_Decl (Node : Tree) + is + pragma Unreferenced (Node); + begin + null; + end Copy_Lang_Decl; + + function Truthvalue_Conversion (Expr : Tree) return Tree + is + Expr_Type : Tree; + type Conv_Array is array (Boolean) of Tree; + Conv : Conv_Array; + begin + Expr_Type := Get_TREE_TYPE (Expr); + if Get_TREE_CODE (Expr_Type) /= BOOLEAN_TYPE then + Conv := (True => Integer_One_Node, + False => Integer_Zero_Node); + else + Conv := (False => Get_TYPE_MIN_VALUE (Expr_Type), + True => Get_TYPE_MAX_VALUE (Expr_Type)); + end if; + + -- From java/decl.c + -- It is simpler and generates better code to have only TRUTH_*_EXPR + -- or comparison expressions as truth values at this level. + + case Get_TREE_CODE (Expr) is + when EQ_EXPR + | NE_EXPR + | LE_EXPR + | GE_EXPR + | LT_EXPR + | GT_EXPR + | TRUTH_ANDIF_EXPR + | TRUTH_ORIF_EXPR + | TRUTH_AND_EXPR + | TRUTH_OR_EXPR + | ERROR_MARK => + return Expr; + + when INTEGER_CST => + if Integer_Zerop (Expr) = C_False then + -- EXPR is not 0, so EXPR is interpreted as TRUE. + return Conv (True); + else + return Conv (False); + end if; + + when REAL_CST => + if Real_Zerop (Expr) = C_False then + return Conv (True); + else + return Conv (False); + end if; + + when others => + raise Program_Error; + end case; + end Truthvalue_Conversion; + + procedure Incomplete_Type_Error (Value : Tree; Atype : Tree) + is + pragma Unreferenced (Value); + pragma Unreferenced (Atype); + begin + -- Can never happen. + raise Program_Error; + end Incomplete_Type_Error; + + function Maybe_Build_Cleanup (Decl : Tree) return Tree + is + pragma Unreferenced (Decl); + begin + return NULL_TREE; + end Maybe_Build_Cleanup; + + Language_Name : constant String := "GNU vhdl" & Nul; + pragma Export (C, Language_Name); +end Agcc.Fe; diff --git a/ortho/gcc/lang.opt b/ortho/gcc/lang.opt new file mode 100644 index 000000000..b2f650aa0 --- /dev/null +++ b/ortho/gcc/lang.opt @@ -0,0 +1,88 @@ +; Options for the VHDL front-end. +; Copyright (C) 2003, 2004, 2005 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 COPYING. If not, write to the Free +; Software Foundation, 59 Temple Place - Suite 330, Boston, MA +; 02111-1307, USA. + +Language +vhdl + +-std= +vhdl Joined +Select the vhdl standard + +-compile-standard +vhdl +Used during compiler build to compile the std.standard package + +-bootstrap +vhdl +Used during compiler build to compile std packages + +-work= +vhdl Joined +Set the name of the work library + +-workdir= +vhdl Joined +Set the directory of the work library + +P +vhdl Joined +-P Add to the end of the vhdl library path + +-elab +vhdl Separate +--elab Used internally during elaboration of + +-anaelab +vhdl Separate +--anaelab Used internally during elaboration of + +c +vhdl Separate +-c Analyze for --anaelab + +v +vhdl +Verbose + +-warn- +vhdl Joined +--warn- Warn about + +-ghdl +vhdl Joined +--ghdl-