diff options
119 files changed, 3266 insertions, 554 deletions
diff --git a/Makefile.in b/Makefile.in index 7cf69b6a6..ddae0c82a 100644 --- a/Makefile.in +++ b/Makefile.in @@ -14,11 +14,14 @@ # You should have received a copy of the GNU General Public License # along with this program. If not, see <gnu.org/licenses>. CC=@CC@ +CFLAGS=@CFLAGS@ CXX=@CXX@ +CXXFLAGS=@CXXFLAGS@ build=@build@ srcdir=@srcdir@ abs_srcdir=@abs_srcdir@ GNATMAKE=@GNATMAKE@ +ADA_FLAGS=@ADA_FLAGS@ MAKE=@MAKE@ prefix=@prefix@ backend=@backend@ @@ -76,11 +79,19 @@ endif # Coverage ifeq "$(build_mode)" "coverage" -OPT_FLAGS+=-fprofile-arcs -ftest-coverage +COVERAGE_FLAGS+=-fprofile-arcs -ftest-coverage endif -GNATFLAGS=-gnat12 -gnaty3befhkmr -gnatwa -gnatwC -gnatf $(OPT_FLAGS) $(ADA_FLAGS) -GRT_FLAGS=$(OPT_FLAGS) +# Warnings as errors. Comment this line if a warning looks not valid. +ifeq "$(enable_werror)" "true" +WARN_ADAFLAGS+=-gnatwe +endif + +WARN_ADAFLAGS+=-gnatwa -gnatwC -gnatf + +GNATFLAGS=-gnat12 -gnaty3befhkmr $(OPT_FLAGS) $(COVERAGE_FLAGS) $(WARN_ADAFLAGS) $(ADA_FLAGS) +GRT_FLAGS=$(COVERAGE_FLAGS) +GRT_ADAFLAGS:=$(OPT_FLAGS) $(WARN_ADAFLAGS) -gnatw.X $(filter-out -gnata,$(ADA_FLAGS)) ifeq "$(default_pic)" "true" GRT_FLAGS+=$(PIC_FLAGS) @@ -88,12 +99,10 @@ endif WARN_CFLAGS=-Wall -GNAT_BARGS=-bargs -E +CFLAGS:=$(OPT_FLAGS) $(WARN_CFLAGS) $(CFLAGS) +CXXFLAGS:=$(OPT_FLAGS) $(WARN_CFLAGS) $(CXXFLAGS) -# Warnings as errors. Comment this line if a warning looks not valid. -ifeq "$(enable_werror)" "true" -GNATFLAGS+=-gnatwe -endif +GNAT_BARGS=-bargs -E target=$(build) #target=i686-pc-linux-gnu @@ -191,10 +200,10 @@ GHDL_MCODE_INCFLAGS=$(GHDL_COMMON_INCFLAGS) -aI$(srcdir)/src/ghdldrv -aI$(srcdir ghdl_mcode$(EXEEXT): GRT_FLAGS+=-DWITH_GNAT_RUN_TIME ghdl_mcode$(EXEEXT): $(GRT_ADD_OBJS) $(GRT_SRC_DEPS) $(ORTHO_DEPS) \ memsegs_c.o chkstk.o version.ads force - $(GNATMAKE) -o $@ -gnat12 $(GHDL_MCODE_INCFLAGS) $(GNATFLAGS) -gnatw.A ghdl_jit.adb $(GNAT_BARGS) -largs memsegs_c.o chkstk.o $(GRT_ADD_OBJS) $(LDFLAGS) $(GNAT_LARGS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB) $(GRT_EXEC_OPTS)) + $(GNATMAKE) -o $@ -gnat12 $(GHDL_MCODE_INCFLAGS) $(GNATFLAGS) -gnatw.A ghdl_jit.adb $(GNAT_BARGS) -largs memsegs_c.o chkstk.o $(GRT_ADD_OBJS) $(LDFLAGS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB) $(GRT_EXEC_OPTS)) memsegs_c.o: $(srcdir)/src/ortho/mcode/memsegs_c.c - $(CC) -c $(OPT_FLAGS) -o $@ $< + $(CC) -c $(COVERAGE_FLAGS) $(CFLAGS) -o $@ $< libs.vhdl.mcode: ghdl_mcode$(EXEEXT) $(MAKE) -f $(srcdir)/libraries/Makefile.inc $(LIBVHDL_FLAGS_TO_PASS) GHDL=$(PWD)/ghdl_mcode$(EXEEXT) GHDL_FLAGS="" VHDL_COPY_OBJS=no vhdl.libs.all @@ -305,7 +314,7 @@ ghdl1-gcc$(EXEEXT): version.ads force ghdl_gcc$(EXEEXT): version.ads $(GRT_SYNTH_OBJS) force $(GNATMAKE) $(GHDL_GCC_INCFLAGS) -aI$(srcdir)/src/ghdldrv \ $(GNATFLAGS) ghdl_gcc $(GNAT_BARGS) \ - -largs $(GRT_SYNTH_OBJS) $(GNAT_LARGS) + -largs $(LDFLAGS) $(GRT_SYNTH_OBJS) libs.vhdl.local_gcc: ghdl_gcc$(EXEEXT) ghdl1-gcc$(EXEEXT) $(MAKE) -f $(srcdir)/libraries/Makefile.inc $(LIBVHDL_FLAGS_TO_PASS) GHDL=$(PWD)/ghdl_gcc$(EXEEXT) GHDL_FLAGS="--GHDL1=$(PWD)/ghdl1-gcc$(EXEEXT) $(LIB_CFLAGS)" vhdl.libs.all libs.vhdl.standard @@ -333,13 +342,13 @@ ghdl_llvm_jit$(EXEEXT): GRT_FLAGS+=-DWITH_GNAT_RUN_TIME ghdl_llvm_jit$(EXEEXT): $(GRT_ADD_OBJS) $(GRT_SRC_DEPS) $(ORTHO_DEPS) \ llvm-cbindings.o version.ads force $(GNATMAKE) -o $@ $(GHDL_LLVM_INCFLAGS) $(GNATFLAGS) ghdl_jit.adb \ - $(GNAT_BARGS) -largs llvm-cbindings.o $(GNAT_LARGS) $(GRT_ADD_OBJS) \ + $(GNAT_BARGS) -largs llvm-cbindings.o $(GRT_ADD_OBJS) \ $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) --LINK=$(CXX) \ `$(LLVM_CONFIG) --ldflags --libs --system-libs` $(LDFLAGS) llvm-cbindings.o: $(srcdir)/src/ortho/$(llvm_be)/llvm-cbindings.cpp $(CXX) -c `$(LLVM_CONFIG) --includedir --cxxflags` \ - $(OPT_FLAGS) -o $@ $< + $(COVERAGE_FLAGS) $(CXXFLAGS) -o $@ $< libs.vhdl.llvmjit: ghdl_llvm_jit$(EXEEXT) $(MAKE) -f $(srcdir)/libraries/Makefile.inc $(LIBVHDL_FLAGS_TO_PASS) GHDL=$(PWD)/ghdl_llvm$(EXEEXT) GHDL_FLAGS="" VHDLLIBS_COPY_OBJS=no vhdl.libs.all @@ -354,14 +363,14 @@ ghdl_llvm$(EXEEXT): version.ads $(GRT_SYNTH_OBJS) force $(GNATMAKE) $(GHDL_LLVM_INCFLAGS) \ -aI$(srcdir)/src/ghdldrv $(GNATFLAGS) \ ghdl_llvm $(GNAT_BARGS) \ - -largs $(LDFLAGS) $(GRT_SYNTH_OBJS) $(GNAT_LARGS) + -largs $(LDFLAGS) $(GRT_SYNTH_OBJS) ghdl1-llvm$(EXEEXT): version.ads force $(MAKE) -f $(srcdir)/src/ortho/$(llvm_be)/Makefile \ ortho_srcdir=$(srcdir)/src/ortho ortho_exec=$@ \ GNATFLAGS="$(GHDL_LLVM_INCFLAGS) $(GNATFLAGS)" LDFLAGS="$(LDFLAGS)" \ LLVM_CONFIG="$(LLVM_CONFIG)" CXX="$(CXX)" \ - CFLAGS="$(WARN_FLAGS) $(OPT_FLAGS)" \ + CXXFLAGS="$(COVERAGE_FLAGS) $(CXXFLAGS)" \ GNATMAKE="$(GNATMAKE)" all oread-llvm$(EXEEXT): force @@ -391,7 +400,7 @@ uninstall.llvm: uninstall.llvm.program uninstall.grt GHDL_SIMUL_INCFLAGS=$(GHDL_COMMON_INCFLAGS) -aI$(srcdir)/src/ghdldrv -aI$(srcdir)/src/vhdl/simulate -aI$(srcdir)/src/synth ghdl_simul$(EXEEXT): $(GRT_ADD_OBJS) $(GRT_SRC_DEPS) version.ads force - $(GNATMAKE) $(GHDL_SIMUL_INCFLAGS) $(GNATFLAGS) -gnat12 ghdl_simul $(GNAT_BARGS) -largs $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) + $(GNATMAKE) $(GHDL_SIMUL_INCFLAGS) $(GNATFLAGS) -gnat12 ghdl_simul $(GNAT_BARGS) -largs $(LDFLAGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) libs.vhdl.simul: ghdl_simul$(EXEEXT) $(MAKE) -f $(srcdir)/libraries/Makefile.inc $(LIBVHDL_FLAGS_TO_PASS) GHDL=$(PWD)/ghdl_simul$(EXEEXT) GHDL_FLAGS="" VHDLLIBS_COPY_OBJS=no vhdl.libs.all @@ -418,7 +427,7 @@ LIBGHDL_GRT_OBJS= pic/grt-cstdio.o lib/$(libghdl_name): $(GRT_SRC_DEPS) $(LIBGHDL_GRT_OBJS) version.ads force # Use -g for gnatlink so that the binder file is not removed. We need # it for libghdl.a - $(GNATMAKE) -I- -aI. -D pic -z libghdl -o $@ -gnat12 $(GNATFLAGS) $(PIC_FLAGS) $(LIBGHDL_INCFLAGS) -bargs -shared -Llibghdl_ -largs -g -shared $(SHLIB_FLAGS) $(LIBGHDL_GRT_OBJS) + $(GNATMAKE) -I- -aI. -D pic -z libghdl -o $@ -gnat12 $(GNATFLAGS) $(PIC_FLAGS) $(LIBGHDL_INCFLAGS) -bargs -shared -Llibghdl_ -largs -g -shared $(SHLIB_FLAGS) $(filter-out -static,$(LDFLAGS)) $(LIBGHDL_GRT_OBJS) # On windows, gnatmake (via Osint.Executable_Name) always appends .exe # Adjust. (Other solution: use gnatmake for compilation and binding, # then use gnatlink directly for linking). @@ -475,18 +484,18 @@ libghdl-py.tgz: GHWDUMP_OBJS=ghwdump.o libghw.o ghwdump$(EXEEXT): $(GHWDUMP_OBJS) - $(CC) -o $@ $(GHWDUMP_OBJS) + $(CC) $(LDFLAGS) -o $@ $(GHWDUMP_OBJS) -libghw$(SOEXT): libghw.o - $(CC) $(PIC_FLAGS) -shared -o lib/$@ libghw.o +lib/libghw$(SOEXT): libghw.o + $(CC) $(PIC_FLAGS) $(LDFLAGS) -shared -o $@ $^ ghwdump.o: $(srcdir)/ghw/ghwdump.c $(srcdir)/ghw/libghw.h - $(CC) -c -o $@ $< $(OPT_FLAGS) $(WARN_CFLAGS) + $(CC) -c -o $@ $< $(COVERAGE_FLAGS) $(CFLAGS) libghw.o: $(srcdir)/ghw/libghw.c $(srcdir)/ghw/libghw.h - $(CC) $(PIC_FLAGS) -c -o $@ $< $(OPT_FLAGS) $(WARN_CFLAGS) + $(CC) $(PIC_FLAGS) -c -o $@ $< $(COVERAGE_FLAGS) $(CFLAGS) -all.ghw: ghwdump$(EXEEXT) libghw$(SOEXT) +all.ghw: ghwdump$(EXEEXT) lib/libghw$(SOEXT) install.ghw: $(INSTALL_PROGRAM) -p ghwdump$(EXEEXT) $(DESTDIR)$(bindir)/ @@ -525,15 +534,13 @@ uninstall.grt: ################ VPI ##################################################### vpi_thunk.o: $(GRTSRCDIR)/vpi_thunk.c $(GRTSRCDIR)/vpi_thunk.h -# Do not use OPT_FLAGS (do not enable coverage) - $(CC) -c -o $@ $< $(PIC_FLAGS) -O $(WARN_CFLAGS) + $(CC) -c -o $@ $< $(PIC_FLAGS) $(CFLAGS) vhpi_thunk.o: $(GRTSRCDIR)/vhpi_thunk.c $(GRTSRCDIR)/vhpi_thunk.h -# Do not use OPT_FLAGS (do not enable coverage) - $(CC) -c -o $@ $< $(PIC_FLAGS) -O $(WARN_CFLAGS) + $(CC) -c -o $@ $< $(PIC_FLAGS) $(CFLAGS) lib/libghdlvpi$(SOEXT): vpi_thunk.o vhpi_thunk.o - $(CC) -o $@ $^ -shared $(SHLIB_FLAGS) + $(CC) $(SHLIB_FLAGS) $(LDFLAGS) -shared -o $@ $^ all.vpi: lib/libghdlvpi$(SOEXT) @@ -27,9 +27,11 @@ backend=mcode CC=${CC:-gcc} CXX=${CXX:-clang++} CFLAGS=${CFLAGS:--g} +CXXFLAGS=${CXXFLAGS:--g} GNATMAKE=${GNATMAKE:-gnatmake} +ADA_FLAGS=${ADA_FLAGS:-} MAKE=${MAKE:-make} -LDFLAGS= +LDFLAGS=${LDFLAGS:-} prefix=/usr/local libdirsuffix=lib/ghdl libdirreverse=../.. @@ -52,7 +54,7 @@ PIC_FLAGS=-fPIC show_help=no progname=$0 -subst_vars="CC CXX GNATMAKE MAKE CFLAGS LDFLAGS build srcdir abs_srcdir prefix backend libdirsuffix libdirreverse gcc_src_dir llvm_config llvm_be backtrace_lib build_mode EXEEXT SOEXT PIC_FLAGS default_pic enable_werror enable_checks enable_gplcompat enable_libghdl libghdl_version ghdl_version" +subst_vars="CC CXX GNATMAKE ADA_FLAGS MAKE CFLAGS CXXFLAGS LDFLAGS build srcdir abs_srcdir prefix backend libdirsuffix libdirreverse gcc_src_dir llvm_config llvm_be backtrace_lib build_mode EXEEXT SOEXT PIC_FLAGS default_pic enable_werror enable_checks enable_gplcompat enable_libghdl libghdl_version ghdl_version" # Find srcdir srcdir=`dirname $progname` diff --git a/doc/ghw/index.rst b/doc/ghw/index.rst index bc3d7284f..456bc407c 100644 --- a/doc/ghw/index.rst +++ b/doc/ghw/index.rst @@ -14,11 +14,12 @@ There is neither any equivalent in the VHDL LRM. So, the author of GHDL, Tristan Gingold, implemented an alternative format named GHW, for allowing all VHDL types to be dumped. He also contributed a reader to GTKWave based on libghw (see `gtkwave/gtkwave/search?q=libghw <https://github.com/gtkwave/gtkwave/search?q=libghw>`__ and `gtkwave/gtkwave: gtkwave3/src/ghw.c <https://github.com/gtkwave/gtkwave/blob/master/gtkwave3/src/ghw.c>`__), -which allows visualizing GHW waves . +which allows visualizing GHW waves. The GHW format is not completely fixed, and it might change slightly as new language features are implemented in GHDL or as a result of internal tweaks. -Nevertheless, the GHDL codebase (:ghdlsrc:`grt/grt-waves.adb <grt/grt-waves.adb>`) is kept in sync with the utilities in subdir :ghdlsrc:`ghw <../ghw>`. +Nevertheless, the GHDL codebase (:ghdlsrc:`grt/grt-waves.adb <grt/grt-waves.adb>`) is kept in sync with the utilities in +subdir :ghdlsrc:`ghw <../ghw>`. .. TIP:: In `nturley/ghw-notes <https://github.com/nturley/ghw-notes>`__, there is some work for defining the GHW format as a diff --git a/doc/using/ImplementationOfVHDL.rst b/doc/using/ImplementationOfVHDL.rst index 332cd7402..a623801db 100644 --- a/doc/using/ImplementationOfVHDL.rst +++ b/doc/using/ImplementationOfVHDL.rst @@ -60,7 +60,8 @@ 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). +before). This incompatibility can be bypassed with the +:option:`-frelaxed` option. Minor corrections were added by the 2002 revision of the VHDL standard. This revision is not fully backward compatible with VHDL-00 since, for example, diff --git a/doc/using/Simulation.rst b/doc/using/Simulation.rst index 83e716f89..58bfa20f2 100644 --- a/doc/using/Simulation.rst +++ b/doc/using/Simulation.rst @@ -195,10 +195,11 @@ Here is the list of the most useful options. For further info, see :ref:`DEV:Deb Export waveforms ================ +.. NOTE:: All the waveform formats supported by GHDL are also supported by `GTKWave <http://gtkwave.sourceforge.net/>`__. + .. option:: --read-wave-opt=<FILENAME> - Filter signals to be dumped to the wave file according to the wave option - file provided. + Filter signals to be dumped to the wave file according to the wave option file provided. Here is a description of the wave option file format currently supported :: @@ -230,9 +231,8 @@ Export waveforms .. option:: --write-wave-opt=<FILENAME> - If the wave option file doesn't exist, creates it with all the signals of - the design. Otherwise throws an error, because it won't erase an existing - file. + If the wave option file doesn't exist, creates it with all the signals of the design. + Otherwise throws an error, because it won't erase an existing file. .. option:: --vcd=<FILENAME> @@ -244,21 +244,18 @@ Export waveforms .. index:: dump of signals - Option :option:`--vcd` dumps into the VCD file `FILENAME` the signal - values before each non-delta cycle. If `FILENAME` is ``-``, - then the standard output is used, otherwise a file is created or - overwritten. + Option :option:`--vcd` dumps into the VCD file `FILENAME` the signal values before each non-delta cycle. + If `FILENAME` is ``-``, then the standard output is used, otherwise a file is created or overwritten. - The :option:`--vcdgz` option is the same as the :option:`--vcd` option, - but the output is compressed using the `zlib` (`gzip` - compression). However, you can't use the ``-`` filename. + The :option:`--vcdgz` option is the same as the :option:`--vcd` option, but the output is compressed using the `zlib` + (`gzip` compression). + However, you can't use the ``-`` filename. Furthermore, only one VCD file can be written. - :dfn:`VCD` (value change dump) is a file format defined - by the `verilog` standard and used by virtually any wave viewer. - - Since it comes from `verilog`, only a few VHDL types can be dumped. GHDL - dumps only signals whose base type is of the following: + :dfn:`VCD` (value change dump) is a file format defined by the `verilog` standard and used by virtually any wave + viewer. + Since it comes from `verilog`, only a few VHDL types can be dumped. + GHDL dumps only signals whose base type is of the following: * types defined in the ``std.standard`` package: @@ -274,14 +271,9 @@ Export waveforms * any integer type - I have successfully used `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 (:ref:`Reporting_bugs`). + .. NOTE:: + 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 :ref:`let us know <Reporting_bugs>`! .. option:: --vcd-nodate @@ -289,19 +281,12 @@ Export waveforms .. option:: --fst=<FILENAME> - Write the waveforms into an `fst` file that can be displayed by - `gtkwave`. The `fst` files are much smaller than VCD or - `GHW` files, but it handles only the same signals as the VCD format. + Write the waveforms into an `fst` file. + The `fst` files are much smaller than VCD or `GHW` files, but it handles only the same signals as the VCD format. .. option:: --wave=<FILENAME> - Write the waveforms into a `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 completely fixed. - It may change slightly. The ``gtkwave`` tool can read the GHW files. - + Write the waveforms into a :ref:`GHW` file. Contrary to VCD files, any VHDL type can be dumped into a GHW file. Export hierarchy and references @@ -312,8 +297,8 @@ Export hierarchy and references .. index:: 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. `KIND` is optional, but if set must be one of: + This may be useful to understand the structure of a complex design. + `KIND` is optional, but if set must be one of: * ``none`` Do not display hierarchy. Same as if the option was not present. @@ -322,22 +307,24 @@ Export hierarchy and references * ``proc`` Like ``inst`` but also display processes. * ``port`` Like ``proc`` but display ports and signals too. - If `KIND` is not specified, the hierarchy is displayed with the - ``port`` mode. + If `KIND` is not specified, the hierarchy is displayed with the ``port`` mode. .. option:: --xref-html [options] files... - To easily navigate through your sources, you may generate cross-references. This command generates an html file for - each ``file`` given in the command line, with syntax highlighting and full cross-reference: every identifier is a - link to its declaration. An index of the files is created too. + To easily navigate through your sources, you may generate cross-references. + This command generates an html file for each ``file`` given in the command line, with syntax highlighting and full + cross-reference: every identifier is a link to its declaration. + An index of the files is created too. The set of ``files`` are analyzed, and then, if the analysis is successful, html files are generated in the directory - specified by the ``-o <DIR>`` option, or :file:`html/` directory by default. The style of the html file can be - modified with the :option:`--format` option. + specified by the ``-o <DIR>`` option, or :file:`html/` directory by default. + The style of the html file can be modified with the :option:`--format` option. .. option:: --psl-report=<FILENAME> - Write a report for PSL at the end of simulation. For each PSL cover and assert statements, the name, source location and whether it passed or failed is reported. The file is written using the JSON format, but is still human readable. + Write a report for PSL at the end of simulation. + For each PSL cover and assert statements, the name, source location and whether it passed or failed is reported. + The file is written using the JSON format, but is still human readable. .. option:: --psl-report-uncovered diff --git a/doc/using/Synthesis.rst b/doc/using/Synthesis.rst index e5f9554cc..d3968fe67 100644 --- a/doc/using/Synthesis.rst +++ b/doc/using/Synthesis.rst @@ -87,13 +87,16 @@ In addition to those options, there are some synthesis specific options. $ ghdl --synth --std=08 -gDEPTH=12 [library.]top_unit [arch] -.. option:: --out=<vhdl|raw-vhdl|dot|none|raw|dump> +.. option:: --out=<vhdl|raw-vhdl|verilog|dot|none|raw|dump> * **vhdl** *(default)*: equivalent to ``raw-vhdl``, but the original top-level unit is preserved unmodified, so the synthesized design can be simulated with the same testbench. - * **raw-vhdl**: all statements are converted to a simple VHDL 1993 netlist, for allowing instantiation in other - synthesis tools without modern VHDL support. + * **raw-vhdl**: all statements are converted to a simple VHDL 1993 + netlist, for allowing instantiation in other synthesis tools + without modern VHDL support. + + * **verilog**: generate a verilog netlist. * **dot**: generate a graphviz dot diagram of the netlist AST. diff --git a/ghw/ghwdump.c b/ghw/ghwdump.c index fa385af52..e6f24ca87 100644 --- a/ghw/ghwdump.c +++ b/ghw/ghwdump.c @@ -292,7 +292,7 @@ main (int argc, char **argv) case ghw_res_snapshot: case ghw_res_cycle: if (flag_disp_time) - printf ("Time is %lld fs\n", hp->snap_time); + printf ("Time is " GHWPRI64 " fs\n", hp->snap_time); if (flag_disp_signals) { if (!filter_done) diff --git a/ghw/libghw.h b/ghw/libghw.h index a6d22d0c0..4668b9252 100644 --- a/ghw/libghw.h +++ b/ghw/libghw.h @@ -30,8 +30,9 @@ in stdint.h. Header inttypes.h includes stdint.h and provides macro for printf and co specifiers. Use it if known to be available. */ -#if defined(__cplusplus) || \ - (defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)) || \ +#if defined(__cplusplus) || \ + defined(__linux__) || \ + (defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)) || \ defined(HAVE_INTTYPES_H) /* Use C99 standard header. */ #include <inttypes.h> diff --git a/pyGHDL/libghdl/std_names.py b/pyGHDL/libghdl/std_names.py index d99e28081..7f27a0116 100644 --- a/pyGHDL/libghdl/std_names.py +++ b/pyGHDL/libghdl/std_names.py @@ -762,65 +762,67 @@ class Name: Synthesis_Off = 955 Synthesis_On = 956 Off = 957 - Last_Comment = 957 - First_PSL = 958 - A = 958 - Af = 959 - Ag = 960 - Ax = 961 - Abort = 962 - Assume_Guarantee = 963 - Async_Abort = 964 - Before = 965 - Clock = 966 - E = 967 - Ef = 968 - Eg = 969 - Ex = 970 - Endpoint = 971 - Eventually = 972 - Fairness = 973 - Fell = 974 - Forall = 975 - G = 976 - Inf = 977 - Inherit = 978 - Never = 979 - Next_A = 980 - Next_E = 981 - Next_Event = 982 - Next_Event_A = 983 - Next_Event_E = 984 - Onehot = 985 - Onehot0 = 986 - Prev = 987 - Rose = 988 - Strong = 989 - Sync_Abort = 990 - W = 991 - Whilenot = 992 - Within = 993 - X = 994 - Last_PSL = 994 - First_Edif = 995 - Celltype = 1005 - View = 1006 - Viewtype = 1007 - Direction = 1008 - Contents = 1009 - Net = 1010 - Viewref = 1011 - Cellref = 1012 - Libraryref = 1013 - Portinstance = 1014 - Joined = 1015 - Portref = 1016 - Instanceref = 1017 - Design = 1018 - Designator = 1019 - Owner = 1020 - Member = 1021 - Number = 1022 - Rename = 1023 - Userdata = 1024 - Last_Edif = 1024 + Full_Case = 958 + Parallel_Case = 959 + Last_Comment = 959 + First_PSL = 960 + A = 960 + Af = 961 + Ag = 962 + Ax = 963 + Abort = 964 + Assume_Guarantee = 965 + Async_Abort = 966 + Before = 967 + Clock = 968 + E = 969 + Ef = 970 + Eg = 971 + Ex = 972 + Endpoint = 973 + Eventually = 974 + Fairness = 975 + Fell = 976 + Forall = 977 + G = 978 + Inf = 979 + Inherit = 980 + Never = 981 + Next_A = 982 + Next_E = 983 + Next_Event = 984 + Next_Event_A = 985 + Next_Event_E = 986 + Onehot = 987 + Onehot0 = 988 + Prev = 989 + Rose = 990 + Strong = 991 + Sync_Abort = 992 + W = 993 + Whilenot = 994 + Within = 995 + X = 996 + Last_PSL = 996 + First_Edif = 997 + Celltype = 1007 + View = 1008 + Viewtype = 1009 + Direction = 1010 + Contents = 1011 + Net = 1012 + Viewref = 1013 + Cellref = 1014 + Libraryref = 1015 + Portinstance = 1016 + Joined = 1017 + Portref = 1018 + Instanceref = 1019 + Design = 1020 + Designator = 1021 + Owner = 1022 + Member = 1023 + Number = 1024 + Rename = 1025 + Userdata = 1026 + Last_Edif = 1026 diff --git a/pyGHDL/libghdl/vhdl/nodes.py b/pyGHDL/libghdl/vhdl/nodes.py index 3d0c43f4b..65d82e3b3 100644 --- a/pyGHDL/libghdl/vhdl/nodes.py +++ b/pyGHDL/libghdl/vhdl/nodes.py @@ -2592,9 +2592,6 @@ Set_Binding_Indication = libghdl.vhdl__nodes__set_binding_indication Get_Named_Entity = libghdl.vhdl__nodes__get_named_entity Set_Named_Entity = libghdl.vhdl__nodes__set_named_entity -Get_Alias_Declaration = libghdl.vhdl__nodes__get_alias_declaration -Set_Alias_Declaration = libghdl.vhdl__nodes__set_alias_declaration - Get_Referenced_Name = libghdl.vhdl__nodes__get_referenced_name Set_Referenced_Name = libghdl.vhdl__nodes__set_referenced_name diff --git a/pyGHDL/libghdl/vhdl/nodes_meta.py b/pyGHDL/libghdl/vhdl/nodes_meta.py index 97f2b31d3..3f441388d 100644 --- a/pyGHDL/libghdl/vhdl/nodes_meta.py +++ b/pyGHDL/libghdl/vhdl/nodes_meta.py @@ -342,105 +342,104 @@ class fields: Default_Entity_Aspect = 269 Binding_Indication = 270 Named_Entity = 271 - Alias_Declaration = 272 - Referenced_Name = 273 - Expr_Staticness = 274 - Scalar_Size = 275 - Error_Origin = 276 - Operand = 277 - Left = 278 - Right = 279 - Unit_Name = 280 - Name = 281 - Group_Template_Name = 282 - Name_Staticness = 283 - Prefix = 284 - Signature_Prefix = 285 - External_Pathname = 286 - Pathname_Suffix = 287 - Pathname_Expression = 288 - In_Formal_Flag = 289 - Slice_Subtype = 290 - Suffix = 291 - Index_Subtype = 292 - Parameter = 293 - Parameter_2 = 294 - Parameter_3 = 295 - Parameter_4 = 296 - Attr_Chain = 297 - Signal_Attribute_Declaration = 298 - Actual_Type = 299 - Actual_Type_Definition = 300 - Association_Chain = 301 - Individual_Association_Chain = 302 - Subprogram_Association_Chain = 303 - Aggregate_Info = 304 - Sub_Aggregate_Info = 305 - Aggr_Dynamic_Flag = 306 - Aggr_Min_Length = 307 - Aggr_Low_Limit = 308 - Aggr_High_Limit = 309 - Aggr_Others_Flag = 310 - Aggr_Named_Flag = 311 - Aggregate_Expand_Flag = 312 - Association_Choices_Chain = 313 - Case_Statement_Alternative_Chain = 314 - Choice_Staticness = 315 - Procedure_Call = 316 - Implementation = 317 - Parameter_Association_Chain = 318 - Method_Object = 319 - Subtype_Type_Mark = 320 - Subnature_Nature_Mark = 321 - Type_Conversion_Subtype = 322 - Type_Mark = 323 - File_Type_Mark = 324 - Return_Type_Mark = 325 - Has_Disconnect_Flag = 326 - Has_Active_Flag = 327 - Is_Within_Flag = 328 - Type_Marks_List = 329 - Implicit_Alias_Flag = 330 - Alias_Signature = 331 - Attribute_Signature = 332 - Overload_List = 333 - Simple_Name_Identifier = 334 - Simple_Name_Subtype = 335 - Protected_Type_Body = 336 - Protected_Type_Declaration = 337 - Use_Flag = 338 - End_Has_Reserved_Id = 339 - End_Has_Identifier = 340 - End_Has_Postponed = 341 - Has_Label = 342 - Has_Begin = 343 - Has_End = 344 - Has_Is = 345 - Has_Pure = 346 - Has_Body = 347 - Has_Parameter = 348 - Has_Component = 349 - Has_Identifier_List = 350 - Has_Mode = 351 - Has_Class = 352 - Has_Delay_Mechanism = 353 - Suspend_Flag = 354 - Is_Ref = 355 - Is_Forward_Ref = 356 - Psl_Property = 357 - Psl_Sequence = 358 - Psl_Declaration = 359 - Psl_Expression = 360 - Psl_Boolean = 361 - PSL_Clock = 362 - PSL_NFA = 363 - PSL_Nbr_States = 364 - PSL_Clock_Sensitivity = 365 - PSL_EOS_Flag = 366 - Count_Expression = 367 - Clock_Expression = 368 - Default_Clock = 369 - Foreign_Node = 370 + Referenced_Name = 272 + Expr_Staticness = 273 + Scalar_Size = 274 + Error_Origin = 275 + Operand = 276 + Left = 277 + Right = 278 + Unit_Name = 279 + Name = 280 + Group_Template_Name = 281 + Name_Staticness = 282 + Prefix = 283 + Signature_Prefix = 284 + External_Pathname = 285 + Pathname_Suffix = 286 + Pathname_Expression = 287 + In_Formal_Flag = 288 + Slice_Subtype = 289 + Suffix = 290 + Index_Subtype = 291 + Parameter = 292 + Parameter_2 = 293 + Parameter_3 = 294 + Parameter_4 = 295 + Attr_Chain = 296 + Signal_Attribute_Declaration = 297 + Actual_Type = 298 + Actual_Type_Definition = 299 + Association_Chain = 300 + Individual_Association_Chain = 301 + Subprogram_Association_Chain = 302 + Aggregate_Info = 303 + Sub_Aggregate_Info = 304 + Aggr_Dynamic_Flag = 305 + Aggr_Min_Length = 306 + Aggr_Low_Limit = 307 + Aggr_High_Limit = 308 + Aggr_Others_Flag = 309 + Aggr_Named_Flag = 310 + Aggregate_Expand_Flag = 311 + Association_Choices_Chain = 312 + Case_Statement_Alternative_Chain = 313 + Choice_Staticness = 314 + Procedure_Call = 315 + Implementation = 316 + Parameter_Association_Chain = 317 + Method_Object = 318 + Subtype_Type_Mark = 319 + Subnature_Nature_Mark = 320 + Type_Conversion_Subtype = 321 + Type_Mark = 322 + File_Type_Mark = 323 + Return_Type_Mark = 324 + Has_Disconnect_Flag = 325 + Has_Active_Flag = 326 + Is_Within_Flag = 327 + Type_Marks_List = 328 + Implicit_Alias_Flag = 329 + Alias_Signature = 330 + Attribute_Signature = 331 + Overload_List = 332 + Simple_Name_Identifier = 333 + Simple_Name_Subtype = 334 + Protected_Type_Body = 335 + Protected_Type_Declaration = 336 + Use_Flag = 337 + End_Has_Reserved_Id = 338 + End_Has_Identifier = 339 + End_Has_Postponed = 340 + Has_Label = 341 + Has_Begin = 342 + Has_End = 343 + Has_Is = 344 + Has_Pure = 345 + Has_Body = 346 + Has_Parameter = 347 + Has_Component = 348 + Has_Identifier_List = 349 + Has_Mode = 350 + Has_Class = 351 + Has_Delay_Mechanism = 352 + Suspend_Flag = 353 + Is_Ref = 354 + Is_Forward_Ref = 355 + Psl_Property = 356 + Psl_Sequence = 357 + Psl_Declaration = 358 + Psl_Expression = 359 + Psl_Boolean = 360 + PSL_Clock = 361 + PSL_NFA = 362 + PSL_Nbr_States = 363 + PSL_Clock_Sensitivity = 364 + PSL_EOS_Flag = 365 + Count_Expression = 366 + Clock_Expression = 367 + Default_Clock = 368 + Foreign_Node = 369 Get_Boolean = libghdl.vhdl__nodes_meta__get_boolean @@ -1102,8 +1101,6 @@ Has_Binding_Indication = libghdl.vhdl__nodes_meta__has_binding_indication Has_Named_Entity = libghdl.vhdl__nodes_meta__has_named_entity -Has_Alias_Declaration = libghdl.vhdl__nodes_meta__has_alias_declaration - Has_Referenced_Name = libghdl.vhdl__nodes_meta__has_referenced_name Has_Expr_Staticness = libghdl.vhdl__nodes_meta__has_expr_staticness diff --git a/scripts/msys2-mcode/PKGBUILD b/scripts/msys2-mcode/PKGBUILD index 853b0429b..012160139 100644 --- a/scripts/msys2-mcode/PKGBUILD +++ b/scripts/msys2-mcode/PKGBUILD @@ -18,7 +18,7 @@ build() { cd "${srcdir}/builddir" ../../../../configure \ --prefix=${MINGW_PREFIX} \ - LDFLAGS=-static \ + LDFLAGS="-static -Wl,--stack=8388608" \ --enable-libghdl \ --enable-synth make GNATMAKE="gnatmake -j$(nproc)" diff --git a/scripts/windows/mcode/Makefile.in b/scripts/windows/mcode/Makefile.in index be1f11516..0f7b7422d 100644 --- a/scripts/windows/mcode/Makefile.in +++ b/scripts/windows/mcode/Makefile.in @@ -14,7 +14,7 @@ GRTSRCDIR=grt ####grt Makefile.inc ghdl_mcode: default_paths.ads $(GRT_ADD_OBJS) mmap_binding.o force - gnatmake -aIghdldrv -aIghdl -aIortho -aIgrt $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs mmap_binding.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(GRT_EXTRA_LIB) -Wl,--version-script=$(GRTSRCDIR)/grt.ver -Wl,--export-dynamic + gnatmake -aIghdldrv -aIghdl -aIortho -aIgrt $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs mmap_binding.o $(GRT_ADD_OBJS) $(GRT_EXTRA_LIB) -Wl,--version-script=$(GRTSRCDIR)/grt.ver -Wl,--export-dynamic mmap_binding.o: ortho/mmap_binding.c $(CC) -c -g -o $@ $< diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index 7a55cafee..5d76355aa 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -43,6 +43,7 @@ with Vhdl.Utils; with Netlists.Dump; with Netlists.Disp_Vhdl; +with Netlists.Disp_Verilog; with Netlists.Disp_Dot; with Netlists.Errors; @@ -56,6 +57,7 @@ package body Ghdlsynth is (Format_Default, Format_Raw, Format_Dump, Format_Dot, Format_Vhdl, Format_Raw_Vhdl, + Format_Verilog, Format_None); type Name_Id_Array is array (Natural range <>) of Name_Id; @@ -203,6 +205,8 @@ package body Ghdlsynth is Cmd.Oformat := Format_Vhdl; elsif Option = "--out=raw-vhdl" then Cmd.Oformat := Format_Raw_Vhdl; + elsif Option = "--out=verilog" then + Cmd.Oformat := Format_Verilog; elsif Option = "-di" then Flag_Debug_Noinference := True; elsif Option = "-dc" then @@ -435,10 +439,17 @@ package body Ghdlsynth is when Format_Dot => Netlists.Disp_Dot.Disp_Dot_Top_Module (Res); when Format_Vhdl => - Ent := Vhdl.Utils.Get_Entity_From_Configuration (Config); - Synth.Disp_Vhdl.Disp_Vhdl_Wrapper (Ent, Res, Inst); + if Get_Kind (Config) = Iir_Kind_Foreign_Module then + -- Not a VHDL design. + Netlists.Disp_Vhdl.Disp_Vhdl (Res); + else + Ent := Vhdl.Utils.Get_Entity_From_Configuration (Config); + Synth.Disp_Vhdl.Disp_Vhdl_Wrapper (Ent, Res, Inst); + end if; when Format_Raw_Vhdl => Netlists.Disp_Vhdl.Disp_Vhdl (Res); + when Format_Verilog => + Netlists.Disp_Verilog.Disp_Verilog (Res); end case; end Disp_Design; diff --git a/src/grt/Makefile.inc b/src/grt/Makefile.inc index 860c91344..6e4b741e0 100644 --- a/src/grt/Makefile.inc +++ b/src/grt/Makefile.inc @@ -153,8 +153,8 @@ grt/run-bind.o: grt grt/run-bind.adb grt/main.o: grt $(GRTSRCDIR)/main.adb cd grt && $(MSYS2_ARG) $(GRT_ADACOMPILE) -o main.o $(GRTSRCDIR)/main.adb -Igrt -GRT_C_COMPILE = $(CC) -c $(GRT_FLAGS) -o $@ $< -GRT_C_COMPILE_PIC = $(CC) -c $(GRT_FLAGS) $(PIC_FLAGS) -o $@ $< +GRT_C_COMPILE = $(CC) -c $(GRT_FLAGS) $(CFLAGS) -o $@ $< +GRT_C_COMPILE_PIC = $(CC) -c $(GRT_FLAGS) $(PIC_FLAGS) $(CFLAGS) -o $@ $< jumps.o: $(GRTSRCDIR)/config/jumps.c $(GRT_C_COMPILE) diff --git a/src/grt/ghdl_main.adb b/src/grt/ghdl_main.adb index b9121122c..92e69c362 100644 --- a/src/grt/ghdl_main.adb +++ b/src/grt/ghdl_main.adb @@ -42,7 +42,7 @@ is function To_Argv_Type is new Ada.Unchecked_Conversion (Source => System.Address, Target => Grt.Options.Argv_Type); - Args : Grt.Options.Argv_Type := To_Argv_Type (Argv); + Args : constant Grt.Options.Argv_Type := To_Argv_Type (Argv); Progname : Ghdl_C_String := null; begin -- Ada elaboration. diff --git a/src/grt/grt-table.adb b/src/grt/grt-table.adb index 89fc043ad..a800b8c25 100644 --- a/src/grt/grt-table.adb +++ b/src/grt/grt-table.adb @@ -39,7 +39,8 @@ package body Grt.Table is pragma Import (C, Free); -- Resize and reallocate the table according to LAST_VAL. - procedure Resize is + procedure Resize + is function Realloc (T : Table_Ptr; Size : size_t) return Table_Ptr; pragma Import (C, Realloc); @@ -49,8 +50,10 @@ package body Grt.Table is Max := Max + (Max - Table_Low_Bound + 1); end loop; - New_Size := size_t ((Max - Table_Low_Bound + 1) * - (Table_Type'Component_Size / Storage_Unit)); + -- Do the multiplication using size_t to avoid overflow if the bounds + -- are a 32bit type on a 64bit machine. + New_Size := (size_t (Max - Table_Low_Bound + 1) + * size_t (Table_Type'Component_Size / Storage_Unit)); Table := Realloc (Table, New_Size); @@ -113,6 +116,6 @@ begin Last_Val := Table_Index_Type'Pred (Table_Low_Bound); Max := Table_Low_Bound + Table_Index_Type (Table_Initial) - 1; - Table := Malloc (size_t (Table_Initial * - (Table_Type'Component_Size / Storage_Unit))); + Table := Malloc (size_t (Table_Initial) + * size_t (Table_Type'Component_Size / Storage_Unit)); end Grt.Table; diff --git a/src/ortho/debug/Makefile b/src/ortho/debug/Makefile index 885ff0d55..d7d297c1b 100644 --- a/src/ortho/debug/Makefile +++ b/src/ortho/debug/Makefile @@ -23,14 +23,13 @@ CC=gcc CFLAGS=-g ALL_GNAT_FLAGS=-pipe -g -gnato -gnatwaeu -gnatf -gnaty3befhkmr GNATMAKE_FLAGS=$(ALL_GNAT_FLAGS) $(GNATFLAGS) -aI$(ortho_srcdir) -aI$(orthobe_srcdir) -aI. -#LARGS=-largs -static SED=sed all: $(ortho_exec) $(ortho_exec): force $(ortho_srcdir)/$(BE)/ortho_debug.ads - $(GNATMAKE) -o $@ $(GNATMAKE_FLAGS) ortho_debug-main -bargs -E $(LARGS) + $(GNATMAKE) -o $@ $(GNATMAKE_FLAGS) ortho_debug-main -bargs -E -largs $(LDFLAGS) clean: $(RM) -f *.o *.ali *~ b~*.ad? ortho_nodes-main diff --git a/src/ortho/gcc/Makefile b/src/ortho/gcc/Makefile index 5b12ea569..498aa99d0 100644 --- a/src/ortho/gcc/Makefile +++ b/src/ortho/gcc/Makefile @@ -69,7 +69,7 @@ $(ortho_exec): $(AGCC_DEPS) $(orthobe_srcdir)/ortho_gcc.ads force $(GNATMAKE) -o $@ -aI$(ortho_srcdir) \ -aI$(ortho_srcdir)/gcc $(GNATFLAGS) ortho_gcc-main \ -bargs -E -largs --LINK=$(LINKER) $(AGCC_OBJS) \ - $(BACKEND) $(LIBS) $(BACKENDLIBS) + $(LDFLAGS) $(BACKEND) $(LIBS) $(BACKENDLIBS) agcc-clean: force $(RM) -f $(agcc_objdir)/*.o diff --git a/src/ortho/gcc/ortho-lang-49.c b/src/ortho/gcc/ortho-lang-49.c index d2c3dfc52..e8b4f5643 100644 --- a/src/ortho/gcc/ortho-lang-49.c +++ b/src/ortho/gcc/ortho-lang-49.c @@ -50,6 +50,8 @@ #include "stor-layout.h" #include "varasm.h" +#define TYPE_UNBOUNDED(t) TYPE_LANG_FLAG_0(t) + /* Returns the number of FIELD_DECLs in TYPE. Copied here from expr.c in gcc4.9 as it is no longer exported by tree.h. */ @@ -1139,6 +1141,13 @@ new_record_union_field (struct o_element_list *list, { tree res; + if (TYPE_UNBOUNDED(etype)) { + /* If the field type is unbounded, it mustn't use any space in the + record. Use VOID instead. */ + TYPE_UNBOUNDED(list->res) = 1; + etype = void_type_node; + } + res = build_decl (input_location, FIELD_DECL, ident, etype); DECL_CONTEXT (res) = list->res; chain_append (&list->chain, res); @@ -1303,6 +1312,7 @@ new_array_type (tree el_type, tree index_type) /* Build an incomplete array. */ range_type = build_range_type (index_type, size_zero_node, NULL_TREE); res = build_array_type (el_type, range_type); + TYPE_UNBOUNDED(res) = 1; return res; } @@ -1313,6 +1323,7 @@ new_array_subtype (tree atype, tree eltype, tree length) tree index_type; tree res; + gcc_assert(!TYPE_UNBOUNDED(eltype)); index_type = TYPE_DOMAIN (atype); range_type = ortho_build_array_range(index_type, length); diff --git a/src/ortho/gcc/ortho-lang-5.c b/src/ortho/gcc/ortho-lang-5.c index 8daa5dd92..6a3d5cdb8 100644 --- a/src/ortho/gcc/ortho-lang-5.c +++ b/src/ortho/gcc/ortho-lang-5.c @@ -66,6 +66,8 @@ #include "stor-layout.h" #include "varasm.h" +#define TYPE_UNBOUNDED(t) TYPE_LANG_FLAG_0(t) + /* Returns the number of FIELD_DECLs in TYPE. Copied here from expr.c in gcc4.9 as it is no longer exported by tree.h. */ @@ -1125,6 +1127,13 @@ new_record_union_field (struct o_element_list *list, { tree res; + if (TYPE_UNBOUNDED(etype)) { + /* If the field type is unbounded, it mustn't use any space in the + record. Use VOID instead. */ + TYPE_UNBOUNDED(list->res) = 1; + etype = void_type_node; + } + res = build_decl (input_location, FIELD_DECL, ident, etype); DECL_CONTEXT (res) = list->res; chain_append (&list->chain, res); @@ -1289,6 +1298,7 @@ new_array_type (tree el_type, tree index_type) /* Build an incomplete array. */ range_type = build_range_type (index_type, size_zero_node, NULL_TREE); res = build_array_type (el_type, range_type); + TYPE_UNBOUNDED(res) = 1; return res; } @@ -1299,6 +1309,7 @@ new_array_subtype (tree atype, tree eltype, tree length) tree index_type; tree res; + gcc_assert(!TYPE_UNBOUNDED(eltype)); index_type = TYPE_DOMAIN (atype); range_type = ortho_build_array_range(index_type, length); diff --git a/src/ortho/gcc/ortho-lang-6.c b/src/ortho/gcc/ortho-lang-6.c index 244b26c6c..d2f15cc51 100644 --- a/src/ortho/gcc/ortho-lang-6.c +++ b/src/ortho/gcc/ortho-lang-6.c @@ -66,6 +66,8 @@ #include "stor-layout.h" #include "varasm.h" +#define TYPE_UNBOUNDED(t) TYPE_LANG_FLAG_0(t) + /* Returns the number of FIELD_DECLs in TYPE. Copied here from expr.c in gcc4.9 as it is no longer exported by tree.h. */ @@ -1125,6 +1127,13 @@ new_record_union_field (struct o_element_list *list, { tree res; + if (TYPE_UNBOUNDED(etype)) { + /* If the field type is unbounded, it mustn't use any space in the + record. Use VOID instead. */ + TYPE_UNBOUNDED(list->res) = 1; + etype = void_type_node; + } + res = build_decl (input_location, FIELD_DECL, ident, etype); DECL_CONTEXT (res) = list->res; chain_append (&list->chain, res); @@ -1289,6 +1298,7 @@ new_array_type (tree el_type, tree index_type) /* Build an incomplete array. */ range_type = build_range_type (index_type, size_zero_node, NULL_TREE); res = build_array_type (el_type, range_type); + TYPE_UNBOUNDED(res) = 1; return res; } @@ -1299,6 +1309,7 @@ new_array_subtype (tree atype, tree eltype, tree length) tree index_type; tree res; + gcc_assert(!TYPE_UNBOUNDED(eltype)); index_type = TYPE_DOMAIN (atype); range_type = ortho_build_array_range(index_type, length); diff --git a/src/ortho/gcc/ortho-lang-7.c b/src/ortho/gcc/ortho-lang-7.c index a5b97d8c6..4600fc602 100644 --- a/src/ortho/gcc/ortho-lang-7.c +++ b/src/ortho/gcc/ortho-lang-7.c @@ -66,6 +66,8 @@ #include "stor-layout.h" #include "varasm.h" +#define TYPE_UNBOUNDED(t) TYPE_LANG_FLAG_0(t) + /* Returns the number of FIELD_DECLs in TYPE. Copied here from expr.c in gcc4.9 as it is no longer exported by tree.h. */ @@ -1137,6 +1139,13 @@ new_record_union_field (struct o_element_list *list, { tree res; + if (TYPE_UNBOUNDED(etype)) { + /* If the field type is unbounded, it mustn't use any space in the + record. Use VOID instead. */ + TYPE_UNBOUNDED(list->res) = 1; + etype = void_type_node; + } + res = build_decl (input_location, FIELD_DECL, ident, etype); DECL_CONTEXT (res) = list->res; chain_append (&list->chain, res); @@ -1301,6 +1310,7 @@ new_array_type (tree el_type, tree index_type) /* Build an incomplete array. */ range_type = build_range_type (index_type, size_zero_node, NULL_TREE); res = build_array_type (el_type, range_type); + TYPE_UNBOUNDED(res) = 1; return res; } @@ -1311,6 +1321,7 @@ new_array_subtype (tree atype, tree eltype, tree length) tree index_type; tree res; + gcc_assert(!TYPE_UNBOUNDED(eltype)); index_type = TYPE_DOMAIN (atype); range_type = ortho_build_array_range(index_type, length); diff --git a/src/ortho/gcc/ortho-lang-8.c b/src/ortho/gcc/ortho-lang-8.c index 2c37bdbf5..f88cea0c1 100644 --- a/src/ortho/gcc/ortho-lang-8.c +++ b/src/ortho/gcc/ortho-lang-8.c @@ -66,6 +66,8 @@ #include "stor-layout.h" #include "varasm.h" +#define TYPE_UNBOUNDED(t) TYPE_LANG_FLAG_0(t) + /* Returns the number of FIELD_DECLs in TYPE. Copied here from expr.c in gcc4.9 as it is no longer exported by tree.h. */ @@ -1138,6 +1140,13 @@ new_record_union_field (struct o_element_list *list, { tree res; + if (TYPE_UNBOUNDED(etype)) { + /* If the field type is unbounded, it mustn't use any space in the + record. Use VOID instead. */ + TYPE_UNBOUNDED(list->res) = 1; + etype = void_type_node; + } + res = build_decl (input_location, FIELD_DECL, ident, etype); DECL_CONTEXT (res) = list->res; chain_append (&list->chain, res); @@ -1302,6 +1311,7 @@ new_array_type (tree el_type, tree index_type) /* Build an incomplete array. */ range_type = build_range_type (index_type, size_zero_node, NULL_TREE); res = build_array_type (el_type, range_type); + TYPE_UNBOUNDED(res) = 1; return res; } @@ -1312,6 +1322,7 @@ new_array_subtype (tree atype, tree eltype, tree length) tree index_type; tree res; + gcc_assert(!TYPE_UNBOUNDED(eltype)); index_type = TYPE_DOMAIN (atype); range_type = ortho_build_array_range(index_type, length); diff --git a/src/ortho/gcc/ortho-lang-9.c b/src/ortho/gcc/ortho-lang-9.c index 66e7d7ab0..b7dfab4f3 100644 --- a/src/ortho/gcc/ortho-lang-9.c +++ b/src/ortho/gcc/ortho-lang-9.c @@ -66,6 +66,8 @@ #include "stor-layout.h" #include "varasm.h" +#define TYPE_UNBOUNDED(t) TYPE_LANG_FLAG_0(t) + /* Returns the number of FIELD_DECLs in TYPE. Copied here from expr.c in gcc4.9 as it is no longer exported by tree.h. */ @@ -1138,6 +1140,13 @@ new_record_union_field (struct o_element_list *list, { tree res; + if (TYPE_UNBOUNDED(etype)) { + /* If the field type is unbounded, it mustn't use any space in the + record. Use VOID instead. */ + TYPE_UNBOUNDED(list->res) = 1; + etype = void_type_node; + } + res = build_decl (input_location, FIELD_DECL, ident, etype); DECL_CONTEXT (res) = list->res; chain_append (&list->chain, res); @@ -1302,6 +1311,7 @@ new_array_type (tree el_type, tree index_type) /* Build an incomplete array. */ range_type = build_range_type (index_type, size_zero_node, NULL_TREE); res = build_array_type (el_type, range_type); + TYPE_UNBOUNDED(res) = 1; return res; } @@ -1312,6 +1322,7 @@ new_array_subtype (tree atype, tree eltype, tree length) tree index_type; tree res; + gcc_assert(!TYPE_UNBOUNDED(eltype)); index_type = TYPE_DOMAIN (atype); range_type = ortho_build_array_range(index_type, length); diff --git a/src/ortho/llvm-nodebug/Makefile b/src/ortho/llvm-nodebug/Makefile index 50ddc1bc5..880735857 100644 --- a/src/ortho/llvm-nodebug/Makefile +++ b/src/ortho/llvm-nodebug/Makefile @@ -12,7 +12,7 @@ $(ortho_exec): $(ortho_srcdir)/llvm-nodebug/ortho_llvm.ads force llvm-cbindings. $(GNATMAKE) -o $@ -aI$(ortho_srcdir)/llvm-nodebug -aI$(ortho_srcdir) \ $(GNATFLAGS) ortho_code_main -bargs -E \ -largs llvm-cbindings.o --LINK=$(CXX) \ - $(LDFLAGS) `$(LLVM_CONFIG) --ldflags --libs --system-libs` + `$(LLVM_CONFIG) --ldflags --libs --system-libs` $(LDFLAGS) llvm-cbindings.o: $(ortho_srcdir)/llvm-nodebug/llvm-cbindings.cpp $(CXX) -c `$(LLVM_CONFIG) --cxxflags` -o $@ $< diff --git a/src/ortho/llvm35/Makefile b/src/ortho/llvm35/Makefile index 5abe441da..33aee4cf5 100644 --- a/src/ortho/llvm35/Makefile +++ b/src/ortho/llvm35/Makefile @@ -12,7 +12,7 @@ $(ortho_exec): $(ortho_srcdir)/llvm35/ortho_llvm.ads force llvm-cbindings.o $(GNATMAKE) -o $@ -aI$(ortho_srcdir)/llvm -aI$(ortho_srcdir) \ $(GNATFLAGS) ortho_code_main -bargs -E \ -largs llvm-cbindings.o --LINK=$(CXX) \ - $(LDFLAGS) `$(LLVM_CONFIG) --ldflags --libs --system-libs` + `$(LLVM_CONFIG) --ldflags --libs --system-libs` $(LDFLAGS) llvm-cbindings.o: $(ortho_srcdir)/llvm35/llvm-cbindings.cpp $(CXX) -c `$(LLVM_CONFIG) --cxxflags` -o $@ $< diff --git a/src/ortho/llvm4-nodebug/Makefile b/src/ortho/llvm4-nodebug/Makefile index f3be7dbde..b5fd22a8a 100644 --- a/src/ortho/llvm4-nodebug/Makefile +++ b/src/ortho/llvm4-nodebug/Makefile @@ -14,7 +14,7 @@ $(ortho_exec): $(ortho_srcdir)/llvm4-nodebug/ortho_llvm.ads force llvm-cbindings $(GNATMAKE) -o $@ -aI$(ortho_srcdir)/llvm4-nodebug -aI$(ortho_srcdir) \ $(GNATFLAGS) ortho_code_main -bargs -E \ -largs llvm-cbindings.o --LINK=$(CXX) \ - $(LDFLAGS) `$(LLVM_LDFLAGS)` + `$(LLVM_LDFLAGS)` $(LDFLAGS) llvm-cbindings.o: $(ortho_srcdir)/llvm4-nodebug/llvm-cbindings.cpp $(CXX) -c `$(LLVM_CONFIG) --cxxflags` -o $@ $< diff --git a/src/ortho/llvm6/Makefile b/src/ortho/llvm6/Makefile index 31f25c9fa..073512817 100644 --- a/src/ortho/llvm6/Makefile +++ b/src/ortho/llvm6/Makefile @@ -14,10 +14,10 @@ $(ortho_exec): $(ortho_srcdir)/llvm6/ortho_llvm.ads force llvm-cbindings.o $(GNATMAKE) -o $@ -aI$(ortho_srcdir)/llvm6 -aI$(ortho_srcdir) \ $(GNATFLAGS) ortho_code_main -bargs -E \ -largs llvm-cbindings.o --LINK=$(CXX) \ - $(LDFLAGS) `$(LLVM_LDFLAGS)` + `$(LLVM_LDFLAGS)` $(LDFLAGS) llvm-cbindings.o: $(ortho_srcdir)/llvm6/llvm-cbindings.cpp - $(CXX) -c `$(LLVM_CONFIG) --cxxflags` $(CFLAGS) -o $@ $< + $(CXX) -c `$(LLVM_CONFIG) --cxxflags` $(CXXFLAGS) -o $@ $< clean: $(RM) -f *.o *.ali ortho_code_main diff --git a/src/ortho/llvm6/llvm-cbindings.cpp b/src/ortho/llvm6/llvm-cbindings.cpp index 98470d8fa..2f5cebe83 100644 --- a/src/ortho/llvm6/llvm-cbindings.cpp +++ b/src/ortho/llvm6/llvm-cbindings.cpp @@ -376,8 +376,12 @@ struct OTnodeBase { DIType *Dbg; #endif + // Kind of type. OTKind Kind; + + // If true, the type is bounded: all the elements have a defined size. bool Bounded; + OTnodeBase (LLVMTypeRef R, OTKind K, bool Bounded) : Ref(R), #ifdef USE_DEBUG @@ -643,7 +647,7 @@ struct OElementList { OFKind Kind; // Number of fields. - unsigned Count; + unsigned BndCount; // For record: the access to the incomplete (but named) type. OTnode RecType; @@ -685,9 +689,10 @@ extern "C" void new_record_field(OElementList *Elements, OFnodeRec **El, OIdent Ident, OTnode Etype) { - *El = new OFnodeRec(Etype, Ident, Elements->Count); + *El = new OFnodeRec(Etype, Ident, Etype->Bounded ? Elements->BndCount : ~0U); Elements->Els->push_back(*El); - Elements->Count++; + if (Etype->Bounded) + Elements->BndCount++; } struct OTnodeRecBase : OTnodeBase { @@ -710,16 +715,19 @@ struct OTnodeIncompleteRec : OTnodeRecBase { static DINodeArray buildDebugRecordElements(OTnodeRecBase *Atype) { - unsigned Count = Atype->Els.size(); - std::vector<Metadata *> els(Count); + std::vector<Metadata *> els; + + els.reserve(Atype->Els.size()); unsigned i = 0; for (OFnodeBase *e : Atype->Els) { - unsigned bitoff = 8 * LLVMOffsetOfElement(TheTargetData, Atype->Ref, i); - els[i++] = DBuilder->createMemberType - (DebugCurrentSubprg, StringRef(e->Ident.cstr), NULL, 0, - e->FType->getBitSize(), /* align */ 0, - bitoff, DINode::DIFlags::FlagZero, e->FType->Dbg); + if (!e->FType->Bounded) + break; + unsigned bitoff = 8 * LLVMOffsetOfElement(TheTargetData, Atype->Ref, i++); + els.push_back(DBuilder->createMemberType + (DebugCurrentSubprg, StringRef(e->Ident.cstr), NULL, 0, + e->FType->getBitSize(), /* align */ 0, + bitoff, DINode::DIFlags::FlagZero, e->FType->Dbg)); } return DBuilder->getOrCreateArray(els); @@ -729,21 +737,24 @@ buildDebugRecordElements(OTnodeRecBase *Atype) extern "C" void finish_record_type(OElementList *Els, OTnode *Res) { - LLVMTypeRef *Types = new LLVMTypeRef[Els->Count]; + LLVMTypeRef *Types = new LLVMTypeRef[Els->BndCount]; // Create types array for elements. int i = 0; bool Bounded = true; for (OFnodeBase *Field : *Els->Els) { - Bounded &= Field->FType->Bounded; - Types[i++] = Field->FType->Ref; + if (Field->FType->Bounded) + Types[i++] = Field->FType->Ref; + else + Bounded = false; } + assert(i == Els->BndCount); OTnodeRecBase *T; if (Els->RecType != nullptr) { // Completion - LLVMStructSetBody (Els->RecType->Ref, Types, Els->Count, 0); + LLVMStructSetBody (Els->RecType->Ref, Types, Els->BndCount, 0); Els->RecType->Bounded = Bounded; T = static_cast<OTnodeRecBase *>(Els->RecType); T->Els = std::move(*Els->Els); @@ -762,7 +773,7 @@ finish_record_type(OElementList *Els, OTnode *Res) } else { // Non-completion. // Debug info are created when the type is declared. - T = new OTnodeRec(LLVMStructType(Types, Els->Count, 0), Bounded); + T = new OTnodeRec(LLVMStructType(Types, Els->BndCount, 0), Bounded); T->Els = std::move(*Els->Els); } *Res = T; diff --git a/src/ortho/mcode/Makefile b/src/ortho/mcode/Makefile index 791d1f307..25f3c664b 100644 --- a/src/ortho/mcode/Makefile +++ b/src/ortho/mcode/Makefile @@ -10,13 +10,13 @@ all: $(ortho_exec) $(ortho_exec): $(ortho_srcdir)/mcode/ortho_mcode.ads memsegs_c.o force $(GNATMAKE) -o $@ -g -aI$(ortho_srcdir)/mcode -aI$(ortho_srcdir) \ -aI$(ortho_srcdir)/.. $(GNATFLAGS) -gnatw.A ortho_code_main \ - -bargs -E -largs memsegs_c.o #-static + -bargs -E -largs $(LDFLAGS) memsegs_c.o #-static memsegs_c.o: $(ortho_srcdir)/mcode/memsegs_c.c $(CC) -c $(CFLAGS) -o $@ $< oread: $(ortho_srcdir)/mcode/ortho_mcode.ads force - $(GNATMAKE) -m -o $@ -g $(GNATFLAGS) -aI../oread ortho_code_main -aI.. -largs memsegs_c.o + $(GNATMAKE) -m -o $@ -g $(GNATFLAGS) -aI../oread ortho_code_main -aI.. -largs $(LDFLAGS) memsegs_c.o elfdump: force $(GNATMAKE) -m -g $(GNATFLAGS) $@ diff --git a/src/ortho/oread/ortho_front.adb b/src/ortho/oread/ortho_front.adb index 2e08b7ab0..e6bf6b6a3 100644 --- a/src/ortho/oread/ortho_front.adb +++ b/src/ortho/oread/ortho_front.adb @@ -2114,13 +2114,16 @@ package body Ortho_Front is declare V : O_Enode; Bt : Node_Acc; + El_Type : Node_Acc; Res_Type : Node_Acc; begin Next_Token; if N_Type.Kind = Type_Subarray then Bt := N_Type.Subarray_Base; + El_Type := N_Type.Subarray_El; else Bt := N_Type; + El_Type := N_Type.Array_Element; end if; if Bt.Kind /= Type_Array then Parse_Error ("type of prefix is not an array"); @@ -2131,7 +2134,7 @@ package body Ortho_Front is Next_Token; else N := New_Indexed_Element (N, V); - N_Type := Bt.Array_Element; + N_Type := El_Type; end if; Expect (Tok_Right_Brack); Next_Token; diff --git a/src/std_names.adb b/src/std_names.adb index b9eeea05e..ffbfce1ef 100644 --- a/src/std_names.adb +++ b/src/std_names.adb @@ -792,7 +792,7 @@ package body Std_Names is Def ("valueof", Name_Valueof); Def ("valueOf", Name_uValueof); - -- VHDL special comments + -- Special comments Def ("psl", Name_Psl); Def ("pragma", Name_Pragma); Def ("synthesis", Name_Synthesis); @@ -803,6 +803,8 @@ package body Std_Names is Def ("synthesis_off", Name_Synthesis_Off); Def ("synthesis_on", Name_Synthesis_On); Def ("off", Name_Off); + Def ("full_case", Name_Full_Case); + Def ("parallel_case", Name_Parallel_Case); -- PSL keywords Def ("a", Name_A); diff --git a/src/std_names.ads b/src/std_names.ads index 46b7542df..45558cb48 100644 --- a/src/std_names.ads +++ b/src/std_names.ads @@ -920,7 +920,7 @@ package Std_Names is -- while Name_Last_BSV : constant Name_Id := Name_First_BSV + 49; - -- VHDL special comments + -- Special comments Name_First_Comment : constant Name_Id := Name_Last_BSV + 1; Name_Psl : constant Name_Id := Name_First_Comment + 0; Name_Pragma : constant Name_Id := Name_First_Comment + 1; @@ -932,7 +932,9 @@ package Std_Names is Name_Synthesis_Off : constant Name_Id := Name_First_Comment + 7; Name_Synthesis_On : constant Name_Id := Name_First_Comment + 8; Name_Off : constant Name_Id := Name_First_Comment + 9; - Name_Last_Comment : constant Name_Id := Name_Off; + Name_Full_Case : constant Name_Id := Name_First_Comment + 10; + Name_Parallel_Case : constant Name_Id := Name_First_Comment + 11; + Name_Last_Comment : constant Name_Id := Name_Parallel_Case; -- PSL words. Name_First_PSL : constant Name_Id := Name_Last_Comment + 1; diff --git a/src/synth/netlists-cleanup.adb b/src/synth/netlists-cleanup.adb index 2f741e3f3..d7d74b83d 100644 --- a/src/synth/netlists-cleanup.adb +++ b/src/synth/netlists-cleanup.adb @@ -112,6 +112,35 @@ package body Netlists.Cleanup is end loop; end Remove_Unconnected_Instances; + procedure Remove_Output_Gate (Inst : Instance) + is + use Netlists.Gates; + Inp : constant Input := Get_Input (Inst, 0); + In_Drv : constant Net := Get_Driver (Inp); + O : constant Net := Get_Output (Inst, 0); + begin + if In_Drv = O then + -- Connected to itself. + -- TODO: convert to initial value or to X. + return; + end if; + + if In_Drv /= No_Net then + -- Only when the output is driven. + Disconnect (Inp); + Redirect_Inputs (O, In_Drv); + else + Disconnect (Get_First_Sink (O)); + end if; + + if Get_Id (Inst) = Id_Ioutput then + -- Disconnect the initial value. + Disconnect (Get_Input (Inst, 1)); + end if; + + Remove_Instance (Inst); + end Remove_Output_Gate; + procedure Remove_Output_Gates (M : Module) is use Netlists.Gates; @@ -130,29 +159,7 @@ package body Netlists.Cleanup is | Id_Nop => -- Keep gates with an attribute. if not Has_Attribute (Inst) then - declare - Inp : Input; - In_Drv : Net; - O : Net; - begin - Inp := Get_Input (Inst, 0); - In_Drv := Get_Driver (Inp); - O := Get_Output (Inst, 0); - if In_Drv /= No_Net then - -- Only when the output is driven. - Disconnect (Inp); - Redirect_Inputs (O, In_Drv); - else - Disconnect (Get_First_Sink (O)); - end if; - - if Get_Id (Inst) = Id_Ioutput then - -- Disconnect the initial value. - Disconnect (Get_Input (Inst, 1)); - end if; - - Remove_Instance (Inst); - end; + Remove_Output_Gate (Inst); end if; when others => null; diff --git a/src/synth/netlists-disp_verilog.adb b/src/synth/netlists-disp_verilog.adb new file mode 100644 index 000000000..c0c6f0c0a --- /dev/null +++ b/src/synth/netlists-disp_verilog.adb @@ -0,0 +1,1346 @@ +-- Disp a netlist in verilog. +-- Copyright (C) 2021 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- 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, see <gnu.org/licenses>. + +with Simple_IO; use Simple_IO; +with Utils_IO; use Utils_IO; +with Types_Utils; use Types_Utils; +with Files_Map; + +with Netlists.Utils; use Netlists.Utils; +with Netlists.Iterators; use Netlists.Iterators; +with Netlists.Gates; use Netlists.Gates; +with Netlists.Locations; +with Netlists.Dump; use Netlists.Dump; + +package body Netlists.Disp_Verilog is + Flag_Merge_Lit : constant Boolean := True; + Flag_Merge_Edge : constant Boolean := True; + + procedure Put_Type (W : Width) is + begin + if W > 1 then + Put ("["); + Put_Uns32 (W - 1); + Put (":0] "); + end if; + end Put_Type; + + procedure Put_Name_Version (N : Sname) is + begin + Put_Uns32 (Get_Sname_Version (N)); + end Put_Name_Version; + + procedure Put_Name_1 (N : Sname) + is + Prefix : Sname; + begin + -- Do not crash on No_Name. + if N = No_Sname then + Put ("*nil*"); + return; + end if; + + Prefix := Get_Sname_Prefix (N); + if Prefix /= No_Sname then + Put_Name_1 (Prefix); + Put ("_"); + end if; + + case Get_Sname_Kind (N) is + when Sname_User => + Put_Id (Get_Sname_Suffix (N)); + when Sname_Artificial => + Put_Id (Get_Sname_Suffix (N)); + when Sname_Version => + Put ("n"); + Put_Name_Version (N); + end case; + end Put_Name_1; + + procedure Put_Name (N : Sname) is + begin + -- Do not crash on No_Name. + if N = No_Sname then + Put ("*nil*"); + return; + end if; + + if Get_Sname_Kind (N) = Sname_User + and then Get_Sname_Prefix (N) = No_Sname + then + Put_Id (Get_Sname_Suffix (N)); + else + Put_Name_1 (N); + end if; + end Put_Name; + + procedure Put_Interface_Name (N : Sname) is + begin + -- Do not crash on No_Name. + if N = No_Sname then + Put ("*nil*"); + return; + end if; + + -- Interface names are not versionned. + if Get_Sname_Kind (N) in Sname_User .. Sname_Artificial then + Put_Name (N); + else + Put ("*err*"); + end if; + end Put_Interface_Name; + + procedure Disp_Net_Name (N : Net) is + begin + if N = No_Net then + Put ("<unassigned>"); + return; + end if; + + declare + Inst : constant Instance := Get_Net_Parent (N); + Idx : constant Port_Idx := Get_Port_Idx (N); + M : Module; + Inst_Name : Sname; + Port_Name : Sname; + begin + if Is_Self_Instance (Inst) then + -- For ports of the current module, simply use the port name. + Put_Name (Get_Input_Desc (Get_Module (Inst), Idx).Name); + else + Inst_Name := Get_Instance_Name (Inst); + Put_Name (Inst_Name); + M := Get_Module (Inst); + case Get_Id (M) is + when Id_Signal + | Id_Isignal => + -- No suffix for signals (it's 'o'). + null; + when others => + Port_Name := Get_Output_Desc (M, Idx).Name; + Put ("_"); + Put_Interface_Name (Port_Name); + end case; + end if; + end; + end Disp_Net_Name; + + procedure Disp_Instance_Gate (Inst : Instance) + is + Imod : constant Module := Get_Module (Inst); + Idx : Port_Idx; + Max_Idx : Port_Idx; + Name : Sname; + First : Boolean; + Param : Param_Desc; + begin + Put (" "); + + -- Gate name + Name := Get_Module_Name (Imod); + if Get_Id (Imod) < Id_User_None then + Put (" gate_"); + pragma Assert (Get_Sname_Kind (Name) = Sname_Artificial + and then Get_Sname_Prefix (Name) = No_Sname); + Put_Id (Get_Sname_Suffix (Name)); + else + Put_Name (Name); + end if; + + -- Instance name + Put (" "); + Name := Get_Instance_Name (Inst); + if Get_Sname_Kind (Name) = Sname_Version then + Put ("inst_"); + Put_Name_Version (Name); + else + Put_Name (Name); + end if; + + if Get_Nbr_Params (Imod) /= 0 then + Put_Line (" #("); + for P in 1 .. Get_Nbr_Params (Inst) loop + Param := Get_Param_Desc (Imod, P - 1); + if P > 1 then + Put_Line (","); + end if; + Put (" ."); + Put_Interface_Name (Param.Name); + Put ("("); + case Param.Typ is + when Param_Uns32 => + Put_Uns32 (Get_Param_Uns32 (Inst, P - 1)); + when Param_Types_Pval => + Disp_Pval_Binary (Get_Param_Pval (Inst, P - 1)); + when Param_Invalid => + Put ("*invalid*"); + end case; + Put (")"); + end loop; + Put_Line (")"); + Put_Line (" ("); + else + Put_Line (" ("); + end if; + + First := True; + -- Inputs + Idx := 0; + Max_Idx := Get_Nbr_Inputs (Imod); + for I of Inputs (Inst) loop + if First then + First := False; + else + Put_Line (","); + end if; + Put (" "); + if Idx < Max_Idx then + Put ("."); + Put_Interface_Name (Get_Input_Desc (Imod, Idx).Name); + Put ("("); + end if; + Disp_Net_Name (Get_Driver (I)); + if Idx < Max_Idx then + Put (")"); + Idx := Idx + 1; + end if; + end loop; + -- Outputs + Idx := 0; + for O of Outputs (Inst) loop + if First then + First := False; + else + Put_Line (","); + end if; + Put (" ."); + Put_Interface_Name (Get_Output_Desc (Imod, Idx).Name); + Idx := Idx + 1; + Put ("("); + declare + I : Input; + begin + I := Get_First_Sink (O); + if I = No_Input then + Put ("open"); + else + Disp_Net_Name (O); + end if; + end; + Put (")"); + end loop; + Put_Line (");"); + end Disp_Instance_Gate; + + procedure Disp_Binary_Lit (Va : Uns32; Zx : Uns32; Wd : Width) is + begin + Put_Uns32 (Wd); + Put ("'b"); + Disp_Binary_Digits (Va, Zx, Natural (Wd)); + end Disp_Binary_Lit; + + procedure Disp_Const_Bit (Inst : Instance) + is + W : constant Width := Get_Width (Get_Output (Inst, 0)); + Nd : constant Width := W / 32; + Ld : constant Natural := Natural (W mod 32); + begin + Put ('"'); + if Ld > 0 then + Disp_Binary_Digits (Get_Param_Uns32 (Inst, Param_Idx (Nd)), 0, Ld); + end if; + for I in reverse 1 .. Nd loop + Disp_Binary_Digits + (Get_Param_Uns32 (Inst, Param_Idx (I - 1)), 0, 32); + end loop; + Put ('"'); + end Disp_Const_Bit; + + procedure Disp_Const_Log (Inst : Instance) + is + W : constant Width := Get_Width (Get_Output (Inst, 0)); + Nd : constant Width := W / 32; + Ld : constant Natural := Natural (W mod 32); + begin + Put ('"'); + if Ld > 0 then + Disp_Binary_Digits (Get_Param_Uns32 (Inst, Param_Idx (2 * Nd)), + Get_Param_Uns32 (Inst, Param_Idx (2 * Nd + 1)), + Ld); + end if; + for I in reverse 1 .. Nd loop + Disp_Binary_Digits + (Get_Param_Uns32 (Inst, Param_Idx (2 * (I - 1))), + Get_Param_Uns32 (Inst, Param_Idx (2 * (I - 1)) + 1), + 32); + end loop; + Put ('"'); + end Disp_Const_Log; + + procedure Disp_X_Lit (W : Width; C : Character) is + begin + Put_Uns32 (W); + Put ("'b"); + Put (C); + end Disp_X_Lit; + + procedure Disp_Extract (Inst : Instance); + + procedure Disp_Constant_Inline (Inst : Instance) + is + Imod : constant Module := Get_Module (Inst); + O : constant Net := Get_Output (Inst, 0); + begin + case Get_Id (Imod) is + when Id_Const_UB32 + | Id_Const_SB32 => + Disp_Binary_Lit (Get_Param_Uns32 (Inst, 0), 0, Get_Width (O)); + when Id_Const_UL32 => + Disp_Binary_Lit (Get_Param_Uns32 (Inst, 0), + Get_Param_Uns32 (Inst, 1), + Get_Width (O)); + when Id_Const_Z => + Disp_X_Lit (Get_Width (O), 'Z'); + when Id_Const_X => + Disp_X_Lit (Get_Width (O), 'X'); + when Id_Const_Bit => + Disp_Const_Bit (Inst); + when Id_Const_Log => + Disp_Const_Log (Inst); + when Id_Extract => + Disp_Extract (Inst); + when others => + raise Internal_Error; + end case; + end Disp_Constant_Inline; + + procedure Disp_Const_Bit (Inst : Instance; Off : Uns32) + is + Val : Uns32; + Zx : Uns32; + begin + case Get_Id (Inst) is + when Id_Const_Bit => + Zx := 0; + Val := Get_Param_Uns32 (Inst, Param_Idx (Off / 32)); + Val := Shift_Right (Val, Natural (Off mod 32)) and 1; + when Id_Const_Log => + Zx := Get_Param_Uns32 (Inst, 2 * Param_Idx (Off / 32) + 1); + Zx := Shift_Right (Zx, Natural (Off mod 32)) and 1; + Val := Get_Param_Uns32 (Inst, 2 * Param_Idx (Off / 32)); + Val := Shift_Right (Val, Natural (Off mod 32)) and 1; + when Id_Const_UB32 => + Zx := 0; + if Off < 32 then + Val := Get_Param_Uns32 (Inst, 0); + Val := Shift_Right (Val, Natural (Off mod 32)) and 1; + else + Val := 0; + end if; + when Id_Const_UL32 => + if Off < 32 then + Val := Get_Param_Uns32 (Inst, 0); + Val := Shift_Right (Val, Natural (Off mod 32)) and 1; + Zx := Get_Param_Uns32 (Inst, 1); + Zx := Shift_Right (Zx, Natural (Off mod 32)) and 1; + else + Val := 0; + Zx := 0; + end if; + when Id_Const_X => + Zx := 1; + Val := 1; + when others => + raise Internal_Error; + end case; + Put (Bchar (Zx * 2 + Val)); + end Disp_Const_Bit; + + procedure Disp_Memory_Init (Port : Net; Val : Net; W : Width; Depth : Width) + is + Inst : constant Instance := Get_Net_Parent (Val); + begin + case Get_Id (Inst) is + when Id_Const_X => + return; + when others => + null; + end case; + + Put_Line (" initial begin"); + for I in reverse 0 .. Depth - 1 loop + Put (" "); + Disp_Net_Name (Port); + Put ("["); + Put_Uns32 (I); + Put ("] = "); + Put_Uns32 (W); + Put ("'b"); + for J in reverse 0 .. W - 1 loop + Disp_Const_Bit (Inst, I * W + J); + end loop; + Put_Line (";"); + end loop; + Put_Line (" end"); + end Disp_Memory_Init; + + function Need_Name (Inst : Instance) return Boolean + is + Id : constant Module_Id := Get_Id (Inst); + begin + case Id is + when Id_Extract + | Id_Dyn_Extract + | Id_Dyn_Insert + | Id_Utrunc + | Id_Strunc => + return True; + when Id_User_None .. Module_Id'Last => + return True; + when others => + return False; + end case; + end Need_Name; + + -- Return True if constant INST is connected to an instance that needs + -- a name. In that case, a signal will be created and driven. + function Need_Signal (Inst : Instance) return Boolean + is + I : Input; + begin + I := Get_First_Sink (Get_Output (Inst, 0)); + while I /= No_Input loop + if Need_Name (Get_Input_Parent (I)) then + return True; + end if; + I := Get_Next_Sink (I); + end loop; + return False; + end Need_Signal; + + -- Return TRUE if edge INST (posedge or negedge) is used outside clock + -- inputs. + function Need_Edge (Inst : Instance) return Boolean + is + I : Input; + Parent : Instance; + begin + I := Get_First_Sink (Get_Output (Inst, 0)); + while I /= No_Input loop + Parent := Get_Input_Parent (I); + case Get_Id (Parent) is + when Id_Dff + | Id_Adff + | Id_Idff + | Id_Iadff => + if I /= Get_Input (Parent, 0) then + return True; + end if; + when Id_Mem_Rd_Sync + | Id_Mem_Wr_Sync => + if I /= Get_Input (Parent, 2) then + return True; + end if; + when others => + return True; + end case; + I := Get_Next_Sink (I); + end loop; + return False; + end Need_Edge; + + type Conv_Type is + (Conv_None, Conv_Unsigned, Conv_Signed, Conv_Edge, Conv_Clock); + + procedure Disp_Net_Expr (N : Net; Inst : Instance; Conv : Conv_Type) + is + Net_Inst : Instance; + begin + if N = No_Net then + Put ("<unassigned>"); + return; + end if; + + Net_Inst := Get_Net_Parent (N); + if Flag_Merge_Lit + and then Get_Id (Net_Inst) in Constant_Module_Id + and then not Need_Name (Inst) + then + case Conv is + when Conv_None => + Disp_Constant_Inline (Net_Inst); + when Conv_Unsigned => + Put ("$unsigned("); + Disp_Constant_Inline (Net_Inst); + Put (")"); + when Conv_Signed => + Put ("$signed("); + Disp_Constant_Inline (Net_Inst); + Put (")"); + when Conv_Edge + | Conv_Clock => + -- Not expected: a constant is not an edge. + raise Internal_Error; + end case; + else + case Conv is + when Conv_None => + Disp_Net_Name (N); + when Conv_Edge => + case Edge_Module_Id (Get_Id (Net_Inst)) is + when Id_Posedge => + Put ("posedge "); + when Id_Negedge => + Put ("negedge "); + end case; + Disp_Net_Name (Get_Input_Net (Net_Inst, 0)); + when Conv_Clock => + Disp_Net_Name (Get_Input_Net (Net_Inst, 0)); + when Conv_Unsigned => + Put ("$unsigned("); + Disp_Net_Name (N); + Put (")"); + when Conv_Signed => + Put ("$signed("); + Disp_Net_Name (N); + Put (")"); + end case; + end if; + end Disp_Net_Expr; + + NL : constant Character := ASCII.LF; + + type Uns32_Array is array (Natural range <>) of Uns32; + No_Uns32_Arr : constant Uns32_Array := (1 .. 0 => 0); + + -- Template: + -- \[C]AN + -- C: conversion u: unsigned, s: signed, f: force logic + -- A: argument o: output, i: input, n: value, p: parameter, l: label + -- N: argument number (0-9) + procedure Disp_Template + (S : String; Inst : Instance; Val : Uns32_Array := No_Uns32_Arr) + is + I : Positive; + C : Character; + Idx : Natural; + N : Net; + Conv : Conv_Type; + V : Uns32; + begin + I := S'First; + while I <= S'Last loop + C := S (I); + -- Escape character. + if C = '\' then + I := I + 1; + -- Conversion (optional). + case S (I) is + when 'u' => + Conv := Conv_Unsigned; + I := I + 1; + when 's' => + Conv := Conv_Signed; + I := I + 1; + when 'e' => + Conv := Conv_Edge; + I := I + 1; + when 'c' => + Conv := Conv_Clock; + I := I + 1; + when others => + Conv := Conv_None; + end case; + Idx := Character'Pos (S (I + 1)) - Character'Pos ('0'); + case S (I) is + when 'o' => + pragma Assert (Conv = Conv_None); + N := Get_Output (Inst, Port_Idx (Idx)); + Disp_Net_Name (N); + when 'i' => + N := Get_Input_Net (Inst, Port_Idx (Idx)); + Disp_Net_Expr (N, Inst, Conv); + when 'n' => + V := Val (Idx); + Put_Uns32 (V); + when 'p' => + V := Get_Param_Uns32 (Inst, Param_Idx (Idx)); + case Conv is + when Conv_None + | Conv_Unsigned => + Put_Uns32 (V); + when Conv_Signed => + Put_Int32 (To_Int32 (V)); + when Conv_Edge + | Conv_Clock => + raise Internal_Error; + end case; + when 'l' => + pragma Assert (Idx = 0); + pragma Assert (Conv = Conv_None); + Put_Name (Get_Instance_Name (Inst)); + when others => + raise Internal_Error; + end case; + + I := I + 2; + else + Put (C); + I := I + 1; + end if; + end loop; + end Disp_Template; + + procedure Disp_Extract (Inst : Instance) + is + O : constant Net := Get_Output (Inst, 0); + I : constant Net := Get_Input_Net (Inst, 0); + Wd : constant Width := Get_Width (O); + Off : constant Uns32 := Get_Param_Uns32 (Inst, 0); + begin + Disp_Template ("\i0", Inst); + if Get_Width (I) > 1 then + -- If width is 1, the signal is declared as a scalar and + -- therefore cannot be indexed. + if Wd > 1 then + Disp_Template ("[\n0:\n1]", Inst, + (0 => Off + Wd - 1, 1 => Off)); + elsif Wd = 1 then + Disp_Template ("[\n0]", Inst, (0 => Off)); + else + Disp_Template (" (-1 downto 0)", Inst); + end if; + end if; + end Disp_Extract; + + procedure Disp_Memory (Mem : Instance) + is + Ports : constant Net := Get_Output (Mem, 0); + Port : Net; + Port_Inst : Instance; + S : Net; + Data_W : Width; + Depth : Uns32; + begin + -- Display a process, with as sensitivity elements: + -- * write clocks + -- * read address + -- As statements: + Data_W := 0; + Port := Ports; + loop + Port_Inst := Get_Input_Parent (Get_First_Sink (Port)); + case Get_Id (Port_Inst) is + when Id_Mem_Wr_Sync => + -- Clock + S := Get_Input_Net (Port_Inst, 2); + -- Strip the edge. + S := Get_Input_Net (Get_Net_Parent (S), 0); + Data_W := Get_Width (Get_Input_Net (Port_Inst, 4)); + when Id_Mem_Rd => + -- Address + S := Get_Input_Net (Port_Inst, 1); + Data_W := Get_Width (Get_Output (Port_Inst, 1)); + when Id_Mem_Rd_Sync => + -- Clock + S := Get_Input_Net (Port_Inst, 2); + -- Strip the edge. + S := Get_Input_Net (Get_Net_Parent (S), 0); + Data_W := Get_Width (Get_Output (Port_Inst, 1)); + when Id_Memory + | Id_Memory_Init => + exit; + when others => + raise Internal_Error; + end case; + Port := Get_Output (Port_Inst, 0); + end loop; + + Depth := Get_Width (Ports) / Data_W; + + -- Declare the memory. + Put (" reg "); + Put_Type (Data_W); + Disp_Net_Name (Ports); + Put_Type (Depth); + Put_Line("; // memory"); + + -- Initialization + if Get_Id (Mem) = Id_Memory_Init then + declare + Val : Net; + Val_Inst : Instance; + begin + Val := Get_Input_Net (Mem, 1); + Val_Inst := Get_Net_Parent (Val); + if Get_Id (Val_Inst) = Id_Isignal then + Val := Get_Input_Net (Val_Inst, 1); + end if; + Disp_Memory_Init (Ports, Val, Data_W, Depth); + end; + end if; + + Port := Ports; + loop + Port_Inst := Get_Input_Parent (Get_First_Sink (Port)); + case Get_Id (Port_Inst) is + when Id_Mem_Wr_Sync => + Disp_Template + (" always @(\ei2)" & NL & + " if (\i3)" & NL, Port_Inst); + Disp_Template + (" \o0", Mem); + Disp_Template ("[\i1] <= \i4;" & NL, Port_Inst); + when Id_Mem_Rd => + Disp_Template (" assign \o1 = ", Port_Inst); + Disp_Template ("\o0", Mem); + Disp_Template ("[\i1];" & NL, Port_Inst); + when Id_Mem_Rd_Sync => + Disp_Template + (" always @(\ei2)" & NL & + " if (\i3)" & NL & + " \o1 <= ", Port_Inst); + Disp_Template ("\o0", Mem); + Disp_Template ("[\i1];" & NL, Port_Inst); + when Id_Memory + | Id_Memory_Init => + exit; + when others => + raise Internal_Error; + end case; + Port := Get_Output (Port_Inst, 0); + end loop; + end Disp_Memory; + + procedure Disp_Pmux (Inst : Instance) + is + Def : constant Net := Get_Input_Net (Inst, 0); + W : constant Width := Get_Width (Def); + begin + Disp_Template (" always @*" & NL & + " case (\i0)" & NL, Inst); + for I in 1 .. W loop + Put (" "); + -- One hot encoding. + Put_Uns32 (W); + Put ("'b"); + for J in 1 .. W loop + if I = J then + Put ('1'); + else + Put ('0'); + end if; + end loop; + Disp_Template (": \o0 <= ", Inst); + Disp_Net_Expr + (Get_Input_Net (Inst, Port_Idx (2 + W - I)), Inst, Conv_None); + Put_Line (";"); + end loop; + Disp_Template (" endcase" & NL, Inst); + end Disp_Pmux; + + procedure Disp_Instance_Inline (Inst : Instance) + is + Imod : constant Module := Get_Module (Inst); + Loc : constant Location_Type := Locations.Get_Location (Inst); + Id : constant Module_Id := Get_Id (Imod); + begin + if Loc /= No_Location then + declare + File : Name_Id; + Line : Positive; + Col : Natural; + begin + Files_Map.Location_To_Position (Loc, File, Line, Col); + Put (" /* "); + Put_Id (File); + Put (':'); + Put_Uns32 (Uns32 (Line)); + Put (':'); + Put_Uns32 (Uns32 (Col)); + Put (" */"); + New_Line; + end; + end if; + case Id is + when Id_Memory + | Id_Memory_Init => + Disp_Memory (Inst); + when Id_Mem_Rd + | Id_Mem_Rd_Sync + | Id_Mem_Wr_Sync => + null; + when Id_Output => + Disp_Template (" assign \o0 = \i0; // (output)" & NL, Inst); + when Id_Inout + | Id_Iinout => + -- Gates inout are special: output 1 must be connected to an + -- output (with the is_inout flag set) of the module. + Disp_Template (" assign \o1 = \i0; // (inout - port)" & NL, Inst); + Disp_Template (" assign \o0 = ", Inst); + declare + Inp : constant Input := Get_First_Sink (Get_Output (Inst, 1)); + Iinst : constant Instance := Get_Input_Parent (Inp); + begin + Put_Name (Get_Output_Name (Get_Module (Iinst), + Get_Port_Idx (Inp))); + end; + Put ("; // (inout - read)" & NL); + when Id_Signal => + Disp_Template (" assign \o0 = \i0; // (signal)" & NL, Inst); + when Id_Isignal => + if Get_Driver (Get_Input (Inst, 0)) /= No_Net then + -- It is possible (and meaningful) to have unassigned + -- isignal. + Disp_Template (" assign \o0 = \i0; // (isignal)" & NL, Inst); + end if; + when Id_Port => + Disp_Template (" \o0 <= \i0; -- (port)" & NL, Inst); + when Id_Nop => + Disp_Template (" \o0 <= \i0; -- (nop)" & NL, Inst); + when Id_Enable => + Disp_Template (" \o0 <= \i0; -- (enable)" & NL, Inst); + when Id_Not => + Disp_Template (" assign \o0 = ~\i0;" & NL, Inst); + when Id_Neg => + Disp_Template (" assign \o0 = -\i0;" & NL, Inst); + when Id_Abs=> + Disp_Template (" \o0 <= std_logic_vector(abs \si0);" & NL, Inst); + when Id_Extract => + Disp_Template (" assign \o0 = ", Inst); + Disp_Extract (Inst); + Put_Line (";"); + when Id_Memidx => + declare + Step : constant Uns32 := Get_Param_Uns32 (Inst, 0); + begin + Disp_Template + (" assign \o0 = \i0 * \p0;" & NL, Inst, (0 => Step)); + end; + when Id_Addidx => + declare + W0 : constant Width := Get_Width (Get_Input_Net (Inst, 0)); + W1 : constant Width := Get_Width (Get_Input_Net (Inst, 1)); + begin + if W0 > W1 then + Disp_Template + (" \o0 <= std_logic_vector (\ui0 + resize(\ui1, \n0));" + & NL, Inst, (0 => W0)); + elsif W0 < W1 then + Disp_Template + (" \o0 <= std_logic_vector (resize (\ui0, \n0) + \ui1);" + & NL, Inst, (0 => W1)); + else + pragma Assert (W0 = W1); + Disp_Template + (" \o0 <= std_logic_vector (\ui0 + \ui1);" + & NL, Inst); + end if; + end; + when Id_Dyn_Extract => + declare + O : constant Net := Get_Output (Inst, 0); + Wd : constant Width := Get_Width (O); + Off : constant Uns32 := Get_Param_Uns32 (Inst, 0); + begin + Disp_Template + (" assign \o0 = \i0[\i1 + \n0 -: \n1]; //(dyn_extract)" & NL, + Inst, (0 => Off, 1 => Wd)); + end; + when Id_Dyn_Insert + | Id_Dyn_Insert_En => + declare + -- I0: Input, I1: Value, I2: position + -- P0: offset + Iw : constant Width := Get_Width (Get_Input_Net (Inst, 1)); + begin + Put (" always @* begin // (dyn_insert)" & NL); + Disp_Template (" \o0 <= \i0;" & NL, Inst); + if Id = Id_Dyn_Insert_En then + -- TODO: fix indentation. + Disp_Template (" if (\i3)" & NL, Inst); + end if; + Disp_Template + (" \o0 [\i2 + \p0 -: \n0] <= \i1;" & NL, + Inst, (0 => Iw - 1)); + Disp_Template (" end" & NL, Inst); + end; + when Id_Const_UB32 + | Id_Const_UL32 + | Id_Const_Z + | Id_Const_X => + Disp_Template (" \o0 <= ", Inst); + Disp_Constant_Inline (Inst); + Put_Line (";"); + when Id_Const_Bit => + null; + when Id_Adff + | Id_Iadff => + Disp_Template (" always @(\ei0 or posedge \i2)" & NL & + " if (\i2)" & NL & + " \o0 <= \i3;" & NL & + " else" & NL & + " \o0 <= \i1;" & NL, Inst); + when Id_Dff + | Id_Idff => + Disp_Template (" always @(\ei0)" & NL & + " \o0 <= \i1;" & NL, Inst); + when Id_Mux2 => + Disp_Template (" assign \o0 = \i0 ? \i2 : \i1;" & NL, Inst); + when Id_Mux4 => + Disp_Template (" always @*" & NL & + " case (\i0)" & NL & + " 2'b00: \o0 <= \i1;" & NL & + " 2'b01: \o0 <= \i2;" & NL & + " 2'b10: \o0 <= \i3;" & NL & + " 2'b11: \o0 <= \i4;" & NL & + " endcase" & NL, Inst); + when Id_Pmux => + Disp_Pmux (Inst); + when Id_Add => + Disp_Template (" assign \o0 = \i0 + \i1;" & NL, Inst); + when Id_Sub => + Disp_Template (" assign \o0 = \i0 - \i1;" & NL, Inst); + when Id_Umin => + Disp_Template (" assign \o0 = (\i0 < \i1) ? \i0 : \i1;" & NL, + Inst); + when Id_Smin => + Disp_Template (" \o0 <= \i0 when \si0 < \si1 else \i1;" & NL, + Inst); + when Id_Umax => + Disp_Template (" assign \o0 = (\i0 > \i1) ? \i0 : \i1;" & NL, + Inst); + when Id_Smax => + Disp_Template (" \o0 <= \i0 when \si0 > \si1 else \i1;" & NL, + Inst); + when Id_Umul => + Disp_Template (" assign \o0 = \i0 * \i1; // umul" & NL, Inst); + when Id_Smul => + Disp_Template (" assign \o0 = \i0 * \i1; // smul" & NL, Inst); + when Id_Smod => + Disp_Template (" assign \o0 = \i0 % \i1; // smod" & NL, Inst); + when Id_Srem => + Disp_Template (" assign \o0 = \i0 % \i1; // srem" & NL, Inst); + when Id_Umod => + Disp_Template (" assign \o0 = \i0 % \i1; // umod" & NL, Inst); + when Id_Sdiv => + Disp_Template (" assign \o0 = \i0 / \i1; // sdiv" & NL, Inst); + when Id_Udiv => + Disp_Template (" assign \o0 = \i0 / \i1; // udiv" & NL, Inst); + when Id_Lsl => + Disp_Template (" assign \o0 = \i0 << \i1;" & NL, Inst); + when Id_Lsr => + Disp_Template (" assign \o0 = \i0 >> \i1;" & NL, Inst); + when Id_Asr => + Disp_Template (" assign \o0 = \si0 >> \i1;" & NL, Inst); + when Id_Rol => + Disp_Template + (" \o0 <= std_logic_vector " + & "(rotate_left (\ui0, to_integer (\ui1)));" & NL, Inst); + + when Id_Ult => + Disp_Template (" assign \o0 = \ui0 < \ui1;" & NL, Inst); + when Id_Ule => + Disp_Template (" assign \o0 = \ui0 <= \ui1;" & NL, Inst); + when Id_Ugt => + Disp_Template (" assign \o0 = \ui0 > \ui1;" & NL, Inst); + when Id_Uge => + Disp_Template (" assign \o0 = \ui0 >= \ui1;" & NL, Inst); + when Id_Slt => + Disp_Template (" assign \o0 = \si0 < \si1;" & NL, Inst); + when Id_Sle => + Disp_Template (" assign \o0 = \si0 <= \si1;" & NL, Inst); + when Id_Sgt => + Disp_Template (" assign \o0 = \si0 > \si1;" & NL, Inst); + when Id_Sge => + Disp_Template (" assign \o0 = \si0 >= \si1;" & NL, Inst); + when Id_Eq => + Disp_Template (" assign \o0 = \i0 == \i1;" & NL, Inst); + when Id_Ne => + Disp_Template (" assign \o0 = \i0 != \i1;" & NL, Inst); + when Id_Or => + Disp_Template (" assign \o0 = \i0 | \i1;" & NL, Inst); + when Id_And => + Disp_Template (" assign \o0 = \i0 & \i1;" & NL, Inst); + when Id_Xor => + Disp_Template (" assign \o0 = \i0 ^ \i1;" & NL, Inst); + when Id_Nor => + Disp_Template (" assign \o0 = ~(\i0 | \i1);" & NL, Inst); + when Id_Nand => + Disp_Template (" assign \o0 = ~(\i0 & \i1);" & NL, Inst); + when Id_Xnor => + Disp_Template (" assign \o0 = ~(\i0 ^ \i1);" & NL, Inst); + + when Id_Concat2 => + Disp_Template (" assign \o0 = {\i0, \i1};" & NL, Inst); + when Id_Concat3 => + Disp_Template (" assign \o0 = {\i0, \i1, \i2};" & NL, Inst); + when Id_Concat4 => + Disp_Template (" assign \o0 = {\i0, \i1, \i2, \i3};" & NL, Inst); + when Id_Concatn => + Disp_Template (" assign \o0 = {\i0", Inst); + for I in 1 .. Get_Nbr_Inputs (Inst) - 1 loop + Disp_Template (", ", Inst); + Disp_Net_Expr (Get_Input_Net (Inst, I), Inst, Conv_None); + end loop; + Disp_Template("};" & NL, Inst); + when Id_Utrunc + | Id_Strunc => + declare + W : constant Width := Get_Width (Get_Output (Inst, 0)); + begin + if W = 0 then + -- Do not try to slice the input, as it can be a single + -- wire. + Disp_Template (" assign \o0 = """"", Inst); + else + Disp_Template (" assign \o0 = \i0", Inst); + if W = 1 then + Disp_Template ("[0]", Inst); + else + Disp_Template ("[\n0:0]", Inst, (0 => W - 1)); + end if; + end if; + Disp_Template ("; // trunc" & NL, Inst); + end; + when Id_Uextend => + declare + Ow : constant Width := Get_Width (Get_Output (Inst, 0)); + Iw : constant Width := Get_Width (Get_Input_Net (Inst, 0)); + begin + pragma Assert (Ow > Iw); + Disp_Template (" assign \o0 = {", Inst); + Put_Uns32 (Ow - Iw); + Disp_Template ("'b0, \i0}; // uext" & NL, Inst); + end; + when Id_Sextend => + declare + Ow : constant Width := Get_Width (Get_Output (Inst, 0)); + Iw : constant Width := Get_Width (Get_Input_Net (Inst, 0)); + begin + pragma Assert (Ow > Iw); + Disp_Template (" assign \o0 = {{\n0{\i0", + Inst, (0 => Ow - Iw)); + if Iw > 1 then + Disp_Template ("[\n0]", Inst, (0 => Iw - 1)); + end if; + Disp_Template ("}}, \i0}; // sext" & NL, Inst); + end; + when Id_Red_Or => + Disp_Template (" assign \o0 = |(\i0);" & NL, Inst); + when Id_Red_And => + Disp_Template (" assign \o0 = &(\i0);" & NL, Inst); + when Id_Red_Xor => + Disp_Template (" assign \o0 = ^(\i0);" & NL, Inst); + + when Id_Posedge => + Disp_Template (" assign \o0 = 1'b0; // posedge" & NL, Inst); + when Id_Negedge => + Disp_Template (" assign \o0 = 1'b0; // negedge" & NL, Inst); + when Id_Tri => + Disp_Template (" assign \o0 = \i0 ? \i1 : \n0'bz;" & NL, + Inst, (0 => Get_Width (Get_Output (Inst, 0)))); + when Id_Assert => + Disp_Template + (" always @*" & NL & + " if (!\i0)" & NL & + " $fatal(1, ""assertion failure \l0"");" & NL, Inst); + when Id_Assume => + Disp_Template + (" \l0: assert \i0 = '1' severity warning; -- assume" & NL, + Inst); + when Id_Cover => + Disp_Template + (" \l0: assert \i0 = '1' severity note; -- cover" & NL, + Inst); + when Id_Assert_Cover => + Disp_Template + (" always @*" & NL & + " if (!\i0)" & NL & + " $fatal(1, ""assertion(cover) failure \l0"");" & NL, + Inst); + when Id_Resolver => + Disp_Template + (" assign \o0 = \i0;" & NL, Inst); + Disp_Template + (" assign \o0 = \i1;" & NL, Inst); + when others => + Disp_Instance_Gate (Inst); + end case; + end Disp_Instance_Inline; + + procedure Disp_Module_Declarations (M : Module) + is + Id : Module_Id; + begin + for Inst of Instances (M) loop + Id := Get_Id (Inst); + case Id is + when Id_Memory + | Id_Memory_Init => + -- For memories: skip the chain. + null; + when Id_Mem_Wr_Sync => + -- For memories: skip the chain. + null; + when Id_Mem_Rd + | Id_Mem_Rd_Sync => + -- For memories: skip the chain. + declare + N : constant Net := Get_Output (Inst, 1); + begin + if Id = Id_Mem_Rd_Sync then + Put (" reg "); + else + Put (" wire "); + end if; + Put_Type (Get_Width (N)); + Disp_Net_Name (N); + Put_Line ("; // mem_rd"); + end; + when others => + if Is_Self_Instance (Inst) + or else (Flag_Merge_Lit + and then Id in Constant_Module_Id + and then Id < Id_User_None + and then not Need_Signal (Inst)) + or else (Flag_Merge_Edge + and then Id in Edge_Module_Id + and then not Need_Edge (Inst)) + then + -- Not displayed. + null; + else + -- Check location is present. + if Locations.Get_Location (Inst) = No_Location then + case Id is + when Id_Const_UB32 + | Id_Const_SB32 + | Id_Const_UL32 + | Id_Const_Bit + | Id_Const_Log + | Id_Const_Z + | Id_Const_X + | Id_Const_0 + | Id_Concat2 + | Id_Concat3 + | Id_Concat4 + | Id_Concatn + | Id_Extract => + null; + when others => + raise Internal_Error; + end case; + end if; + + -- Display reg/wire for each output. + for N of Outputs (Inst) loop + case Id is + when Id_Dff + | Id_Idff + | Id_Adff + | Id_Iadff => + -- As expected + Put (" reg "); + when Id_Mux4 + | Id_Pmux + | Id_Dyn_Insert + | Id_Dyn_Insert_En => + -- Implemented by a process + Put (" reg "); + when Constant_Module_Id => + Put (" localparam "); + when others => + Put (" wire "); + end case; + Put_Type (Get_Width (N)); + Disp_Net_Name (N); + if Id in Constant_Module_Id then + Put (" = "); + Disp_Constant_Inline (Inst); + end if; + Put_Line (";"); + end loop; + end if; + end case; + end loop; + end Disp_Module_Declarations; + + procedure Disp_Module_Statements (M : Module) + is + Self_Inst : constant Instance := Get_Self_Instance (M); + begin + -- Output assignments. + declare + Idx : Port_Idx; + begin + Idx := 0; + for I of Inputs (Self_Inst) loop + Put (" assign "); + Put_Name (Get_Output_Desc (M, Idx).Name); + Put (" = "); + Disp_Net_Name (Get_Driver (I)); + Put_Line (";"); + Idx := Idx + 1; + end loop; + end; + + for Inst of Instances (M) loop + case Get_Id (Inst) is + when Constant_Module_Id => + if not Flag_Merge_Lit then + Disp_Instance_Inline (Inst); + end if; + when Edge_Module_Id => + if (not Flag_Merge_Edge) or else Need_Edge (Inst) then + Disp_Instance_Inline (Inst); + end if; + when others => + Disp_Instance_Inline (Inst); + end case; + end loop; + end Disp_Module_Statements; + + procedure Disp_Module_Port + (Desc : Port_Desc; Dir : Port_Kind; First : in out Boolean) is + begin + if First then + Put (" ("); + First := False; + else + Put_Line (","); + Put (" "); + end if; + case Dir is + when Port_In => + Put ("input "); + when Port_Out => + Put ("output "); + when Port_Inout => + Put ("inout "); + end case; + Put_Type (Desc.W); + Put_Name (Desc.Name); + end Disp_Module_Port; + + procedure Disp_Module_Ports (M : Module) + is + First : Boolean; + Desc : Port_Desc; + begin + First := True; + for I in 1 .. Get_Nbr_Inputs (M) loop + Disp_Module_Port (Get_Input_Desc (M, I - 1), Port_In, First); + end loop; + for I in 1 .. Get_Nbr_Outputs (M) loop + Desc := Get_Output_Desc (M, I - 1); + if Desc.Is_Inout then + Disp_Module_Port (Desc, Port_Inout, First); + else + Disp_Module_Port (Desc, Port_Out, First); + end if; + end loop; + if not First then + Put (")"); + end if; + Put_Line (";"); + end Disp_Module_Ports; + + procedure Disp_Module_Parameters (M : Module) + is + Nbr : constant Param_Nbr := Get_Nbr_Params (M); + Desc : Param_Desc; + begin + if Nbr = 0 then + return; + end if; + for I in 1 .. Nbr loop + if I = 1 then + Put_Line (" #("); + else + Put_Line (","); + end if; + Desc := Get_Param_Desc (M, I - 1); + Put (" "); + Put_Name (Desc.Name); + end loop; + Put_Line (")"); + end Disp_Module_Parameters; + + procedure Disp_Verilog_Module (M : Module) + is + Self_Inst : constant Instance := Get_Self_Instance (M); + begin + -- Module id and name. + Put ("module "); + Put_Name (Get_Module_Name (M)); + New_Line; + + Disp_Module_Parameters (M); + + Disp_Module_Ports (M); + + if Self_Inst /= No_Instance then + Disp_Module_Declarations (M); + Disp_Module_Statements (M); + end if; + Put_Line ("endmodule"); + New_Line; + end Disp_Verilog_Module; + + procedure Disp_Verilog (M : Module; Is_Top : Boolean) is + begin + -- Disp in reverse order. + declare + Num : Natural; + begin + Num := 0; + for S of Sub_Modules (M) loop + if Get_Id (S) >= Id_User_None then + Num := Num + 1; + end if; + end loop; + + declare + type Module_Array is array (1 .. Num) of Module; + Modules : Module_Array; + begin + Num := 0; + for S of Sub_Modules (M) loop + if Get_Id (S) >= Id_User_None then + Num := Num + 1; + Modules (Num) := S; + end if; + end loop; + + for I in reverse Modules'Range loop + Disp_Verilog (Modules (I), False); + end loop; + end; + end; + + if not Is_Top then + Disp_Verilog_Module (M); + end if; + end Disp_Verilog; + + procedure Disp_Verilog (M : Module) is + begin + Disp_Verilog (M, True); + end Disp_Verilog; +end Netlists.Disp_Verilog; diff --git a/src/synth/netlists-disp_verilog.ads b/src/synth/netlists-disp_verilog.ads new file mode 100644 index 000000000..0873c0eb9 --- /dev/null +++ b/src/synth/netlists-disp_verilog.ads @@ -0,0 +1,21 @@ +-- Disp a netlist in verilog. +-- Copyright (C) 2021 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- 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, see <gnu.org/licenses>. + +package Netlists.Disp_Verilog is + procedure Disp_Verilog (M : Module); +end Netlists.Disp_Verilog; diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb index 001b417ca..9c9385dd4 100644 --- a/src/synth/synth-environment.adb +++ b/src/synth/synth-environment.adb @@ -69,6 +69,22 @@ package body Synth.Environment is Wire_Rec.Kind := Wire_None; end Free_Wire; + procedure Set_Kind (Wid : Wire_Id; Kind : Wire_Kind) + is + Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); + begin + pragma Assert (Kind = Wire_Unset or Wire_Rec.Kind = Wire_Unset); + Wire_Rec.Kind := Kind; + end Set_Kind; + + function Get_Kind (Wid : Wire_Id) return Wire_Kind + is + Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid); + begin + pragma Assert (Wire_Rec.Kind /= Wire_None); + return Wire_Rec.Kind; + end Get_Kind; + procedure Set_Wire_Gate (Wid : Wire_Id; Gate : Net) is begin -- Cannot override a gate. @@ -974,7 +990,7 @@ package body Synth.Environment is begin case Wid_Rec.Kind is when Wire_Signal | Wire_Output | Wire_Inout - | Wire_Variable => + | Wire_Variable | Wire_Unset => null; when Wire_Input | Wire_Enable | Wire_None => raise Internal_Error; @@ -1020,6 +1036,9 @@ package body Synth.Environment is | Wire_Enable => -- For signals, always read the previous value. return Wire_Rec.Gate; + when Wire_Unset => + pragma Assert (Wire_Rec.Cur_Assign = No_Seq_Assign); + return Wire_Rec.Gate; when Wire_None => raise Internal_Error; end case; diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads index 70e472ac9..e06e254b2 100644 --- a/src/synth/synth-environment.ads +++ b/src/synth/synth-environment.ads @@ -78,6 +78,7 @@ package Synth.Environment is Wire_Variable, Wire_Enable, Wire_Signal, + Wire_Unset, Wire_Input, Wire_Output, Wire_Inout ); @@ -87,6 +88,11 @@ package Synth.Environment is -- Mark the wire as free. procedure Free_Wire (Wid : Wire_Id); + -- Change wire WID kind. + -- The only allowed transitions are Unset <-> (Variable or Signal). + procedure Set_Kind (Wid : Wire_Id; Kind : Wire_Kind); + function Get_Kind (Wid : Wire_Id) return Wire_Kind; + -- Read and write the mark flag. function Get_Wire_Mark (Wid : Wire_Id) return Boolean; procedure Set_Wire_Mark (Wid : Wire_Id; Mark : Boolean := True); diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb index 5c9db02e9..2b9b5ffab 100644 --- a/src/synth/synth-static_oper.adb +++ b/src/synth/synth-static_oper.adb @@ -29,7 +29,7 @@ with Netlists; use Netlists; with Synth.Memtype; use Synth.Memtype; with Synth.Errors; use Synth.Errors; with Synth.Source; use Synth.Source; -with Synth.Expr; use Synth.Expr; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Vhdl_Oper; with Synth.Ieee.Std_Logic_1164; use Synth.Ieee.Std_Logic_1164; with Synth.Ieee.Numeric_Std; use Synth.Ieee.Numeric_Std; diff --git a/src/synth/synth-vhdl_aggr.adb b/src/synth/synth-vhdl_aggr.adb index 250ebb1aa..fe7e95058 100644 --- a/src/synth/synth-vhdl_aggr.adb +++ b/src/synth/synth-vhdl_aggr.adb @@ -28,9 +28,9 @@ with Vhdl.Utils; use Vhdl.Utils; with Synth.Memtype; use Synth.Memtype; with Synth.Errors; use Synth.Errors; -with Synth.Expr; use Synth.Expr; -with Synth.Stmts; use Synth.Stmts; -with Synth.Decls; use Synth.Decls; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; +with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; +with Synth.Vhdl_Decls; use Synth.Vhdl_Decls; package body Synth.Vhdl_Aggr is type Stride_Array is array (Dim_Type range <>) of Nat32; diff --git a/src/synth/synth-vhdl_context.adb b/src/synth/synth-vhdl_context.adb index 0ef9b417e..bb3d7b98c 100644 --- a/src/synth/synth-vhdl_context.adb +++ b/src/synth/synth-vhdl_context.adb @@ -26,7 +26,7 @@ with Vhdl.Utils; with Netlists.Folds; use Netlists.Folds; -with Synth.Expr; use Synth.Expr; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Netlists.Locations; package body Synth.Vhdl_Context is diff --git a/src/synth/synth-decls.adb b/src/synth/synth-vhdl_decls.adb index a8f92c1f9..7507d21b0 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-vhdl_decls.adb @@ -31,14 +31,14 @@ with Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; -with Synth.Expr; use Synth.Expr; -with Synth.Stmts; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; +with Synth.Vhdl_Stmts; with Synth.Source; use Synth.Source; with Synth.Errors; use Synth.Errors; with Synth.Vhdl_Files; with Synth.Values; use Synth.Values; -package body Synth.Decls is +package body Synth.Vhdl_Decls is procedure Create_Var_Wire (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : Valtyp) is @@ -962,7 +962,7 @@ package body Synth.Decls is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); Atype : constant Node := Get_Declaration_Type (Decl); Off : Value_Offsets; - Dyn : Stmts.Dyn_Name; + Dyn : Vhdl_Stmts.Dyn_Name; Res : Valtyp; Obj_Typ : Type_Acc; Base : Valtyp; @@ -976,8 +976,8 @@ package body Synth.Decls is Obj_Typ := null; end if; - Stmts.Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), - Base, Typ, Off, Dyn); + Vhdl_Stmts.Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), + Base, Typ, Off, Dyn); pragma Assert (Dyn.Voff = No_Net); if Base.Val.Kind = Value_Net then -- Object is a net if it is not writable. Extract the @@ -1224,4 +1224,4 @@ package body Synth.Decls is Decl := Get_Chain (Decl); end loop; end Finalize_Declarations; -end Synth.Decls; +end Synth.Vhdl_Decls; diff --git a/src/synth/synth-decls.ads b/src/synth/synth-vhdl_decls.ads index d227bdbe1..fa1569430 100644 --- a/src/synth/synth-decls.ads +++ b/src/synth/synth-vhdl_decls.ads @@ -22,7 +22,7 @@ with Netlists; use Netlists; with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Synth.Objtypes; use Synth.Objtypes; -package Synth.Decls is +package Synth.Vhdl_Decls is -- Return the Param_Type for ATYPE. function Type_To_Param_Type (Atype : Node) return Param_Type; @@ -76,4 +76,4 @@ package Synth.Decls is procedure Synth_Package_Instantiation (Parent_Inst : Synth_Instance_Acc; Pkg : Node); -end Synth.Decls; +end Synth.Vhdl_Decls; diff --git a/src/synth/synth-expr.adb b/src/synth/synth-vhdl_expr.adb index d05c0d089..9b2072865 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -42,8 +42,8 @@ with Netlists.Locations; with Synth.Memtype; use Synth.Memtype; with Synth.Errors; use Synth.Errors; with Synth.Vhdl_Environment; -with Synth.Decls; -with Synth.Stmts; use Synth.Stmts; +with Synth.Vhdl_Decls; +with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; with Synth.Vhdl_Oper; use Synth.Vhdl_Oper; with Synth.Vhdl_Heap; use Synth.Vhdl_Heap; with Synth.Debugger; @@ -52,7 +52,7 @@ with Synth.Vhdl_Aggr; with Grt.Types; with Grt.To_Strings; -package body Synth.Expr is +package body Synth.Vhdl_Expr is function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Valtyp; @@ -537,7 +537,7 @@ package body Synth.Expr is when Iir_Kind_String_Literal8 => -- TODO: the value should be computed (once) and its type -- returned. - return Synth.Decls.Synth_Subtype_Indication + return Synth.Vhdl_Decls.Synth_Subtype_Indication (Syn_Inst, Get_Type (Expr)); when others => @@ -2498,7 +2498,7 @@ package body Synth.Expr is T : Type_Acc; Acc : Heap_Index; begin - T := Synth.Decls.Synth_Subtype_Indication + T := Synth.Vhdl_Decls.Synth_Subtype_Indication (Syn_Inst, Get_Subtype_Indication (Expr)); Acc := Allocate_By_Type (T); return Create_Value_Access (Acc, Expr_Type); @@ -2569,4 +2569,4 @@ package body Synth.Expr is (Syn_Inst, Get_Base_Type (Get_Type (Expr))); return Synth_Expression_With_Type (Syn_Inst, Expr, Basetype); end Synth_Expression_With_Basetype; -end Synth.Expr; +end Synth.Vhdl_Expr; diff --git a/src/synth/synth-expr.ads b/src/synth/synth-vhdl_expr.ads index 8dac335c4..c6726732e 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-vhdl_expr.ads @@ -31,7 +31,7 @@ with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; with Synth.Vhdl_Context; use Synth.Vhdl_Context; -package Synth.Expr is +package Synth.Vhdl_Expr is -- Perform a subtype conversion. Check constraints. function Synth_Subtype_Conversion (Ctxt : Context_Acc; Vt : Valtyp; @@ -149,4 +149,4 @@ package Synth.Expr is Vec : in out Logvec_Array; Vec_Off : in out Uns32; Has_Zx : in out Boolean); -end Synth.Expr; +end Synth.Vhdl_Expr; diff --git a/src/synth/synth-vhdl_files.adb b/src/synth/synth-vhdl_files.adb index 180062e01..2300ff9f9 100644 --- a/src/synth/synth-vhdl_files.adb +++ b/src/synth/synth-vhdl_files.adb @@ -26,7 +26,7 @@ with Grt.Stdio; with Synth.Memtype; use Synth.Memtype; with Synth.Objtypes; use Synth.Objtypes; -with Synth.Expr; use Synth.Expr; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Errors; use Synth.Errors; package body Synth.Vhdl_Files is diff --git a/src/synth/synth-insts.adb b/src/synth/synth-vhdl_insts.adb index ac37f8b0a..679b63312 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-vhdl_insts.adb @@ -46,15 +46,15 @@ with Synth.Memtype; use Synth.Memtype; with Synth.Objtypes; use Synth.Objtypes; with Synth.Values; use Synth.Values; with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; -with Synth.Stmts; use Synth.Stmts; -with Synth.Decls; use Synth.Decls; -with Synth.Expr; use Synth.Expr; +with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; +with Synth.Vhdl_Decls; use Synth.Vhdl_Decls; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Source; use Synth.Source; with Synth.Debugger; with Synth.Vhdl_Files; with Synth.Errors; -package body Synth.Insts is +package body Synth.Vhdl_Insts is Root_Instance : Synth_Instance_Acc; function Mode_To_Port_Kind (Mode : Iir_Mode) return Port_Kind is @@ -364,7 +364,8 @@ package body Synth.Insts is begin case Get_Kind (Inter_Type) is when Iir_Kind_Array_Subtype_Definition => - if Synth.Decls.Has_Element_Subtype_Indication (Inter_Type) then + if Synth.Vhdl_Decls.Has_Element_Subtype_Indication (Inter_Type) + then Copy_Object_Subtype (Syn_Inst, Get_Element_Subtype (Inter_Type), Proto_Inst); end if; @@ -1748,4 +1749,4 @@ package body Synth.Insts is Idx := Idx + 1; end loop; end Synth_All_Instances; -end Synth.Insts; +end Synth.Vhdl_Insts; diff --git a/src/synth/synth-insts.ads b/src/synth/synth-vhdl_insts.ads index f0ac690e6..980b4ca8b 100644 --- a/src/synth/synth-insts.ads +++ b/src/synth/synth-vhdl_insts.ads @@ -21,7 +21,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Synth.Flags; use Synth.Flags; -package Synth.Insts is +package Synth.Vhdl_Insts is -- Create the declaration of the top entity. procedure Synth_Top_Entity (Global_Instance : Synth_Instance_Acc; Arch : Node; @@ -44,4 +44,4 @@ package Synth.Insts is procedure Synth_Component_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node); -end Synth.Insts; +end Synth.Vhdl_Insts; diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb index 2c3252a83..fadd500b5 100644 --- a/src/synth/synth-vhdl_oper.adb +++ b/src/synth/synth-vhdl_oper.adb @@ -34,8 +34,8 @@ with Netlists.Utils; with Synth.Memtype; use Synth.Memtype; with Synth.Errors; use Synth.Errors; -with Synth.Stmts; use Synth.Stmts; -with Synth.Expr; use Synth.Expr; +with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Source; with Synth.Static_Oper; use Synth.Static_Oper; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-vhdl_stmts.adb index 8f33e3421..0f2694e06 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -41,9 +41,9 @@ with PSL.NFAs; with Synth.Memtype; use Synth.Memtype; with Synth.Errors; use Synth.Errors; -with Synth.Decls; use Synth.Decls; -with Synth.Expr; use Synth.Expr; -with Synth.Insts; use Synth.Insts; +with Synth.Vhdl_Decls; use Synth.Vhdl_Decls; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; +with Synth.Vhdl_Insts; use Synth.Vhdl_Insts; with Synth.Source; with Synth.Vhdl_Static_Proc; with Synth.Vhdl_Heap; @@ -56,7 +56,7 @@ with Netlists.Gates; use Netlists.Gates; with Netlists.Utils; use Netlists.Utils; with Netlists.Locations; use Netlists.Locations; -package body Synth.Stmts is +package body Synth.Vhdl_Stmts is procedure Synth_Sequential_Statements (C : in out Seq_Context; Stmts : Node); @@ -302,7 +302,7 @@ package body Synth.Stmts is if Is_Fully_Constrained_Type (Targ_Type) then -- If the aggregate subtype is known, just use it. - Bnd := Expr.Synth_Array_Bounds (Syn_Inst, Targ_Type, 1); + Bnd := Vhdl_Expr.Synth_Array_Bounds (Syn_Inst, Targ_Type, 1); else -- Ok, so the subtype of the aggregate is not known, in general -- because the length of an element is not known. That's with @@ -2006,7 +2006,8 @@ package body Synth.Stmts is (C.W_Ret, Build_Control_Signal (Sub_Inst, 1, Imp)); Phi_Assign_Static (C.W_Ret, Bit1); - Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); + Vhdl_Decls.Synth_Declarations + (C.Inst, Get_Declaration_Chain (Bod), True); if not Is_Error (C.Inst) then Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod)); end if; @@ -2031,7 +2032,8 @@ package body Synth.Stmts is Pop_Phi (Subprg_Phi); - Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); + Vhdl_Decls.Finalize_Declarations + (C.Inst, Get_Declaration_Chain (Bod), True); pragma Unreferenced (Infos); -- Propagate assignments. @@ -2106,7 +2108,8 @@ package body Synth.Stmts is end if; end if; - Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); + Vhdl_Decls.Finalize_Declarations + (C.Inst, Get_Declaration_Chain (Bod), True); pragma Unreferenced (Infos); return Res; @@ -3850,4 +3853,4 @@ package body Synth.Stmts is Release (M, Proc_Pool); Instance_Pool := Prev_Instance_Pool; end Synth_Verification_Unit; -end Synth.Stmts; +end Synth.Vhdl_Stmts; diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-vhdl_stmts.ads index 2009b1d4f..9621a7c9f 100644 --- a/src/synth/synth-stmts.ads +++ b/src/synth/synth-vhdl_stmts.ads @@ -26,7 +26,7 @@ with Synth.Values; use Synth.Values; with Synth.Vhdl_Context; use Synth.Vhdl_Context; with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; -package Synth.Stmts is +package Synth.Vhdl_Stmts is procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; Inter_Chain : Node; @@ -164,4 +164,4 @@ private S_En : Boolean; end case; end record; -end Synth.Stmts; +end Synth.Vhdl_Stmts; diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb index 6e3dabfc0..131e6ba04 100644 --- a/src/synth/synthesis.adb +++ b/src/synth/synthesis.adb @@ -20,7 +20,7 @@ with Errorout; use Errorout; with Vhdl.Errors; use Vhdl.Errors; with Synth.Objtypes; -with Synth.Insts; use Synth.Insts; +with Synth.Vhdl_Insts; use Synth.Vhdl_Insts; with Synth.Values.Debug; pragma Unreferenced (Synth.Values.Debug); diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 37ca1646b..5a412dd08 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -2864,6 +2864,7 @@ package body Trans.Chap4 is (El_List, Conv_Info.Instance_Field, Wki_Instance, Block_Info.Block_Decls_Ptr_Type); + -- Add instance field for the entity in case of direct instantiation. if Entity /= Null_Iir then Conv_Info.Instantiated_Entity := Entity; Entity_Info := Get_Info (Entity); @@ -3137,6 +3138,9 @@ package body Trans.Chap4 is end loop; end Translate_Association_Subprograms; + -- Register conversion CONV in association between SIG_IN and SIG_OUT. + -- This procedure allocates a record data (described by INFO), fill it + -- with addresses of signals and register it to REG_SUBPRG. procedure Elab_Conversion (Sig_In : Iir; Sig_Out : Iir; Conv : Iir; diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index f380efb07..02ed20f1e 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -302,6 +302,7 @@ package body Trans.Chap6 is Cond1, Cond2 : O_Enode; Cond : O_Enode; begin + -- FIXME: not correct for enumerations Cond1 := New_Compare_Op (ON_Lt, New_Obj_Value (Off), @@ -1133,7 +1134,8 @@ package body Trans.Chap6 is begin pragma Assert (Mode <= Name_Info.Alias_Kind); case Type_Info.Type_Mode is - when Type_Mode_Unbounded_Array => + when Type_Mode_Unbounded_Array + | Type_Mode_Unbounded_Record => return Get_Var (Name_Info.Alias_Var (Mode), Type_Info, Mode); when Type_Mode_Bounded_Arrays diff --git a/src/vhdl/vhdl-nodes.adb b/src/vhdl/vhdl-nodes.adb index 8acd7f6ac..b5dd5e0bd 100644 --- a/src/vhdl/vhdl-nodes.adb +++ b/src/vhdl/vhdl-nodes.adb @@ -5762,22 +5762,6 @@ package body Vhdl.Nodes is Set_Field4 (Name, Val); end Set_Named_Entity; - function Get_Alias_Declaration (Name : Iir) return Iir is - begin - pragma Assert (Name /= Null_Iir); - pragma Assert (Has_Alias_Declaration (Get_Kind (Name)), - "no field Alias_Declaration"); - return Get_Field2 (Name); - end Get_Alias_Declaration; - - procedure Set_Alias_Declaration (Name : Iir; Val : Iir) is - begin - pragma Assert (Name /= Null_Iir); - pragma Assert (Has_Alias_Declaration (Get_Kind (Name)), - "no field Alias_Declaration"); - Set_Field2 (Name, Val); - end Set_Alias_Declaration; - function Get_Referenced_Name (N : Iir) return Iir is begin pragma Assert (N /= Null_Iir); diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads index 7d79ca43d..da01e6bc4 100644 --- a/src/vhdl/vhdl-nodes.ads +++ b/src/vhdl/vhdl-nodes.ads @@ -4310,8 +4310,6 @@ package Vhdl.Nodes is -- -- Get/Set_Type (Field1) -- - -- Get/Set_Alias_Declaration (Field2) - -- -- Get/Set_Identifier (Field3) -- -- Get/Set_Named_Entity (Field4) @@ -4328,8 +4326,6 @@ package Vhdl.Nodes is -- -- Get/Set_Type (Field1) -- - -- Get/Set_Alias_Declaration (Field2) - -- -- Get/Set_Identifier (Field3) -- -- Get/Set_Named_Entity (Field4) @@ -4346,8 +4342,6 @@ package Vhdl.Nodes is -- -- Get/Set_Type (Field1) -- - -- Get/Set_Alias_Declaration (Field2) - -- -- Get/Set_Identifier (Field3) -- -- Get/Set_Named_Entity (Field4) @@ -4379,8 +4373,6 @@ package Vhdl.Nodes is -- -- Get/Set_Type (Field1) -- - -- Get/Set_Alias_Declaration (Field2) - -- -- Get/Set_Identifier (Field3) -- -- Get/Set_Named_Entity (Field4) @@ -8788,12 +8780,6 @@ package Vhdl.Nodes is function Get_Named_Entity (Name : Iir) return Iir; procedure Set_Named_Entity (Name : Iir; Val : Iir); - -- If a name designate a non-object alias, the designated alias. - -- Named_Entity will designate the aliased entity. - -- Field: Field2 Ref - function Get_Alias_Declaration (Name : Iir) return Iir; - procedure Set_Alias_Declaration (Name : Iir; Val : Iir); - -- Field: Field2 Ref function Get_Referenced_Name (N : Iir) return Iir; procedure Set_Referenced_Name (N : Iir; Name : Iir); diff --git a/src/vhdl/vhdl-nodes_meta.adb b/src/vhdl/vhdl-nodes_meta.adb index bd85e083c..91f764376 100644 --- a/src/vhdl/vhdl-nodes_meta.adb +++ b/src/vhdl/vhdl-nodes_meta.adb @@ -289,7 +289,6 @@ package body Vhdl.Nodes_Meta is Field_Default_Entity_Aspect => Type_Iir, Field_Binding_Indication => Type_Iir, Field_Named_Entity => Type_Iir, - Field_Alias_Declaration => Type_Iir, Field_Referenced_Name => Type_Iir, Field_Expr_Staticness => Type_Iir_Staticness, Field_Scalar_Size => Type_Scalar_Size, @@ -942,8 +941,6 @@ package body Vhdl.Nodes_Meta is return "binding_indication"; when Field_Named_Entity => return "named_entity"; - when Field_Alias_Declaration => - return "alias_declaration"; when Field_Referenced_Name => return "referenced_name"; when Field_Expr_Staticness => @@ -2332,8 +2329,6 @@ package body Vhdl.Nodes_Meta is return Attr_Maybe_Ref; when Field_Named_Entity => return Attr_Maybe_Forward_Ref; - when Field_Alias_Declaration => - return Attr_Ref; when Field_Referenced_Name => return Attr_Ref; when Field_Expr_Staticness => @@ -4767,7 +4762,6 @@ package body Vhdl.Nodes_Meta is Field_Expr_Staticness, Field_Name_Staticness, Field_Type, - Field_Alias_Declaration, Field_Named_Entity, Field_Base_Name, -- Iir_Kind_Simple_Name @@ -4776,7 +4770,6 @@ package body Vhdl.Nodes_Meta is Field_Expr_Staticness, Field_Name_Staticness, Field_Type, - Field_Alias_Declaration, Field_Named_Entity, Field_Base_Name, -- Iir_Kind_Selected_Name @@ -4786,14 +4779,12 @@ package body Vhdl.Nodes_Meta is Field_Name_Staticness, Field_Prefix, Field_Type, - Field_Alias_Declaration, Field_Named_Entity, Field_Base_Name, -- Iir_Kind_Operator_Symbol Field_Identifier, Field_Is_Forward_Ref, Field_Type, - Field_Alias_Declaration, Field_Named_Entity, Field_Base_Name, -- Iir_Kind_Reference_Name @@ -5494,74 +5485,74 @@ package body Vhdl.Nodes_Meta is Iir_Kind_Break_Statement => 1959, Iir_Kind_If_Statement => 1969, Iir_Kind_Elsif => 1975, - Iir_Kind_Character_Literal => 1983, - Iir_Kind_Simple_Name => 1991, - Iir_Kind_Selected_Name => 2000, - Iir_Kind_Operator_Symbol => 2006, - Iir_Kind_Reference_Name => 2011, - Iir_Kind_External_Constant_Name => 2020, - Iir_Kind_External_Signal_Name => 2029, - Iir_Kind_External_Variable_Name => 2039, - Iir_Kind_Selected_By_All_Name => 2045, - Iir_Kind_Parenthesis_Name => 2050, - Iir_Kind_Package_Pathname => 2054, - Iir_Kind_Absolute_Pathname => 2055, - Iir_Kind_Relative_Pathname => 2056, - Iir_Kind_Pathname_Element => 2061, - Iir_Kind_Base_Attribute => 2063, - Iir_Kind_Subtype_Attribute => 2068, - Iir_Kind_Element_Attribute => 2073, - Iir_Kind_Across_Attribute => 2078, - Iir_Kind_Through_Attribute => 2083, - Iir_Kind_Nature_Reference_Attribute => 2087, - Iir_Kind_Left_Type_Attribute => 2092, - Iir_Kind_Right_Type_Attribute => 2097, - Iir_Kind_High_Type_Attribute => 2102, - Iir_Kind_Low_Type_Attribute => 2107, - Iir_Kind_Ascending_Type_Attribute => 2112, - Iir_Kind_Image_Attribute => 2118, - Iir_Kind_Value_Attribute => 2124, - Iir_Kind_Pos_Attribute => 2130, - Iir_Kind_Val_Attribute => 2136, - Iir_Kind_Succ_Attribute => 2142, - Iir_Kind_Pred_Attribute => 2148, - Iir_Kind_Leftof_Attribute => 2154, - Iir_Kind_Rightof_Attribute => 2160, - Iir_Kind_Signal_Slew_Attribute => 2168, - Iir_Kind_Quantity_Slew_Attribute => 2176, - Iir_Kind_Ramp_Attribute => 2184, - Iir_Kind_Zoh_Attribute => 2192, - Iir_Kind_Ltf_Attribute => 2200, - Iir_Kind_Ztf_Attribute => 2210, - Iir_Kind_Dot_Attribute => 2217, - Iir_Kind_Integ_Attribute => 2224, - Iir_Kind_Above_Attribute => 2232, - Iir_Kind_Quantity_Delayed_Attribute => 2240, - Iir_Kind_Delayed_Attribute => 2249, - Iir_Kind_Stable_Attribute => 2258, - Iir_Kind_Quiet_Attribute => 2267, - Iir_Kind_Transaction_Attribute => 2276, - Iir_Kind_Event_Attribute => 2280, - Iir_Kind_Active_Attribute => 2284, - Iir_Kind_Last_Event_Attribute => 2288, - Iir_Kind_Last_Active_Attribute => 2292, - Iir_Kind_Last_Value_Attribute => 2296, - Iir_Kind_Driving_Attribute => 2300, - Iir_Kind_Driving_Value_Attribute => 2304, - Iir_Kind_Behavior_Attribute => 2304, - Iir_Kind_Structure_Attribute => 2304, - Iir_Kind_Simple_Name_Attribute => 2311, - Iir_Kind_Instance_Name_Attribute => 2316, - Iir_Kind_Path_Name_Attribute => 2321, - Iir_Kind_Left_Array_Attribute => 2328, - Iir_Kind_Right_Array_Attribute => 2335, - Iir_Kind_High_Array_Attribute => 2342, - Iir_Kind_Low_Array_Attribute => 2349, - Iir_Kind_Length_Array_Attribute => 2356, - Iir_Kind_Ascending_Array_Attribute => 2363, - Iir_Kind_Range_Array_Attribute => 2370, - Iir_Kind_Reverse_Range_Array_Attribute => 2377, - Iir_Kind_Attribute_Name => 2386 + Iir_Kind_Character_Literal => 1982, + Iir_Kind_Simple_Name => 1989, + Iir_Kind_Selected_Name => 1997, + Iir_Kind_Operator_Symbol => 2002, + Iir_Kind_Reference_Name => 2007, + Iir_Kind_External_Constant_Name => 2016, + Iir_Kind_External_Signal_Name => 2025, + Iir_Kind_External_Variable_Name => 2035, + Iir_Kind_Selected_By_All_Name => 2041, + Iir_Kind_Parenthesis_Name => 2046, + Iir_Kind_Package_Pathname => 2050, + Iir_Kind_Absolute_Pathname => 2051, + Iir_Kind_Relative_Pathname => 2052, + Iir_Kind_Pathname_Element => 2057, + Iir_Kind_Base_Attribute => 2059, + Iir_Kind_Subtype_Attribute => 2064, + Iir_Kind_Element_Attribute => 2069, + Iir_Kind_Across_Attribute => 2074, + Iir_Kind_Through_Attribute => 2079, + Iir_Kind_Nature_Reference_Attribute => 2083, + Iir_Kind_Left_Type_Attribute => 2088, + Iir_Kind_Right_Type_Attribute => 2093, + Iir_Kind_High_Type_Attribute => 2098, + Iir_Kind_Low_Type_Attribute => 2103, + Iir_Kind_Ascending_Type_Attribute => 2108, + Iir_Kind_Image_Attribute => 2114, + Iir_Kind_Value_Attribute => 2120, + Iir_Kind_Pos_Attribute => 2126, + Iir_Kind_Val_Attribute => 2132, + Iir_Kind_Succ_Attribute => 2138, + Iir_Kind_Pred_Attribute => 2144, + Iir_Kind_Leftof_Attribute => 2150, + Iir_Kind_Rightof_Attribute => 2156, + Iir_Kind_Signal_Slew_Attribute => 2164, + Iir_Kind_Quantity_Slew_Attribute => 2172, + Iir_Kind_Ramp_Attribute => 2180, + Iir_Kind_Zoh_Attribute => 2188, + Iir_Kind_Ltf_Attribute => 2196, + Iir_Kind_Ztf_Attribute => 2206, + Iir_Kind_Dot_Attribute => 2213, + Iir_Kind_Integ_Attribute => 2220, + Iir_Kind_Above_Attribute => 2228, + Iir_Kind_Quantity_Delayed_Attribute => 2236, + Iir_Kind_Delayed_Attribute => 2245, + Iir_Kind_Stable_Attribute => 2254, + Iir_Kind_Quiet_Attribute => 2263, + Iir_Kind_Transaction_Attribute => 2272, + Iir_Kind_Event_Attribute => 2276, + Iir_Kind_Active_Attribute => 2280, + Iir_Kind_Last_Event_Attribute => 2284, + Iir_Kind_Last_Active_Attribute => 2288, + Iir_Kind_Last_Value_Attribute => 2292, + Iir_Kind_Driving_Attribute => 2296, + Iir_Kind_Driving_Value_Attribute => 2300, + Iir_Kind_Behavior_Attribute => 2300, + Iir_Kind_Structure_Attribute => 2300, + Iir_Kind_Simple_Name_Attribute => 2307, + Iir_Kind_Instance_Name_Attribute => 2312, + Iir_Kind_Path_Name_Attribute => 2317, + Iir_Kind_Left_Array_Attribute => 2324, + Iir_Kind_Right_Array_Attribute => 2331, + Iir_Kind_High_Array_Attribute => 2338, + Iir_Kind_Low_Array_Attribute => 2345, + Iir_Kind_Length_Array_Attribute => 2352, + Iir_Kind_Ascending_Array_Attribute => 2359, + Iir_Kind_Range_Array_Attribute => 2366, + Iir_Kind_Reverse_Range_Array_Attribute => 2373, + Iir_Kind_Attribute_Name => 2382 ); function Get_Fields_First (K : Iir_Kind) return Fields_Index is @@ -6360,8 +6351,6 @@ package body Vhdl.Nodes_Meta is return Get_Binding_Indication (N); when Field_Named_Entity => return Get_Named_Entity (N); - when Field_Alias_Declaration => - return Get_Alias_Declaration (N); when Field_Referenced_Name => return Get_Referenced_Name (N); when Field_Error_Origin => @@ -6818,8 +6807,6 @@ package body Vhdl.Nodes_Meta is Set_Binding_Indication (N, V); when Field_Named_Entity => Set_Named_Entity (N, V); - when Field_Alias_Declaration => - Set_Alias_Declaration (N, V); when Field_Referenced_Name => Set_Referenced_Name (N, V); when Field_Error_Origin => @@ -11124,19 +11111,6 @@ package body Vhdl.Nodes_Meta is end case; end Has_Named_Entity; - function Has_Alias_Declaration (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol => - return True; - when others => - return False; - end case; - end Has_Alias_Declaration; - function Has_Referenced_Name (K : Iir_Kind) return Boolean is begin return K = Iir_Kind_Reference_Name; diff --git a/src/vhdl/vhdl-nodes_meta.ads b/src/vhdl/vhdl-nodes_meta.ads index 65ace54bb..0585fbe93 100644 --- a/src/vhdl/vhdl-nodes_meta.ads +++ b/src/vhdl/vhdl-nodes_meta.ads @@ -333,7 +333,6 @@ package Vhdl.Nodes_Meta is Field_Default_Entity_Aspect, Field_Binding_Indication, Field_Named_Entity, - Field_Alias_Declaration, Field_Referenced_Name, Field_Expr_Staticness, Field_Scalar_Size, @@ -922,7 +921,6 @@ package Vhdl.Nodes_Meta is function Has_Default_Entity_Aspect (K : Iir_Kind) return Boolean; function Has_Binding_Indication (K : Iir_Kind) return Boolean; function Has_Named_Entity (K : Iir_Kind) return Boolean; - function Has_Alias_Declaration (K : Iir_Kind) return Boolean; function Has_Referenced_Name (K : Iir_Kind) return Boolean; function Has_Expr_Staticness (K : Iir_Kind) return Boolean; function Has_Scalar_Size (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb index 663adac7b..06b6fbced 100644 --- a/src/vhdl/vhdl-sem.adb +++ b/src/vhdl/vhdl-sem.adb @@ -1367,6 +1367,21 @@ package body Vhdl.Sem is end loop; end Are_Trees_Chain_Equal; + function Are_Trees_List_Equal (Left, Right : Iir_Flist) return Boolean + is + El_Left, El_Right : Iir; + begin + pragma Assert (Flist_Last (Left) = Flist_Last (Right)); + for I in Flist_First .. Flist_Last (Left) loop + El_Left := Get_Nth_Element (Left, I); + El_Right := Get_Nth_Element (Right, I); + if not Are_Trees_Equal (El_Left, El_Right) then + return False; + end if; + end loop; + return True; + end Are_Trees_List_Equal; + -- Return TRUE iff LEFT and RIGHT are (in depth) equal. -- This corresponds to conformance rules, LRM93 2.7 function Are_Trees_Equal (Left, Right : Iir) return Boolean @@ -1489,46 +1504,21 @@ package body Vhdl.Sem is then return False; end if; - declare - L_Left : constant Iir_Flist := Get_Index_Subtype_List (Left); - L_Right : constant Iir_Flist := Get_Index_Subtype_List (Right); - begin - if Get_Nbr_Elements (L_Left) /= Get_Nbr_Elements (L_Right) then - return False; - end if; - for I in Flist_First .. Flist_Last (L_Left) loop - El_Left := Get_Nth_Element (L_Left, I); - El_Right := Get_Nth_Element (L_Right, I); - if not Are_Trees_Equal (El_Left, El_Right) then - return False; - end if; - end loop; - end; + if not Are_Trees_List_Equal (Get_Index_Subtype_List (Left), + Get_Index_Subtype_List (Right)) + then + return False; + end if; return True; when Iir_Kind_Record_Subtype_Definition => if Get_Base_Type (Left) /= Get_Base_Type (Right) then return False; end if; - if not Are_Trees_Equal (Get_Resolution_Indication (Left), + return Are_Trees_Equal (Get_Resolution_Indication (Left), Get_Resolution_Indication (Right)) - then - return False; - end if; - declare - L_Left : constant Iir_Flist := - Get_Elements_Declaration_List (Left); - L_Right : constant Iir_Flist := - Get_Elements_Declaration_List (Right); - begin - for I in Flist_First .. Flist_Last (L_Left) loop - El_Left := Get_Nth_Element (L_Left, I); - El_Right := Get_Nth_Element (L_Right, I); - if not Are_Trees_Equal (El_Left, El_Right) then - return False; - end if; - end loop; - end; - return True; + and then + Are_Trees_List_Equal (Get_Elements_Declaration_List (Left), + Get_Elements_Declaration_List (Right)); when Iir_Kind_Integer_Literal => if Get_Value (Left) /= Get_Value (Right) then @@ -1596,6 +1586,18 @@ package body Vhdl.Sem is Are_Trees_Equal (Get_Expression (Left), Get_Expression (Right)); + when Iir_Kind_Indexed_Name => + return Are_Trees_Equal (Get_Prefix (Left), + Get_Prefix (Right)) + and then + Are_Trees_List_Equal (Get_Index_List (Left), + Get_Index_List (Right)); + when Iir_Kind_Slice_Name => + return Are_Trees_Equal (Get_Prefix (Left), + Get_Prefix (Right)) + and then Are_Trees_Equal (Get_Suffix (Left), + Get_Suffix (Right)); + when Iir_Kind_Access_Type_Definition | Iir_Kind_Record_Type_Definition | Iir_Kind_Array_Type_Definition @@ -1609,14 +1611,10 @@ package body Vhdl.Sem is then return False; end if; - if not Are_Trees_Equal (Get_Left_Limit (Left), + return Are_Trees_Equal (Get_Left_Limit (Left), Get_Left_Limit (Right)) - or else not Are_Trees_Equal (Get_Right_Limit (Left), - Get_Right_Limit (Right)) - then - return False; - end if; - return True; + and then Are_Trees_Equal (Get_Right_Limit (Left), + Get_Right_Limit (Right)); when Iir_Kind_High_Type_Attribute | Iir_Kind_Low_Type_Attribute @@ -1661,21 +1659,9 @@ package body Vhdl.Sem is if not Are_Trees_Equal (Get_Type (Left), Get_Type (Right)) then return False; end if; - declare - El_L, El_R : Iir; - begin - El_L := Get_Association_Choices_Chain (Left); - El_R := Get_Association_Choices_Chain (Right); - loop - exit when El_L = Null_Iir and El_R = Null_Iir; - if not Are_Trees_Equal (El_L, El_R) then - return False; - end if; - El_L := Get_Chain (El_L); - El_R := Get_Chain (El_R); - end loop; - return True; - end; + return Are_Trees_Chain_Equal + (Get_Association_Choices_Chain (Left), + Get_Association_Choices_Chain (Right)); when Iir_Kind_Choice_By_None | Iir_Kind_Choice_By_Others => diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb index ab4451d77..1ed7c7b64 100644 --- a/src/vhdl/vhdl-sem_names.adb +++ b/src/vhdl/vhdl-sem_names.adb @@ -2152,7 +2152,6 @@ package body Vhdl.Sem_Names is if not Keep_Alias and then Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration then - Set_Alias_Declaration (Name, Res); Res := Get_Named_Entity (Get_Name (Res)); end if; else diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb index b0b0447da..b52476f9b 100644 --- a/src/vhdl/vhdl-sem_stmts.adb +++ b/src/vhdl/vhdl-sem_stmts.adb @@ -879,6 +879,7 @@ package body Vhdl.Sem_Stmts is Target : Iir; Target_Type : Iir; Target_Object : Iir; + Target_Prefix : Iir; Expr : Iir; Constrained : Boolean; begin @@ -894,6 +895,7 @@ package body Vhdl.Sem_Stmts is Target := Sem_Expression_Wildcard (Target, Wildcard_Any_Type); Target_Object := Null_Iir; + Target_Prefix := Null_Iir; Target_Type := Wildcard_Any_Type; if Target = Null_Iir then -- To avoid spurious errors, assume the target is fully @@ -905,21 +907,22 @@ package body Vhdl.Sem_Stmts is Check_Target (Stmt, Target); Target_Type := Get_Type (Target); Target_Object := Check_Simple_Signal_Target_Object (Target); + Target_Prefix := Get_Object_Prefix (Target_Object); Constrained := Is_Object_Name_Fully_Constrained (Target_Object); else Constrained := False; end if; end if; - if Target_Object /= Null_Iir then + if Target_Prefix /= Null_Iir then -- LRM08 10.5.2 Simple signal assignments -- If the right-hand side of a simple force assignment or a simple -- release assignment does not specify a force mode, then a default -- force mode is used as follow: if not Get_Has_Force_Mode (Stmt) then - case Get_Kind (Target_Object) is + case Get_Kind (Target_Prefix) is when Iir_Kind_Interface_Signal_Declaration => - case Get_Mode (Target_Object) is + case Get_Mode (Target_Prefix) is when Iir_In_Mode => -- - If the target is a port or signal parameter of -- mode IN, a force mode IN is used. @@ -950,10 +953,10 @@ package body Vhdl.Sem_Stmts is else -- It is an error if a force mode of OUT is specified and the -- target is a port of mode IN. - case Get_Kind (Target_Object) is + case Get_Kind (Target_Prefix) is when Iir_Kind_Interface_Signal_Declaration => if Get_Force_Mode (Stmt) = Iir_Force_Out - and then Get_Mode (Target_Object) = Iir_In_Mode + and then Get_Mode (Target_Prefix) = Iir_In_Mode then Error_Msg_Sem (+Stmt, "cannot use force OUT for IN port %n", diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb index 578576e1e..46c9bcd72 100644 --- a/src/vhdl/vhdl-utils.adb +++ b/src/vhdl/vhdl-utils.adb @@ -1088,11 +1088,16 @@ package body Vhdl.Utils is | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Object_Alias_Declaration => - if (Get_Kind (Get_Subtype_Indication (Base)) - = Iir_Kind_Subtype_Attribute) - then - return True; - end if; + declare + Ind : constant Iir := Get_Subtype_Indication (Base); + begin + -- Note: an object alias may not have subtype indication. + if Ind /= Null_Iir + and then Get_Kind (Ind) = Iir_Kind_Subtype_Attribute + then + return True; + end if; + end; when Iir_Kind_Dereference | Iir_Kind_Implicit_Dereference => null; diff --git a/testsuite/gna/issue1751/ent.vhdl b/testsuite/gna/issue1751/ent.vhdl new file mode 100644 index 000000000..bc807b635 --- /dev/null +++ b/testsuite/gna/issue1751/ent.vhdl @@ -0,0 +1,18 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +entity ent is +end entity ent; + +architecture beh of ent is + signal sig_1 : std_logic; + alias a_sig_1 is sig_1; +begin + process + begin + a_sig_1 <= force '1'; + a_sig_1 <= release; + wait; + end process; +end architecture beh; diff --git a/testsuite/gna/issue1751/testsuite.sh b/testsuite/gna/issue1751/testsuite.sh new file mode 100755 index 000000000..feb77e063 --- /dev/null +++ b/testsuite/gna/issue1751/testsuite.sh @@ -0,0 +1,9 @@ +#! /bin/sh + +. ../../testenv.sh + +$GHDL -s --std=08 ent.vhdl + +clean --std=08 + +echo "Test successful" diff --git a/testsuite/gna/issue1757/testm.vhdl b/testsuite/gna/issue1757/testm.vhdl new file mode 100644 index 000000000..0b23642fd --- /dev/null +++ b/testsuite/gna/issue1757/testm.vhdl @@ -0,0 +1,52 @@ +library ieee; +use ieee.std_logic_1164.all; + +entity testm is + +port (clk : in std_logic; + data : in std_logic_vector(2+1 downto 0); + q1 : out std_logic_vector(3 downto 0) + ); +end testm; + +architecture rtl of testm is + +-- img_log2 function + function tlog2(d : positive) return natural is + variable tmp : positive; + begin + tmp := 1; + for count in 0 to d loop + if (tmp >= d) then + return count; + end if; + tmp := tmp*2; + end loop; + return d; + end; + + constant SBITS : integer := tlog2(16); + + signal fred : std_logic_vector(SBITS - 1 downto 0); + +begin + + fred <= data; + + process (fred) + begin + case (fred(1 downto 0)) is + when "00" => + q1 <= data; + + when "01" => + q1 <= "0000"; + + when "10" => + q1 <= data; + + when others => + q1 <= "1111"; + end case; + end process; +end rtl; diff --git a/testsuite/gna/issue1757/testsuite.sh b/testsuite/gna/issue1757/testsuite.sh new file mode 100755 index 000000000..368449f1a --- /dev/null +++ b/testsuite/gna/issue1757/testsuite.sh @@ -0,0 +1,15 @@ +#! /bin/sh + +. ../../testenv.sh + +analyze_failure testm.vhdl + +clean + +export GHDL_STD_FLAGS=--std=08 +analyze testm.vhdl +elab_simulate testm + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue1764/repro.vhdl b/testsuite/gna/issue1764/repro.vhdl new file mode 100644 index 000000000..a00be03ba --- /dev/null +++ b/testsuite/gna/issue1764/repro.vhdl @@ -0,0 +1,47 @@ +entity repro is +end; + +architecture behav of repro is + type my_channel is record + valid : bit; + ack : bit; + data : bit_vector; + end record; + + type my_bus is record + waddr : my_channel; + wdata : my_channel; + end record; + + function init_channel (fmt : my_channel) return my_channel is + begin + return (valid => '0', + ack => '0', + data => (fmt.data'range => '0')); + end init_channel; + + function init_bus (fmt: my_bus) return my_bus is + begin + return (waddr => init_channel (fmt.waddr), + wdata => init_channel (fmt.wdata)); + end init_bus; + + constant chan8 : my_channel := (valid => '0', ack => '0', data => x"a5"); +begin + process + variable b0 : my_bus (waddr(data (7 downto 0)), wdata (data (15 downto 0))); + variable b1 : b0'subtype; + begin + b1 := init_bus(b1); + assert b1.waddr.valid = '0'; + assert b1.waddr.ack = '0'; + assert b1.waddr.data = "00000000"; + + assert b1.wdata.valid = '0'; + assert b1.wdata.ack = '0'; + assert b1.wdata.data = x"0000"; + + wait; + end process; +end behav; + diff --git a/testsuite/gna/issue1764/testsuite-osvvm.sh b/testsuite/gna/issue1764/testsuite-osvvm.sh new file mode 100755 index 000000000..e05c92748 --- /dev/null +++ b/testsuite/gna/issue1764/testsuite-osvvm.sh @@ -0,0 +1,87 @@ +#! /bin/sh + +. ../../testenv.sh + +COMMON_FLAGS="--std=08" +COMMON_FLAGS="$COMMON_FLAGS -O -g" +#COMMON_FLAGS="$COMMON_FLAGS --post -Wp,-g" +export GHDL_STD_FLAGS=$COMMON_FLAGS + +GHDL_STD_FLAGS="$COMMON_FLAGS --work=osvvm" +DIR=OSVVM +analyze $DIR/NamePkg.vhd +analyze $DIR/OsvvmGlobalPkg.vhd + +analyze $DIR/VendorCovApiPkg.vhd + +analyze $DIR/TranscriptPkg.vhd +analyze $DIR/TextUtilPkg.vhd +analyze $DIR/AlertLogPkg.vhd + +analyze $DIR/MessagePkg.vhd +analyze $DIR/SortListPkg_int.vhd +analyze $DIR/RandomBasePkg.vhd +analyze $DIR/RandomPkg.vhd +analyze $DIR/CoveragePkg.vhd +analyze $DIR/MemoryPkg.vhd + +analyze $DIR/ScoreboardGenericPkg.vhd +analyze $DIR/ScoreboardPkg_slv.vhd +analyze $DIR/ScoreboardPkg_int.vhd + +analyze $DIR/ResolutionPkg.vhd +analyze $DIR/TbUtilPkg.vhd + +analyze $DIR/OsvvmContext.vhd + +GHDL_STD_FLAGS="$COMMON_FLAGS --work=osvvm_common" +DIR=OsvvmLibraries/Common +#analyze $DIR/src/StreamTransactionPkg.vhd +analyze $DIR/src/AddressBusTransactionPkg.vhd +analyze $DIR/src/AddressBusResponderTransactionPkg.vhd +#analyze $DIR/src/AddressBusVersionCompatibilityPkg.vhd +analyze $DIR/src/ModelParametersPkg.vhd +#analyze $DIR/src/FifoFillPkg_slv.vhd +#analyze $DIR/src/InterruptHandler.vhd +#analyze $DIR/src/InterruptHandlerComponentPkg.vhd +analyze $DIR/src/OsvvmCommonContext.vhd + +GHDL_STD_FLAGS="$COMMON_FLAGS --work=osvvm_axi4" +DIR=OsvvmLibraries/AXI4/common +analyze $DIR/src/Axi4LiteInterfacePkg.vhd +analyze $DIR/src/Axi4InterfacePkg.vhd +analyze $DIR/src/Axi4CommonPkg.vhd +analyze $DIR/src/Axi4ModelPkg.vhd +analyze $DIR/src/Axi4OptionsPkg.vhd +#analyze $DIR/src/Axi4VersionCompatibilityPkg.vhd + +DIR=OsvvmLibraries/AXI4/Axi4 +analyze $DIR/src/Axi4ComponentPkg.vhd +#analyze $DIR/src/Axi4ComponentVtiPkg.vhd +analyze $DIR/src/Axi4Context.vhd +analyze $DIR/src/Axi4Master.vhd +#analyze $DIR/src/Axi4MasterVti.vhd +analyze $DIR/src/Axi4Monitor_dummy.vhd +analyze $DIR/src/Axi4Responder_Transactor.vhd +#analyze $DIR/src/Axi4ResponderVti_Transactor.vhd +#analyze $DIR/src/Axi4Memory.vhd +#analyze $DIR/src/Axi4MemoryVti.vhd + +GHDL_STD_FLAGS="$COMMON_FLAGS" +DIR=ghdl_issues/GHDL_1764_Axi4Master_Sim_Fails/Axi4Testbench_fails/ + +#analyze --work=osvvm_axi4 $DIR/Axi4Master.vhd +analyze $DIR/TestCtrl_e_ghdl.vhd +analyze $DIR/TbAxi4.vhd +analyze $DIR/TbAxi4Memory.vhd + +DIR=ghdl_issues/GHDL_1764_Axi4Master_Sim_Fails/TestCases/ +analyze $DIR/TbAxi4_BasicReadWrite.vhd +elab_simulate TbAxi4_BasicReadWrite + +analyze $DIR/TbAxi4_MemoryReadWrite1.vhd +elab_simulate TbAxi4_MemoryReadWrite1 + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue1764/testsuite.sh b/testsuite/gna/issue1764/testsuite.sh new file mode 100755 index 000000000..15fea4385 --- /dev/null +++ b/testsuite/gna/issue1764/testsuite.sh @@ -0,0 +1,11 @@ +#! /bin/sh + +. ../../testenv.sh + +export GHDL_STD_FLAGS=--std=08 +analyze repro.vhdl +elab_simulate repro --assert-level=error + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue1765/ent.vhdl b/testsuite/gna/issue1765/ent.vhdl new file mode 100644 index 000000000..c2f21f62e --- /dev/null +++ b/testsuite/gna/issue1765/ent.vhdl @@ -0,0 +1,28 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +--use work.TestPkg.all ; + +entity test is + port( + input : in unsigned ; + output : out unsigned + ); +end entity; + +architecture rtl of test is +alias A is Output ; -- does not work +-- alias A : unsigned(output'range) is Output ; -- Works +-- alias A : output'subtype is Output ; -- Works + +begin + A <= (output'range => '0') ; + + process + begin + wait on input ; -- Suppress first run + report "input = " & to_hstring(input) ; + end process ; + +end architecture ; diff --git a/testsuite/gna/issue1765/ent93.vhdl b/testsuite/gna/issue1765/ent93.vhdl new file mode 100644 index 000000000..3ac359299 --- /dev/null +++ b/testsuite/gna/issue1765/ent93.vhdl @@ -0,0 +1,28 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +--use work.TestPkg.all ; + +entity test is + port( + input : in unsigned ; + output : out unsigned + ); +end entity; + +architecture rtl of test is +alias A is Output ; -- does not work +-- alias A : unsigned(output'range) is Output ; -- Works +-- alias A : output'subtype is Output ; -- Works + +begin + A <= (output'range => '0') ; + + process + begin + wait on input ; -- Suppress first run +-- report "input = " & to_hstring(input) ; + end process ; + +end architecture ; diff --git a/testsuite/gna/issue1765/testsuite.sh b/testsuite/gna/issue1765/testsuite.sh new file mode 100755 index 000000000..644614735 --- /dev/null +++ b/testsuite/gna/issue1765/testsuite.sh @@ -0,0 +1,14 @@ +#! /bin/sh + +. ../../testenv.sh + +analyze ent93.vhdl + +clean + +export GHDL_STD_FLAGS=--std=08 +analyze ent.vhdl + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue1768/repro.vhdl b/testsuite/gna/issue1768/repro.vhdl new file mode 100644 index 000000000..2d2dda374 --- /dev/null +++ b/testsuite/gna/issue1768/repro.vhdl @@ -0,0 +1,25 @@ +package pkg is + function log2 (v : positive) return natural; +end pkg; + +package body pkg is + function log2 (v : positive) return natural is + begin + return 2; + end log2; +end pkg; + +use work.pkg.all; + +package repro is + constant W : natural := 8; + function f (vec : bit_vector(log2(W / 2) - 1 downto 0)) return bit; +end repro; + +package body repro is + function f (vec : bit_vector(log2(W / 2) - 1 downto 0)) return bit is + begin + return '1'; + end f; +end repro; + diff --git a/testsuite/gna/issue1768/repro2.vhdl b/testsuite/gna/issue1768/repro2.vhdl new file mode 100644 index 000000000..e2e9f15cc --- /dev/null +++ b/testsuite/gna/issue1768/repro2.vhdl @@ -0,0 +1,22 @@ +package pkg2 is + type natural_array is array (positive range <>) of natural; + constant log2 : natural_array := (1 => 0, + 2 => 1, + 3 to 4 => 2, + 5 to 8 => 3); +end pkg2; + +use work.pkg2.all; + +package repro2 is + constant W : natural := 8; + function f (vec : bit_vector(log2(W / 2) - 1 downto 0)) return bit; +end repro2; + +package body repro2 is + function f (vec : bit_vector(log2(W / 2) - 1 downto 0)) return bit is + begin + return '1'; + end f; +end repro2; + diff --git a/testsuite/gna/issue1768/repro3.vhdl b/testsuite/gna/issue1768/repro3.vhdl new file mode 100644 index 000000000..7c64f4c67 --- /dev/null +++ b/testsuite/gna/issue1768/repro3.vhdl @@ -0,0 +1,12 @@ +package repro3 is + constant bv : bit_vector := "1010011"; + function f (vec : bit_vector := bv (0 to 3)) return bit; +end repro3; + +package body repro3 is + function f (vec : bit_vector := bv (0 to 3)) return bit is + begin + return '1'; + end f; +end repro3; + diff --git a/testsuite/gna/issue1768/testsuite.sh b/testsuite/gna/issue1768/testsuite.sh new file mode 100755 index 000000000..3ce439f6f --- /dev/null +++ b/testsuite/gna/issue1768/testsuite.sh @@ -0,0 +1,11 @@ +#! /bin/sh + +. ../../testenv.sh + +analyze repro.vhdl +analyze repro2.vhdl +analyze repro3.vhdl + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue641/test_1a_unsigned_port/TbTest.vhd b/testsuite/gna/issue641/test_1a_unsigned_port/TbTest.vhd new file mode 100644 index 000000000..e24014577 --- /dev/null +++ b/testsuite/gna/issue641/test_1a_unsigned_port/TbTest.vhd @@ -0,0 +1,34 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity TbTest is +end entity TbTest; + +architecture rtl of TbTest is + + component test is + port( + input : in unsigned); + end component test; + + signal Fred : unsigned(7 downto 0) ; +begin + test_1 : test + port map ( + input => Fred + ); + + process + begin + Fred <= X"00" ; + wait for 1 ns ; + for i in 1 to 10 loop + Fred <= X"00" + i ; + wait for 1 ns ; + end loop ; + std.env.stop ; + end process ; +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_1a_unsigned_port/Test.vhd b/testsuite/gna/issue641/test_1a_unsigned_port/Test.vhd new file mode 100644 index 000000000..2d2f85cfc --- /dev/null +++ b/testsuite/gna/issue641/test_1a_unsigned_port/Test.vhd @@ -0,0 +1,24 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity test is + port( + input : in unsigned + ); +end entity; + +architecture rtl of test is + signal copy : input'subtype; +begin + copy <= input ; + + process + begin + wait on copy ; -- Suppress first run + report "Copy = " & to_hstring(Copy) ; + end process ; + +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_1a_unsigned_port/TestPkg.vhd b/testsuite/gna/issue641/test_1a_unsigned_port/TestPkg.vhd new file mode 100644 index 000000000..879e0315a --- /dev/null +++ b/testsuite/gna/issue641/test_1a_unsigned_port/TestPkg.vhd @@ -0,0 +1,7 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package TestPkg is + +end package TestPkg ; diff --git a/testsuite/gna/issue641/test_1a_unsigned_port/test_1a_unsigned_port.pro b/testsuite/gna/issue641/test_1a_unsigned_port/test_1a_unsigned_port.pro new file mode 100644 index 000000000..e93963344 --- /dev/null +++ b/testsuite/gna/issue641/test_1a_unsigned_port/test_1a_unsigned_port.pro @@ -0,0 +1,6 @@ +library default + +analyze TestPkg.vhd +analyze Test.vhd +analyze TbTest.vhd +simulate TbTest
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_1b_unsigned_alias/TbTest.vhd b/testsuite/gna/issue641/test_1b_unsigned_alias/TbTest.vhd new file mode 100644 index 000000000..e24014577 --- /dev/null +++ b/testsuite/gna/issue641/test_1b_unsigned_alias/TbTest.vhd @@ -0,0 +1,34 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity TbTest is +end entity TbTest; + +architecture rtl of TbTest is + + component test is + port( + input : in unsigned); + end component test; + + signal Fred : unsigned(7 downto 0) ; +begin + test_1 : test + port map ( + input => Fred + ); + + process + begin + Fred <= X"00" ; + wait for 1 ns ; + for i in 1 to 10 loop + Fred <= X"00" + i ; + wait for 1 ns ; + end loop ; + std.env.stop ; + end process ; +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_1b_unsigned_alias/Test.vhd b/testsuite/gna/issue641/test_1b_unsigned_alias/Test.vhd new file mode 100644 index 000000000..8f07e8469 --- /dev/null +++ b/testsuite/gna/issue641/test_1b_unsigned_alias/Test.vhd @@ -0,0 +1,25 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity test is + port( + input : in unsigned); +end entity; + +architecture rtl of test is + signal copy : input'subtype; + + alias B is copy ; +begin + copy <= input ; + + process + begin + wait on copy ; -- Suppress first run + report "Copy, B = " & to_hstring(Copy) & ", " & to_hstring(B) ; + end process ; + +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_1b_unsigned_alias/TestPkg.vhd b/testsuite/gna/issue641/test_1b_unsigned_alias/TestPkg.vhd new file mode 100644 index 000000000..879e0315a --- /dev/null +++ b/testsuite/gna/issue641/test_1b_unsigned_alias/TestPkg.vhd @@ -0,0 +1,7 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package TestPkg is + +end package TestPkg ; diff --git a/testsuite/gna/issue641/test_1b_unsigned_alias/test_1b_unsigned_alias.pro b/testsuite/gna/issue641/test_1b_unsigned_alias/test_1b_unsigned_alias.pro new file mode 100644 index 000000000..e93963344 --- /dev/null +++ b/testsuite/gna/issue641/test_1b_unsigned_alias/test_1b_unsigned_alias.pro @@ -0,0 +1,6 @@ +library default + +analyze TestPkg.vhd +analyze Test.vhd +analyze TbTest.vhd +simulate TbTest
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2a_record_subtype/TbTest.vhd b/testsuite/gna/issue641/test_2a_record_subtype/TbTest.vhd new file mode 100644 index 000000000..9cecebfb6 --- /dev/null +++ b/testsuite/gna/issue641/test_2a_record_subtype/TbTest.vhd @@ -0,0 +1,35 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity TbTest is +end entity TbTest; + +architecture rtl of TbTest is + + component test is + port( + input : in ARecType + ); + end component test; + + signal Fred : ARecType( A(7 downto 0)) ; +begin + test_1 : test + port map ( + input => Fred + ); + + process + begin + Fred.A <= X"00" ; + wait for 1 ns ; + for i in 1 to 10 loop + Fred.A <= X"00" + i ; + wait for 1 ns ; + end loop ; + std.env.stop ; + end process ; +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2a_record_subtype/Test.vhd b/testsuite/gna/issue641/test_2a_record_subtype/Test.vhd new file mode 100644 index 000000000..b0b419755 --- /dev/null +++ b/testsuite/gna/issue641/test_2a_record_subtype/Test.vhd @@ -0,0 +1,24 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity test is + port( + input : in ARecType + ); +end entity; + +architecture rtl of test is + signal copy : input'subtype; +begin + copy <= input ; + + process + begin + wait on copy ; -- Suppress first run + report "Copy.A = " & to_hstring(Copy.A) ; + end process ; + +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2a_record_subtype/TestPkg.vhd b/testsuite/gna/issue641/test_2a_record_subtype/TestPkg.vhd new file mode 100644 index 000000000..24eeaabf4 --- /dev/null +++ b/testsuite/gna/issue641/test_2a_record_subtype/TestPkg.vhd @@ -0,0 +1,10 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package TestPkg is + type ARecType is record + A : unsigned ; + end record ARecType ; + +end package TestPkg ; diff --git a/testsuite/gna/issue641/test_2a_record_subtype/test_2a_record_subtype.pro b/testsuite/gna/issue641/test_2a_record_subtype/test_2a_record_subtype.pro new file mode 100644 index 000000000..e93963344 --- /dev/null +++ b/testsuite/gna/issue641/test_2a_record_subtype/test_2a_record_subtype.pro @@ -0,0 +1,6 @@ +library default + +analyze TestPkg.vhd +analyze Test.vhd +analyze TbTest.vhd +simulate TbTest
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2b_record_subtype_alias/TbTest.vhd b/testsuite/gna/issue641/test_2b_record_subtype_alias/TbTest.vhd new file mode 100644 index 000000000..700e9a82a --- /dev/null +++ b/testsuite/gna/issue641/test_2b_record_subtype_alias/TbTest.vhd @@ -0,0 +1,35 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity TbTest is +end entity TbTest; + +architecture rtl of TbTest is + + component test is + port( + input : in ARecType + ); + end component test; + + signal Fred : ARecType( A(7 downto 0)) ; +begin + test_1 : test + port map ( + input => Fred + ); + + process + begin + Fred.A <= X"00" ; + wait for 1 ns ; + for i in 1 to 10 loop + Fred.A <= X"00" + i ; + wait for 1 ns ; + end loop ; + std.env.stop ; + end process ; +end architecture; diff --git a/testsuite/gna/issue641/test_2b_record_subtype_alias/Test.vhd b/testsuite/gna/issue641/test_2b_record_subtype_alias/Test.vhd new file mode 100644 index 000000000..7e22615d2 --- /dev/null +++ b/testsuite/gna/issue641/test_2b_record_subtype_alias/Test.vhd @@ -0,0 +1,33 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity test is + port( + input : in ARecType + ); +end entity; + +architecture rtl of test is + signal copy : input'subtype; -- fails +-- signal copy : ARecType(A(input.A'range)) ; -- Works + + alias B is copy ; + +-- Inconjunction with input'subtype the following all fail. +-- alias B : ARecType(A(input.A'range)) is copy ; -- with failing case, causes runtime bounds check failure +-- alias B : ARecType(A(7 downto 0)) is copy ; +-- subtype BType is AReCType(A(7 downto 0)) ; +-- alias B : BType is copy ; +begin + copy <= input ; + + process + begin + wait on copy ; -- Suppress first run + report "Copy.A, B.A = " & to_hstring(Copy.A) & ", " & to_hstring(B.A) ; + end process ; + +end architecture; diff --git a/testsuite/gna/issue641/test_2b_record_subtype_alias/TestPkg.vhd b/testsuite/gna/issue641/test_2b_record_subtype_alias/TestPkg.vhd new file mode 100644 index 000000000..24eeaabf4 --- /dev/null +++ b/testsuite/gna/issue641/test_2b_record_subtype_alias/TestPkg.vhd @@ -0,0 +1,10 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package TestPkg is + type ARecType is record + A : unsigned ; + end record ARecType ; + +end package TestPkg ; diff --git a/testsuite/gna/issue641/test_2b_record_subtype_alias/test_2b_record_subtype_alias.pro b/testsuite/gna/issue641/test_2b_record_subtype_alias/test_2b_record_subtype_alias.pro new file mode 100644 index 000000000..e93963344 --- /dev/null +++ b/testsuite/gna/issue641/test_2b_record_subtype_alias/test_2b_record_subtype_alias.pro @@ -0,0 +1,6 @@ +library default + +analyze TestPkg.vhd +analyze Test.vhd +analyze TbTest.vhd +simulate TbTest
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2c_record_range_alias/TbTest.vhd b/testsuite/gna/issue641/test_2c_record_range_alias/TbTest.vhd new file mode 100644 index 000000000..9cecebfb6 --- /dev/null +++ b/testsuite/gna/issue641/test_2c_record_range_alias/TbTest.vhd @@ -0,0 +1,35 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity TbTest is +end entity TbTest; + +architecture rtl of TbTest is + + component test is + port( + input : in ARecType + ); + end component test; + + signal Fred : ARecType( A(7 downto 0)) ; +begin + test_1 : test + port map ( + input => Fred + ); + + process + begin + Fred.A <= X"00" ; + wait for 1 ns ; + for i in 1 to 10 loop + Fred.A <= X"00" + i ; + wait for 1 ns ; + end loop ; + std.env.stop ; + end process ; +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2c_record_range_alias/Test.vhd b/testsuite/gna/issue641/test_2c_record_range_alias/Test.vhd new file mode 100644 index 000000000..3668d7400 --- /dev/null +++ b/testsuite/gna/issue641/test_2c_record_range_alias/Test.vhd @@ -0,0 +1,27 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity test is + port( + input : in ARecType + ); +end entity; + +architecture rtl of test is + signal copy : ARecType(A(input.A'range)) ; -- Works + + alias B is copy ; + +begin + copy <= input ; + + process + begin + wait on copy ; -- Suppress first run + report "Copy.A, B.A = " & to_hstring(Copy.A) & ", " & to_hstring(B.A) ; + end process ; + +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2c_record_range_alias/TestPkg.vhd b/testsuite/gna/issue641/test_2c_record_range_alias/TestPkg.vhd new file mode 100644 index 000000000..24eeaabf4 --- /dev/null +++ b/testsuite/gna/issue641/test_2c_record_range_alias/TestPkg.vhd @@ -0,0 +1,10 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package TestPkg is + type ARecType is record + A : unsigned ; + end record ARecType ; + +end package TestPkg ; diff --git a/testsuite/gna/issue641/test_2c_record_range_alias/test_2c_record_range_alias.pro b/testsuite/gna/issue641/test_2c_record_range_alias/test_2c_record_range_alias.pro new file mode 100644 index 000000000..e93963344 --- /dev/null +++ b/testsuite/gna/issue641/test_2c_record_range_alias/test_2c_record_range_alias.pro @@ -0,0 +1,6 @@ +library default + +analyze TestPkg.vhd +analyze Test.vhd +analyze TbTest.vhd +simulate TbTest
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2d_record_subtype_length_decl/TbTest.vhd b/testsuite/gna/issue641/test_2d_record_subtype_length_decl/TbTest.vhd new file mode 100644 index 000000000..9cecebfb6 --- /dev/null +++ b/testsuite/gna/issue641/test_2d_record_subtype_length_decl/TbTest.vhd @@ -0,0 +1,35 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity TbTest is +end entity TbTest; + +architecture rtl of TbTest is + + component test is + port( + input : in ARecType + ); + end component test; + + signal Fred : ARecType( A(7 downto 0)) ; +begin + test_1 : test + port map ( + input => Fred + ); + + process + begin + Fred.A <= X"00" ; + wait for 1 ns ; + for i in 1 to 10 loop + Fred.A <= X"00" + i ; + wait for 1 ns ; + end loop ; + std.env.stop ; + end process ; +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2d_record_subtype_length_decl/Test.vhd b/testsuite/gna/issue641/test_2d_record_subtype_length_decl/Test.vhd new file mode 100644 index 000000000..2a81249b4 --- /dev/null +++ b/testsuite/gna/issue641/test_2d_record_subtype_length_decl/Test.vhd @@ -0,0 +1,27 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity test is + port( + input : in ARecType + ); +end entity; + +architecture rtl of test is + signal copy : input'subtype; -- fails + + constant B : integer := Copy.A'length ; + +begin + copy <= input ; + + process + begin + wait on copy ; -- Suppress first run + report "Copy.A, B = " & to_hstring(Copy.A) & ", " & to_string(B) ; + end process ; + +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2d_record_subtype_length_decl/TestPkg.vhd b/testsuite/gna/issue641/test_2d_record_subtype_length_decl/TestPkg.vhd new file mode 100644 index 000000000..24eeaabf4 --- /dev/null +++ b/testsuite/gna/issue641/test_2d_record_subtype_length_decl/TestPkg.vhd @@ -0,0 +1,10 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package TestPkg is + type ARecType is record + A : unsigned ; + end record ARecType ; + +end package TestPkg ; diff --git a/testsuite/gna/issue641/test_2d_record_subtype_length_decl/test_2d_record_subtype_length_decl.pro b/testsuite/gna/issue641/test_2d_record_subtype_length_decl/test_2d_record_subtype_length_decl.pro new file mode 100644 index 000000000..e93963344 --- /dev/null +++ b/testsuite/gna/issue641/test_2d_record_subtype_length_decl/test_2d_record_subtype_length_decl.pro @@ -0,0 +1,6 @@ +library default + +analyze TestPkg.vhd +analyze Test.vhd +analyze TbTest.vhd +simulate TbTest
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2e_record_simple_alias/TbTest.vhd b/testsuite/gna/issue641/test_2e_record_simple_alias/TbTest.vhd new file mode 100644 index 000000000..05e0e05f8 --- /dev/null +++ b/testsuite/gna/issue641/test_2e_record_simple_alias/TbTest.vhd @@ -0,0 +1,35 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity TbTest is +end entity TbTest; + +architecture rtl of TbTest is + + component test is + port( + input : in ARecType + ); + end component test; + + signal Fred : ARecType ; +begin + test_1 : test + port map ( + input => Fred + ); + + process + begin + Fred.A <= 0 ; + wait for 1 ns ; + for i in 1 to 10 loop + Fred.A <= i ; + wait for 1 ns ; + end loop ; + std.env.stop ; + end process ; +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2e_record_simple_alias/Test.vhd b/testsuite/gna/issue641/test_2e_record_simple_alias/Test.vhd new file mode 100644 index 000000000..babbea3b2 --- /dev/null +++ b/testsuite/gna/issue641/test_2e_record_simple_alias/Test.vhd @@ -0,0 +1,27 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity test is + port( + input : in ARecType + ); +end entity; + +architecture rtl of test is + alias B is input ; + + signal Copy : ARecType ; + +begin + copy <= input ; + + process + begin + wait on copy ; -- Suppress first run + report "Copy.A, B.A = " & to_string(Copy.A) & ", " & to_string(B.A) ; + end process ; + +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2e_record_simple_alias/TestPkg.vhd b/testsuite/gna/issue641/test_2e_record_simple_alias/TestPkg.vhd new file mode 100644 index 000000000..7ae5e6be5 --- /dev/null +++ b/testsuite/gna/issue641/test_2e_record_simple_alias/TestPkg.vhd @@ -0,0 +1,10 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package TestPkg is + type ARecType is record + A : integer ; + end record ARecType ; + +end package TestPkg ; diff --git a/testsuite/gna/issue641/test_2e_record_simple_alias/test_2e_record_simple_alias.pro b/testsuite/gna/issue641/test_2e_record_simple_alias/test_2e_record_simple_alias.pro new file mode 100644 index 000000000..612699efb --- /dev/null +++ b/testsuite/gna/issue641/test_2e_record_simple_alias/test_2e_record_simple_alias.pro @@ -0,0 +1,6 @@ +library test2e + +analyze TestPkg.vhd +analyze Test.vhd +analyze TbTest.vhd +simulate TbTest
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2f_record_constrained_alias/TbTest.vhd b/testsuite/gna/issue641/test_2f_record_constrained_alias/TbTest.vhd new file mode 100644 index 000000000..1791d8ece --- /dev/null +++ b/testsuite/gna/issue641/test_2f_record_constrained_alias/TbTest.vhd @@ -0,0 +1,35 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity TbTest is +end entity TbTest; + +architecture rtl of TbTest is + + component test is + port( + input : in ARecType + ); + end component test; + + signal Fred : ARecType ; +begin + test_1 : test + port map ( + input => Fred + ); + + process + begin + Fred.A <= X"00" ; + wait for 1 ns ; + for i in 1 to 10 loop + Fred.A <= X"00" + i ; + wait for 1 ns ; + end loop ; + std.env.stop ; + end process ; +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2f_record_constrained_alias/Test.vhd b/testsuite/gna/issue641/test_2f_record_constrained_alias/Test.vhd new file mode 100644 index 000000000..cac55351a --- /dev/null +++ b/testsuite/gna/issue641/test_2f_record_constrained_alias/Test.vhd @@ -0,0 +1,27 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity test is + port( + input : in ARecType + ); +end entity; + +architecture rtl of test is + signal copy : input'subtype; + + alias B is copy ; + +begin + copy <= input ; + + process + begin + wait on copy ; -- Suppress first run + report "Copy.A, B.A = " & to_hstring(Copy.A) & ", " & to_hstring(B.A) ; + end process ; + +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2f_record_constrained_alias/TestPkg.vhd b/testsuite/gna/issue641/test_2f_record_constrained_alias/TestPkg.vhd new file mode 100644 index 000000000..e16e8c8c4 --- /dev/null +++ b/testsuite/gna/issue641/test_2f_record_constrained_alias/TestPkg.vhd @@ -0,0 +1,10 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package TestPkg is + type ARecType is record + A : unsigned(7 downto 0) ; + end record ARecType ; + +end package TestPkg ; diff --git a/testsuite/gna/issue641/test_2f_record_constrained_alias/test_2f_record_constrained_alias.pro b/testsuite/gna/issue641/test_2f_record_constrained_alias/test_2f_record_constrained_alias.pro new file mode 100644 index 000000000..e93963344 --- /dev/null +++ b/testsuite/gna/issue641/test_2f_record_constrained_alias/test_2f_record_constrained_alias.pro @@ -0,0 +1,6 @@ +library default + +analyze TestPkg.vhd +analyze Test.vhd +analyze TbTest.vhd +simulate TbTest
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2g_record_alias_port/TbTest.vhd b/testsuite/gna/issue641/test_2g_record_alias_port/TbTest.vhd new file mode 100644 index 000000000..9cecebfb6 --- /dev/null +++ b/testsuite/gna/issue641/test_2g_record_alias_port/TbTest.vhd @@ -0,0 +1,35 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity TbTest is +end entity TbTest; + +architecture rtl of TbTest is + + component test is + port( + input : in ARecType + ); + end component test; + + signal Fred : ARecType( A(7 downto 0)) ; +begin + test_1 : test + port map ( + input => Fred + ); + + process + begin + Fred.A <= X"00" ; + wait for 1 ns ; + for i in 1 to 10 loop + Fred.A <= X"00" + i ; + wait for 1 ns ; + end loop ; + std.env.stop ; + end process ; +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2g_record_alias_port/Test.vhd b/testsuite/gna/issue641/test_2g_record_alias_port/Test.vhd new file mode 100644 index 000000000..939aae531 --- /dev/null +++ b/testsuite/gna/issue641/test_2g_record_alias_port/Test.vhd @@ -0,0 +1,33 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +use work.TestPkg.all ; + +entity test is + port( + input : in ARecType + ); +end entity; + +architecture rtl of test is + alias B is input ; + + signal copy : input'subtype; + +-- The following all fail, but the following error +-- .\tbtest:error: bound check failure at ../../src/ieee2008/std_logic_1164-body.vhdl:905 +-- alias B : ARecType(A(input.A'range)) is input ; +-- alias B : ARecType(A(7 downto 0)) is input ; +-- subtype BType is ARecType(A(7 downto 0)) ; +-- alias B : BType is input ; +begin + copy <= input ; + + process + begin + wait on copy ; -- Suppress first run + report "Copy.A, B.A = " & to_hstring(Copy.A) & ", " & to_hstring(B.A) ; + end process ; + +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/issue641/test_2g_record_alias_port/TestPkg.vhd b/testsuite/gna/issue641/test_2g_record_alias_port/TestPkg.vhd new file mode 100644 index 000000000..24eeaabf4 --- /dev/null +++ b/testsuite/gna/issue641/test_2g_record_alias_port/TestPkg.vhd @@ -0,0 +1,10 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package TestPkg is + type ARecType is record + A : unsigned ; + end record ARecType ; + +end package TestPkg ; diff --git a/testsuite/gna/issue641/test_2g_record_alias_port/test_2g_record_alias_port.pro b/testsuite/gna/issue641/test_2g_record_alias_port/test_2g_record_alias_port.pro new file mode 100644 index 000000000..e93963344 --- /dev/null +++ b/testsuite/gna/issue641/test_2g_record_alias_port/test_2g_record_alias_port.pro @@ -0,0 +1,6 @@ +library default + +analyze TestPkg.vhd +analyze Test.vhd +analyze TbTest.vhd +simulate TbTest
\ No newline at end of file diff --git a/testsuite/gna/issue641/testsuite.sh b/testsuite/gna/issue641/testsuite.sh index 88c716c6b..2c95e8cb3 100755 --- a/testsuite/gna/issue641/testsuite.sh +++ b/testsuite/gna/issue641/testsuite.sh @@ -13,4 +13,69 @@ done clean +# From synthworks + +analyze test_1a_unsigned_port/TestPkg.vhd +analyze test_1a_unsigned_port/Test.vhd +analyze test_1a_unsigned_port/TbTest.vhd +elab_simulate TbTest + +clean + +analyze test_1b_unsigned_alias/TestPkg.vhd +analyze test_1b_unsigned_alias/Test.vhd +analyze test_1b_unsigned_alias/TbTest.vhd +elab_simulate TbTest + +clean + +analyze test_2a_record_subtype/TestPkg.vhd +analyze test_2a_record_subtype/Test.vhd +analyze test_2a_record_subtype/TbTest.vhd +elab_simulate TbTest + +clean + +analyze test_2b_record_subtype_alias/TestPkg.vhd +analyze test_2b_record_subtype_alias/Test.vhd +analyze test_2b_record_subtype_alias/TbTest.vhd +elab_simulate TbTest + +clean + +analyze test_2c_record_range_alias/TestPkg.vhd +analyze test_2c_record_range_alias/Test.vhd +analyze test_2c_record_range_alias/TbTest.vhd +elab_simulate TbTest + +clean + +analyze test_2d_record_subtype_length_decl/TestPkg.vhd +analyze test_2d_record_subtype_length_decl/Test.vhd +analyze test_2d_record_subtype_length_decl/TbTest.vhd +elab_simulate TbTest + +clean + +analyze test_2e_record_simple_alias/TestPkg.vhd +analyze test_2e_record_simple_alias/Test.vhd +analyze test_2e_record_simple_alias/TbTest.vhd +elab_simulate TbTest + +clean + +analyze test_2f_record_constrained_alias/TestPkg.vhd +analyze test_2f_record_constrained_alias/Test.vhd +analyze test_2f_record_constrained_alias/TbTest.vhd +elab_simulate TbTest + +clean + +analyze test_2g_record_alias_port/TestPkg.vhd +analyze test_2g_record_alias_port/Test.vhd +analyze test_2g_record_alias_port/TbTest.vhd +elab_simulate TbTest + +clean + echo "Test successful" diff --git a/testsuite/synth/dff05/dff01.vhdl b/testsuite/synth/dff05/dff01.vhdl new file mode 100644 index 000000000..f16e614dc --- /dev/null +++ b/testsuite/synth/dff05/dff01.vhdl @@ -0,0 +1,13 @@ +library ieee; +use ieee.std_logic_1164.all; + +entity dff01 is + port (q : out std_logic; + d : std_logic; + clk : std_logic); +end dff01; + +architecture behav of dff01 is +begin + q <= d when rising_edge (clk); +end behav; diff --git a/testsuite/synth/dff05/dff02.vhdl b/testsuite/synth/dff05/dff02.vhdl new file mode 100644 index 000000000..09d10e29c --- /dev/null +++ b/testsuite/synth/dff05/dff02.vhdl @@ -0,0 +1,14 @@ +library ieee; +use ieee.std_logic_1164.all; + +entity dff02 is + port (q : out std_logic; + d : std_logic; + clk : std_logic; + rst : std_logic); +end dff02; + +architecture behav of dff02 is +begin + q <= '0' when rst = '1' else d when rising_edge (clk); +end behav; diff --git a/testsuite/synth/dff05/tb_dff01.vhdl b/testsuite/synth/dff05/tb_dff01.vhdl new file mode 100644 index 000000000..7008a8b95 --- /dev/null +++ b/testsuite/synth/dff05/tb_dff01.vhdl @@ -0,0 +1,40 @@ +entity tb_dff01 is +end tb_dff01; + +library ieee; +use ieee.std_logic_1164.all; + +architecture behav of tb_dff01 is + signal clk : std_logic; + signal din : std_logic; + signal dout : std_logic; +begin + dut: entity work.dff01 + port map ( + q => dout, + d => din, + clk => clk); + + process + procedure pulse is + begin + clk <= '0'; + wait for 1 ns; + clk <= '1'; + wait for 1 ns; + end pulse; + begin + din <= '0'; + pulse; + assert dout = '0' severity failure; + din <= '1'; + pulse; + assert dout = '1' severity failure; + pulse; + assert dout = '1' severity failure; + din <= '0'; + pulse; + assert dout = '0' severity failure; + wait; + end process; +end behav; diff --git a/testsuite/synth/dff05/tb_dff02.vhdl b/testsuite/synth/dff05/tb_dff02.vhdl new file mode 100644 index 000000000..d22a3bd9c --- /dev/null +++ b/testsuite/synth/dff05/tb_dff02.vhdl @@ -0,0 +1,55 @@ +entity tb_dff02 is +end tb_dff02; + +library ieee; +use ieee.std_logic_1164.all; + +architecture behav of tb_dff02 is + signal clk : std_logic; + signal din : std_logic; + signal dout : std_logic; + signal rst : std_logic; +begin + dut: entity work.dff02 + port map ( + q => dout, + d => din, + clk => clk, + rst => rst); + + process + procedure pulse is + begin + clk <= '0'; + wait for 1 ns; + clk <= '1'; + wait for 1 ns; + end pulse; + begin + rst <= '1'; + wait for 1 ns; + assert dout = '0' severity failure; + + rst <= '0'; + din <= '1'; + pulse; + assert dout = '1' severity failure; + + din <= '0'; + pulse; + assert dout = '0' severity failure; + + pulse; + assert dout = '0' severity failure; + + din <= '1'; + pulse; + assert dout = '1' severity failure; + + rst <= '1'; + wait for 1 ns; + assert dout = '0' severity failure; + + wait; + end process; +end behav; diff --git a/testsuite/synth/dff05/testsuite.sh b/testsuite/synth/dff05/testsuite.sh new file mode 100755 index 000000000..a86174437 --- /dev/null +++ b/testsuite/synth/dff05/testsuite.sh @@ -0,0 +1,9 @@ +#! /bin/sh + +. ../../testenv.sh + +for t in dff01 dff02; do + synth_tb $t +done + +echo "Test successful" |