diff options
167 files changed, 3219 insertions, 450 deletions
@@ -86,7 +86,7 @@ or if you don't want to install makeinfo: $ make install MAKEINFO=true Build and install vhdl libraries: -$ cd .. +$ cd /path/to/ghdl/source/dir $ make ghdllib $ make install @@ -34,7 +34,7 @@ compiler and GNAT GPL is very easy to install (download anonymously from libre.adacore.com, untar and run the doinstall script). You also need zlib (for Debian or Ubuntu: install zlib1g-dev package). -In the GHDL source directory, configure and build: +In the GHDL base directory, configure and build: ```sh $ ./configure --prefix=/usr/local $ make @@ -25,7 +25,7 @@ PIC_FLAGS=-fPIC show_help=no progname=$0 -subst_vars="CC GNATMAKE CFLAGS LDFLAGS build srcdir prefix backend libdirsuffix libdirreverse gcc_src_dir llvm_config llvm_be llvm_be_ver backtrace_lib build_mode EXEEXT SOEXT PIC_FLAGS" +subst_vars="CC GNATMAKE CFLAGS LDFLAGS build srcdir prefix backend libdirsuffix libdirreverse gcc_src_dir llvm_config llvm_be llvm_be_ver backtrace_lib build_mode EXEEXT SOEXT PIC_FLAGS default_pie" # Find srcdir srcdir=`dirname $progname` @@ -163,7 +163,7 @@ if test $backend = llvm; then fi if check_version 3.5 $llvm_version; then llvm_be=llvm - elif check_version 3.6 $llvm_version || + elif check_version 3.6 $llvm_version || check_version 3.7 $llvm_version || check_version 3.8 $llvm_version; then @@ -195,6 +195,14 @@ case "$build" in *) SOEXT=".so"; EXEEXT=""; PIC_FLAGS="-fPIC";; esac +# Check if gcc was configured with --enable-default-pie. In that case -fPIC +# should be added. +if gcc --version 2>&1 | grep -q enable-default-pie; then + default_pie="yes" +else + default_pie="no" +fi + # Generate config.status rm -f config.status { @@ -266,6 +274,7 @@ sed -e "s%@COMPILER_GCC@%ghdl1-gcc$EXEEXT%" \ -e "s%@INSTALL_PREFIX@%$prefix%" \ -e "s%@LIB_PREFIX@%$libdirsuffix%" \ -e "s%@SOEXT@%$SOEXT%" \ + -e "s%@default_pie@%$default_pie%" \ < $srcdir/src/ghdldrv/default_pathes.ads.in > default_pathes.ads exit 0 diff --git a/dist/gcc/Make-lang.in b/dist/gcc/Make-lang.in index 12c797999..7e2b66bb5 100644 --- a/dist/gcc/Make-lang.in +++ b/dist/gcc/Make-lang.in @@ -108,6 +108,7 @@ vhdl/default_pathes.ads: Makefile echo " \"lib/ghdl\";" >> tmp-dpathes.ads echo " Shared_Library_Extension : constant String :=">> tmp-dpathes.ads echo " \"$(VHDL_SOEXT)\";" >> tmp-dpathes.ads + echo " Default_Pie : constant Boolean := False;" >> tmp-dpathes.ads echo "end Default_Pathes;" >> tmp-dpathes.ads $(srcdir)/../move-if-change tmp-dpathes.ads $@ diff --git a/dist/mcode/windows/shared.psm1 b/dist/mcode/windows/shared.psm1 index d888b1059..20aa5d7da 100644 --- a/dist/mcode/windows/shared.psm1 +++ b/dist/mcode/windows/shared.psm1 @@ -106,20 +106,20 @@ function Format-VHDLSourceFile ) begin - { $State = 1 - $Version = switch ($Version) - { "87" { 87 } - "93" { 93 } - "02" { 2 } - "08" { 8 } - } + { $State = 0 + $VersionAsInt = switch ($Version) + { "87" { 87 } + "93" { 93 } + "02" { 2 } + "08" { 8 } + } } process { if ($InputObject -is [String]) { $Line = $InputObject.ToString() if ($Line.StartsWith("--START-V")) - { $State = switch ($Line.Substring(9, 2)) + { $State = switch ($Line.Substring(9, 2)) { "87" { 87 } "93" { 93 } "02" { 2 } @@ -128,19 +128,21 @@ function Format-VHDLSourceFile } elseif ($Line.StartsWith("--START-!V")) { if ($Line.Substring(10, 2) -eq $Version) - { $State = 2 } + { $State = -1 } } elseif ($Line.StartsWith("--END-V") -or $Line.StartsWith("--END-!V")) - { $State = 1 } + { $State = 0 } else - { if ($State -eq 1) + { if ($State -eq 0) { if ($Line.EndsWith("--V$Version")) { Write-Output $Line } elseif (-not (($Line -like "*--V??") -or ($Line.EndsWith("--!V$Version")))) { Write-Output $Line } } - elseif ($State -eq $Version) + elseif ($State -eq $VersionAsInt) { Write-Output $Line } + # else + # { Write-Host "Discard line: $Line" -ForegroundColor Red } } } else diff --git a/doc/Invoking_GHDL.rst b/doc/Invoking_GHDL.rst index e3d8f4153..fb121ed22 100644 --- a/doc/Invoking_GHDL.rst +++ b/doc/Invoking_GHDL.rst @@ -460,7 +460,19 @@ manual for details. .. option:: --GHDL1=<COMMAND> Use :samp:`COMMAND` as the command name for the compiler. If :samp:`COMMAND` is - not a path, then it is search in the list of program directories. + not a path, then it is searched in the path. + + +.. option:: --AS=<COMMAND> + + Use :samp:`COMMAND` as the command name for the assembler. If :samp:`COMMAND` is + not a path, then it is searched in the path. The default is :samp:`as`. + + +.. option:: --LINK=<COMMAND> + + Use :samp:`COMMAND` as the linker driver. If :samp:`COMMAND` is + not a path, then it is searched in the path. The default is :samp:`gcc`. .. option:: -v diff --git a/libraries/vendors/compile-altera.ps1 b/libraries/vendors/compile-altera.ps1 index bcbbcba0d..030c21926 100644 --- a/libraries/vendors/compile-altera.ps1 +++ b/libraries/vendors/compile-altera.ps1 @@ -194,7 +194,7 @@ if ((-not $StopCompiling) -and $Altera) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -208,7 +208,7 @@ if ((-not $StopCompiling) -and $Altera) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -226,7 +226,7 @@ if ((-not $StopCompiling) -and $Altera) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -240,7 +240,7 @@ if ((-not $StopCompiling) -and $Altera) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -253,7 +253,7 @@ if ((-not $StopCompiling) -and $Altera) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -269,7 +269,7 @@ if ((-not $StopCompiling) -and $Max) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -283,7 +283,7 @@ if ((-not $StopCompiling) -and $Max) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -297,7 +297,7 @@ if ((-not $StopCompiling) -and $Max) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -313,7 +313,7 @@ if ((-not $StopCompiling) -and $Arria) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -327,7 +327,7 @@ if ((-not $StopCompiling) -and $Arria) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -342,7 +342,7 @@ if ((-not $StopCompiling) -and $Arria) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -358,7 +358,7 @@ if ((-not $StopCompiling) -and $Arria) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -374,7 +374,7 @@ if ((-not $StopCompiling) -and $Arria) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -388,7 +388,7 @@ if ((-not $StopCompiling) -and $Arria) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -404,7 +404,7 @@ if ((-not $StopCompiling) -and $Cyclone) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -418,7 +418,7 @@ if ((-not $StopCompiling) -and $Cyclone) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -432,7 +432,7 @@ if ((-not $StopCompiling) -and $Cyclone) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -448,7 +448,7 @@ if ((-not $StopCompiling) -and $Cyclone) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -464,7 +464,7 @@ if ((-not $StopCompiling) -and $Stratix) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -478,7 +478,7 @@ if ((-not $StopCompiling) -and $Stratix) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -494,7 +494,7 @@ if ((-not $StopCompiling) -and $Stratix) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -508,7 +508,7 @@ if ((-not $StopCompiling) -and $Stratix) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -522,7 +522,7 @@ if ((-not $StopCompiling) -and $Nanometer) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -540,7 +540,7 @@ if ((-not $StopCompiling) -and $Nanometer) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } diff --git a/libraries/vendors/compile-lattice.ps1 b/libraries/vendors/compile-lattice.ps1 index b73787032..789e6bd65 100644 --- a/libraries/vendors/compile-lattice.ps1 +++ b/libraries/vendors/compile-lattice.ps1 @@ -227,7 +227,7 @@ if ((-not $StopCompiling) -and $ec) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -238,7 +238,7 @@ if ((-not $StopCompiling) -and $ecp) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -249,7 +249,7 @@ if ((-not $StopCompiling) -and $ecp2) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -260,7 +260,7 @@ if ((-not $StopCompiling) -and $ecp3) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -271,7 +271,7 @@ if ((-not $StopCompiling) -and $ecp5u) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -282,7 +282,7 @@ if ((-not $StopCompiling) -and $lptm) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -293,7 +293,7 @@ if ((-not $StopCompiling) -and $lptm2) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -304,7 +304,7 @@ if ((-not $StopCompiling) -and $MachXO) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -315,7 +315,7 @@ if ((-not $StopCompiling) -and $MachXO2) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -326,7 +326,7 @@ if ((-not $StopCompiling) -and $machxo3l) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -337,7 +337,7 @@ if ((-not $StopCompiling) -and $sc) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -348,7 +348,7 @@ if ((-not $StopCompiling) -and $scm) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -359,7 +359,7 @@ if ((-not $StopCompiling) -and $xp) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -370,7 +370,7 @@ if ((-not $StopCompiling) -and $xp2) $SourceFiles = $FileLists[$Library] | % { "$SourceDirectory\$Library\src\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } diff --git a/libraries/vendors/compile-osvvm.ps1 b/libraries/vendors/compile-osvvm.ps1 index 17fac23fe..9617f2f3f 100644 --- a/libraries/vendors/compile-osvvm.ps1 +++ b/libraries/vendors/compile-osvvm.ps1 @@ -141,12 +141,15 @@ if ((-not $StopCompiling) -and $OSVVM) "RandomBasePkg.vhd",
"RandomPkg.vhd",
"CoveragePkg.vhd",
+ "ScoreboardGenericPkg.vhd",
+ "ScoreboardPkg_int.vhd",
+ "ScoreboardPkg_slv.vhd",
"OsvvmContext.vhd"
)
$SourceFiles = $Files | % { "$SourceDirectory\$_" }
$ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug
+ Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug
$StopCompiling = $HaltOnError -and ($ErrorCount -ne 0)
}
diff --git a/libraries/vendors/compile-osvvm.sh b/libraries/vendors/compile-osvvm.sh index 4cd8ce670..38541aca2 100755 --- a/libraries/vendors/compile-osvvm.sh +++ b/libraries/vendors/compile-osvvm.sh @@ -202,6 +202,9 @@ if [ "$COMPILE_OSVVM" == "TRUE" ]; then RandomBasePkg.vhd RandomPkg.vhd CoveragePkg.vhd + ScoreboardGenericPkg.vhd + ScoreboardPkg_int.vhd + ScoreboardPkg_slv.vhd OsvvmContext.vhd ) diff --git a/libraries/vendors/compile-uvvm.sh b/libraries/vendors/compile-uvvm.sh new file mode 100644 index 000000000..94485421e --- /dev/null +++ b/libraries/vendors/compile-uvvm.sh @@ -0,0 +1,386 @@ +#! /usr/bin/env bash +# EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- +# vim: tabstop=2:shiftwidth=2:noexpandtab +# kate: tab-width 2; replace-tabs off; indent-width 2; +# +# ============================================================================== +# Authors: Patrick Lehmann +# +# Bash Script: Script to compile the UVVM library for GHDL on Linux +# +# Description: +# ------------------------------------ +# This is a Bash script (executable) which: +# - creates a subdirectory in the current working directory +# - compiles all UVVM packages +# +# ============================================================================== +# Copyright (C) 2015-2016 Patrick Lehmann - Dresden, Germany +# +# GHDL is free software; you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free +# Software Foundation; either version 2, or (at your option) any later +# version. +# +# GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# +# You should have received a copy of the GNU General Public License +# along with GHDL; see the file COPYING. If not, write to the Free +# Software Foundation, 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA. +# ============================================================================== + +# --------------------------------------------- +# work around for Darwin (Mac OS) +READLINK=readlink; if [[ $(uname) == "Darwin" ]]; then READLINK=greadlink; fi + +# save working directory +WorkingDir=$(pwd) +ScriptDir="$(dirname $0)" +ScriptDir="$($READLINK -f $ScriptDir)" + +# source configuration file from GHDL's 'vendors' library directory +source $ScriptDir/config.sh +source $ScriptDir/shared.sh + +# command line argument processing +NO_COMMAND=1 +SUPPRESS_WARNINGS=0 +HALT_ON_ERROR=0 +GHDLBinDir="" +DestDir="" +SrcDir="" +while [[ $# > 0 ]]; do + key="$1" + case $key in + -c|--clean) + CLEAN=TRUE + NO_COMMAND=0 + ;; + -a|--all) + COMPILE_ALL=TRUE + NO_COMMAND=0 + ;; + --uvvm) + COMPILE_UVVM=TRUE + NO_COMMAND=0 + ;; + --uvvm-vip) + COMPILE_UVVM_VIP=TRUE + NO_COMMAND=0 + ;; + -h|--help) + HELP=TRUE + NO_COMMAND=0 + ;; + -n|--no-warnings) + SUPPRESS_WARNINGS=1 + ;; + -H|--halt-on-error) + HALT_ON_ERROR=1 + ;; + --ghdl) + GHDLBinDir="$2" + shift # skip argument + ;; + --src) + SrcDir="$2" + shift # skip argument + ;; + --out) + DestDir="$2" + shift # skip argument + ;; + *) # unknown option + echo 1>&2 -e "${COLORED_ERROR} Unknown command line option '$key'.${ANSI_NOCOLOR}" + exit -1 + ;; + esac + shift # past argument or value +done + +# makes no sense to enable it for UVVM +SKIP_EXISTING_FILES=0 + +if [ $NO_COMMAND -eq 1 ]; then + HELP=TRUE +fi + +if [ "$HELP" == "TRUE" ]; then + test $NO_COMMAND -eq 1 && echo 1>&2 -e "/n${COLORED_ERROR} No command selected." + echo "" + echo "Synopsis:" + echo " A script to compile the simulation library 'uvvm_util' for GHDL on Linux." + echo " A library folder 'uvvm_util/v08' will be created relative to the current" + echo " working directory." + echo "" + echo " Use the adv. options or edit 'config.sh' to supply paths and default params." + echo "" + echo "Usage:" + echo " compile-uvvm.sh <common command>|<library> [<options>] [<adv. options>]" + echo "" + echo "Common commands:" + echo " -h --help Print this help page" + echo " -c --clean Remove all generated files" + echo "" + echo "Libraries:" + echo " -a --all Compile all libraries." + echo " --uvvm Compile UVVM library packages." + echo " --uvvm-vip Compile UVVM Verification IPs (VIPs)." + echo "" + echo "Library compile options:" + echo " -H --halt-on-error Halt on error(s)." + echo "" + echo "Advanced options:" + echo " --ghdl <GHDL bin dir> Path to GHDL's binary directory, e.g. /usr/local/bin" + echo " --out <dir name> Name of the output directory, e.g. uvvm_util" + echo " --src <Path to UVVM> Path to the sources." + echo "" + echo "Verbosity:" + echo " -n --no-warnings Suppress all warnings. Show only error messages." + echo "" + exit 0 +fi + +if [ "$COMPILE_ALL" == "TRUE" ]; then + COMPILE_UVVM=TRUE + COMPILE_UVVM_VIP=TRUE +fi +if [ "$COMPILE_UVVM" == "TRUE" ]; then + COMPILE_UVVM_UTILITIES=TRUE + COMPILE_UVVM_VVC_FRAMEWORK=TRUE +fi +if [ "$COMPILE_UVVM_VIP" == "TRUE" ]; then + COMPILE_UVVM_VIP_AXILITE=TRUE + COMPILE_UVVM_VIP_AXISTREAM=TRUE + COMPILE_UVVM_VIP_I2C=TRUE + COMPILE_UVVM_VIP_SBI=TRUE + COMPILE_UVVM_VIP_UART=TRUE +fi + +# -> $SourceDirectories +# -> $DestinationDirectories +# -> $SrcDir +# -> $DestDir +# -> $GHDLBinDir +# <= $SourceDirectory +# <= $DestinationDirectory +# <= $GHDLBinary +SetupDirectories UVVM "UVVM" + +# create "uvvm_util" directory and change to it +# => $DestinationDirectory +CreateDestinationDirectory +cd $DestinationDirectory + + +# => $SUPPRESS_WARNINGS +# <= $GRC_COMMAND +SetupGRCat + + +# define global GHDL Options +GHDL_OPTIONS=(-fexplicit -frelaxed-rules --no-vital-checks --warn-binding --mb-comments) + +# create a set of GHDL parameters +GHDL_PARAMS=(${GHDL_OPTIONS[@]}) +GHDL_PARAMS+=(--std=08 -P$DestinationDirectory) + +# Cleanup directory +# ============================================================================== +if [ "$CLEAN" == "TRUE" ]; then + echo -e "${ANSI_YELLOW}Cleaning up vendor directory ...${ANSI_NOCOLOR}" + rm *.o 2> /dev/null + rm *.cf 2> /dev/null +fi + +# UVVM libraries +# ============================================================================== +# compile uvvm_util packages +ERRORCOUNT=0 +if [ "$COMPILE_UVVM" == "TRUE" ]; then + Library="uvvm_util" + VHDLVersion="v08" + Files=( + uvvm_util/src/types_pkg.vhd + uvvm_util/src/adaptations_pkg.vhd + uvvm_util/src/string_methods_pkg.vhd + uvvm_util/src/protected_types_pkg.vhd + uvvm_util/src/hierarchy_linked_list_pkg.vhd + uvvm_util/src/alert_hierarchy_pkg.vhd + uvvm_util/src/license_pkg.vhd + uvvm_util/src/methods_pkg.vhd + uvvm_util/src/bfm_common_pkg.vhd + uvvm_util/src/uvvm_util_context.vhd + ) + + # append absolute source path + SourceFiles=() + for File in ${Files[@]}; do + SourceFiles+=("$SourceDirectory/$File") + done + + GHDLCompilePackages +fi + +# compile uvvm_vvc_framework packages +ERRORCOUNT=0 +if [ "$COMPILE_UVVM" == "TRUE" ]; then + Library="uvvm_vvc_framework" + VHDLVersion="v08" + Files=( + uvvm_vvc_framework/src/ti_vvc_framework_support_pkg.vhd + uvvm_vvc_framework/src/ti_generic_queue_pkg.vhd + uvvm_vvc_framework/src/ti_data_queue_pkg.vhd + uvvm_vvc_framework/src/ti_data_fifo_pkg.vhd + uvvm_vvc_framework/src/ti_data_stack_pkg.vhd + ) + + # append absolute source path + SourceFiles=() + for File in ${Files[@]}; do + SourceFiles+=("$SourceDirectory/$File") + done + + GHDLCompilePackages +fi + +# Verification IPs +# ============================================================================== +# compile bitvis_vip_axilite packages +ERRORCOUNT=0 +if [ "$COMPILE_UVVM_VIP_AXILITE" == "TRUE" ]; then + Library="bitvis_vip_axilite" + VHDLVersion="v08" + Files=( + bitvis_vip_axilite/src/axilite_bfm_pkg.vhd + bitvis_vip_axilite/src/vvc_cmd_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_target_support_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_vvc_framework_common_methods_pkg.vhd + bitvis_vip_axilite/src/vvc_methods_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_queue_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_vvc_entity_support_pkg.vhd + bitvis_vip_axilite/src/axilite_vvc.vhd + ) + + # append absolute source path + SourceFiles=() + for File in ${Files[@]}; do + SourceFiles+=("$SourceDirectory/$File") + done + + GHDLCompilePackages +fi + +# compile bitvis_vip_axistream packages +ERRORCOUNT=0 +if [ "$COMPILE_UVVM_VIP_AXISTREAM" == "TRUE" ]; then + Library="bitvis_vip_axistream" + VHDLVersion="v08" + Files=( + bitvis_vip_axistream/src/axistream_bfm_pkg.vhd + bitvis_vip_axistream/src/vvc_cmd_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_target_support_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_vvc_framework_common_methods_pkg.vhd + bitvis_vip_axistream/src/vvc_methods_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_queue_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_vvc_entity_support_pkg.vhd + bitvis_vip_axistream/src/axistream_vvc.vhd + ) + + # append absolute source path + SourceFiles=() + for File in ${Files[@]}; do + SourceFiles+=("$SourceDirectory/$File") + done + + GHDLCompilePackages +fi + +# compile bitvis_vip_i2c packages +ERRORCOUNT=0 +if [ "$COMPILE_UVVM_VIP_I2C" == "TRUE" ]; then + Library="bitvis_vip_i2c" + VHDLVersion="v08" + Files=( + bitvis_vip_i2c/src/i2c_bfm_pkg.vhd + bitvis_vip_i2c/src/vvc_cmd_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_target_support_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_vvc_framework_common_methods_pkg.vhd + bitvis_vip_i2c/src/vvc_methods_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_queue_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_vvc_entity_support_pkg.vhd + bitvis_vip_i2c/src/i2c_vvc.vhd + ) + + # append absolute source path + SourceFiles=() + for File in ${Files[@]}; do + SourceFiles+=("$SourceDirectory/$File") + done + + GHDLCompilePackages +fi + +# compile bitvis_vip_sbi packages +ERRORCOUNT=0 +if [ "$COMPILE_UVVM_VIP_SBI" == "TRUE" ]; then + Library="bitvis_vip_sbi" + VHDLVersion="v08" + Files=( + bitvis_vip_sbi/src/sbi_bfm_pkg.vhd + bitvis_vip_sbi/src/vvc_cmd_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_target_support_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_vvc_framework_common_methods_pkg.vhd + bitvis_vip_sbi/src/vvc_methods_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_queue_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_vvc_entity_support_pkg.vhd + bitvis_vip_sbi/src/sbi_vvc.vhd + ) + + # append absolute source path + SourceFiles=() + for File in ${Files[@]}; do + SourceFiles+=("$SourceDirectory/$File") + done + + GHDLCompilePackages +fi + +# compile bitvis_vip_uart packages +ERRORCOUNT=0 +if [ "$COMPILE_UVVM_VIP_UART" == "TRUE" ]; then + Library="bitvis_vip_uart" + VHDLVersion="v08" + Files=( + bitvis_vip_uart/src/uart_bfm_pkg.vhd + bitvis_vip_uart/src/vvc_cmd_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_target_support_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_vvc_framework_common_methods_pkg.vhd + bitvis_vip_uart/src/vvc_methods_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_queue_pkg.vhd + uvvm_vvc_framework/src_target_dependent/td_vvc_entity_support_pkg.vhd + bitvis_vip_uart/src/uart_rx_vvc.vhd + bitvis_vip_uart/src/uart_tx_vvc.vhd + bitvis_vip_uart/src/uart_vvc.vhd + ) + + # append absolute source path + SourceFiles=() + for File in ${Files[@]}; do + SourceFiles+=("$SourceDirectory/$File") + done + + GHDLCompilePackages +fi + +echo "--------------------------------------------------------------------------------" +echo -n "Compiling UVVM packages " +if [ $ERRORCOUNT -gt 0 ]; then + echo -e $COLORED_FAILED +else + echo -e $COLORED_SUCCESSFUL +fi diff --git a/libraries/vendors/compile-vunit.ps1 b/libraries/vendors/compile-vunit.ps1 index 0948dc5d0..993a91a31 100644 --- a/libraries/vendors/compile-vunit.ps1 +++ b/libraries/vendors/compile-vunit.ps1 @@ -172,7 +172,7 @@ if ((-not $StopCompiling) -and $VUnit) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } diff --git a/libraries/vendors/compile-vunit.sh b/libraries/vendors/compile-vunit.sh index 0f98d2cd6..277ec47ef 100755 --- a/libraries/vendors/compile-vunit.sh +++ b/libraries/vendors/compile-vunit.sh @@ -110,7 +110,7 @@ if [ "$HELP" == "TRUE" ]; then echo "" echo "Synopsis:" echo " A script to compile the simulation library 'vunit_lib' for GHDL on Linux." - echo " A library folder 'vunit/v08' will be created relative to the current" + echo " A library folder 'vunit_lib/v08' will be created relative to the current" echo " working directory." echo "" echo " Use the adv. options or edit 'config.sh' to supply paths and default params." @@ -131,7 +131,7 @@ if [ "$HELP" == "TRUE" ]; then echo "" echo "Advanced options:" echo " --ghdl <GHDL bin dir> Path to GHDL's binary directory, e.g. /usr/local/bin" - echo " --out <dir name> Name of the output directory, e.g. vunit" + echo " --out <dir name> Name of the output directory, e.g. vunit_lib" echo " --src <Path to VUnit> Path to the sources." echo "" echo "Verbosity:" diff --git a/libraries/vendors/compile-xilinx-ise.ps1 b/libraries/vendors/compile-xilinx-ise.ps1 index 39d680128..3ec51d591 100644 --- a/libraries/vendors/compile-xilinx-ise.ps1 +++ b/libraries/vendors/compile-xilinx-ise.ps1 @@ -193,7 +193,7 @@ if ((-not $StopCompiling) -and $Unisim) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -203,7 +203,7 @@ if ((-not $StopCompiling) -and $Unisim) $SourceFiles = dir "$SourceDirectory\unisims\primitive\*.vhd*" $ErrorCount += 0 - Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -213,7 +213,7 @@ if ((-not $StopCompiling) -and $Unisim -and $SecureIP) $SourceFiles = dir "$SourceDirectory\unisims\secureip\*.vhd*" $ErrorCount += 0 - Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -228,7 +228,7 @@ if ((-not $StopCompiling) -and $Unimacro) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -238,7 +238,7 @@ if ((-not $StopCompiling) -and $Unimacro) $SourceFiles = dir "$SourceDirectory\unimacro\*_MACRO.vhd*" $ErrorCount += 0 - Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -254,7 +254,7 @@ if ((-not $StopCompiling) -and $Simprim) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -264,7 +264,7 @@ if ((-not $StopCompiling) -and $Simprim) $SourceFiles = dir "$SourceDirectory\simprims\primitive\other\*.vhd*" $ErrorCount += 0 - Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -274,7 +274,7 @@ if ((-not $StopCompiling) -and $Simprim -and $SecureIP) $SourceFiles = dir "$SourceDirectory\simprims\secureip\other\*.vhd*" $ErrorCount += 0 - Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -298,7 +298,7 @@ if ((-not $StopCompiling) -and $CoreLib) } $ErrorCount += 0 - Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } diff --git a/libraries/vendors/compile-xilinx-ise.sh b/libraries/vendors/compile-xilinx-ise.sh index 25716aaf7..efe361b34 100755 --- a/libraries/vendors/compile-xilinx-ise.sh +++ b/libraries/vendors/compile-xilinx-ise.sh @@ -276,7 +276,10 @@ fi # compile unisim primitives if [ $STOPCOMPILING -eq 0 ] && [ "$COMPILE_UNISIM" == "TRUE" ]; then Library="unisim" - SourceFiles="$(LC_COLLATE=C ls $SourceDirectory/${Library}s/primitive/*.vhd)" + SourceFiles=() + while IFS= read -r File; do + SourceFiles+=("$SourceDirectory/${Library}s/primitive/$File") + done < <(grep --no-filename -R '^[a-zA-Z]' "$SourceDirectory/${Library}s/primitive/vhdl_analyze_order") GHDLCompileLibrary fi @@ -284,7 +287,10 @@ fi # compile unisim secureip primitives if [ $STOPCOMPILING -eq 0 ] && [ "$COMPILE_UNISIM" == "TRUE" ] && [ "$COMPILE_SECUREIP" == "TRUE" ]; then Library="secureip" - SourceFiles="$(LC_COLLATE=C ls $SourceDirectory/unisims/$Library/*.vhd)" + SourceFiles=() + while IFS= read -r File; do + SourceFiles+=("$SourceDirectory/unisims/$Library/$File") + done < <(grep --no-filename -R '^[a-zA-Z]' "$SourceDirectory/unisims/$Library/vhdl_analyze_order") GHDLCompileLibrary fi @@ -309,7 +315,7 @@ fi # compile unimacro macros if [ $STOPCOMPILING -eq 0 ] && [ "$COMPILE_UNIMACRO" == "TRUE" ]; then Library="unimacro" - SourceFiles="$(LC_COLLATE=C ls $SourceDirectory/$Library/*_MACRO.vhd)" + SourceFiles=($(LC_COLLATE=C ls $SourceDirectory/$Library/*_MACRO.vhd)) GHDLCompileLibrary fi @@ -335,7 +341,10 @@ fi # compile simprim primitives if [ $STOPCOMPILING -eq 0 ] && [ "$COMPILE_SIMPRIM" == "TRUE" ]; then Library="simprim" - SourceFiles="$(LC_COLLATE=C ls $SourceDirectory/${Library}s/primitive/other/*.vhd)" + SourceFiles=() + while IFS= read -r File; do + SourceFiles+=("$SourceDirectory/${Library}s/primitive/other/$File") + done < <(grep --no-filename -R '^[a-zA-Z]' "$SourceDirectory/${Library}s/primitive/other/vhdl_analyze_order") GHDLCompileLibrary fi @@ -343,7 +352,10 @@ fi # compile simprim secureip primitives if [ $STOPCOMPILING -eq 0 ] && [ "$COMPILE_SIMPRIM" == "TRUE" ] && [ "$COMPILE_SECUREIP" == "TRUE" ]; then Library="secureip" - SourceFiles="$(LC_COLLATE=C ls $SourceDirectory/simprims/$Library/other/*.vhd)" + SourceFiles=() + while IFS= read -r File; do + SourceFiles+=("$SourceDirectory/simprims/$Library/other/$File") + done < <(grep --no-filename -R '^[a-zA-Z]' "$SourceDirectory/simprims/$Library/other/vhdl_analyze_order") GHDLCompileLibrary fi diff --git a/libraries/vendors/compile-xilinx-vivado.ps1 b/libraries/vendors/compile-xilinx-vivado.ps1 index 2627298db..621d84ab0 100644 --- a/libraries/vendors/compile-xilinx-vivado.ps1 +++ b/libraries/vendors/compile-xilinx-vivado.ps1 @@ -181,7 +181,7 @@ if ((-not $StopCompiling) -and $Unisim) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -191,7 +191,7 @@ if ((-not $StopCompiling) -and $Unisim) $SourceFiles = dir "$SourceDirectory\unisims\primitive\*.vhd*" $ErrorCount += 0 - Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -201,7 +201,7 @@ if ((-not $StopCompiling) -and $Unisim) $SourceFiles = dir "$SourceDirectory\unisims\retarget\*.vhd*" $ErrorCount += 0 - Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -211,7 +211,7 @@ if ((-not $StopCompiling) -and $Unisim -and $SecureIP) $SourceFiles = dir "$SourceDirectory\unisims\secureip\*.vhd*" $ErrorCount += 0 - Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -226,7 +226,7 @@ if ((-not $StopCompiling) -and $Unimacro) $SourceFiles = $Files | % { "$SourceDirectory\$_" } $ErrorCount += 0 - Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PackageCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } @@ -236,7 +236,7 @@ if ((-not $StopCompiling) -and $Unimacro) $SourceFiles = dir "$SourceDirectory\unimacro\*_MACRO.vhd*" $ErrorCount += 0 - Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug + Start-PrimitiveCompilation $GHDLBinary $GHDLOptions $DestinationDirectory $Library $VHDLVersion $SourceFiles $SuppressWarnings $HaltOnError -Verbose:$EnableVerbose -Debug:$EnableDebug $StopCompiling = $HaltOnError -and ($ErrorCount -ne 0) } diff --git a/libraries/vendors/compile-xilinx-vivado.sh b/libraries/vendors/compile-xilinx-vivado.sh index 64e48c2b0..5d14e8110 100755 --- a/libraries/vendors/compile-xilinx-vivado.sh +++ b/libraries/vendors/compile-xilinx-vivado.sh @@ -76,6 +76,10 @@ while [[ $# > 0 ]]; do COMPILE_UNIMACRO=TRUE NO_COMMAND=0 ;; + --unifast) + COMPILE_UNIFAST=TRUE + NO_COMMAND=0 + ;; --secureip) COMPILE_SECUREIP=TRUE ;; @@ -146,6 +150,7 @@ if [ "$HELP" == "TRUE" ]; then echo " -a --all Compile all Xilinx simulation libraries." echo " --unisim Compile the unisim library." echo " --unimacro Compile the unimacro library." + echo " --unifast Compile the unifast library." echo " --secureip Compile the secureip library." echo "" echo "Library compile options:" @@ -169,6 +174,7 @@ fi if [ "$COMPILE_ALL" == "TRUE" ]; then COMPILE_UNISIM=TRUE COMPILE_UNIMACRO=TRUE + COMPILE_UNIFAST=TRUE COMPILE_SECUREIP=TRUE fi @@ -266,7 +272,10 @@ fi # compile unisim primitives if [ $STOPCOMPILING -eq 0 ] && [ "$COMPILE_UNISIM" == "TRUE" ]; then Library="unisim" - SourceFiles="$(LC_COLLATE=C ls $SourceDirectory/${Library}s/primitive/*.vhd)" + SourceFiles=() + while IFS= read -r File; do + SourceFiles+=("$SourceDirectory/${Library}s/primitive/$File") + done < <(grep --no-filename -R '^[a-zA-Z]' "$SourceDirectory/${Library}s/primitive/vhdl_analyze_order") GHDLCompileLibrary fi @@ -307,14 +316,26 @@ fi # compile unimacro macros if [ $STOPCOMPILING -eq 0 ] && [ "$COMPILE_UNIMACRO" == "TRUE" ]; then Library="unimacro" - SourceFiles="$(LC_COLLATE=C ls $SourceDirectory/$Library/*_MACRO.vhd)" + SourceFiles=() + while IFS= read -r File; do + SourceFiles+=("$SourceDirectory/${Library}/$File") + done < <(grep --no-filename -R '^[a-zA-Z]' "$SourceDirectory/${Library}/vhdl_analyze_order") GHDLCompileLibrary fi # Library UNIFAST # ============================================================================== -# TODO: +# compile unisim primitives +if [ $STOPCOMPILING -eq 0 ] && [ "$COMPILE_UNIFAST" == "TRUE" ]; then + Library="unifast" + SourceFiles=() + while IFS= read -r File; do + SourceFiles+=("$SourceDirectory/${Library}/primitive/$File") + done < <(grep --no-filename -R '^[a-zA-Z]' "$SourceDirectory/${Library}/primitive/vhdl_analyze_order") + + GHDLCompileLibrary +fi echo "--------------------------------------------------------------------------------" echo -n "Compiling Xilinx Vivado libraries " diff --git a/libraries/vendors/config.sh b/libraries/vendors/config.sh index 357236f61..0880fdb4a 100644 --- a/libraries/vendors/config.sh +++ b/libraries/vendors/config.sh @@ -43,6 +43,7 @@ declare -A InstallationDirectories InstallationDirectories[AlteraQuartus]="" # "/opt/altera/16.0/quartus" InstallationDirectories[LatticeDiamond]="" # "/usr/local/diamond/3.7_x64" InstallationDirectories[OSVVM]="" # "~/git/github/osvvm" +InstallationDirectories[UVVM]="" # "~/git/github/uvvm_all" InstallationDirectories[VUnit]="" # "~/git/github/vunit" InstallationDirectories[XilinxISE]="" # "/opt/Xilinx/14.7/ISE_DS/ISE" InstallationDirectories[XilinxVivado]="" # "/opt/Xilinx/Vivado/2016.2" @@ -52,6 +53,7 @@ declare -A DestinationDirectories DestinationDirectories[AlteraQuartus]="altera" DestinationDirectories[LatticeDiamond]="lattice" DestinationDirectories[OSVVM]="." # "osvvm" +DestinationDirectories[UVVM]="." DestinationDirectories[VUnit]="." # "vunit_lib" DestinationDirectories[XilinxISE]="xilinx-ise" DestinationDirectories[XilinxVivado]="xilinx-vivado" @@ -59,11 +61,12 @@ DestinationDirectories[XilinxVivado]="xilinx-vivado" # Declare source directories depending on the installation paths: declare -A SourceDirectories SourceDirectories[AlteraQuartus]="eda/sim_lib" -SourceDirectories[XilinxISE]="vhdl/src" -SourceDirectories[XilinxVivado]="data/vhdl/src" SourceDirectories[LatticeDiamond]="cae_library/simulation/vhdl" SourceDirectories[OSVVM]="." +SourceDirectories[UVVM]="." SourceDirectories[VUnit]="vunit/vhdl" +SourceDirectories[XilinxISE]="vhdl/src" +SourceDirectories[XilinxVivado]="data/vhdl/src" # input files greater than $LARGE_FILESIZE are skipped if '--skip-largefiles' is set LARGE_FILESIZE=125000 diff --git a/libraries/vendors/shared.psm1 b/libraries/vendors/shared.psm1 index 9cc31b375..f91b773e0 100644 --- a/libraries/vendors/shared.psm1 +++ b/libraries/vendors/shared.psm1 @@ -266,6 +266,7 @@ function Start-PackageCompilation [Parameter(Mandatory=$true)][string]$Library, [Parameter(Mandatory=$true)][string]$VHDLVersion, [Parameter(Mandatory=$true)][string[]]$SourceFiles, + [Parameter(Mandatory=$true)][bool]$SuppressWarnings, [Parameter(Mandatory=$true)][bool]$HaltOnError ) # set default values @@ -325,6 +326,7 @@ function Start-PrimitiveCompilation [Parameter(Mandatory=$true)][string]$Library, [Parameter(Mandatory=$true)][string]$VHDLVersion, [Parameter(Mandatory=$true)][string[]]$SourceFiles, + [Parameter(Mandatory=$true)][bool]$SuppressWarnings, [Parameter(Mandatory=$true)][bool]$HaltOnError ) # set default values @@ -450,6 +452,11 @@ function Write-ColoredGHDLLine Write-Host "${Indent}ERROR: " -NoNewline -ForegroundColor Red Write-Host $InputObject } + elseif ($InputObject -match ":error:\s") + { $ErrorRecordFound = $true + Write-Host "${Indent}ERROR: " -NoNewline -ForegroundColor Red + Write-Host $InputObject + } else { Write-Host "${Indent}$InputObject" } } diff --git a/src/ghdldrv/default_pathes.ads.in b/src/ghdldrv/default_pathes.ads.in index a7c3d15f7..8b0801e13 100644 --- a/src/ghdldrv/default_pathes.ads.in +++ b/src/ghdldrv/default_pathes.ads.in @@ -39,4 +39,5 @@ package Default_Pathes is Shared_Library_Extension : constant String := "@SOEXT@"; + Default_Pie : constant Boolean := "@default_pie@" = String'("yes"); end Default_Pathes; diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index 082d1db57..ae8e510f3 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -41,8 +41,8 @@ package body Ghdldrv is -- Name of the tools used. Compiler_Cmd : String_Access := null; Post_Processor_Cmd : String_Access := null; - Assembler_Cmd : constant String := "as"; - Linker_Cmd : constant String := "gcc"; + Assembler_Cmd : String_Access := null; + Linker_Cmd : String_Access := null; -- Path of the tools. Compiler_Path : String_Access; @@ -63,6 +63,9 @@ package body Ghdldrv is -- "-quiet" option. Dash_Quiet : constant String_Access := new String'("-quiet"); + -- "-fpic" option. + Dash_Fpic : constant String_Access := new String'("-fpic"); + -- True if --post is present. Flag_Postprocess : Boolean := False; @@ -162,7 +165,7 @@ package body Ghdldrv is declare P : Natural; Nbr_Args : constant Natural := - Last (Compiler_Args) + Options'Length + 4; + Last (Compiler_Args) + Options'Length + 5; Args : Argument_List (1 .. Nbr_Args); begin P := 0; @@ -191,6 +194,20 @@ package body Ghdldrv is end case; end if; + -- Add -fpic for gcc/llvm. + if not Flag_Postprocess + and then Default_Pathes.Default_Pie + then + case Backend is + when Backend_Gcc + | Backend_Llvm => + P := P + 1; + Args (P) := Dash_Fpic; + when Backend_Mcode => + null; + end case; + end if; + -- Object file (or assembly file). Args (P + 1) := Dash_o; if Flag_Postprocess then @@ -409,7 +426,7 @@ package body Ghdldrv is raise Option_Error; end Tool_Not_Found; - -- Set the compiler command according to the configuration (and swicthes). + -- Set the compiler command according to the configuration (and switches). procedure Set_Tools_Name is begin -- Set tools name. @@ -430,6 +447,12 @@ package body Ghdldrv is if Post_Processor_Cmd = null then Post_Processor_Cmd := new String'(Default_Pathes.Post_Processor); end if; + if Assembler_Cmd = null then + Assembler_Cmd := new String'("as"); + end if; + if Linker_Cmd = null then + Linker_Cmd := new String'("gcc"); + end if; end Set_Tools_Name; function Locate_Exec_Tool (Toolname : String) return String_Access is @@ -489,9 +512,9 @@ package body Ghdldrv is -- Assembler. case Backend is when Backend_Gcc => - Assembler_Path := Locate_Exec_On_Path (Assembler_Cmd); + Assembler_Path := Locate_Exec_On_Path (Assembler_Cmd.all); if Assembler_Path = null and not Flag_Asm then - Tool_Not_Found (Assembler_Cmd); + Tool_Not_Found (Assembler_Cmd.all); end if; when Backend_Llvm | Backend_Mcode => @@ -499,9 +522,9 @@ package body Ghdldrv is end case; -- Linker. - Linker_Path := Locate_Exec_On_Path (Linker_Cmd); + Linker_Path := Locate_Exec_On_Path (Linker_Cmd.all); if Linker_Path = null then - Tool_Not_Found (Linker_Cmd); + Tool_Not_Found (Linker_Cmd.all); end if; end Locate_Tools; @@ -570,6 +593,12 @@ package body Ghdldrv is elsif Opt'Length > 8 and then Opt (1 .. 8) = "--GHDL1=" then Compiler_Cmd := new String'(Opt (9 .. Opt'Last)); Res := Option_Ok; + elsif Opt'Length > 5 and then Opt (1 .. 5) = "--AS=" then + Assembler_Cmd := new String'(Opt (6 .. Opt'Last)); + Res := Option_Ok; + elsif Opt'Length > 7 and then Opt (1 .. 7) = "--LINK=" then + Linker_Cmd := new String'(Opt (8 .. Opt'Last)); + Res := Option_Ok; elsif Opt = "-S" then Flag_Asm := True; Res := Option_Ok; @@ -649,6 +678,8 @@ package body Ghdldrv is Disp_Long_Help (Command_Lib (Cmd)); Put_Line (" -v Be verbose"); Put_Line (" --GHDL1=PATH Set the path of the ghdl1 compiler"); + Put_Line (" --AS=as Use as for the assembler"); + Put_Line (" --LINK=gcc Use gcc for the linker driver"); Put_Line (" -S Do not assemble"); Put_Line (" -o FILE Set the name of the output file"); -- Put_Line (" -m32 Generate 32bit code on 64bit machines"); @@ -705,13 +736,13 @@ package body Ghdldrv is case Backend is when Backend_Gcc => Put ("assembler command: "); - Put_Line (Assembler_Cmd); + Put_Line (Assembler_Cmd.all); when Backend_Llvm | Backend_Mcode => null; end case; Put ("linker command: "); - Put_Line (Linker_Cmd); + Put_Line (Linker_Cmd.all); Put_Line ("default lib prefix: " & Default_Pathes.Lib_Prefix); New_Line; diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb index 7b62dae65..adabc6a87 100644 --- a/src/grt/grt-vpi.adb +++ b/src/grt/grt-vpi.adb @@ -1330,18 +1330,26 @@ package body Grt.Vpi is return Res; end vpi_register_cb; -------------------------------------------------------------------------------- --- * * * V P I d u m m i e s * * * * * * * * * * * * * * * * * * * * * * -------------------------------------------------------------------------------- - -- int vpi_free_object(vpiHandle ref) function vpi_free_object (aRef: vpiHandle) return integer is - pragma Unreferenced (aRef); + Ref_Copy : vpiHandle; begin + if Flag_Trace then + Trace_Start ("vpi_free_object ("); + Trace (aRef); + Trace (")"); + Trace_Newline; + end if; + Ref_Copy := aRef; + Free(Ref_Copy); return 1; end vpi_free_object; +------------------------------------------------------------------------------- +-- * * * V P I d u m m i e s * * * * * * * * * * * * * * * * * * * * * * +------------------------------------------------------------------------------- + -- int vpi_get_vlog_info(p_vpi_vlog_info vlog_info_p) function vpi_get_vlog_info (info : p_vpi_vlog_info) return integer is begin diff --git a/src/libraries.adb b/src/libraries.adb index 40764e56b..3f737f466 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -23,8 +23,6 @@ with System; with Errorout; use Errorout; with Scanner; with Iirs_Utils; use Iirs_Utils; -with Iir_Chains; -with Nodes_Meta; with Parse; with Name_Table; use Name_Table; with Str_Table; @@ -1551,8 +1549,9 @@ package body Libraries is procedure Finish_Compilation (Unit : Iir_Design_Unit; Main : Boolean := False) is - Lib_Unit : constant Iir := Get_Library_Unit (Unit); + Lib_Unit : Iir; begin + Lib_Unit := Get_Library_Unit (Unit); if (Main or Flags.Dump_All) and then Flags.Dump_Parse then Disp_Tree.Disp_Tree (Unit); end if; @@ -1603,23 +1602,6 @@ package body Libraries is Canon.Canonicalize (Unit); - -- FIXME: for Main only ? - if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration - and then not Get_Need_Body (Lib_Unit) - and then Get_Need_Instance_Bodies (Lib_Unit) - then - -- Create the bodies for instances - Set_Package_Instantiation_Bodies_Chain - (Lib_Unit, Canon.Create_Instantiation_Bodies (Lib_Unit, Lib_Unit)); - elsif Get_Kind (Lib_Unit) = Iir_Kind_Package_Body - and then Get_Need_Instance_Bodies (Get_Package (Lib_Unit)) - then - Iir_Chains.Append_Chain - (Lib_Unit, Nodes_Meta.Field_Declaration_Chain, - Canon.Create_Instantiation_Bodies (Get_Package (Lib_Unit), - Lib_Unit)); - end if; - if (Main or Flags.Dump_All) and then Flags.Dump_Canon then Disp_Tree.Disp_Tree (Unit); end if; diff --git a/src/ortho/llvm-nodebug/ortho_code_main35.adb b/src/ortho/llvm-nodebug/ortho_code_main35.adb index 61b836369..bb5458b49 100644 --- a/src/ortho/llvm-nodebug/ortho_code_main35.adb +++ b/src/ortho/llvm-nodebug/ortho_code_main35.adb @@ -62,7 +62,7 @@ procedure Ortho_Code_Main35 is CPU : constant Cstring := Empty_Cstring; Features : constant Cstring := Empty_Cstring; - Reloc : constant RelocMode := RelocDefault; + Reloc : RelocMode := RelocDefault; function To_String (C : Cstring) return String is function Strlen (C : Cstring) return Natural; @@ -117,6 +117,10 @@ begin Optimization := CodeGenLevelDefault; elsif Arg = "-O3" then Optimization := CodeGenLevelAggressive; + elsif Arg = "-fpic" or Arg = "-fPIC" then + Reloc := RelocPIC; + elsif Arg = "-fno-pic" then + Reloc := RelocStatic; elsif Arg = "--emit-llvm" then Output_Kind := Output_Llvm; elsif Arg = "--emit-bc" then diff --git a/src/ortho/llvm-nodebug/ortho_code_main39.adb b/src/ortho/llvm-nodebug/ortho_code_main39.adb index d1e84b6e3..11e52220e 100644 --- a/src/ortho/llvm-nodebug/ortho_code_main39.adb +++ b/src/ortho/llvm-nodebug/ortho_code_main39.adb @@ -62,7 +62,7 @@ procedure Ortho_Code_Main39 is CPU : constant Cstring := Empty_Cstring; Features : constant Cstring := Empty_Cstring; - Reloc : constant RelocMode := RelocDefault; + Reloc : RelocMode := RelocDefault; function To_String (C : Cstring) return String is function Strlen (C : Cstring) return Natural; @@ -117,6 +117,10 @@ begin Optimization := CodeGenLevelDefault; elsif Arg = "-O3" then Optimization := CodeGenLevelAggressive; + elsif Arg = "-fpic" or Arg = "-fPIC" then + Reloc := RelocPIC; + elsif Arg = "-fno-pic" then + Reloc := RelocStatic; elsif Arg = "--emit-llvm" then Output_Kind := Output_Llvm; elsif Arg = "--emit-bc" then diff --git a/src/ortho/llvm/ortho_code_main.adb b/src/ortho/llvm/ortho_code_main.adb index 5558a8bbe..56c869ad1 100644 --- a/src/ortho/llvm/ortho_code_main.adb +++ b/src/ortho/llvm/ortho_code_main.adb @@ -70,7 +70,7 @@ procedure Ortho_Code_Main is CPU : constant Cstring := Empty_Cstring; Features : constant Cstring := Empty_Cstring; - Reloc : constant RelocMode := RelocDefault; + Reloc : RelocMode := RelocDefault; function To_String (C : Cstring) return String is function Strlen (C : Cstring) return Natural; @@ -125,6 +125,10 @@ begin Optimization := CodeGenLevelDefault; elsif Arg = "-O3" then Optimization := CodeGenLevelAggressive; + elsif Arg = "-fpic" or Arg = "-fPIC" then + Reloc := RelocPIC; + elsif Arg = "-fno-pic" then + Reloc := RelocStatic; elsif Arg = "--emit-llvm" then Output_Kind := Output_Llvm; elsif Arg = "--emit-bc" then diff --git a/src/ortho/oread/tests/acc.on b/src/ortho/oread/tests/acc.on new file mode 100644 index 000000000..aa6773325 --- /dev/null +++ b/src/ortho/oread/tests/acc.on @@ -0,0 +1,5 @@ +type __ghdl_file_index is unsigned (32); + +type __ghdl_file_index_ptr is access __ghdl_file_index; + +public var acc1 : __ghdl_file_index_ptr; diff --git a/src/ortho/oread/tests/acc2.on b/src/ortho/oread/tests/acc2.on new file mode 100644 index 000000000..faf786282 --- /dev/null +++ b/src/ortho/oread/tests/acc2.on @@ -0,0 +1,15 @@ +type __ghdl_file_index_ptr is access; + +type __ghdl_file_index is unsigned (32); + +type __ghdl_file_index_ptr is access __ghdl_file_index; + +public var acc1 : __ghdl_file_index_ptr; + +public function Get () return __ghdl_file_index +declare +begin + -- return __ghdl_file_index'[0]; + return acc1.all; +end; + diff --git a/src/ortho/oread/tests/acc3.on b/src/ortho/oread/tests/acc3.on new file mode 100644 index 000000000..00cecad68 --- /dev/null +++ b/src/ortho/oread/tests/acc3.on @@ -0,0 +1,18 @@ +type index_ptr1 is access; + +type index is unsigned (32); + +type index_ptr1 is access index; + +type index_ptr2 is access index; + +public var acc1 : index_ptr1; + +public function Get () return index +declare + local var acc2 : index_ptr2; +begin + acc2 := index_ptr2'conv(acc1); + return acc2.all; +end; + diff --git a/src/ortho/oread/tests/align1.on b/src/ortho/oread/tests/align1.on new file mode 100644 index 000000000..f32039cbc --- /dev/null +++ b/src/ortho/oread/tests/align1.on @@ -0,0 +1,9 @@ +-- internal declarations, part 1 + +type __ghdl_size_type is unsigned (32); + +type __ghdl_index_type is unsigned (32); + +public constant align1 : __ghdl_size_type; + +constant align1 := __ghdl_size_type'alignof (__ghdl_index_type); diff --git a/src/ortho/oread/tests/arg1.on b/src/ortho/oread/tests/arg1.on new file mode 100644 index 000000000..d67c15622 --- /dev/null +++ b/src/ortho/oread/tests/arg1.on @@ -0,0 +1,7 @@ +type __ghdl_integer is signed (32); + +public function test_arg (v : __ghdl_integer) return __ghdl_integer +declare +begin + return v; +end; diff --git a/src/ortho/oread/tests/arr1.on b/src/ortho/oread/tests/arr1.on new file mode 100644 index 000000000..49ea69c53 --- /dev/null +++ b/src/ortho/oread/tests/arr1.on @@ -0,0 +1,5 @@ +type __ghdl_index_type is unsigned (32); + +type __ghdl_char is unsigned (8); + +type __ghdl_chararray is array [__ghdl_index_type] of __ghdl_char; diff --git a/src/ortho/oread/tests/arraggr1.on b/src/ortho/oread/tests/arraggr1.on new file mode 100644 index 000000000..1c1313103 --- /dev/null +++ b/src/ortho/oread/tests/arraggr1.on @@ -0,0 +1,12 @@ +type __ghdl_index_type is unsigned (32); + +type __ghdl_char is unsigned (8); + +type __ghdl_chararray is array [__ghdl_index_type] of __ghdl_char; + +private constant _UI00000000 : subarray __ghdl_chararray[__ghdl_index_type'[10] + ]; + +constant _UI00000000 := {__ghdl_char'[110], __ghdl_char'[101], + __ghdl_char'[115], __ghdl_char'[116], __ghdl_char'[49], __ghdl_char'[46], + __ghdl_char'[118], __ghdl_char'[104], __ghdl_char'[100], __ghdl_char'[0]}; diff --git a/src/ortho/oread/tests/asgn_acc.on b/src/ortho/oread/tests/asgn_acc.on new file mode 100644 index 000000000..01559c081 --- /dev/null +++ b/src/ortho/oread/tests/asgn_acc.on @@ -0,0 +1,13 @@ +TYPE int32 IS SIGNED (32); +TYPE int32_acc IS ACCESS int32; +PRIVATE CONSTANT zero_i32 : int32 := 0; + +PRIVATE PROCEDURE call_arg_addr () +DECLARE +BEGIN +DECLARE + LOCAL VAR ap : int32_acc; +BEGIN + ap := int32_acc'address (zero_i32); +END; +END;
\ No newline at end of file diff --git a/src/ortho/oread/tests/bool.on b/src/ortho/oread/tests/bool.on new file mode 100644 index 000000000..c1f3e424d --- /dev/null +++ b/src/ortho/oread/tests/bool.on @@ -0,0 +1 @@ +type __ghdl_bool_type is boolean {false, true}; diff --git a/src/ortho/oread/tests/bug_mcode1.on b/src/ortho/oread/tests/bug_mcode1.on new file mode 100644 index 000000000..bd9737119 --- /dev/null +++ b/src/ortho/oread/tests/bug_mcode1.on @@ -0,0 +1,41 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +-- package std.standard + +TYPE std__standard__integer__BT IS SIGNED (32); + +TYPE std__standard__real__BT IS FLOAT; + +-- package declaration math_real + +EXTERNAL FUNCTION ieee__math_real__ceil (x: std__standard__real__BT) + RETURN std__standard__real__BT; + +--F /Users/gingold/devel/vhdl-testsuite/OSVVM_2014_01/src/CoveragePkg.vhd + +TYPE work__coveragepkg__covptype__covbinbasetemptype IS RECORD + action: std__standard__integer__BT; + action2: std__standard__integer__BT; + count: std__standard__integer__BT; + atleast: std__standard__integer__BT; +END RECORD; + +TYPE work__coveragepkg__covptype__covbintemptype__BASE IS ARRAY [ + __ghdl_index_type] OF work__coveragepkg__covptype__covbinbasetemptype; + +TYPE work__coveragepkg__covptype__covbintemptype__ARR IS SUBARRAY + work__coveragepkg__covptype__covbintemptype__BASE[2]; + +PRIVATE FUNCTION work__coveragepkg__covptype__calcweightO1 () + RETURN std__standard__integer__BT +DECLARE + LOCAL VAR RESULT : std__standard__integer__BT; + LOCAL VAR x : std__standard__real__BT; + LOCAL VAR b : work__coveragepkg__covptype__covbintemptype__ARR; + LOCAL VAR T2_8 : __ghdl_index_type; +BEGIN + RESULT := ( (std__standard__integer__BT + 'conv (ieee__math_real__ceil (x)) -# b[T2_8].count)); + RETURN RESULT; +END; + diff --git a/src/ortho/oread/tests/conv.on b/src/ortho/oread/tests/conv.on new file mode 100644 index 000000000..1b07fc5fe --- /dev/null +++ b/src/ortho/oread/tests/conv.on @@ -0,0 +1,40 @@ +TYPE float64 IS FLOAT; +TYPE int32 IS SIGNED (32); +TYPE int64 IS SIGNED (64); + +PUBLIC FUNCTION to_int32 (a : float64) RETURN int32 +DECLARE +BEGIN + RETURN int32'conv(a); +END; + +PUBLIC FUNCTION fp_to_int32 (a : float64) RETURN int64 +DECLARE +BEGIN + RETURN int64'conv(a); +END; + +PUBLIC FUNCTION to_fp64 (a : int32) RETURN float64 +DECLARE +BEGIN + RETURN float64'conv(a); +END; + +PUBLIC FUNCTION conv2 (a : int32) RETURN int32 +DECLARE +BEGIN + RETURN to_int32 (to_fp64 (a)); +END; + +PUBLIC FUNCTION to_int64 (a : int32) RETURN int64 +DECLARE +BEGIN + RETURN int64'conv(a); +END; + +-- Test spill +PUBLIC FUNCTION spill1 (a : int32) RETURN int64 +DECLARE +BEGIN + RETURN int64'conv(a) +# to_int64 (a); +END; diff --git a/src/ortho/oread/tests/enum1.on b/src/ortho/oread/tests/enum1.on new file mode 100644 index 000000000..87dc75cab --- /dev/null +++ b/src/ortho/oread/tests/enum1.on @@ -0,0 +1,4 @@ +type __ghdl_compare_type is enum {lt = 0, eq = 1, gt = 2}; + +public constant en1 : __ghdl_compare_type; +constant en1 := __ghdl_compare_type'[eq];
\ No newline at end of file diff --git a/src/ortho/oread/tests/fabs.on b/src/ortho/oread/tests/fabs.on new file mode 100644 index 000000000..90f19a36f --- /dev/null +++ b/src/ortho/oread/tests/fabs.on @@ -0,0 +1,38 @@ +TYPE float64 IS FLOAT; + +PUBLIC FUNCTION fadd (a : float64; b : float64) RETURN float64 +DECLARE +BEGIN + RETURN a +# b; +END; + +PUBLIC FUNCTION fsub (a : float64; b : float64) RETURN float64 +DECLARE +BEGIN + RETURN a -# b; +END; + +PUBLIC FUNCTION fmul (a : float64; b : float64) RETURN float64 +DECLARE +BEGIN + RETURN a *# b; +END; + +PUBLIC FUNCTION fdiv (a : float64; b : float64) RETURN float64 +DECLARE +BEGIN + RETURN a /# b; +END; + +PUBLIC FUNCTION fneg (a : float64) RETURN float64 +DECLARE +BEGIN + RETURN -a; +END; + +PUBLIC FUNCTION fabs (a : float64) RETURN float64 +DECLARE +BEGIN + RETURN ABS a; +END; + diff --git a/src/ortho/oread/tests/fdiv.on b/src/ortho/oread/tests/fdiv.on new file mode 100644 index 000000000..197316e65 --- /dev/null +++ b/src/ortho/oread/tests/fdiv.on @@ -0,0 +1,17 @@ +TYPE float64 IS FLOAT; +TYPE int32 IS SIGNED (32); +TYPE int64 IS SIGNED (64); + +PUBLIC FUNCTION fdiv (a : int64; b : int64) RETURN float64 +DECLARE +BEGIN + RETURN float64'conv(a) /# float64'conv (b); +END; + +TYPE char IS UNSIGNED(8); + +PUBLIC FUNCTION add (a : char; b : char) RETURN int32 +DECLARE +BEGIN + RETURN int32'conv(a) +# int32'conv(b); +END; diff --git a/src/ortho/oread/tests/fops.on b/src/ortho/oread/tests/fops.on new file mode 100644 index 000000000..74cd6f2aa --- /dev/null +++ b/src/ortho/oread/tests/fops.on @@ -0,0 +1,104 @@ +TYPE float64 IS FLOAT; +TYPE bool IS BOOLEAN {false, true}; +TYPE int32 IS SIGNED (32); + +PUBLIC FUNCTION fadd (a : float64; b : float64) RETURN float64 +DECLARE +BEGIN + RETURN a +# b; +END; + +PUBLIC FUNCTION fsub (a : float64; b : float64) RETURN float64 +DECLARE +BEGIN + RETURN a -# b; +END; + +PUBLIC FUNCTION fmul (a : float64; b : float64) RETURN float64 +DECLARE +BEGIN + RETURN a *# b; +END; + +PUBLIC FUNCTION fdiv (a : float64; b : float64) RETURN float64 +DECLARE +BEGIN + RETURN a /# b; +END; + +PUBLIC FUNCTION fneg (a : float64) RETURN float64 +DECLARE +BEGIN + RETURN -a; +END; + +PUBLIC FUNCTION fabs (a : float64) RETURN float64 +DECLARE +BEGIN + RETURN ABS a; +END; + +PUBLIC FUNCTION fcall1 (a : float64; b : float64) RETURN float64 +DECLARE +BEGIN + RETURN fadd (fmul (a, b), fneg (b)); +END; + +PUBLIC FUNCTION fgt (a : float64; b : float64) RETURN bool +DECLARE +BEGIN + RETURN bool'(a >= b); +END; + +PUBLIC FUNCTION mainint () RETURN int32 +DECLARE + LOCAL VAR l : int32; + LOCAL VAR r : int32; +BEGIN + l:= 1; + r := 2; + IF bool'(l < r) THEN + RETURN int32'(0); + ELSE + RETURN int32'(1); + END IF; +END; + +PRIVATE CONSTANT fone : float64; +CONSTANT fone := 1.0; + +-- Return 0 in case of error. +PUBLIC FUNCTION main () RETURN int32 +DECLARE + LOCAL VAR lf : float64; + LOCAL VAR rf : float64; +BEGIN + lf := 1.0; + rf := 2.0; + IF bool'(lf >= rf) THEN + RETURN int32'(0); + END IF; + lf := fadd (lf, fone); + IF bool'(lf /= rf) THEN + RETURN int32'(0); + END IF; + + lf := fone; + lf := -lf; + IF bool'(lf > 0.0) THEN + RETURN int32'(0); + END IF; + + lf := ABS lf; + IF bool'(lf /= fone) THEN + RETURN int32'(0); + END IF; + + lf := 2.0; + IF bool'(fdiv (lf, fone) /= lf) THEN + RETURN int32'(0); + END IF; + + RETURN int32'(1); +END; + diff --git a/src/ortho/oread/tests/fp_add.on b/src/ortho/oread/tests/fp_add.on new file mode 100644 index 000000000..949f370de --- /dev/null +++ b/src/ortho/oread/tests/fp_add.on @@ -0,0 +1,13 @@ +TYPE float IS FLOAT; + +PRIVATE FUNCTION add_float (a : float; b : float) RETURN float +DECLARE +BEGIN + RETURN a +# b; +END; + +PRIVATE FUNCTION add3_float (a : float; b : float; c : float) RETURN float +DECLARE +BEGIN + RETURN add_float (a, add_float (b, c)); +END; diff --git a/src/ortho/oread/tests/if1.on b/src/ortho/oread/tests/if1.on new file mode 100644 index 000000000..16d9b9835 --- /dev/null +++ b/src/ortho/oread/tests/if1.on @@ -0,0 +1,12 @@ +type __ghdl_bool_type is boolean {false, true}; +type __ghdl_integer is signed (32); + +public function test_arg (v : __ghdl_bool_type) return __ghdl_integer +declare +begin + if v then + return __ghdl_integer'[1]; + else + return __ghdl_integer'[0]; + end if; +end; diff --git a/src/ortho/oread/tests/if2.on b/src/ortho/oread/tests/if2.on new file mode 100644 index 000000000..0c38be4b6 --- /dev/null +++ b/src/ortho/oread/tests/if2.on @@ -0,0 +1,11 @@ +type __ghdl_bool_type is boolean {false, true}; +type __ghdl_integer is signed (32); + +public function test_arg (v : __ghdl_bool_type) return __ghdl_integer +declare +begin + if v then + return __ghdl_integer'[1]; + end if; + return __ghdl_integer'[0]; +end; diff --git a/src/ortho/oread/tests/if3.on b/src/ortho/oread/tests/if3.on new file mode 100644 index 000000000..95e5149a1 --- /dev/null +++ b/src/ortho/oread/tests/if3.on @@ -0,0 +1,18 @@ +type __ghdl_bool_type is boolean {false, true}; +type __ghdl_integer is signed (32); + +public function test_arg (v : __ghdl_bool_type) return __ghdl_integer +declare + local var r : __ghdl_integer; +begin + r := __ghdl_integer'[0]; + if v then + declare + local var w : __ghdl_integer; + begin + w := __ghdl_integer'[1]; + r := w; + end; + end if; + return r; +end; diff --git a/src/ortho/oread/tests/if4.on b/src/ortho/oread/tests/if4.on new file mode 100644 index 000000000..33857165e --- /dev/null +++ b/src/ortho/oread/tests/if4.on @@ -0,0 +1,39 @@ +type __ghdl_bool_type is boolean {false, true}; +type __ghdl_integer is signed (32); + +public function test_arg (b1 : __ghdl_bool_type; + b2 : __ghdl_bool_type; + b3 : __ghdl_bool_type) return __ghdl_integer +declare + local var r : __ghdl_integer; +begin + r := __ghdl_integer'[0]; + if b1 then + if b2 then + declare + local var w : __ghdl_integer; + begin + w := __ghdl_integer'[1]; + r := w; + end; + else + if b3 then + declare + local var w : __ghdl_integer; + begin + w := __ghdl_integer'[2]; + r := w; + end; + else + end if; + end if; + else + declare + local var w : __ghdl_integer; + begin + w := __ghdl_integer'[3]; + r := w; + end; + end if; + return r; +end; diff --git a/src/ortho/oread/tests/local1.on b/src/ortho/oread/tests/local1.on new file mode 100644 index 000000000..1c985a2a5 --- /dev/null +++ b/src/ortho/oread/tests/local1.on @@ -0,0 +1,9 @@ +type __ghdl_integer is signed (32); + +public function test_arg (v : __ghdl_integer) return __ghdl_integer +declare + local var w : __ghdl_integer; +begin + w := v; + return w; +end; diff --git a/src/ortho/oread/tests/local2.on b/src/ortho/oread/tests/local2.on new file mode 100644 index 000000000..e06cdb8ea --- /dev/null +++ b/src/ortho/oread/tests/local2.on @@ -0,0 +1,15 @@ +type __ghdl_integer is signed (32); + +public function test_arg (v : __ghdl_integer) return __ghdl_integer +declare + local var w : __ghdl_integer; +begin + w := v; + declare + local var z : __ghdl_integer; + begin + z := v +# w; + w := z; + end; + return w; +end; diff --git a/src/ortho/oread/tests/local3.on b/src/ortho/oread/tests/local3.on new file mode 100644 index 000000000..034bd1846 --- /dev/null +++ b/src/ortho/oread/tests/local3.on @@ -0,0 +1,33 @@ +type __ghdl_integer is signed (32); + +public function test_arg (v : __ghdl_integer) return __ghdl_integer +declare + local var w : __ghdl_integer; +begin + w := v; + declare + local var b1 : __ghdl_integer; + begin + b1 := w; + w := b1; + declare + local var b2 : __ghdl_integer; + begin + b2 := w; + w := b2; + end; + declare + local var b3 : __ghdl_integer; + begin + b3 := w; + w := b3; + end; + end; + declare + local var b4 : __ghdl_integer; + begin + b4 := w; + w := b4; + end; + return w; +end; diff --git a/src/ortho/oread/tests/ra1.on b/src/ortho/oread/tests/ra1.on new file mode 100644 index 000000000..0f5300e66 --- /dev/null +++ b/src/ortho/oread/tests/ra1.on @@ -0,0 +1,8 @@ +TYPE int32 IS SIGNED (32); +TYPE char IS UNSIGNED(8); + +PUBLIC FUNCTION add (a : char; b : char) RETURN int32 +DECLARE +BEGIN + RETURN int32'conv(a) +# int32'conv(b); +END; diff --git a/src/ortho/oread/tests/ra2.on b/src/ortho/oread/tests/ra2.on new file mode 100644 index 000000000..57c6a631a --- /dev/null +++ b/src/ortho/oread/tests/ra2.on @@ -0,0 +1,16 @@ +TYPE float64 IS FLOAT; +TYPE int32 IS SIGNED (32); +TYPE int64 IS SIGNED (64); + +PUBLIC FUNCTION to_int64 (a : int32) RETURN int64 +DECLARE +BEGIN + RETURN int64'conv(a); +END; + +-- Test spill +PUBLIC FUNCTION spill1 (a : int32) RETURN int64 +DECLARE +BEGIN + RETURN int64'conv(a) +# to_int64 (a); +END; diff --git a/src/ortho/oread/tests/ra3.on b/src/ortho/oread/tests/ra3.on new file mode 100644 index 000000000..e135bc83a --- /dev/null +++ b/src/ortho/oread/tests/ra3.on @@ -0,0 +1,9 @@ +TYPE float64 IS FLOAT; +TYPE int32 IS SIGNED (32); +TYPE int64 IS SIGNED (64); + +PUBLIC FUNCTION div (a : int32; b : int32) RETURN float64 +DECLARE +BEGIN + RETURN float64'conv (a /# int32'(1)) /# float64'conv (b /# int32'(1)); +END; diff --git a/src/ortho/oread/tests/repro1.on b/src/ortho/oread/tests/repro1.on new file mode 100644 index 000000000..a26bd387f --- /dev/null +++ b/src/ortho/oread/tests/repro1.on @@ -0,0 +1,21 @@ +TYPE int32 IS SIGNED (32); +TYPE uns32 IS UNSIGNED (32); +TYPE char8 IS UNSIGNED (8); + +TYPE string8 IS ARRAY [uns32] OF char8; +TYPE string_acc IS ACCESS string8; + +TYPE bool IS BOOLEAN {false, true}; + +PRIVATE PROCEDURE puts (s : string_acc); + +PRIVATE PROCEDURE puti32 (n : int32) +DECLARE + TYPE str8x11 IS SUBARRAY string8[11]; + LOCAL VAR s : str8x11; + LOCAL VAR i : uns32; +BEGIN + i := 9; + s[10] := 0; + puts(string_acc'address(s[i...])); +END; diff --git a/src/ortho/oread/tests/ret1.on b/src/ortho/oread/tests/ret1.on new file mode 100644 index 000000000..02137048c --- /dev/null +++ b/src/ortho/oread/tests/ret1.on @@ -0,0 +1,7 @@ +type __ghdl_integer is signed (32); + +public function test_assign () return __ghdl_integer +declare +begin + return __ghdl_integer'[5]; +end; diff --git a/src/ortho/oread/tests/ret2.on b/src/ortho/oread/tests/ret2.on new file mode 100644 index 000000000..5850b5537 --- /dev/null +++ b/src/ortho/oread/tests/ret2.on @@ -0,0 +1,7 @@ +type __ghdl_index_type is unsigned (32); + +public procedure test_ret () +declare +begin + return; +end; diff --git a/src/ortho/oread/tests/ret3.on b/src/ortho/oread/tests/ret3.on new file mode 100644 index 000000000..1a415b086 --- /dev/null +++ b/src/ortho/oread/tests/ret3.on @@ -0,0 +1,8 @@ +type __ghdl_index_type is unsigned (32); + +public procedure test_ret () +declare +begin + return; + return; +end; diff --git a/src/ortho/oread/tests/ret4.on b/src/ortho/oread/tests/ret4.on new file mode 100644 index 000000000..267511479 --- /dev/null +++ b/src/ortho/oread/tests/ret4.on @@ -0,0 +1,8 @@ +type __ghdl_integer is signed (32); + +public function test_assign () return __ghdl_integer +declare +begin + return __ghdl_integer'[5]; + return __ghdl_integer'[4]; +end; diff --git a/src/ortho/oread/tests/run_case1.on b/src/ortho/oread/tests/run_case1.on new file mode 100644 index 000000000..d457e59ba --- /dev/null +++ b/src/ortho/oread/tests/run_case1.on @@ -0,0 +1,13 @@ +type __ghdl_index_type is unsigned (32); +type __ghdl_bool_type is boolean {false, true}; + +public function main (a : __ghdl_index_type) return __ghdl_index_type +declare +begin + case a is + when 1 => + return 2; + when default => + return 0; + end case; +end; diff --git a/src/ortho/oread/tests/run_case2.on b/src/ortho/oread/tests/run_case2.on new file mode 100644 index 000000000..6707f4f96 --- /dev/null +++ b/src/ortho/oread/tests/run_case2.on @@ -0,0 +1,15 @@ +type __ghdl_index_type is unsigned (32); +type __ghdl_bool_type is boolean {false, true}; + +public function main (a : __ghdl_index_type) return __ghdl_index_type +declare +begin + case a is + when 1 => + return 2; + when 3 ... 5 => + return 1; + when default => + return 0; + end case; +end; diff --git a/src/ortho/oread/tests/run_case3.on b/src/ortho/oread/tests/run_case3.on new file mode 100644 index 000000000..ff5d5beee --- /dev/null +++ b/src/ortho/oread/tests/run_case3.on @@ -0,0 +1,15 @@ +type __ghdl_index_type is unsigned (32); +type __ghdl_bool_type is boolean {false, true}; + +public function main (a : __ghdl_index_type) return __ghdl_index_type +declare +begin + case a is + when 1, 2, 7 => + return 2; + when 3 ... 5 => + return 1; + when default => + return 0; + end case; +end; diff --git a/src/ortho/oread/tests/run_case4.on b/src/ortho/oread/tests/run_case4.on new file mode 100644 index 000000000..ea19b62a5 --- /dev/null +++ b/src/ortho/oread/tests/run_case4.on @@ -0,0 +1,15 @@ +type __ghdl_index_type is unsigned (32); +type __ghdl_bool_type is boolean {false, true}; + +public function main (a : __ghdl_index_type) return __ghdl_index_type +declare +begin + case a is + when 1, 2, 7 => + when 3 ... 5 => + return 1; + when default => + return 0; + end case; + return 4; +end; diff --git a/src/ortho/oread/tests/run_case5.on b/src/ortho/oread/tests/run_case5.on new file mode 100644 index 000000000..6391bb315 --- /dev/null +++ b/src/ortho/oread/tests/run_case5.on @@ -0,0 +1,13 @@ +type __ghdl_index_type is unsigned (32); +type __ghdl_bool_type is boolean {false, true}; + +public function main (a : __ghdl_index_type) return __ghdl_index_type +declare +begin + case __ghdl_bool_type'(a > 10) is + when __ghdl_bool_type'[true] => + when __ghdl_bool_type'[false] => + return 1; + end case; + return 4; +end; diff --git a/src/ortho/oread/tests/run_case6.on b/src/ortho/oread/tests/run_case6.on new file mode 100644 index 000000000..3e33ff6f4 --- /dev/null +++ b/src/ortho/oread/tests/run_case6.on @@ -0,0 +1,19 @@ +type __ghdl_index_type is unsigned (32); +type __ghdl_bool_type is boolean {false, true}; + +public function main (a : __ghdl_index_type) return __ghdl_index_type +declare + local var b : __ghdl_index_type; +begin + case a is + when 10 ... 15 => + case __ghdl_bool_type'(a > 10) is + when __ghdl_bool_type'[true] => + b := 5; + when __ghdl_bool_type'[false] => + end case; + when default => + return 4; + end case; + return 5; +end; diff --git a/src/ortho/oread/tests/run_case7.on b/src/ortho/oread/tests/run_case7.on new file mode 100644 index 000000000..708029c22 --- /dev/null +++ b/src/ortho/oread/tests/run_case7.on @@ -0,0 +1,14 @@ +type __ghdl_index_type is unsigned (32); +type __ghdl_bool_type is boolean {false, true}; + +public function main (a : __ghdl_index_type) return __ghdl_index_type +declare + local var b : __ghdl_index_type; +begin + case __ghdl_bool_type'(a > 10) is + when __ghdl_bool_type'[true] => + b := 5; + when __ghdl_bool_type'[false] => + end case; + return 5; +end; diff --git a/src/ortho/oread/tests/run_declare.on b/src/ortho/oread/tests/run_declare.on new file mode 100644 index 000000000..b0af18c9f --- /dev/null +++ b/src/ortho/oread/tests/run_declare.on @@ -0,0 +1,16 @@ +type __ghdl_int is unsigned (32); + +public function main (a : __ghdl_int) return __ghdl_int +declare + local var b : __ghdl_int; + local var z : __ghdl_int; +begin + b := a; + declare + local var c : __ghdl_int; + begin + c := b; + z := c; + end; + return z +# 1; +end; diff --git a/src/ortho/oread/tests/run_declare2.on b/src/ortho/oread/tests/run_declare2.on new file mode 100644 index 000000000..ae38b660d --- /dev/null +++ b/src/ortho/oread/tests/run_declare2.on @@ -0,0 +1,21 @@ +type __ghdl_int is unsigned (32); + +public function main (a : __ghdl_int) return __ghdl_int +declare + local var b : __ghdl_int; + local var z : __ghdl_int; +begin + b := a; + declare + local var c : __ghdl_int; + begin + c := b; + end; + declare + local var d : __ghdl_int; + begin + d := b; + z := d; + end; + return z +# 1; +end; diff --git a/src/ortho/oread/tests/run_declare3.c b/src/ortho/oread/tests/run_declare3.c new file mode 100644 index 000000000..cccfdb7cb --- /dev/null +++ b/src/ortho/oread/tests/run_declare3.c @@ -0,0 +1,17 @@ +int main1 (int a) +{ + int b; + int z; + + b = a; + + { + int g; + int c; + + c = b; + g = c; + z = g + c; + } + return z + 1; +} diff --git a/src/ortho/oread/tests/run_declare3.on b/src/ortho/oread/tests/run_declare3.on new file mode 100644 index 000000000..85684a249 --- /dev/null +++ b/src/ortho/oread/tests/run_declare3.on @@ -0,0 +1,18 @@ +type __ghdl_int is unsigned (32); + +public function main (a : __ghdl_int) return __ghdl_int +declare + local var b : __ghdl_int; + local var z : __ghdl_int; +begin + b := a; + declare + local var g : __ghdl_int; + local var c : __ghdl_int; + begin + c := b; + g := c; + z := g +# c; + end; + return z +# 1; +end; diff --git a/src/ortho/oread/tests/run_func1.on b/src/ortho/oread/tests/run_func1.on new file mode 100644 index 000000000..d0ea4e876 --- /dev/null +++ b/src/ortho/oread/tests/run_func1.on @@ -0,0 +1,16 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +PUBLIC FUNCTION inc (a : __ghdl_index_type) RETURN __ghdl_index_type; + +PUBLIC FUNCTION inc (a : __ghdl_index_type) RETURN __ghdl_index_type +DECLARE +BEGIN + RETURN a +# 1; +END; + +PUBLIC FUNCTION main (a : __ghdl_index_type) RETURN __ghdl_index_type +DECLARE +BEGIN + RETURN inc (a); +END; + diff --git a/src/ortho/oread/tests/run_gvar.on b/src/ortho/oread/tests/run_gvar.on new file mode 100644 index 000000000..4efa46bca --- /dev/null +++ b/src/ortho/oread/tests/run_gvar.on @@ -0,0 +1,10 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +PUBLIC VAR v : __ghdl_index_type; + +PUBLIC FUNCTION main (a : __ghdl_index_type) RETURN __ghdl_index_type +DECLARE +BEGIN + v := a; + RETURN v +# 1; +END; diff --git a/src/ortho/oread/tests/run_id.on b/src/ortho/oread/tests/run_id.on new file mode 100644 index 000000000..81581bf3a --- /dev/null +++ b/src/ortho/oread/tests/run_id.on @@ -0,0 +1,7 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +PUBLIC FUNCTION main (a : __ghdl_index_type) RETURN __ghdl_index_type +DECLARE +BEGIN + RETURN a; +END; diff --git a/src/ortho/oread/tests/run_idx.on b/src/ortho/oread/tests/run_idx.on new file mode 100644 index 000000000..9e12acbd7 --- /dev/null +++ b/src/ortho/oread/tests/run_idx.on @@ -0,0 +1,17 @@ +type __ghdl_index_type is unsigned (32); +type __ghdl_bool_type is boolean {false, true}; + +type __ghdl_char is unsigned (8); + +type __ghdl_chararray is array [__ghdl_index_type] of __ghdl_index_type; + +private constant TAB : subarray __ghdl_chararray[__ghdl_index_type'[10] + ]; + +constant TAB := {65, 66, 67, 68, 69, 48, 49, 50, 51, 52 }; + +public function main (a : __ghdl_index_type) return __ghdl_index_type +declare +begin + return TAB[a]; +end; diff --git a/src/ortho/oread/tests/run_if.on b/src/ortho/oread/tests/run_if.on new file mode 100644 index 000000000..d9ea8484a --- /dev/null +++ b/src/ortho/oread/tests/run_if.on @@ -0,0 +1,12 @@ +type __ghdl_index_type is unsigned (32); +type __ghdl_bool_type is boolean {false, true}; + +public function main (a : __ghdl_index_type) return __ghdl_index_type +declare +begin + if __ghdl_bool_type'(a > 5) then + return a +# 1; + else + return a -# 1; + end if; +end; diff --git a/src/ortho/oread/tests/run_neg.on b/src/ortho/oread/tests/run_neg.on new file mode 100644 index 000000000..d7ec2dcc0 --- /dev/null +++ b/src/ortho/oread/tests/run_neg.on @@ -0,0 +1,7 @@ +type __ghdl_index_type is signed (32); + +public function main (a : __ghdl_index_type) return __ghdl_index_type +declare +begin + return -a; +end; diff --git a/src/ortho/oread/tests/run_not.on b/src/ortho/oread/tests/run_not.on new file mode 100644 index 000000000..61480c362 --- /dev/null +++ b/src/ortho/oread/tests/run_not.on @@ -0,0 +1,7 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +PUBLIC FUNCTION main (a : __ghdl_index_type) RETURN __ghdl_index_type +DECLARE +BEGIN + RETURN NOT a; +END; diff --git a/src/ortho/oread/tests/run_plus.on b/src/ortho/oread/tests/run_plus.on new file mode 100644 index 000000000..0465df200 --- /dev/null +++ b/src/ortho/oread/tests/run_plus.on @@ -0,0 +1,7 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +PUBLIC FUNCTION main (a : __ghdl_index_type) RETURN __ghdl_index_type +DECLARE +BEGIN + RETURN a +# 1; +END; diff --git a/src/ortho/oread/tests/run_plus64.on b/src/ortho/oread/tests/run_plus64.on new file mode 100644 index 000000000..beea5a932 --- /dev/null +++ b/src/ortho/oread/tests/run_plus64.on @@ -0,0 +1,7 @@ +TYPE __ghdl_index_type IS UNSIGNED (64); + +PUBLIC FUNCTION main (a : __ghdl_index_type) RETURN __ghdl_index_type +DECLARE +BEGIN + RETURN a +# 1; +END; diff --git a/src/ortho/oread/tests/size1.on b/src/ortho/oread/tests/size1.on new file mode 100644 index 000000000..8ac5aeca1 --- /dev/null +++ b/src/ortho/oread/tests/size1.on @@ -0,0 +1,9 @@ +-- internal declarations, part 1 + +type __ghdl_size_type is unsigned (32); + +type __ghdl_index_type is unsigned (32); + +public constant size1 : __ghdl_size_type; + +constant size1 := __ghdl_size_type'sizeof (__ghdl_index_type); diff --git a/src/ortho/oread/tests/smod.on b/src/ortho/oread/tests/smod.on new file mode 100644 index 000000000..152f69c73 --- /dev/null +++ b/src/ortho/oread/tests/smod.on @@ -0,0 +1,32 @@ +type int is signed (32); + +public function smod (a : int; b : int) return int +declare +begin + return a mod# b; +end; + +public function do_m3_m3 () return int +declare +begin + return -3 mod# -3; +end; + +public function do_m3_m2 () return int +declare +begin + return -3 mod# -2; +end; + +public function do_11_5 () return int +declare +begin + return 11 mod# 5; +end; + +public function do_m11_5 () return int +declare +begin + return -11 mod# 5; +end; + diff --git a/src/ortho/oread/tests/struct1.on b/src/ortho/oread/tests/struct1.on new file mode 100644 index 000000000..f6a0ad86b --- /dev/null +++ b/src/ortho/oread/tests/struct1.on @@ -0,0 +1,16 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +TYPE __ghdl_char IS UNSIGNED (8); + +TYPE __ghdl_chararray IS ARRAY [__ghdl_index_type] OF __ghdl_char; + +TYPE __ghdl_char_ptr IS ACCESS __ghdl_chararray; + +TYPE __ghdl_char_ptr_array IS ARRAY [__ghdl_index_type] OF __ghdl_char_ptr; + +TYPE __ghdl_str_len IS RECORD + len: __ghdl_index_type; + str: __ghdl_char_ptr; +END RECORD; + +PUBLIC VAR var1 : __ghdl_str_len; diff --git a/src/ortho/oread/tests/struct2.on b/src/ortho/oread/tests/struct2.on new file mode 100644 index 000000000..70200cd12 --- /dev/null +++ b/src/ortho/oread/tests/struct2.on @@ -0,0 +1,25 @@ +type __ghdl_rti_u8 is unsigned (8); + +type __ghdl_rti_common is record + mode: __ghdl_rti_u8; +end record; + +type __ghdl_rti_access is access __ghdl_rti_common; + +type __ghdl_component_link_type is record; + +type __ghdl_component_link_acc is access __ghdl_component_link_type; + +type __ghdl_entity_link_type is record + rti: __ghdl_rti_access; + parent: __ghdl_component_link_acc; +end record; + +type __ghdl_entity_link_acc is access __ghdl_entity_link_type; + +type __ghdl_component_link_type is record + stmt: __ghdl_rti_access; +end record; + +public var var1 : __ghdl_component_link_type; +public var var2 : __ghdl_component_link_acc; diff --git a/src/ortho/oread/tests/struct3.on b/src/ortho/oread/tests/struct3.on new file mode 100644 index 000000000..b4dc6586d --- /dev/null +++ b/src/ortho/oread/tests/struct3.on @@ -0,0 +1,41 @@ +type __ghdl_rtik is enum {__ghdl_rtik_top = 0, __ghdl_rtik_library = 1, + __ghdl_rtik_package = 2, __ghdl_rtik_package_body = 3, + __ghdl_rtik_entity = 4, __ghdl_rtik_architecture = 5, + __ghdl_rtik_process = 6, __ghdl_rtik_block = 7, + __ghdl_rtik_if_generate = 8, __ghdl_rtik_for_generate = 9, + __ghdl_rtik_instance = 10, __ghdl_rtik_constant = 11, + __ghdl_rtik_iterator = 12, __ghdl_rtik_variable = 13, + __ghdl_rtik_signal = 14, __ghdl_rtik_file = 15, __ghdl_rtik_port = 16, + __ghdl_rtik_generic = 17, __ghdl_rtik_alias = 18, __ghdl_rtik_guard = 19, + __ghdl_rtik_component = 20, __ghdl_rtik_attribute = 21, + __ghdl_rtik_type_b2 = 22, __ghdl_rtik_type_e8 = 23, + __ghdl_rtik_type_e32 = 24, __ghdl_rtik_type_i32 = 25, + __ghdl_rtik_type_i64 = 26, __ghdl_rtik_type_f64 = 27, + __ghdl_rtik_type_p32 = 28, __ghdl_rtik_type_p64 = 29, + __ghdl_rtik_type_access = 30, __ghdl_rtik_type_array = 31, + __ghdl_rtik_type_record = 32, __ghdl_rtik_type_file = 33, + __ghdl_rtik_subtype_scalar = 34, __ghdl_rtik_subtype_array = 35, + __ghdl_rtik_subtype_unconstrained_array = 36, + __ghdl_rtik_subtype_record = 37, __ghdl_rtik_subtype_access = 38, + __ghdl_rtik_type_protected = 39, __ghdl_rtik_element = 40, + __ghdl_rtik_unit64 = 41, __ghdl_rtik_unitptr = 42, + __ghdl_rtik_attribute_transaction = 43, __ghdl_rtik_attribute_quiet = 44, + __ghdl_rtik_attribute_stable = 45, __ghdl_rtik_psl_assert = 46, + __ghdl_rtik_error = 47}; + +type __ghdl_rti_depth is unsigned (8); + +type __ghdl_rti_u8 is unsigned (8); + +type __ghdl_rti_common is record + kind: __ghdl_rtik; + depth: __ghdl_rti_depth; + mode: __ghdl_rti_u8; + max_depth: __ghdl_rti_depth; +end record; + +type __ghdl_rti_access is access __ghdl_rti_common; + +public var st3p : __ghdl_rti_access; + +public var st3 : __ghdl_rti_common; diff --git a/src/ortho/oread/tests/struct4.on b/src/ortho/oread/tests/struct4.on new file mode 100644 index 000000000..6b027185d --- /dev/null +++ b/src/ortho/oread/tests/struct4.on @@ -0,0 +1,10 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +TYPE __ghdl_char IS UNSIGNED (8); + +TYPE struct4 IS RECORD + i: __ghdl_index_type; + c : __ghdl_char; +END RECORD; + +PUBLIC VAR var1 : struct4; diff --git a/src/ortho/oread/tests/struct5.on b/src/ortho/oread/tests/struct5.on new file mode 100644 index 000000000..31661d368 --- /dev/null +++ b/src/ortho/oread/tests/struct5.on @@ -0,0 +1,10 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +TYPE __ghdl_char IS UNSIGNED (8); + +TYPE struct5 IS RECORD + c : __ghdl_char; + i: __ghdl_index_type; +END RECORD; + +PUBLIC VAR var1 : struct5; diff --git a/src/ortho/oread/tests/struct6.on b/src/ortho/oread/tests/struct6.on new file mode 100644 index 000000000..7cb5e4619 --- /dev/null +++ b/src/ortho/oread/tests/struct6.on @@ -0,0 +1,18 @@ +TYPE float IS FLOAT; + +TYPE __ghdl_index_type IS UNSIGNED (32); + +TYPE __ghdl_char IS UNSIGNED (8); + +TYPE struct6 IS RECORD + f : float; + i: __ghdl_char; +END RECORD; + +PUBLIC VAR var1 : struct6; + +TYPE struct6_arr IS ARRAY [__ghdl_index_type] OF struct6; + +TYPE struct6x2 IS SUBARRAY struct6_arr[2]; + +PUBLIC VAR var2 : struct6x2;
\ No newline at end of file diff --git a/src/ortho/oread/tests/struct7.on b/src/ortho/oread/tests/struct7.on new file mode 100644 index 000000000..9654bc755 --- /dev/null +++ b/src/ortho/oread/tests/struct7.on @@ -0,0 +1,14 @@ +TYPE float IS FLOAT; + +TYPE __ghdl_index_type IS UNSIGNED (32); + +TYPE __ghdl_char IS UNSIGNED (8); +TYPE string IS ARRAY [__ghdl_index_type] OF __ghdl_char; +TYPE str7 IS SUBARRAY string[7]; + +TYPE struct7 IS RECORD + f : float; + s : str7; +END RECORD; + +PUBLIC VAR var1 : struct7; diff --git a/src/ortho/oread/tests/structref1.on b/src/ortho/oread/tests/structref1.on new file mode 100644 index 000000000..dfa903abe --- /dev/null +++ b/src/ortho/oread/tests/structref1.on @@ -0,0 +1,22 @@ +type __ghdl_index_type is unsigned (32); + +type __ghdl_char is unsigned (8); + +type __ghdl_chararray is array [__ghdl_index_type] of __ghdl_char; + +type __ghdl_char_ptr is access __ghdl_chararray; + +type __ghdl_char_ptr_array is array [__ghdl_index_type] of __ghdl_char_ptr; + +type __ghdl_str_len is record + len: __ghdl_index_type; + str: __ghdl_char_ptr; +end record; + +public var var1 : __ghdl_str_len; + +public function get_len () return __ghdl_index_type +declare +begin + return var1.len; +end; diff --git a/src/ortho/oread/tests/structref2.on b/src/ortho/oread/tests/structref2.on new file mode 100644 index 000000000..1090fe799 --- /dev/null +++ b/src/ortho/oread/tests/structref2.on @@ -0,0 +1,22 @@ +type __ghdl_index_type is unsigned (32); + +type __ghdl_char is unsigned (8); + +type __ghdl_chararray is array [__ghdl_index_type] of __ghdl_char; + +type __ghdl_char_ptr is access __ghdl_chararray; + +type __ghdl_char_ptr_array is array [__ghdl_index_type] of __ghdl_char_ptr; + +type __ghdl_str_len is record + str: __ghdl_char_ptr; + len: __ghdl_index_type; +end record; + +public var var1 : __ghdl_str_len; + +public function get_len () return __ghdl_index_type +declare +begin + return var1.len; +end; diff --git a/src/ortho/oread/tests/test_alloca.on b/src/ortho/oread/tests/test_alloca.on new file mode 100644 index 000000000..1b402c07c --- /dev/null +++ b/src/ortho/oread/tests/test_alloca.on @@ -0,0 +1,22 @@ +type __ghdl_size_type is unsigned (32); + +type __ghdl_index_type is unsigned (32); + +type __ghdl_integer is signed (32); + +type integer_array is array[__ghdl_index_type] of __ghdl_integer; +type integer_arr_ptr is access integer_array; + +public procedure test_alloca () +declare + local var len : __ghdl_size_type; +begin + len := __ghdl_size_type'[16]; + declare + local var ptr : integer_arr_ptr; + begin + ptr := integer_arr_ptr'alloca (len); + end; + len := __ghdl_size_type'[0]; +end; + diff --git a/src/ortho/oread/tests/test_alloca1.on b/src/ortho/oread/tests/test_alloca1.on new file mode 100644 index 000000000..06d4a2d71 --- /dev/null +++ b/src/ortho/oread/tests/test_alloca1.on @@ -0,0 +1,20 @@ +type __ghdl_size_type is unsigned (32); + +type __ghdl_index_type is unsigned (32); + +type __ghdl_integer is signed (32); + +type integer_array is array[__ghdl_index_type] of __ghdl_integer; +type integer_arr_ptr is access integer_array; + +public procedure test_alloca () +declare + local var len : __ghdl_size_type; + local var ptr : integer_arr_ptr; +begin + len := __ghdl_size_type'[16]; + ptr := integer_arr_ptr'alloca (len); + len := __ghdl_size_type'[0]; + return; +end; + diff --git a/src/ortho/oread/tests/test_assign.on b/src/ortho/oread/tests/test_assign.on new file mode 100644 index 000000000..f52091e53 --- /dev/null +++ b/src/ortho/oread/tests/test_assign.on @@ -0,0 +1,19 @@ +TYPE __ghdl_size_type IS UNSIGNED (32); + +TYPE __ghdl_index_type IS UNSIGNED (32); + +TYPE __ghdl_integer IS SIGNED (32); + +PUBLIC VAR gbl : __ghdl_integer; + +PUBLIC PROCEDURE test_assign () +DECLARE +BEGIN + gbl := __ghdl_integer'[5]; +END; + +PUBLIC PROCEDURE main () +DECLARE +BEGIN + test_assign (); +END; diff --git a/src/ortho/oread/tests/test_assign64.on b/src/ortho/oread/tests/test_assign64.on new file mode 100644 index 000000000..89e3c3996 --- /dev/null +++ b/src/ortho/oread/tests/test_assign64.on @@ -0,0 +1,22 @@ +TYPE __ghdl_integer IS SIGNED (64); + +PUBLIC VAR gbl : __ghdl_integer; + +PUBLIC PROCEDURE test_assign (v : __ghdl_integer) +DECLARE +BEGIN + gbl := __ghdl_integer'[123456] -# v; +END; + +PUBLIC PROCEDURE test_assign2 (v : __ghdl_integer) +DECLARE +BEGIN + gbl := __ghdl_integer'[891234567890] +# v; +END; + +PUBLIC PROCEDURE main () +DECLARE +BEGIN + test_assign (12); + test_assign (5); +END; diff --git a/src/ortho/oread/tests/test_dup.on b/src/ortho/oread/tests/test_dup.on new file mode 100644 index 000000000..82a85f8a2 --- /dev/null +++ b/src/ortho/oread/tests/test_dup.on @@ -0,0 +1,19 @@ +type __ghdl_size_type is unsigned (32); + +type __ghdl_index_type is unsigned (32); + +type __ghdl_integer is signed (32); + +type integer_array is array[__ghdl_index_type] of __ghdl_integer; +type integer_arr_ptr is access integer_array; + +public procedure test_alloca () +declare +begin +end; + +public procedure test_alloca () +declare +begin +end; + diff --git a/src/ortho/oread/tests/test_incomp.on b/src/ortho/oread/tests/test_incomp.on new file mode 100644 index 000000000..3cd631562 --- /dev/null +++ b/src/ortho/oread/tests/test_incomp.on @@ -0,0 +1,17 @@ +type int is signed (32); +type bool is boolean { false, true }; + +type incomp_ptr is access; +type rec is record + nxt : incomp_ptr; + val : int; +end record; + +type incomp_ptr is access rec; + +public function eq (l : incomp_ptr; r : incomp_ptr) return bool +declare +begin + return bool'(l.all.val = r.all.val); +end; + diff --git a/src/ortho/oread/tests/test_init.on b/src/ortho/oread/tests/test_init.on new file mode 100644 index 000000000..b631e16e5 --- /dev/null +++ b/src/ortho/oread/tests/test_init.on @@ -0,0 +1,36 @@ +TYPE __ghdl_size_type IS UNSIGNED (32); + +TYPE __ghdl_index_type IS UNSIGNED (32); + +TYPE __ghdl_char IS UNSIGNED (8); + +TYPE __ghdl_chararray IS ARRAY [__ghdl_index_type] OF __ghdl_char; + +TYPE __ghdl_char_ptr IS ACCESS __ghdl_chararray; + +TYPE __ghdl_str_len IS RECORD + len: __ghdl_index_type; + str: __ghdl_char_ptr; +END RECORD; + +PRIVATE VAR c : __ghdl_str_len; + +CONSTANT c := __ghdl_str_len'[DEFAULT]; + +PUBLIC VAR c2 : __ghdl_str_len; + +CONSTANT c2 := { __ghdl_index_type'[1], __ghdl_char_ptr'[DEFAULT]}; + + + +TYPE rec1_type IS RECORD; + +TYPE rec1_acc IS ACCESS rec1_type; + +TYPE rec1_type IS RECORD + len: __ghdl_index_type; +END RECORD; + +PRIVATE VAR c3 : rec1_type; + +CONSTANT c3 := rec1_type'[DEFAULT]; diff --git a/src/ortho/oread/tests/test_init2.on b/src/ortho/oread/tests/test_init2.on new file mode 100644 index 000000000..cb80c7a92 --- /dev/null +++ b/src/ortho/oread/tests/test_init2.on @@ -0,0 +1,18 @@ +TYPE std__standard__bit IS BOOLEAN {C_0, C_1}; + +--F /Users/gingold/devel/ghdl-updates.git/testsuite/gna/simple1/simple1.vhdl + +-- architecture behav + +TYPE work__simple1__ARCH__behav__INSTTYPE IS RECORD; + +TYPE work__simple1__ARCH__behav__INSTPTR IS ACCESS + work__simple1__ARCH__behav__INSTTYPE; + +TYPE work__simple1__ARCH__behav__INSTTYPE IS RECORD + s_VAL: std__standard__bit; +END RECORD; + +PRIVATE CONSTANT INST000001 : work__simple1__ARCH__behav__INSTTYPE; + +-- CONSTANT INST000001 := { std__standard__bit'[C_0]}; diff --git a/src/ortho/oread/tests/test_init3.on b/src/ortho/oread/tests/test_init3.on new file mode 100644 index 000000000..40bf75782 --- /dev/null +++ b/src/ortho/oread/tests/test_init3.on @@ -0,0 +1,24 @@ +TYPE std__standard__bit IS BOOLEAN {C_0, C_1}; + +--F /Users/gingold/devel/ghdl-updates.git/testsuite/gna/simple1/simple1.vhdl + +-- architecture behav + +TYPE work__simple1__ARCH__behav__INSTTYPE IS RECORD; + +TYPE work__simple1__ARCH__behav__INSTPTR IS ACCESS + work__simple1__ARCH__behav__INSTTYPE; + +PRIVATE VAR v_acc : work__simple1__ARCH__behav__INSTPTR; + +TYPE work__simple1__ARCH__behav__INSTTYPE IS RECORD + s_VAL: std__standard__bit; +END RECORD; +-- f : work__simple1__ARCH__behav__INSTPTR; + + +PRIVATE VAR v_inst : work__simple1__ARCH__behav__INSTTYPE; + +PRIVATE CONSTANT INST000001 : work__simple1__ARCH__behav__INSTTYPE; + +CONSTANT INST000001 := { std__standard__bit'[C_0]}; diff --git a/src/ortho/oread/tests/test_varglb.on b/src/ortho/oread/tests/test_varglb.on new file mode 100644 index 000000000..50d97b739 --- /dev/null +++ b/src/ortho/oread/tests/test_varglb.on @@ -0,0 +1,7 @@ +type __ghdl_size_type is unsigned (32); + +type __ghdl_index_type is unsigned (32); + +type __ghdl_integer is signed (32); + +public var gbl : __ghdl_integer; diff --git a/src/ortho/oread/tests/type1.on b/src/ortho/oread/tests/type1.on new file mode 100644 index 000000000..9e6732665 --- /dev/null +++ b/src/ortho/oread/tests/type1.on @@ -0,0 +1,5 @@ +-- internal declarations, part 1 + +type __ghdl_size_type is unsigned (32); + +type __ghdl_index_type is unsigned (32); diff --git a/src/ortho/oread/tests/unaggr1.on b/src/ortho/oread/tests/unaggr1.on new file mode 100644 index 000000000..ab14f53d4 --- /dev/null +++ b/src/ortho/oread/tests/unaggr1.on @@ -0,0 +1,16 @@ +type __ghdl_index_type is unsigned (32); + +type __ghdl_char is unsigned (8); + +type __ghdl_ptr is access __ghdl_char; + +type __ghdl_rti_loc is union + offset: __ghdl_char; + address: __ghdl_ptr; +end union; + +public constant var1 : __ghdl_rti_loc; +constant var1 := {.address = __ghdl_ptr'[null]}; + +public constant var2 : __ghdl_rti_loc; +constant var2 := {.offset = __ghdl_char'[0]}; diff --git a/src/ortho/oread/tests/union1.on b/src/ortho/oread/tests/union1.on new file mode 100644 index 000000000..a01d42758 --- /dev/null +++ b/src/ortho/oread/tests/union1.on @@ -0,0 +1,12 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +TYPE __ghdl_char IS UNSIGNED (8); + +TYPE __ghdl_ptr IS ACCESS __ghdl_char; + +TYPE __ghdl_rti_loc IS UNION + offset: __ghdl_char; + address: __ghdl_ptr; +END UNION; + +PUBLIC VAR var1 : __ghdl_rti_loc; diff --git a/src/ortho/oread/tests/union2.on b/src/ortho/oread/tests/union2.on new file mode 100644 index 000000000..6c8177987 --- /dev/null +++ b/src/ortho/oread/tests/union2.on @@ -0,0 +1,14 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +TYPE __ghdl_char IS UNSIGNED (8); + +TYPE __ghdl_ptr IS ACCESS __ghdl_char; + +TYPE __ghdl_rti_loc IS UNION + S0: RECORD + offset: __ghdl_char; + address: __ghdl_ptr; + END RECORD; +END UNION; + +PUBLIC VAR var1 : __ghdl_rti_loc; diff --git a/src/ortho/oread/tests/union3.on b/src/ortho/oread/tests/union3.on new file mode 100644 index 000000000..afad26d27 --- /dev/null +++ b/src/ortho/oread/tests/union3.on @@ -0,0 +1,27 @@ +TYPE __ghdl_index_type IS UNSIGNED (32); + +TYPE __ghdl_char IS UNSIGNED (8); + +TYPE __ghdl_ptr IS ACCESS __ghdl_char; + +TYPE __ghdl_rti_loc IS UNION + offset: __ghdl_char; + address: __ghdl_ptr; +END UNION; + +TYPE rec1 IS RECORD + f1: __ghdl_char; + f2: __ghdl_rti_loc; + f3: __ghdl_index_type; +END RECORD; + +PUBLIC VAR var1 : rec1; + +PUBLIC FUNCTION main (a : __ghdl_index_type) RETURN __ghdl_index_type +DECLARE +BEGIN + var1.f3 := 3; + var1.f1 := 1; + var1.f2.offset := 2; + RETURN 0; +END; diff --git a/src/ortho/oread/tests/var1.on b/src/ortho/oread/tests/var1.on new file mode 100644 index 000000000..7f3e9fc18 --- /dev/null +++ b/src/ortho/oread/tests/var1.on @@ -0,0 +1,8 @@ +-- internal declarations, part 1 + +TYPE __ghdl_size_type IS UNSIGNED (32); + +TYPE __ghdl_index_type IS UNSIGNED (32); + +PUBLIC CONSTANT size1 : __ghdl_size_type; +CONSTANT size1 := __ghdl_size_type'[2];
\ No newline at end of file diff --git a/src/ortho/oread/tests/var2.on b/src/ortho/oread/tests/var2.on new file mode 100644 index 000000000..b82073a63 --- /dev/null +++ b/src/ortho/oread/tests/var2.on @@ -0,0 +1,5 @@ +-- internal declarations, part 1 + +TYPE __ghdl_size_type IS UNSIGNED (32); + +PUBLIC VAR size1 : __ghdl_size_type; diff --git a/src/ortho/oread/tests/var_signed.on b/src/ortho/oread/tests/var_signed.on new file mode 100644 index 000000000..2acca3af6 --- /dev/null +++ b/src/ortho/oread/tests/var_signed.on @@ -0,0 +1,5 @@ +-- internal declarations, part 1 + +TYPE integer IS SIGNED (32); + +PUBLIC VAR v1 : integer; diff --git a/src/ortho/oread/tests/vla.on b/src/ortho/oread/tests/vla.on new file mode 100644 index 000000000..eb516f218 --- /dev/null +++ b/src/ortho/oread/tests/vla.on @@ -0,0 +1,9 @@ +type __ghdl_int is signed (32); + +public function vla (a : __ghdl_int) return __ghdl_int +declare + local var b : __ghdl_int; +begin + b := a; + return b; +end; diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb index a23bbeb3f..577ff9e8f 100644 --- a/src/vhdl/canon.adb +++ b/src/vhdl/canon.adb @@ -2592,6 +2592,7 @@ package body Canon is function Canon_Package_Instantiation_Declaration (Decl : Iir) return Iir is Pkg : constant Iir := Get_Uninstantiated_Package_Decl (Decl); + Bod : Iir; begin -- Canon map aspect. Set_Generic_Map_Aspect_Chain @@ -2600,79 +2601,25 @@ package body Canon is (Get_Generic_Chain (Decl), Get_Generic_Map_Aspect_Chain (Decl), Decl)); - if Get_Macro_Expanded_Flag (Pkg) then - declare - New_Decl : Iir; - New_Hdr : Iir; - begin - -- Replace package instantiation by the macro-expanded - -- generic-mapped package. - -- Use move semantics. - -- FIXME: adjust Parent. - New_Decl := Create_Iir (Iir_Kind_Package_Declaration); - Location_Copy (New_Decl, Decl); - Set_Parent (New_Decl, Get_Parent (Decl)); - Set_Identifier (New_Decl, Get_Identifier (Decl)); - Set_Need_Body (New_Decl, Get_Need_Body (Pkg)); - - New_Hdr := Create_Iir (Iir_Kind_Package_Header); - Set_Package_Header (New_Decl, New_Hdr); - Location_Copy (New_Hdr, Get_Package_Header (Pkg)); - Set_Generic_Chain (New_Hdr, Get_Generic_Chain (Decl)); - Set_Generic_Map_Aspect_Chain - (New_Hdr, Get_Generic_Map_Aspect_Chain (Decl)); - Set_Generic_Chain (Decl, Null_Iir); - Set_Generic_Map_Aspect_Chain (Decl, Null_Iir); - - Set_Declaration_Chain (New_Decl, Get_Declaration_Chain (Decl)); - Set_Declaration_Chain (Decl, Null_Iir); - Set_Chain (New_Decl, Get_Chain (Decl)); - Set_Chain (Decl, Null_Iir); - - Set_Package_Origin (New_Decl, Decl); - return New_Decl; - end; - else - return Decl; + -- Generate the body now. + -- Note: according to the LRM, if the instantiation occurs within a + -- package, the body of the instance should be appended to the package + -- body. + -- FIXME: generate only if generating code for this unit. + if Get_Macro_Expanded_Flag (Pkg) + and then Get_Need_Body (Pkg) + then + Bod := Sem_Inst.Instantiate_Package_Body (Decl); + Set_Parent (Bod, Get_Parent (Decl)); + Set_Package_Body (Decl, Bod); end if; - end Canon_Package_Instantiation_Declaration; - - function Create_Instantiation_Bodies - (Decl : Iir_Package_Declaration; Parent : Iir) return Iir - is - First, Last : Iir; - El : Iir; - Bod : Iir; - begin - First := Null_Iir; - Last := Null_Iir; -- Kill the warning - El := Get_Declaration_Chain (Decl); - while Is_Valid (El) loop - if Get_Kind (El) = Iir_Kind_Package_Declaration - and then Get_Need_Body (El) - and then Get_Package_Origin (El) /= Null_Iir - then - Bod := Sem_Inst.Instantiate_Package_Body (El); - Set_Parent (Bod, Parent); - -- Append. - if First = Null_Iir then - First := Bod; - else - Set_Chain (Last, Bod); - end if; - Last := Bod; - end if; - El := Get_Chain (El); - end loop; - return First; - end Create_Instantiation_Bodies; + return Decl; + end Canon_Package_Instantiation_Declaration; - function Canon_Declaration (Top : Iir_Design_Unit; - Decl : Iir; - Parent : Iir; - Decl_Parent : Iir) - return Iir + function Canon_Declaration + (Top : Iir_Design_Unit; Decl : Iir; Parent : Iir; Decl_Parent : Iir) + return Iir is Stmts : Iir; begin diff --git a/src/vhdl/canon.ads b/src/vhdl/canon.ads index 40ce5088f..45e7db6a5 100644 --- a/src/vhdl/canon.ads +++ b/src/vhdl/canon.ads @@ -61,11 +61,6 @@ package Canon is (Arch : Iir_Architecture_Body) return Iir_Design_Unit; - -- Macro-expand package bodies for instantiations in DECL. Return the - -- chain of bodies (the parent of each body is set to PARENT). - function Create_Instantiation_Bodies - (Decl : Iir_Package_Declaration; Parent : Iir) return Iir; - -- Canonicalize a subprogram call. procedure Canon_Subprogram_Call (Call : Iir); diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb index ecfc93ba4..92cfff293 100644 --- a/src/vhdl/disp_tree.adb +++ b/src/vhdl/disp_tree.adb @@ -452,6 +452,8 @@ package body Disp_Tree is Ndepth := Depth - 1; when Attr_Of_Ref => Ndepth := 0; + when Attr_Ref => + Ndepth := 0; when Attr_Of_Maybe_Ref => if Get_Is_Ref (N) then Ndepth := 0; diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb index 291214af6..c00565515 100644 --- a/src/vhdl/disp_vhdl.adb +++ b/src/vhdl/disp_vhdl.adb @@ -2335,7 +2335,18 @@ package body Disp_Vhdl is end if; Formal := Get_Formal (El); if Formal /= Null_Iir then - Disp_Expression (Formal); + case Get_Kind (El) is + when Iir_Kind_Association_Element_Package + | Iir_Kind_Association_Element_Type + | Iir_Kind_Association_Element_Subprogram => + Disp_Name (Formal); + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open => + Disp_Expression (Formal); + when others => + raise Internal_Error; + end case; if Conv /= Null_Iir then Put (")"); end if; @@ -2346,7 +2357,8 @@ package body Disp_Vhdl is when Iir_Kind_Association_Element_Open => Put ("open"); when Iir_Kind_Association_Element_Package - | Iir_Kind_Association_Element_Type => + | Iir_Kind_Association_Element_Type + | Iir_Kind_Association_Element_Subprogram => Disp_Name (Get_Actual (El)); when others => Conv := Get_In_Conversion (El); diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index 7119563cc..c5c5d9b1f 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -1259,9 +1259,11 @@ package body Errorout is case Get_Kind (Subprg) is when Iir_Kind_Enumeration_Literal => Append (Res, "enumeration literal "); - when Iir_Kind_Function_Declaration => + when Iir_Kind_Function_Declaration + | Iir_Kind_Interface_Function_Declaration => Append (Res, "function "); - when Iir_Kind_Procedure_Declaration => + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Interface_Procedure_Declaration => Append (Res, "procedure "); when others => Error_Kind ("disp_subprg", Subprg); @@ -1289,8 +1291,8 @@ package body Errorout is Append (Res, " ["); case Get_Kind (Subprg) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => + when Iir_Kinds_Subprogram_Declaration + | Iir_Kinds_Interface_Subprogram_Declaration => declare El : Iir; begin @@ -1308,6 +1310,7 @@ package body Errorout is case Get_Kind (Subprg) is when Iir_Kind_Function_Declaration + | Iir_Kind_Interface_Function_Declaration | Iir_Kind_Enumeration_Literal => Append (Res, " return "); Append_Type (Get_Return_Type (Subprg)); diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index a5a12a742..219d21734 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -1776,23 +1776,6 @@ package body Iirs is Set_Field5 (Pkg, Decl); end Set_Package_Body; - function Get_Package_Instantiation_Bodies_Chain (Pkg : Iir) return Iir is - begin - pragma Assert (Pkg /= Null_Iir); - pragma Assert (Has_Package_Instantiation_Bodies_Chain (Get_Kind (Pkg)), - "no field Package_Instantiation_Bodies_Chain"); - return Get_Field8 (Pkg); - end Get_Package_Instantiation_Bodies_Chain; - - procedure Set_Package_Instantiation_Bodies_Chain (Pkg : Iir; Chain : Iir) - is - begin - pragma Assert (Pkg /= Null_Iir); - pragma Assert (Has_Package_Instantiation_Bodies_Chain (Get_Kind (Pkg)), - "no field Package_Instantiation_Bodies_Chain"); - Set_Field8 (Pkg, Chain); - end Set_Package_Instantiation_Bodies_Chain; - function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean is begin pragma Assert (Decl /= Null_Iir); @@ -4741,7 +4724,7 @@ package body Iirs is pragma Assert (Target /= Null_Iir); pragma Assert (Has_Actual_Type (Get_Kind (Target)), "no field Actual_Type"); - return Get_Field3 (Target); + return Get_Field5 (Target); end Get_Actual_Type; procedure Set_Actual_Type (Target : Iir; Atype : Iir) is @@ -4749,7 +4732,7 @@ package body Iirs is pragma Assert (Target /= Null_Iir); pragma Assert (Has_Actual_Type (Get_Kind (Target)), "no field Actual_Type"); - Set_Field3 (Target, Atype); + Set_Field5 (Target, Atype); end Set_Actual_Type; function Get_Actual_Type_Definition (Target : Iir) return Iir is @@ -4757,7 +4740,7 @@ package body Iirs is pragma Assert (Target /= Null_Iir); pragma Assert (Has_Actual_Type_Definition (Get_Kind (Target)), "no field Actual_Type_Definition"); - return Get_Field5 (Target); + return Get_Field3 (Target); end Get_Actual_Type_Definition; procedure Set_Actual_Type_Definition (Target : Iir; Atype : Iir) is @@ -4765,7 +4748,7 @@ package body Iirs is pragma Assert (Target /= Null_Iir); pragma Assert (Has_Actual_Type_Definition (Get_Kind (Target)), "no field Actual_Type_Definition"); - Set_Field5 (Target, Atype); + Set_Field3 (Target, Atype); end Set_Actual_Type_Definition; function Get_Association_Chain (Target : Iir) return Iir is diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 4e0cbfd57..380ae998a 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -452,10 +452,11 @@ package Iirs is -- -- Owner of Actual_Type if needed. -- Only for Iir_Kind_Association_Element_By_Individual: - -- Get/Set_Actual_Type_Definition (Field5) + -- Get/Set_Actual_Type_Definition (Field3) -- -- Only for Iir_Kind_Association_Element_By_Individual: - -- Get/Set_Actual_Type (Field3) + -- Only for Iir_Kind_Association_Element_Type: + -- Get/Set_Actual_Type (Field5) -- -- Get/Set the whole association flag (true if the formal is associated in -- whole and not individually, see LRM93 4.3.2.2) @@ -883,10 +884,6 @@ package Iirs is -- -- Get/Set_Package_Origin (Field7) -- - -- Chain of bodies for package instantiation. Present only in certain - -- conditions. - -- Get/Set_Package_Instantiation_Bodies_Chain (Field8) - -- -- If true, the package need a body. -- Get/Set_Need_Body (Flag1) -- @@ -896,10 +893,10 @@ package Iirs is -- type. -- Get/Set_Macro_Expanded_Flag (Flag2) -- - -- True if the package declaration has the package has at least one - -- package instantiation declaration whose uninstantiated declaration - -- needs both a body and macro-expansion. In that case, the instantiation - -- needs macro-expansion of their body. + -- True if the package declaration at least one package instantiation + -- declaration whose uninstantiated declaration needs both a body and + -- macro-expansion. In that case, the instantiation needs macro-expansion + -- of their body. -- Get/Set_Need_Instance_Bodies (Flag3) -- -- Get/Set_Visible_Flag (Flag4) @@ -4719,6 +4716,11 @@ package Iirs is Iir_Predefined_None .. Iir_Predefined_Functions'Last; + -- Explicit known subprograms (from ieee) + subtype Iir_Predefined_IEEE_Explicit is Iir_Predefined_Functions range + Iir_Predefined_Functions'Succ (Iir_Predefined_None) .. + Iir_Predefined_Functions'Last; + -- Staticness as defined by LRM93 6.1 and 7.4 type Iir_Staticness is (Unknown, None, Globally, Locally); @@ -6008,10 +6010,6 @@ package Iirs is function Get_Package_Body (Pkg : Iir) return Iir; procedure Set_Package_Body (Pkg : Iir; Decl : Iir); - -- Field: Field8 Chain - function Get_Package_Instantiation_Bodies_Chain (Pkg : Iir) return Iir; - procedure Set_Package_Instantiation_Bodies_Chain (Pkg : Iir; Chain : Iir); - -- Field: Flag1 function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean; procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean); @@ -6929,11 +6927,11 @@ package Iirs is -- Unless the formal is an unconstrained array type, this is the same as -- the formal type. -- Subtype indiciation for a type association. - -- Field: Field3 Ref + -- Field: Field5 Ref function Get_Actual_Type (Target : Iir) return Iir; procedure Set_Actual_Type (Target : Iir; Atype : Iir); - -- Field: Field5 + -- Field: Field3 function Get_Actual_Type_Definition (Target : Iir) return Iir; procedure Set_Actual_Type_Definition (Target : Iir; Atype : Iir); diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index 5495e6057..99ce824e9 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -376,7 +376,8 @@ package body Iirs_Utils is El := Formal; loop case Get_Kind (El) is - when Iir_Kind_Simple_Name => + when Iir_Kind_Simple_Name + | Iir_Kind_Operator_Symbol => return Get_Named_Entity (El); when Iir_Kinds_Interface_Declaration => return El; @@ -425,7 +426,8 @@ package body Iirs_Utils is if Formal /= Null_Iir then -- Strip denoting name case Get_Kind (Formal) is - when Iir_Kind_Simple_Name => + when Iir_Kind_Simple_Name + | Iir_Kind_Operator_Symbol => return Get_Named_Entity (Formal); when Iir_Kinds_Interface_Declaration => -- Shouldn't happen. diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index 67a25689b..65917b4aa 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -93,7 +93,6 @@ package body Nodes_Meta is Field_Entity_Name => Type_Iir, Field_Package => Type_Iir, Field_Package_Body => Type_Iir, - Field_Package_Instantiation_Bodies_Chain => Type_Iir, Field_Need_Body => Type_Boolean, Field_Macro_Expanded_Flag => Type_Boolean, Field_Need_Instance_Bodies => Type_Boolean, @@ -500,8 +499,6 @@ package body Nodes_Meta is return "package"; when Field_Package_Body => return "package_body"; - when Field_Package_Instantiation_Bodies_Chain => - return "package_instantiation_bodies_chain"; when Field_Need_Body => return "need_body"; when Field_Macro_Expanded_Flag => @@ -1690,8 +1687,6 @@ package body Nodes_Meta is return Attr_Ref; when Field_Package_Body => return Attr_Forward_Ref; - when Field_Package_Instantiation_Bodies_Chain => - return Attr_Chain; when Field_Need_Body => return Attr_None; when Field_Macro_Expanded_Flag => @@ -2345,6 +2340,7 @@ package body Nodes_Meta is Field_Chain, Field_Actual, Field_Subprogram_Association_Chain, + Field_Actual_Type, -- Iir_Kind_Association_Element_Subprogram Field_Whole_Association_Flag, Field_Collapse_Signal_Flag, @@ -2764,7 +2760,6 @@ package body Nodes_Meta is Field_Attribute_Value_Chain, Field_Package_Body, Field_Package_Origin, - Field_Package_Instantiation_Bodies_Chain, -- Iir_Kind_Package_Instantiation_Declaration Field_Identifier, Field_Visible_Flag, @@ -4352,61 +4347,61 @@ package body Nodes_Meta is Iir_Kind_Association_Element_By_Individual => 111, Iir_Kind_Association_Element_Open => 116, Iir_Kind_Association_Element_Package => 121, - Iir_Kind_Association_Element_Type => 127, - Iir_Kind_Association_Element_Subprogram => 132, - Iir_Kind_Choice_By_Others => 137, - Iir_Kind_Choice_By_Expression => 144, - Iir_Kind_Choice_By_Range => 151, - Iir_Kind_Choice_By_None => 156, - Iir_Kind_Choice_By_Name => 162, - Iir_Kind_Entity_Aspect_Entity => 164, - Iir_Kind_Entity_Aspect_Configuration => 165, - Iir_Kind_Entity_Aspect_Open => 165, - Iir_Kind_Block_Configuration => 171, - Iir_Kind_Block_Header => 175, - Iir_Kind_Component_Configuration => 182, - Iir_Kind_Binding_Indication => 186, - Iir_Kind_Entity_Class => 188, - Iir_Kind_Attribute_Value => 196, - Iir_Kind_Signature => 199, - Iir_Kind_Aggregate_Info => 206, - Iir_Kind_Procedure_Call => 210, - Iir_Kind_Record_Element_Constraint => 216, - Iir_Kind_Array_Element_Resolution => 218, - Iir_Kind_Record_Resolution => 219, - Iir_Kind_Record_Element_Resolution => 222, - Iir_Kind_Attribute_Specification => 230, - Iir_Kind_Disconnection_Specification => 236, - Iir_Kind_Configuration_Specification => 242, - Iir_Kind_Access_Type_Definition => 250, - Iir_Kind_Incomplete_Type_Definition => 258, - Iir_Kind_Interface_Type_Definition => 265, - Iir_Kind_File_Type_Definition => 272, - Iir_Kind_Protected_Type_Declaration => 281, - Iir_Kind_Record_Type_Definition => 291, - Iir_Kind_Array_Type_Definition => 303, - Iir_Kind_Array_Subtype_Definition => 318, - Iir_Kind_Record_Subtype_Definition => 329, - Iir_Kind_Access_Subtype_Definition => 337, - Iir_Kind_Physical_Subtype_Definition => 347, - Iir_Kind_Floating_Subtype_Definition => 358, - Iir_Kind_Integer_Subtype_Definition => 368, - Iir_Kind_Enumeration_Subtype_Definition => 378, - Iir_Kind_Enumeration_Type_Definition => 388, - Iir_Kind_Integer_Type_Definition => 396, - Iir_Kind_Floating_Type_Definition => 404, - Iir_Kind_Physical_Type_Definition => 415, - Iir_Kind_Range_Expression => 423, - Iir_Kind_Protected_Type_Body => 430, - Iir_Kind_Wildcard_Type_Definition => 435, - Iir_Kind_Subtype_Definition => 440, - Iir_Kind_Scalar_Nature_Definition => 444, - Iir_Kind_Overload_List => 445, - Iir_Kind_Type_Declaration => 452, - Iir_Kind_Anonymous_Type_Declaration => 458, - Iir_Kind_Subtype_Declaration => 465, - Iir_Kind_Nature_Declaration => 471, - Iir_Kind_Subnature_Declaration => 477, + Iir_Kind_Association_Element_Type => 128, + Iir_Kind_Association_Element_Subprogram => 133, + Iir_Kind_Choice_By_Others => 138, + Iir_Kind_Choice_By_Expression => 145, + Iir_Kind_Choice_By_Range => 152, + Iir_Kind_Choice_By_None => 157, + Iir_Kind_Choice_By_Name => 163, + Iir_Kind_Entity_Aspect_Entity => 165, + Iir_Kind_Entity_Aspect_Configuration => 166, + Iir_Kind_Entity_Aspect_Open => 166, + Iir_Kind_Block_Configuration => 172, + Iir_Kind_Block_Header => 176, + Iir_Kind_Component_Configuration => 183, + Iir_Kind_Binding_Indication => 187, + Iir_Kind_Entity_Class => 189, + Iir_Kind_Attribute_Value => 197, + Iir_Kind_Signature => 200, + Iir_Kind_Aggregate_Info => 207, + Iir_Kind_Procedure_Call => 211, + Iir_Kind_Record_Element_Constraint => 217, + Iir_Kind_Array_Element_Resolution => 219, + Iir_Kind_Record_Resolution => 220, + Iir_Kind_Record_Element_Resolution => 223, + Iir_Kind_Attribute_Specification => 231, + Iir_Kind_Disconnection_Specification => 237, + Iir_Kind_Configuration_Specification => 243, + Iir_Kind_Access_Type_Definition => 251, + Iir_Kind_Incomplete_Type_Definition => 259, + Iir_Kind_Interface_Type_Definition => 266, + Iir_Kind_File_Type_Definition => 273, + Iir_Kind_Protected_Type_Declaration => 282, + Iir_Kind_Record_Type_Definition => 292, + Iir_Kind_Array_Type_Definition => 304, + Iir_Kind_Array_Subtype_Definition => 319, + Iir_Kind_Record_Subtype_Definition => 330, + Iir_Kind_Access_Subtype_Definition => 338, + Iir_Kind_Physical_Subtype_Definition => 348, + Iir_Kind_Floating_Subtype_Definition => 359, + Iir_Kind_Integer_Subtype_Definition => 369, + Iir_Kind_Enumeration_Subtype_Definition => 379, + Iir_Kind_Enumeration_Type_Definition => 389, + Iir_Kind_Integer_Type_Definition => 397, + Iir_Kind_Floating_Type_Definition => 405, + Iir_Kind_Physical_Type_Definition => 416, + Iir_Kind_Range_Expression => 424, + Iir_Kind_Protected_Type_Body => 431, + Iir_Kind_Wildcard_Type_Definition => 436, + Iir_Kind_Subtype_Definition => 441, + Iir_Kind_Scalar_Nature_Definition => 445, + Iir_Kind_Overload_List => 446, + Iir_Kind_Type_Declaration => 453, + Iir_Kind_Anonymous_Type_Declaration => 459, + Iir_Kind_Subtype_Declaration => 466, + Iir_Kind_Nature_Declaration => 472, + Iir_Kind_Subnature_Declaration => 478, Iir_Kind_Package_Declaration => 492, Iir_Kind_Package_Instantiation_Declaration => 505, Iir_Kind_Package_Body => 513, @@ -5018,8 +5013,6 @@ package body Nodes_Meta is return Get_Package (N); when Field_Package_Body => return Get_Package_Body (N); - when Field_Package_Instantiation_Bodies_Chain => - return Get_Package_Instantiation_Bodies_Chain (N); when Field_Block_Configuration => return Get_Block_Configuration (N); when Field_Concurrent_Statement_Chain => @@ -5418,8 +5411,6 @@ package body Nodes_Meta is Set_Package (N, V); when Field_Package_Body => Set_Package_Body (N, V); - when Field_Package_Instantiation_Bodies_Chain => - Set_Package_Instantiation_Bodies_Chain (N, V); when Field_Block_Configuration => Set_Block_Configuration (N, V); when Field_Concurrent_Statement_Chain => @@ -7047,12 +7038,6 @@ package body Nodes_Meta is end case; end Has_Package_Body; - function Has_Package_Instantiation_Bodies_Chain (K : Iir_Kind) - return Boolean is - begin - return K = Iir_Kind_Package_Declaration; - end Has_Package_Instantiation_Bodies_Chain; - function Has_Need_Body (K : Iir_Kind) return Boolean is begin return K = Iir_Kind_Package_Declaration; @@ -9802,7 +9787,13 @@ package body Nodes_Meta is function Has_Actual_Type (K : Iir_Kind) return Boolean is begin - return K = Iir_Kind_Association_Element_By_Individual; + case K is + when Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Type => + return True; + when others => + return False; + end case; end Has_Actual_Type; function Has_Actual_Type_Definition (K : Iir_Kind) return Boolean is diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads index ddd23ed79..0400f4025 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -133,7 +133,6 @@ package Nodes_Meta is Field_Entity_Name, Field_Package, Field_Package_Body, - Field_Package_Instantiation_Bodies_Chain, Field_Need_Body, Field_Macro_Expanded_Flag, Field_Need_Instance_Bodies, @@ -640,8 +639,6 @@ package Nodes_Meta is function Has_Entity_Name (K : Iir_Kind) return Boolean; function Has_Package (K : Iir_Kind) return Boolean; function Has_Package_Body (K : Iir_Kind) return Boolean; - function Has_Package_Instantiation_Bodies_Chain (K : Iir_Kind) - return Boolean; function Has_Need_Body (K : Iir_Kind) return Boolean; function Has_Macro_Expanded_Flag (K : Iir_Kind) return Boolean; function Has_Need_Instance_Bodies (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 99c459027..31af2556d 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -3162,7 +3162,7 @@ package body Parse is Set_Minus_Terminal (First, Parse_Name); end if; when others => - Error_Msg_Parse ("missign type or across/throught aspect " + Error_Msg_Parse ("missing type or across/throught aspect " & "in quantity declaration"); Eat_Tokens_Until_Semi_Colon; raise Expect_Error; @@ -3271,7 +3271,7 @@ package body Parse is if Current_Token /= Tok_Comma then case Current_Token is when Tok_Assign => - Error_Msg_Parse ("missign type in " & Disp_Name (Kind)); + Error_Msg_Parse ("missing type in " & Disp_Name (Kind)); exit; when others => Error_Msg_Parse @@ -6642,23 +6642,27 @@ package body Parse is return Res; end Parse_Process_Statement; - procedure Check_Formal_Form (Formal : Iir) is + function Check_Formal_Form (Formal : Iir) return Iir is begin if Formal = Null_Iir then - return; + return Formal; end if; case Get_Kind (Formal) is when Iir_Kind_Simple_Name | Iir_Kind_Slice_Name | Iir_Kind_Selected_Name => - null; + return Formal; when Iir_Kind_Parenthesis_Name => -- Could be an indexed name, so nothing to check within the -- parenthesis. - null; + return Formal; + when Iir_Kind_String_Literal8 => + -- Operator designator + return String_To_Operator_Symbol (Formal); when others => - Error_Msg_Parse (+Formal, "incorrect formal name"); + Error_Msg_Parse (+Formal, "incorrect formal name ignored"); + return Null_Iir; end case; end Check_Formal_Form; @@ -6736,10 +6740,8 @@ package body Parse is end if; when Tok_Double_Arrow => - Formal := Actual; - -- Check that FORMAL is a name and not an expression. - Check_Formal_Form (Formal); + Formal := Check_Formal_Form (Actual); -- Skip '=>' Scan; @@ -6805,8 +6807,13 @@ package body Parse is function Parse_Generic_Map_Aspect return Iir is begin Expect (Tok_Generic); + + -- Skip 'generic'. Scan_Expect (Tok_Map); + + -- Skip 'map'. Scan; + return Parse_Association_List_In_Parenthesis; end Parse_Generic_Map_Aspect; @@ -8539,6 +8546,10 @@ package body Parse is if Current_Token = Tok_Generic then Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); + elsif Current_Token = Tok_Left_Paren then + Error_Msg_Parse ("missing 'generic map'"); + Set_Generic_Map_Aspect_Chain + (Res, Parse_Association_List_In_Parenthesis); end if; Expect (Tok_Semi_Colon); diff --git a/src/vhdl/parse.ads b/src/vhdl/parse.ads index ea7c56cf0..41f22a3fd 100644 --- a/src/vhdl/parse.ads +++ b/src/vhdl/parse.ads @@ -36,6 +36,10 @@ package Parse is Len : Nat32; Loc : Location_Type) return Name_Id; + -- Convert string literal STR to an operator symbol. + -- Emit an error message if the string is not an operator name. + function String_To_Operator_Symbol (Str : Iir) return Iir; + -- Parse a single design unit. -- The scanner must have been initialized, however, the current_token -- shouldn't have been set. diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb index 40fe9a4e7..d9039fcc6 100644 --- a/src/vhdl/scanner.adb +++ b/src/vhdl/scanner.adb @@ -905,13 +905,60 @@ package body Scanner is end if; end if; end; - end if; - if Vhdl_Std > Vhdl_87 and then C = '\' then + elsif Vhdl_Std > Vhdl_87 and then C = '\' then -- Start of extended identifier. Cannot follow an identifier. Error_Separator; end if; - when Invalid - | Format_Effector + + when Invalid => + -- Improve error message for use of UTF-8 quote marks. + -- It's possible because in the sequence of UTF-8 bytes for the + -- quote marks, there are invalid character (in the 128-160 + -- range). + if C = Character'Val (16#80#) + and then Nam_Buffer (Len) = Character'Val (16#e2#) + and then (Source (Pos + 1) = Character'Val (16#98#) + or else Source (Pos + 1) = Character'Val (16#99#)) + then + -- UTF-8 left or right single quote mark. + if Len > 1 then + -- The first byte (0xe2) is part of the identifier. An + -- error will be detected as the next byte (0x80) is + -- invalid. Remove the first byte from the identifier, and + -- let's catch the error later. + Nam_Length := Len - 1; + Pos := Pos - 1; + else + Error_Msg_Scan ("invalid use of UTF8 character for '"); + Pos := Pos + 2; + + -- Distinguish between character literal and tick. Don't + -- care about possible invalid character literal, as in any + -- case we have already emitted an error message. + if Current_Context.Prev_Token /= Tok_Identifier + and then Current_Context.Prev_Token /= Tok_Character + and then + (Source (Pos + 1) = ''' + or else + (Source (Pos + 1) = Character'Val (16#e2#) + and then Source (Pos + 2) = Character'Val (16#80#) + and then Source (Pos + 3) = Character'Val (16#99#))) + then + Current_Token := Tok_Character; + Current_Context.Identifier := + Name_Table.Get_Identifier (Source (Pos)); + if Source (Pos + 1) = ''' then + Pos := Pos + 2; + else + Pos := Pos + 4; + end if; + else + Current_Token := Tok_Tick; + end if; + return; + end if; + end if; + when Format_Effector | Space_Character => null; end case; diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 1664d67e1..39916bb76 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -1479,6 +1479,12 @@ package body Sem is when Iir_Kinds_Monadic_Operator => return Are_Trees_Equal (Get_Operand (Left), Get_Operand (Right)); + when Iir_Kind_Function_Call => + return Are_Trees_Equal (Get_Prefix (Left), Get_Prefix (Right)) + and then + Are_Trees_Chain_Equal (Get_Parameter_Association_Chain (Left), + Get_Parameter_Association_Chain (Right)); + when Iir_Kind_Access_Type_Definition | Iir_Kind_Record_Type_Definition | Iir_Kind_Array_Type_Definition @@ -2867,9 +2873,14 @@ package body Sem is -- FIXME: unless the parent is a package declaration library unit, the -- design unit depends on the body. - if Get_Need_Body (Pkg) then - Bod := Libraries.Load_Secondary_Unit - (Get_Design_Unit (Pkg), Null_Identifier, Decl); + if Get_Need_Body (Pkg) and then not Is_Nested_Package (Pkg) then + Bod := Get_Package_Body (Pkg); + if Is_Null (Bod) then + Bod := Libraries.Load_Secondary_Unit + (Get_Design_Unit (Pkg), Null_Identifier, Decl); + else + Bod := Get_Design_Unit (Bod); + end if; if Is_Null (Bod) then Error_Msg_Sem (+Decl, "cannot find package body of %n", +Pkg); else diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb index af573ae3b..b85050ff3 100644 --- a/src/vhdl/sem_assocs.adb +++ b/src/vhdl/sem_assocs.adb @@ -20,6 +20,7 @@ with Errorout; use Errorout; with Flags; use Flags; with Types; use Types; with Iirs_Utils; use Iirs_Utils; +with Parse; with Std_Names; with Sem_Names; use Sem_Names; with Sem_Types; @@ -33,20 +34,61 @@ package body Sem_Assocs is return Iir is N_Assoc : Iir; + Actual : Iir; begin + Actual := Get_Actual (Assoc); case Get_Kind (Inter) is when Iir_Kind_Interface_Package_Declaration => N_Assoc := Create_Iir (Iir_Kind_Association_Element_Package); when Iir_Kind_Interface_Type_Declaration => N_Assoc := Create_Iir (Iir_Kind_Association_Element_Type); + if Get_Kind (Actual) = Iir_Kind_Parenthesis_Name then + -- Convert parenthesis name to array subtype. + declare + N_Actual : Iir; + Sub_Assoc : Iir; + Indexes : Iir_List; + Old : Iir; + begin + N_Actual := Create_Iir (Iir_Kind_Array_Subtype_Definition); + Location_Copy (N_Actual, Actual); + Set_Subtype_Type_Mark (N_Actual, Get_Prefix (Actual)); + Sub_Assoc := Get_Association_Chain (Actual); + Indexes := Create_Iir_List; + Set_Index_Constraint_List (N_Actual, Indexes); + while Is_Valid (Sub_Assoc) loop + if Get_Kind (Sub_Assoc) + /= Iir_Kind_Association_Element_By_Expression + then + Error_Msg_Sem + (+Sub_Assoc, "index constraint must be a range"); + else + if Get_Formal (Sub_Assoc) /= Null_Iir then + Error_Msg_Sem + (+Sub_Assoc, "formal part not allowed"); + end if; + Append_Element (Indexes, Get_Actual (Sub_Assoc)); + end if; + Old := Sub_Assoc; + Sub_Assoc := Get_Chain (Sub_Assoc); + Free_Iir (Old); + end loop; + Old := Actual; + Free_Iir (Old); + Actual := N_Actual; + end; + end if; when Iir_Kinds_Interface_Subprogram_Declaration => N_Assoc := Create_Iir (Iir_Kind_Association_Element_Subprogram); + if Get_Kind (Actual) = Iir_Kind_String_Literal8 then + Actual := Parse.String_To_Operator_Symbol (Actual); + end if; when others => Error_Kind ("rewrite_non_object_association", Inter); end case; Location_Copy (N_Assoc, Assoc); Set_Formal (N_Assoc, Get_Formal (Assoc)); - Set_Actual (N_Assoc, Get_Actual (Assoc)); + Set_Actual (N_Assoc, Actual); Set_Chain (N_Assoc, Get_Chain (Assoc)); Set_Whole_Association_Flag (N_Assoc, True); Free_Iir (Assoc); @@ -69,18 +111,20 @@ package body Sem_Assocs is Res := Null_Iir; -- Common case: only objects in interfaces. - while Inter /= Null_Iir loop + while Is_Valid (Inter) loop exit when Get_Kind (Inter) not in Iir_Kinds_Interface_Object_Declaration; Inter := Get_Chain (Inter); end loop; - if Inter = Null_Iir then + if Is_Null (Inter) then + -- Only interface object, nothing to to. return Assoc_Chain; end if; + Inter := Inter_Chain; loop -- Don't try to detect errors. - if Assoc = Null_Iir then + if Is_Null (Assoc) then return Res; end if; @@ -97,7 +141,8 @@ package body Sem_Assocs is Assoc := Rewrite_Non_Object_Association (Assoc, Inter); end if; else - if Get_Kind (Formal) = Iir_Kind_Simple_Name then + if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol) + then -- A candidate. Search the corresponding interface. Inter := Find_Name_In_Chain (Inter_Chain, Get_Identifier (Formal)); @@ -120,6 +165,9 @@ package body Sem_Assocs is end if; Prev_Assoc := Assoc; Assoc := Get_Chain (Assoc); + if Is_Valid (Inter) then + Inter := Get_Chain (Inter); + end if; end loop; end Extract_Non_Object_Association; @@ -1288,7 +1336,8 @@ package body Sem_Assocs is Formal_Type : Iir; begin case Get_Kind (Formal) is - when Iir_Kind_Simple_Name => + when Iir_Kind_Simple_Name + | Iir_Kind_Operator_Symbol => -- Certainly the most common case: FORMAL_NAME => VAL. -- It is also the easiest. So, handle it completly now. if Get_Identifier (Formal) = Get_Identifier (Inter) then @@ -1522,7 +1571,7 @@ package body Sem_Assocs is -- Can be associated only once Match := Fully_Compatible; else - if Get_Kind (Formal) = Iir_Kind_Simple_Name + if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol) and then Get_Identifier (Formal) = Get_Identifier (Inter) then Match := Fully_Compatible; @@ -1537,7 +1586,6 @@ package body Sem_Assocs is Formal : constant Iir := Get_Formal (Assoc); begin if Formal /= Null_Iir then - pragma Assert (Get_Kind (Formal) = Iir_Kind_Simple_Name); pragma Assert (Get_Identifier (Formal) = Get_Identifier (Inter)); Set_Named_Entity (Formal, Inter); Set_Base_Name (Formal, Inter); @@ -1610,14 +1658,12 @@ package body Sem_Assocs is end Sem_Association_Package; -- Create an implicit association_element_subprogram for the declaration - -- of function ID for ACTUAL (a name of a type). + -- of function ID for ACTUAL_Type (a type/subtype definition). function Sem_Implicit_Operator_Association - (Id : Name_Id; Actual : Iir) return Iir + (Id : Name_Id; Actual_Type : Iir; Actual_Name : Iir) return Iir is use Sem_Scopes; - Atype : constant Iir := Get_Type (Actual); - -- Return TRUE if DECL is a function declaration with a comparaison -- operator profile. function Has_Comparaison_Profile (Decl : Iir) return Boolean @@ -1641,7 +1687,8 @@ package body Sem_Assocs is if Inter = Null_Iir then return False; end if; - if Get_Base_Type (Get_Type (Inter)) /= Get_Base_Type (Atype) then + if Get_Base_Type (Get_Type (Inter)) /= Get_Base_Type (Actual_Type) + then return False; end if; Inter := Get_Chain (Inter); @@ -1661,16 +1708,17 @@ package body Sem_Assocs is Decl := Get_Declaration (Interp); if Has_Comparaison_Profile (Decl) then Res := Create_Iir (Iir_Kind_Association_Element_Subprogram); - Location_Copy (Res, Actual); - Set_Actual (Res, Build_Simple_Name (Decl, Get_Location (Actual))); + Location_Copy (Res, Actual_Name); + Set_Actual + (Res, Build_Simple_Name (Decl, Get_Location (Actual_Name))); Set_Use_Flag (Decl, True); return Res; end if; Interp := Get_Next_Interpretation (Interp); end loop; - Error_Msg_Sem (+Actual, "cannot find a %i declaration for type %i", - (+Id, +Actual)); + Error_Msg_Sem (+Actual_Name, "cannot find a %i declaration for type %i", + (+Id, +Actual_Name)); return Null_Iir; end Sem_Implicit_Operator_Association; @@ -1681,6 +1729,7 @@ package body Sem_Assocs is is Inter_Def : constant Iir := Get_Type (Inter); Actual : Iir; + Actual_Type : Iir; Op_Eq, Op_Neq : Iir; begin if not Finish then @@ -1701,15 +1750,21 @@ package body Sem_Assocs is -- Set type association for analysis of reference to this interface. pragma Assert (Is_Null (Get_Associated_Type (Inter_Def))); - Set_Associated_Type (Inter_Def, Get_Type (Actual)); + if Get_Kind (Actual) in Iir_Kinds_Subtype_Definition then + Actual_Type := Actual; + else + Actual_Type := Get_Type (Actual); + end if; + Set_Actual_Type (Assoc, Actual_Type); + Set_Associated_Type (Inter_Def, Actual_Type); -- FIXME: it is not clear at all from the LRM how the implicit -- associations are done... Op_Eq := Sem_Implicit_Operator_Association - (Std_Names.Name_Op_Equality, Actual); + (Std_Names.Name_Op_Equality, Actual_Type, Actual); if Op_Eq /= Null_Iir then Op_Neq := Sem_Implicit_Operator_Association - (Std_Names.Name_Op_Inequality, Actual); + (Std_Names.Name_Op_Inequality, Actual_Type, Actual); Set_Chain (Op_Eq, Op_Neq); Set_Subprogram_Association_Chain (Assoc, Op_Eq); end if; @@ -1838,11 +1893,11 @@ package body Sem_Assocs is end if; when Iir_Kind_Overload_List => declare - First_Error : Boolean; + Nbr_Errors : Natural; List : Iir_List; El, R : Iir; begin - First_Error := True; + Nbr_Errors := 0; R := Null_Iir; List := Get_Overload_List (Res); for I in Natural loop @@ -1852,18 +1907,18 @@ package body Sem_Assocs is if Is_Null (R) then R := El; else - if First_Error then + if Nbr_Errors = 0 then Error_Msg_Sem (+Assoc, "many possible actual subprogram for %n:", +Inter); Error_Msg_Sem (+Assoc, " %n declared at %l", (+R, + R)); - First_Error := False; else Error_Msg_Sem (+Assoc, " %n declared at %l", (+El, +El)); end if; + Nbr_Errors := Nbr_Errors + 1; end if; end if; end loop; @@ -1881,7 +1936,7 @@ package body Sem_Assocs is end loop; end if; return; - elsif First_Error then + elsif Nbr_Errors > 0 then return; end if; Free_Overload_List (Res); @@ -1892,6 +1947,7 @@ package body Sem_Assocs is end case; Set_Named_Entity (Actual, Res); + Xrefs.Xref_Name (Actual); Set_Use_Flag (Res, True); end Sem_Association_Subprogram; diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb index 9fac6d50e..e75092a33 100644 --- a/src/vhdl/sem_decls.adb +++ b/src/vhdl/sem_decls.adb @@ -444,6 +444,7 @@ package body Sem_Decls is Set_Return_Type (Operation, Return_Type); Set_Identifier (Operation, Name); Set_Visible_Flag (Operation, True); + Set_Pure_Flag (Operation, True); Compute_Subprogram_Hash (Operation); return Operation; end Create_Implicit_Interface_Function; @@ -489,6 +490,7 @@ package body Sem_Decls is procedure Sem_Interface_Subprogram_Declaration (Inter : Iir) is begin Sem_Subprogram_Specification (Inter); + Xref_Decl (Inter); end Sem_Interface_Subprogram_Declaration; procedure Sem_Interface_Chain (Interface_Chain: Iir; diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index 9807fc24a..545d3937a 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -967,8 +967,7 @@ package body Sem_Expr is -- Check purity rules when SUBPRG calls CALLEE. -- Both SUBPRG and CALLEE are subprogram declarations. -- Update purity_state/impure_depth of SUBPRG if it is a procedure. - procedure Sem_Call_Purity_Check (Subprg : Iir; Callee : Iir; Loc : Iir) - is + procedure Sem_Call_Purity_Check (Subprg : Iir; Callee : Iir; Loc : Iir) is begin if Callee = Subprg then return; @@ -991,7 +990,8 @@ package body Sem_Expr is end case; case Get_Kind (Callee) is - when Iir_Kind_Function_Declaration => + when Iir_Kind_Function_Declaration + | Iir_Kind_Interface_Function_Declaration => if Get_Pure_Flag (Callee) then -- Pure functions may be called anywhere. return; diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb index 147073063..bbe5ad4d7 100644 --- a/src/vhdl/sem_inst.adb +++ b/src/vhdl/sem_inst.adb @@ -21,6 +21,7 @@ with Types; use Types; with Files_Map; with Iirs_Utils; use Iirs_Utils; with Errorout; use Errorout; +with Sem; package body Sem_Inst is -- Table of origin. This is an extension of vhdl nodes to track the @@ -573,7 +574,7 @@ package body Sem_Inst is when Iir_Kind_Interface_Type_Declaration => Set_Type (Res, Get_Type (Inter)); when Iir_Kinds_Interface_Subprogram_Declaration => - null; + Sem.Compute_Subprogram_Hash (Res); when others => Error_Kind ("instantiate_generic_chain", Res); end case; @@ -740,7 +741,8 @@ package body Sem_Inst is if Is_Valid (Formal) then loop case Get_Kind (Formal) is - when Iir_Kind_Simple_Name => + when Iir_Kind_Simple_Name + | Iir_Kind_Operator_Symbol => Set_Named_Entity (Formal, Get_Instance (Get_Named_Entity (Formal))); exit; @@ -782,7 +784,7 @@ package body Sem_Inst is declare Inter_Type_Def : constant Iir := Get_Type (Get_Association_Interface (Assoc, Inter)); - Actual_Type : constant Iir := Get_Type (Get_Actual (Assoc)); + Actual_Type : constant Iir := Get_Actual_Type (Assoc); begin Set_Instance (Inter_Type_Def, Actual_Type); end; @@ -861,8 +863,7 @@ package body Sem_Inst is function Instantiate_Package_Body (Inst : Iir) return Iir is - Inst_Decl : constant Iir := Get_Package_Origin (Inst); - Pkg : constant Iir := Get_Uninstantiated_Package_Decl (Inst_Decl); + Pkg : constant Iir := Get_Uninstantiated_Package_Decl (Inst); Prev_Instance_File : constant Source_File_Entry := Instance_File; Mark : constant Instance_Index_Type := Prev_Instance_Table.Last; Res : Iir; @@ -877,7 +878,6 @@ package body Sem_Inst is Set_Instance (Pkg, Inst); declare Pkg_Hdr : constant Iir := Get_Package_Header (Pkg); - Inst_Hdr : constant Iir := Get_Package_Header (Inst); Pkg_El : Iir; Inst_El : Iir; Inter_El : Iir; @@ -886,7 +886,7 @@ package body Sem_Inst is -- In the body, references to interface object are redirected to the -- instantiated interface objects. Pkg_El := Get_Generic_Chain (Pkg_Hdr); - Inst_El := Get_Generic_Chain (Inst_Hdr); + Inst_El := Get_Generic_Chain (Inst); while Is_Valid (Pkg_El) loop if Get_Kind (Pkg_El) in Iir_Kinds_Interface_Object_Declaration then Set_Instance (Pkg_El, Inst_El); @@ -897,8 +897,8 @@ package body Sem_Inst is -- In the body, references to interface type are substitued to the -- mapped type. - Inst_El := Get_Generic_Map_Aspect_Chain (Inst_Hdr); - Inter_El := Get_Generic_Chain (Inst_Hdr); + Inst_El := Get_Generic_Map_Aspect_Chain (Inst); + Inter_El := Get_Generic_Chain (Inst); while Is_Valid (Inst_El) loop case Get_Kind (Inst_El) is when Iir_Kind_Association_Element_Type => diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index 26672b385..0d03b8d4f 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -386,7 +386,13 @@ package body Sem_Names is | Iir_Kind_For_Generate_Statement => null; when Iir_Kind_Package_Declaration => - null; + declare + Header : constant Iir := Get_Package_Header (Decl); + begin + if Is_Valid (Header) then + Iterator_Decl_Chain (Get_Generic_Chain (Header), Id); + end if; + end; when Iir_Kind_Package_Instantiation_Declaration | Iir_Kind_Interface_Package_Declaration => Iterator_Decl_Chain (Get_Generic_Chain (Decl), Id); @@ -2116,6 +2122,7 @@ package body Sem_Names is -- LRM93 §6.3 -- This form of expanded name is only allowed within the -- construct itself. + -- FIXME: LRM08 12.3 Visibility h) if not Kind_In (Prefix, Iir_Kind_Package_Declaration, Iir_Kind_Package_Instantiation_Declaration) @@ -2645,7 +2652,8 @@ package body Sem_Names is when Iir_Kind_Procedure_Declaration | Iir_Kind_Interface_Procedure_Declaration => - Error_Msg_Sem (+Name, "function name is a procedure"); + Error_Msg_Sem (+Name, "cannot call %n in an expression", + +Prefix); when Iir_Kinds_Process_Statement | Iir_Kind_Component_Declaration diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 015bca20d..6ed07c180 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -755,21 +755,19 @@ package body Trans.Chap2 is Pop_Instance_Factory (Info.Package_Body_Scope'Access); end Pop_Package_Instance_Factory; - procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration) + -- Translate a package declaration or a macro-expanded package + -- instantiation. HEADER is the node containing generic and generic_map. + procedure Translate_Package (Decl : Iir; Header : Iir) is Is_Nested : constant Boolean := Is_Nested_Package (Decl); - Header : constant Iir := Get_Package_Header (Decl); + Is_Uninstantiated : constant Boolean := + Get_Kind (Decl) = Iir_Kind_Package_Declaration + and then Is_Uninstantiated_Package (Decl); Mark : Id_Mark_Type; Info : Ortho_Info_Acc; Interface_List : O_Inter_List; Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; - Bod : Iir; begin - -- Skip uninstantiated package that have to be macro-expanded. - if Get_Macro_Expanded_Flag (Decl) then - return; - end if; - Info := Add_Info (Decl, Kind_Package); if Is_Nested then @@ -777,7 +775,7 @@ package body Trans.Chap2 is end if; -- Translate declarations. - if Is_Uninstantiated_Package (Decl) then + if Is_Uninstantiated then -- Create an instance for the spec. Push_Instance_Factory (Info.Package_Spec_Scope'Access); Chap4.Translate_Generic_Chain (Header); @@ -806,10 +804,6 @@ package body Trans.Chap2 is Chap4.Translate_Generic_Chain (Header); end if; Chap4.Translate_Declaration_Chain (Decl); - Bod := Get_Package_Instantiation_Bodies_Chain (Decl); - if Is_Valid (Bod) then - Chap4.Translate_Declaration_Chain (Bod); - end if; if not Is_Nested then Info.Package_Elab_Var := Create_Var (Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type); @@ -821,10 +815,6 @@ package body Trans.Chap2 is -- For nested package, this will be translated when translating -- subprograms. Chap4.Translate_Declaration_Chain_Subprograms (Decl); - Bod := Get_Package_Instantiation_Bodies_Chain (Decl); - if Is_Valid (Bod) then - Chap4.Translate_Declaration_Chain_Subprograms (Bod); - end if; end if; -- Declare elaborator for the body. @@ -837,7 +827,7 @@ package body Trans.Chap2 is (Interface_List, Info.Package_Elab_Body_Subprg); end if; - if Is_Uninstantiated_Package (Decl) then + if Is_Uninstantiated then Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); -- The spec elaborator has a spec instance argument. @@ -862,16 +852,16 @@ package body Trans.Chap2 is if Global_Storage = O_Storage_Public then -- Create elaboration procedure for the spec - Elab_Package (Decl); + Elab_Package (Decl, Header); end if; end if; - if Is_Uninstantiated_Package (Decl) then + if Is_Uninstantiated then Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); end if; Save_Local_Identifier (Info.Package_Local_Id); - if Is_Uninstantiated_Package (Decl) + if Is_Uninstantiated and then not Get_Need_Body (Decl) and then Get_Package_Body (Decl) = Null_Iir then @@ -884,18 +874,58 @@ package body Trans.Chap2 is if Is_Nested then Pop_Identifier_Prefix (Mark); end if; + end Translate_Package; + + procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration) + is + El : Iir; + Bod : Iir; + begin + -- Skip uninstantiated package that have to be macro-expanded. + if Get_Macro_Expanded_Flag (Decl) then + return; + end if; + + Translate_Package (Decl, Get_Package_Header (Decl)); + + if Global_Storage = O_Storage_Public then + -- If there are package instances declared that were macro-expanded + -- and if the package has (possibly) no body, translate the bodies + -- of the instances. + if Get_Need_Instance_Bodies (Decl) +-- and not Get_Need_Body (Decl) + then + El := Get_Declaration_Chain (Decl); + while Is_Valid (El) loop + if Get_Kind (El) = Iir_Kind_Package_Instantiation_Declaration + then + Bod := Get_Package_Body (El); + if Is_Valid (Bod) then + Translate_Package_Body (Bod); + end if; + end if; + El := Get_Chain (El); + end loop; + end if; + end if; end Translate_Package_Declaration; procedure Translate_Package_Body (Bod : Iir_Package_Body) is Is_Nested : constant Boolean := Is_Nested_Package (Bod); Spec : constant Iir_Package_Declaration := Get_Package (Bod); + + -- True if the package spec is a package declaration. It could be a + -- package instantiation declaration. + Is_Spec_Decl : constant Boolean := + Get_Kind (Spec) = Iir_Kind_Package_Declaration; + Info : constant Ortho_Info_Acc := Get_Info (Spec); Prev_Storage : constant O_Storage := Global_Storage; Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; Mark : Id_Mark_Type; begin - if Get_Macro_Expanded_Flag (Spec) then + if Is_Spec_Decl and then Get_Macro_Expanded_Flag (Spec) then return; end if; @@ -904,7 +934,7 @@ package body Trans.Chap2 is end if; -- Translate declarations. - if Is_Uninstantiated_Package (Spec) then + if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then Push_Package_Instance_Factory (Spec); -- Translate the specifications. @@ -921,7 +951,7 @@ package body Trans.Chap2 is return; end if; - if not Is_Uninstantiated_Package (Spec) then + if not (Is_Spec_Decl and then Is_Uninstantiated_Package (Spec)) then Restore_Local_Identifier (Info.Package_Local_Id); Chap4.Translate_Declaration_Chain (Bod); @@ -935,7 +965,7 @@ package body Trans.Chap2 is Rtis.Generate_Unit (Bod); end if; - if Is_Uninstantiated_Package (Spec) then + if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then -- Add access to the specs. Subprgs.Push_Subprg_Instance (Info.Package_Body_Scope'Access, Info.Package_Body_Ptr_Type, @@ -945,13 +975,13 @@ package body Trans.Chap2 is Info.Package_Body_Scope'Access); end if; - if not Is_Nested then + if not Is_Nested or else not Is_Spec_Decl then -- Translate subprograms. For nested package, this has to be called -- when translating subprograms. Chap4.Translate_Declaration_Chain_Subprograms (Bod); end if; - if Is_Uninstantiated_Package (Spec) then + if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then Clear_Scope (Info.Package_Spec_Scope); Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); end if; @@ -967,7 +997,8 @@ package body Trans.Chap2 is end if; end Translate_Package_Body; - procedure Elab_Package (Spec : Iir_Package_Declaration) + -- Elaborate a package or a package instantiation. + procedure Elab_Package (Spec : Iir; Header : Iir) is Is_Nested : constant Boolean := Is_Nested_Package (Spec); Info : constant Ortho_Info_Acc := Get_Info (Spec); @@ -982,8 +1013,8 @@ package body Trans.Chap2 is Elab_Dependence (Get_Design_Unit (Spec)); - if not Is_Uninstantiated_Package (Spec) - and then Get_Kind (Get_Parent (Spec)) = Iir_Kind_Design_Unit + if not (Get_Kind (Spec) = Iir_Kind_Package_Declaration + and then Is_Uninstantiated_Package (Spec)) then -- Register the top level package. This is done dynamically, as -- we know only during elaboration that the design depends on a @@ -999,9 +1030,11 @@ package body Trans.Chap2 is Open_Temp; end if; - if Is_Generic_Mapped_Package (Spec) then + if Is_Valid (Header) + and then Is_Valid (Get_Generic_Map_Aspect_Chain (Header)) + then Chap5.Elab_Generic_Map_Aspect - (Get_Package_Header (Spec), Get_Package_Header (Spec), + (Header, Header, (Info.Package_Spec_Scope'Access, Info.Package_Spec_Scope)); end if; Chap4.Elab_Declaration_Chain (Spec, Final); @@ -1017,16 +1050,23 @@ package body Trans.Chap2 is procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir) is + Is_Spec_Decl : constant Boolean := + Get_Kind (Spec) = Iir_Kind_Package_Declaration; + Info : constant Ortho_Info_Acc := Get_Info (Spec); If_Blk : O_If_Block; Constr : O_Assoc_List; Final : Boolean; begin + if Is_Spec_Decl and then Get_Macro_Expanded_Flag (Spec) then + return; + end if; + Start_Subprogram_Body (Info.Package_Elab_Body_Subprg); Push_Local_Factory; Subprgs.Start_Subprg_Instance_Use (Info.Package_Elab_Body_Instance); - if Is_Uninstantiated_Package (Spec) then + if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then Set_Scope_Via_Field (Info.Package_Spec_Scope, Info.Package_Spec_Field, Info.Package_Body_Scope'Access); @@ -1053,7 +1093,7 @@ package body Trans.Chap2 is Close_Temp; end if; - if Is_Uninstantiated_Package (Spec) then + if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then Clear_Scope (Info.Package_Spec_Scope); end if; @@ -1346,8 +1386,25 @@ package body Trans.Chap2 is Info : Ortho_Info_Acc; Interface_List : O_Inter_List; begin - -- Canon must have replaced instatiation by generic-mapped packages. - pragma Assert (not Get_Macro_Expanded_Flag (Spec)); + if Get_Macro_Expanded_Flag (Spec) then + -- Macro-expanded instantiations are translated like a package. + Translate_Package (Inst, Inst); + + -- For top-level package, generate code for the body. + if Global_Storage = O_Storage_Public + and then not Is_Nested_Package (Inst) + then + declare + Bod : constant Iir := Get_Package_Body (Inst); + begin + if Is_Valid (Bod) then + Translate_Package_Body (Bod); + end if; + end; + end if; + + return; + end if; Instantiate_Info_Package (Inst); Info := Get_Info (Inst); @@ -1402,6 +1459,11 @@ package body Trans.Chap2 is Info : constant Ortho_Info_Acc := Get_Info (Inst); Constr : O_Assoc_List; begin + if Get_Macro_Expanded_Flag (Spec) then + Elab_Package (Inst, Inst); + return; + end if; + Set_Scope_Via_Var (Pkg_Info.Package_Body_Scope, Info.Package_Instance_Body_Var); @@ -1423,22 +1485,12 @@ package body Trans.Chap2 is Clear_Scope (Pkg_Info.Package_Body_Scope); end Elab_Package_Instantiation_Declaration; - procedure Elab_Dependence_Package (Pkg : Iir_Package_Declaration) + procedure Elab_Dependence_Package (Pkg : Iir) is Info : Ortho_Info_Acc; If_Blk : O_If_Block; Constr : O_Assoc_List; begin - -- Std.Standard is pre-elaborated. - if Pkg = Standard_Package then - return; - end if; - - -- Nothing to do for uninstantiated package. - if Is_Uninstantiated_Package (Pkg) then - return; - end if; - -- Call the package elaborator only if not already elaborated. Info := Get_Info (Pkg); Start_If_Stmt @@ -1451,13 +1503,36 @@ package body Trans.Chap2 is Finish_If_Stmt (If_Blk); end Elab_Dependence_Package; - procedure Elab_Dependence_Package_Instantiation (Pkg : Iir) - is - Info : constant Ortho_Info_Acc := Get_Info (Pkg); - Constr : O_Assoc_List; + procedure Elab_Dependence_Package_Declaration + (Pkg : Iir_Package_Declaration) is begin - Start_Association (Constr, Info.Package_Instance_Elab_Subprg); - New_Procedure_Call (Constr); + -- Std.Standard is pre-elaborated. + if Pkg = Standard_Package then + return; + end if; + + -- Nothing to do for uninstantiated package. + if Is_Uninstantiated_Package (Pkg) then + return; + end if; + + Elab_Dependence_Package (Pkg); + end Elab_Dependence_Package_Declaration; + + procedure Elab_Dependence_Package_Instantiation (Pkg : Iir) is + begin + if Get_Macro_Expanded_Flag (Get_Uninstantiated_Package_Decl (Pkg)) then + -- Handled as a normal package + Elab_Dependence_Package (Pkg); + else + declare + Info : constant Ortho_Info_Acc := Get_Info (Pkg); + Constr : O_Assoc_List; + begin + Start_Association (Constr, Info.Package_Instance_Elab_Subprg); + New_Procedure_Call (Constr); + end; + end if; end Elab_Dependence_Package_Instantiation; procedure Elab_Dependence (Design_Unit: Iir_Design_Unit) @@ -1475,7 +1550,7 @@ package body Trans.Chap2 is Library_Unit := Get_Library_Unit (Design); case Get_Kind (Library_Unit) is when Iir_Kind_Package_Declaration => - Elab_Dependence_Package (Library_Unit); + Elab_Dependence_Package_Declaration (Library_Unit); when Iir_Kind_Package_Instantiation_Declaration => Elab_Dependence_Package_Instantiation (Library_Unit); when Iir_Kind_Entity_Declaration => diff --git a/src/vhdl/translate/trans-chap2.ads b/src/vhdl/translate/trans-chap2.ads index 74247d6e1..4d81c2bf6 100644 --- a/src/vhdl/translate/trans-chap2.ads +++ b/src/vhdl/translate/trans-chap2.ads @@ -35,7 +35,7 @@ package Trans.Chap2 is procedure Translate_Package_Body (Bod : Iir_Package_Body); procedure Translate_Package_Instantiation_Declaration (Inst : Iir); - procedure Elab_Package (Spec : Iir_Package_Declaration); + procedure Elab_Package (Spec : Iir; Header : Iir); procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir); procedure Elab_Package_Instantiation_Declaration (Inst : Iir); diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 14d04d486..ba5853935 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -2388,6 +2388,18 @@ package body Trans.Chap4 is Translate_Declaration_Chain_Subprograms (El); Pop_Identifier_Prefix (Mark); end; + when Iir_Kind_Package_Instantiation_Declaration => + if Get_Macro_Expanded_Flag + (Get_Uninstantiated_Package_Decl (El)) + then + declare + Mark : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (El)); + Translate_Declaration_Chain_Subprograms (El); + Pop_Identifier_Prefix (Mark); + end; + end if; when others => null; end case; @@ -2485,7 +2497,7 @@ package body Trans.Chap4 is null; when Iir_Kind_Package_Declaration => - Chap2.Elab_Package (Decl); + Chap2.Elab_Package (Decl, Get_Package_Header (Decl)); -- FIXME: finalizer when Iir_Kind_Package_Body => declare diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index 77c12a358..7623b5032 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -2302,24 +2302,30 @@ package body Trans.Rtis is | Iir_Kind_Group_Declaration => null; when Iir_Kind_Package_Declaration => - declare - Mark : Id_Mark_Type; - begin - Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); - Generate_Block (Decl, Parent_Rti); - Pop_Identifier_Prefix (Mark); - end; + if Get_Info (Decl) /= null then + -- Do not generate RTIs for untranslated packages. + declare + Mark : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); + Generate_Block (Decl, Parent_Rti); + Pop_Identifier_Prefix (Mark); + end; + end if; when Iir_Kind_Package_Body => - declare - Mark : Id_Mark_Type; - Mark1 : Id_Mark_Type; - begin - Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); - Push_Identifier_Prefix (Mark1, "BODY"); - Generate_Block (Decl, Parent_Rti); - Pop_Identifier_Prefix (Mark1); - Pop_Identifier_Prefix (Mark); - end; + if Get_Info (Get_Package (Decl)) /= null then + -- Do not generate RTIs for untranslated packages. + declare + Mark : Id_Mark_Type; + Mark1 : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); + Push_Identifier_Prefix (Mark1, "BODY"); + Generate_Block (Decl, Parent_Rti); + Pop_Identifier_Prefix (Mark1); + Pop_Identifier_Prefix (Mark); + end; + end if; when Iir_Kind_Package_Instantiation_Declaration => -- FIXME: todo @@ -2600,7 +2606,8 @@ package body Trans.Rtis is Field_Off := O_Cnode_Null; case Get_Kind (Blk) is - when Iir_Kind_Package_Declaration => + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration => Kind := Ghdl_Rtik_Package; Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti); when Iir_Kind_Package_Body => @@ -2741,7 +2748,8 @@ package body Trans.Rtis is when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => Info.Process_Rti_Const := Rti; - when Iir_Kind_Package_Declaration => + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration => Info.Package_Rti_Const := Rti; when Iir_Kind_Package_Body => -- Replace package declaration RTI with the body one. @@ -2855,8 +2863,9 @@ package body Trans.Rtis is -- Compute parent RTI. case Get_Kind (Lib_Unit) is when Iir_Kind_Package_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Configuration_Declaration => + | Iir_Kind_Entity_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Package_Instantiation_Declaration => -- The library. declare Lib : Iir_Library_Declaration; diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 1a4703f95..bc69661bb 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -289,6 +289,12 @@ package body Translation is New_Debug_Comment_Decl ("package declaration " & Image_Identifier (Lib_Unit)); Chap2.Translate_Package_Declaration (Lib_Unit); + if Get_Package_Origin (Lib_Unit) /= Null_Iir + and then Get_Package_Body (Lib_Unit) /= Null_Iir + then + -- Corresponding body for package instantiation. + Chap2.Translate_Package_Body (Get_Package_Body (Lib_Unit)); + end if; when Iir_Kind_Package_Body => New_Debug_Comment_Decl ("package body " & Image_Identifier (Lib_Unit)); diff --git a/testsuite/gna/bug058/tb.vhdl b/testsuite/gna/bug058/tb.vhdl new file mode 100644 index 000000000..779a5d6f6 --- /dev/null +++ b/testsuite/gna/bug058/tb.vhdl @@ -0,0 +1,22 @@ +package pkg1 is + generic (type t; c : natural); + generic map (t => natural, c => 5); + + function f return natural; +end pkg1; + +package body pkg1 is + function f return natural is + variable v : t; + begin + return c; + end f; +end pkg1; + +entity tb is +end tb; + +architecture behav of tb is +begin + assert work.pkg1.f = 5; +end behav; diff --git a/testsuite/gna/bug058/tb1.vhdl b/testsuite/gna/bug058/tb1.vhdl new file mode 100644 index 000000000..1e183bec2 --- /dev/null +++ b/testsuite/gna/bug058/tb1.vhdl @@ -0,0 +1,21 @@ +package pkg1 is + generic (type t; c : t); + generic map (t => natural, c => 5); + + function f return t; +end pkg1; + +package body pkg1 is + function f return t is + begin + return c; + end f; +end pkg1; + +entity tb is +end tb; + +architecture behav of tb is +begin + assert work.pkg1.f = 5; +end behav; diff --git a/testsuite/gna/bug058/tb2.vhdl b/testsuite/gna/bug058/tb2.vhdl new file mode 100644 index 000000000..98f7bc5c1 --- /dev/null +++ b/testsuite/gna/bug058/tb2.vhdl @@ -0,0 +1,20 @@ +entity tb2 is +end tb2; + +architecture behav of tb2 is + package pkg1 is + generic (c : natural); + generic map (c => 5); + + function f return natural; + end pkg1; + + package body pkg1 is + function f return natural is + begin + return c; + end f; + end pkg1; +begin + assert pkg1.f = 5 severity failure; +end behav; diff --git a/testsuite/gna/bug058/testsuite.sh b/testsuite/gna/bug058/testsuite.sh new file mode 100755 index 000000000..737932da6 --- /dev/null +++ b/testsuite/gna/bug058/testsuite.sh @@ -0,0 +1,15 @@ +#! /bin/sh + +. ../../testenv.sh + +GHDL_STD_FLAGS=--std=08 + +analyze tb.vhdl +elab_simulate tb + +analyze tb2.vhdl +elab_simulate tb2 + +clean + +echo "Test successful" diff --git a/testsuite/gna/bug063/dff.expected b/testsuite/gna/bug063/dff.expected new file mode 100644 index 000000000..3e8fb698b --- /dev/null +++ b/testsuite/gna/bug063/dff.expected @@ -0,0 +1,4 @@ +dff.vhdl:10:25: invalid use of UTF8 character for ' +dff.vhdl:11:23: invalid use of UTF8 character for ' +dff.vhdl:12:23: invalid use of UTF8 character for ' +dff.vhdl:12:42: invalid use of UTF8 character for ' diff --git a/testsuite/gna/bug063/dff.vhdl b/testsuite/gna/bug063/dff.vhdl new file mode 100644 index 000000000..c1c7809a9 --- /dev/null +++ b/testsuite/gna/bug063/dff.vhdl @@ -0,0 +1,17 @@ +entity DFF is + port (CLK, CLEAR, D : in bit; + Q : out bit); +end; + +architecture BEHAV of DFF is +begin +process (CLK, CLEAR) + begin + if (CLEAR = ‘1’) then + Q <= ‘0’; + elsif (CLK’event and CLK = ‘1’) then + Q <= D; + end if; + end process; +end BEHAV; + diff --git a/testsuite/gna/bug063/testsuite.sh b/testsuite/gna/bug063/testsuite.sh new file mode 100755 index 000000000..5bb108e0f --- /dev/null +++ b/testsuite/gna/bug063/testsuite.sh @@ -0,0 +1,11 @@ +#! /bin/sh + +. ../../testenv.sh + +analyze_failure dff.vhdl 2> dff.out +diff dff.out dff.expected + +rm -f dff.out +clean + +echo "Test successful" diff --git a/testsuite/gna/bug064/repro.vhdl b/testsuite/gna/bug064/repro.vhdl new file mode 100644 index 000000000..32c94b820 --- /dev/null +++ b/testsuite/gna/bug064/repro.vhdl @@ -0,0 +1,17 @@ +package gen is + generic (type t); +end gen; + +entity e is +end entity; + +library ieee; +use ieee.std_logic_1164.all; + +architecture a of e is + subtype T_DATA is std_logic_vector(31 downto 0); + type T_DATA_VECTOR is array(natural range <>) of T_DATA; + + package pkg is new work.gen (t => t_data_vector); +begin +end architecture; diff --git a/testsuite/gna/bug064/testsuite.sh b/testsuite/gna/bug064/testsuite.sh new file mode 100755 index 000000000..b44fe1761 --- /dev/null +++ b/testsuite/gna/bug064/testsuite.sh @@ -0,0 +1,10 @@ +#! /bin/sh + +. ../../testenv.sh + +export GHDL_STD_FLAGS=--std=08 +analyze_failure repro.vhdl + +clean + +echo "Test successful" diff --git a/testsuite/gna/bug065/repro.vhdl b/testsuite/gna/bug065/repro.vhdl new file mode 100644 index 000000000..70035bbd3 --- /dev/null +++ b/testsuite/gna/bug065/repro.vhdl @@ -0,0 +1,17 @@ +package gen is + generic (type t); +end gen; + +entity e is +end entity; + +library ieee; +use ieee.std_logic_1164.all; + +architecture a of e is + subtype T_DATA is std_logic_vector(31 downto 0); + type T_DATA_VECTOR is array(natural range <>) of T_DATA; + + package pkg is new work.gen generic map (t => t_data_vector); +begin +end architecture; diff --git a/testsuite/gna/bug065/testsuite.sh b/testsuite/gna/bug065/testsuite.sh new file mode 100755 index 000000000..f4a473727 --- /dev/null +++ b/testsuite/gna/bug065/testsuite.sh @@ -0,0 +1,11 @@ +#! /bin/sh + +. ../../testenv.sh + +export GHDL_STD_FLAGS=--std=08 +analyze repro.vhdl +elab_simulate e + +clean + +echo "Test successful" diff --git a/testsuite/gna/bug066/repro.vhdl b/testsuite/gna/bug066/repro.vhdl new file mode 100644 index 000000000..3ebe995fc --- /dev/null +++ b/testsuite/gna/bug066/repro.vhdl @@ -0,0 +1,17 @@ +package foo is + procedure bar (signal a, b : in bit; signal c : out bit); + procedure bar (signal a, b, c : in bit; signal d : out bit); +end package foo; + +package body foo is + procedure bar (signal a, b : in bit; signal c : out bit) is + begin + c <= a xor b; + end procedure bar; + + procedure bar (signal a, b, c : in bit; signal d : out bit) + is + begin + d <= a xor b xor c; + end procedure bar; +end package body foo; diff --git a/testsuite/gna/bug066/testsuite.sh b/testsuite/gna/bug066/testsuite.sh new file mode 100755 index 000000000..a08478e96 --- /dev/null +++ b/testsuite/gna/bug066/testsuite.sh @@ -0,0 +1,9 @@ +#! /bin/sh + +. ../../testenv.sh + +analyze repro.vhdl + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue107/test1.vhdl b/testsuite/gna/issue107/test1.vhdl new file mode 100644 index 000000000..4e3e74174 --- /dev/null +++ b/testsuite/gna/issue107/test1.vhdl @@ -0,0 +1,28 @@ +library ieee; + use ieee.std_logic_1164.all; + +entity ApbMasterBfmE is + generic ( + G_ADDR_WIDTH : positive := 8; --* address bus width + G_DATA_WIDTH : positive := 8; --* data bus width + G_SLAVE_COUNT : positive := 1 + ); + port ( + PRreset_n_i : in std_logic; + PClk_i : in std_logic + ); +end entity ApbMasterBfmE; + + +package MyTestPkg is new work.TestPkg generic map (G_TEST => 17); + + +architecture sim of ApbMasterBfmE is + + use work.MyTestPkg.all; + +begin + + assert false report "done" severity note; + +end architecture sim; diff --git a/testsuite/gna/issue107/testpkg.vhdl b/testsuite/gna/issue107/testpkg.vhdl new file mode 100644 index 000000000..917b08976 --- /dev/null +++ b/testsuite/gna/issue107/testpkg.vhdl @@ -0,0 +1,16 @@ +package TestPkg is + + generic ( + G_TEST : positive := 8 + ); +end package TestPkg; + + +package body TestPkg is + + procedure TestReport is + begin + report "G_TEST :" & to_string(G_TEST); + end procedure; + +end package body; diff --git a/testsuite/gna/issue107/testsuite.sh b/testsuite/gna/issue107/testsuite.sh new file mode 100755 index 000000000..4f35fc111 --- /dev/null +++ b/testsuite/gna/issue107/testsuite.sh @@ -0,0 +1,12 @@ +#! /bin/sh + +. ../../testenv.sh + +GHDL_STD_FLAGS=--std=08 + +analyze testpkg.vhdl +analyze test1.vhdl + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue151/tb.vhdl b/testsuite/gna/issue151/tb.vhdl new file mode 100644 index 000000000..8aadd3f4b --- /dev/null +++ b/testsuite/gna/issue151/tb.vhdl @@ -0,0 +1,19 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +entity test is + port (in_vec : in std_logic_vector); +end entity; + +architecture rtl of test is +signal A : natural; +begin + + gen2 : if in_vec'length <= 2 generate + A <= 2; + end generate; + gen3 : if in_vec'length > 2 generate + A <= 3; + end generate; +end architecture; diff --git a/testsuite/gna/issue151/testsuite.sh b/testsuite/gna/issue151/testsuite.sh new file mode 100755 index 000000000..a77ea351b --- /dev/null +++ b/testsuite/gna/issue151/testsuite.sh @@ -0,0 +1,8 @@ +#! /bin/sh + +. ../../testenv.sh + +analyze tb.vhdl +clean + +echo "Test successful" diff --git a/testsuite/gna/issue199/repro.vhdl b/testsuite/gna/issue199/repro.vhdl new file mode 100644 index 000000000..cc688af52 --- /dev/null +++ b/testsuite/gna/issue199/repro.vhdl @@ -0,0 +1,30 @@ +ENTITY repro IS +END repro; + +package genpkg is + generic (function match (l, R : integer) return boolean); + procedure comp (l, R : integer; res : out boolean); +end genpkg; + +package body genpkg is + procedure comp (l, R : integer; res : out boolean) is + begin + res := match (l, r); + end comp; +end genpkg; + +package my_pkg is new work.genpkg generic map (match => "="); + +use work.my_pkg.all; + +ARCHITECTURE behav OF repro IS +BEGIN + PROCESS + variable ok : boolean; + BEGIN + comp (5, 2 + 3, ok); + --ok := my_pkg.comp (5, 2 + 3); + assert ok severity error; + wait; + END PROCESS; +end behav; diff --git a/testsuite/gna/issue199/testsuite.sh b/testsuite/gna/issue199/testsuite.sh new file mode 100755 index 000000000..8d22a2073 --- /dev/null +++ b/testsuite/gna/issue199/testsuite.sh @@ -0,0 +1,11 @@ +#! /bin/sh + +. ../../testenv.sh + +export GHDL_STD_FLAGS=--std=08 +analyze repro.vhdl +elab_simulate repro + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue201/repro.vhdl b/testsuite/gna/issue201/repro.vhdl new file mode 100644 index 000000000..3f3ce9ac4 --- /dev/null +++ b/testsuite/gna/issue201/repro.vhdl @@ -0,0 +1,14 @@ +package gen is + generic (type t); +end gen; + +entity e is +end entity; + +architecture a of e is + subtype T_DATA is bit_vector(31 downto 0); + type T_DATA_VECTOR is array(natural range <>) of T_DATA; + + package pkg is new work.gen generic map (t => t_data_vector (31 downto 0)); +begin +end architecture; diff --git a/testsuite/gna/issue201/testsuite.sh b/testsuite/gna/issue201/testsuite.sh new file mode 100755 index 000000000..f4a473727 --- /dev/null +++ b/testsuite/gna/issue201/testsuite.sh @@ -0,0 +1,11 @@ +#! /bin/sh + +. ../../testenv.sh + +export GHDL_STD_FLAGS=--std=08 +analyze repro.vhdl +elab_simulate e + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue204/repro.vhdl b/testsuite/gna/issue204/repro.vhdl new file mode 100644 index 000000000..09abdbbcb --- /dev/null +++ b/testsuite/gna/issue204/repro.vhdl @@ -0,0 +1,22 @@ +package SortListGenericPkg is + generic ( + type ElementType; + type ArrayofElementType; + function array_length(A : ArrayofElementType) return natural; + function element_get(A : ArrayofElementType; index : natural) return ElementType + ); + + function inside (constant E : ElementType; constant A : in ArrayofElementType) return boolean ; +end package; + +package body SortListGenericPkg is + function inside (constant E : ElementType; constant A : in ArrayofElementType) return boolean is + begin + for i in 0 to array_length(A) - 1 loop --A'range loop + if E = element_get(A, i) then + return TRUE ; + end if ; + end loop ; + return FALSE ; + end function inside ; +end package body; diff --git a/testsuite/gna/issue204/testsuite.sh b/testsuite/gna/issue204/testsuite.sh new file mode 100755 index 000000000..7b37332aa --- /dev/null +++ b/testsuite/gna/issue204/testsuite.sh @@ -0,0 +1,10 @@ +#! /bin/sh + +. ../../testenv.sh + +export GHDL_STD_FLAGS=--std=08 +analyze repro.vhdl + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue205/repro.vhdl b/testsuite/gna/issue205/repro.vhdl new file mode 100644 index 000000000..d981e81d0 --- /dev/null +++ b/testsuite/gna/issue205/repro.vhdl @@ -0,0 +1,7 @@ +package SortListGenericPkg is + generic ( + type ElementType; + function "<"(L : ElementType; R : ElementType) return boolean; + function "<="(L : ElementType; R : ElementType) return boolean + ); +end package; diff --git a/testsuite/gna/issue205/repro1.vhdl b/testsuite/gna/issue205/repro1.vhdl new file mode 100644 index 000000000..79ccfd54f --- /dev/null +++ b/testsuite/gna/issue205/repro1.vhdl @@ -0,0 +1,33 @@ +package SortListGenericPkg is + generic ( + type ElementType; + function "<"(L : ElementType; R : ElementType) return boolean; + function "<="(L : ElementType; R : ElementType) return boolean + ); + function f (a, b : ElementType) return boolean; +end package; + +package body SortListGenericPkg is + function f (a, b : ElementType) return boolean is + begin + return a <= b; + end f; +end; + +package mysort is new work.SortListGenericPkg generic map (natural, "<", "<="); + +entity repro is +end repro; + +use work.mysort.all; +architecture behav of repro +is +begin + process + variable ok : boolean; + begin + ok := f (3, 12); + assert ok report "bad comparaison" severity failure; + wait; + end process; +end behav; diff --git a/testsuite/gna/issue205/testsuite.sh b/testsuite/gna/issue205/testsuite.sh new file mode 100755 index 000000000..eefe1e0b3 --- /dev/null +++ b/testsuite/gna/issue205/testsuite.sh @@ -0,0 +1,11 @@ +#! /bin/sh + +. ../../testenv.sh + +export GHDL_STD_FLAGS=--std=08 +analyze repro1.vhdl +elab_simulate repro + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue207/pack.vhd b/testsuite/gna/issue207/pack.vhd new file mode 100644 index 000000000..124eb9efc --- /dev/null +++ b/testsuite/gna/issue207/pack.vhd @@ -0,0 +1,91 @@ +--------------------------------------------------------------------------------
+--
+-- Package demo with two simple overloaded procedures
+--
+--------------------------------------------------------------------------------
+
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+
+package pack is
+
+ procedure inc(signal val:inout std_logic_vector);
+ procedure inc(signal val:inout unsigned);
+ procedure inc(signal val:inout signed);
+ procedure inc(signal val:inout integer);
+ procedure inc(variable val:inout unsigned);
+ procedure inc(variable val:inout integer);
+ procedure dec(signal val:inout std_logic_vector);
+ procedure dec(signal val:inout unsigned);
+ procedure dec(signal val:inout signed);
+ procedure dec(signal val:inout integer);
+ procedure dec(variable val:inout unsigned);
+ procedure dec(variable val:inout integer);
+
+end pack;
+
+package body pack is
+
+ procedure inc(signal val:inout std_logic_vector) is
+ begin
+ val<= std_logic_vector(unsigned(val) + 1);
+ end;
+
+ procedure inc(signal val:inout signed) is
+ begin
+ val<= val + 1;
+ end;
+
+ procedure inc(signal val:inout unsigned) is
+ begin
+ val<= val + 1;
+ end;
+
+ procedure inc(signal val:inout integer) is
+ begin
+ val<= val + 1;
+ end;
+
+ procedure inc(variable val:inout unsigned) is
+ begin
+ val := val + 1;
+ end;
+
+ procedure inc(variable val:inout integer) is
+ begin
+ val := val + 1;
+ end;
+
+ procedure dec(signal val:inout std_logic_vector) is
+ begin
+ val<= std_logic_vector(unsigned(val) - 1);
+ end;
+
+ procedure dec(signal val:inout unsigned) is
+ begin
+ val<= val - 1;
+ end;
+
+ procedure dec(signal val:inout signed) is
+ begin
+ val<= val - 1;
+ end;
+
+ procedure dec(signal val:inout integer) is
+ begin
+ val<= val - 1;
+ end;
+
+ procedure dec(variable val:inout unsigned) is
+ begin
+ val := val - 1;
+ end;
+
+ procedure dec(variable val:inout integer) is
+ begin
+ val := val - 1;
+ end;
+
+end;
+
diff --git a/testsuite/gna/issue207/pack1.vhd b/testsuite/gna/issue207/pack1.vhd new file mode 100644 index 000000000..0951b5a80 --- /dev/null +++ b/testsuite/gna/issue207/pack1.vhd @@ -0,0 +1,128 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package pack0 is + + procedure inc(signal val:inout std_logic_vector); + procedure inc(signal val:inout unsigned); + procedure inc(signal val:inout signed); + procedure inc(signal val:inout integer); + procedure dec(signal val:inout std_logic_vector); + procedure dec(signal val:inout unsigned); + procedure dec(signal val:inout signed); + procedure dec(signal val:inout integer); + +end pack0; + +package body pack0 is + + procedure inc(signal val:inout std_logic_vector) is + begin + val<= std_logic_vector(unsigned(val) + 1); + end; + + procedure inc(signal val:inout signed) is + begin + val<= val + 1; + end; + + procedure inc(signal val:inout unsigned) is + begin + val<= val + 1; + end; + + procedure inc(signal val:inout integer) is + begin + val<= val + 1; + end; + + procedure dec(signal val:inout std_logic_vector) is + begin + val<= std_logic_vector(unsigned(val) - 1); + end; + + procedure dec(signal val:inout unsigned) is + begin + val<= val - 1; + end; + + procedure dec(signal val:inout signed) is + begin + val<= val - 1; + end; + + procedure dec(signal val:inout integer) is + begin + val<= val - 1; + end; + +end; + +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; + +package pack1 is + + procedure inc(variable val:inout unsigned); + procedure inc(variable val:inout integer); + procedure dec(variable val:inout unsigned); + procedure dec(variable val:inout integer); + +end pack1; + +package body pack1 is + + procedure inc(variable val:inout unsigned) is + begin + val := val + 1; + end; + + procedure inc(variable val:inout integer) is + begin + val := val + 1; + end; + + procedure dec(variable val:inout unsigned) is + begin + val := val - 1; + end; + + procedure dec(variable val:inout integer) is + begin + val := val - 1; + end; + +end; + +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; +use work.pack0.all; +use work.pack1.all; + +entity overload is +end entity; + +architecture foo of overload is + signal sig: unsigned ( 7 downto 0) := (others => '0'); + signal int: integer range 0 to 255; -- 'LEFT = 0 initial value +begin + process + variable isig: unsigned ( 7 downto 0) := (others => '0'); + variable iint: integer range 0 to 255; + begin + inc(sig); + inc(isig); + inc(int); + inc(iint); + wait for 0 ns; + dec(sig); + dec(isig); + dec(int); + dec(iint); + wait; + end process; + +end architecture; diff --git a/testsuite/gna/issue207/testsuite.sh b/testsuite/gna/issue207/testsuite.sh new file mode 100755 index 000000000..3bd9f00f1 --- /dev/null +++ b/testsuite/gna/issue207/testsuite.sh @@ -0,0 +1,10 @@ +#! /bin/sh + +. ../../testenv.sh + +analyze_failure pack.vhd +analyze_failure pack1.vhd + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue209/main.vhdl b/testsuite/gna/issue209/main.vhdl new file mode 100644 index 000000000..75198235a --- /dev/null +++ b/testsuite/gna/issue209/main.vhdl @@ -0,0 +1,14 @@ +library work; + use work.all; + +package ShiftReg is + procedure main(new_sample: integer); +end package; + +package body ShiftReg is + procedure main(new_sample: integer) is + variable dummy: Util.integer_list_t(0 to 3); -- Here i use the type + begin + dummy := new_sample & dummy(0 to dummy'high-1); -- Error about missing & + end procedure; +end package body; diff --git a/testsuite/gna/issue209/main2.vhdl b/testsuite/gna/issue209/main2.vhdl new file mode 100644 index 000000000..1d8e9f321 --- /dev/null +++ b/testsuite/gna/issue209/main2.vhdl @@ -0,0 +1,17 @@ +library work; + use work.all; + +package ShiftReg is + type integer_list_t is array (natural range <>) of integer; -- notice this line + procedure main(new_sample: integer); +end package; + +package body ShiftReg is + + procedure main(new_sample: integer) is + variable dummy: integer_list_t(0 to 3); -- notice this line + begin + dummy := new_sample & dummy(0 to dummy'high-1); --no error + end procedure; + +end package body; diff --git a/testsuite/gna/issue209/testsuite.sh b/testsuite/gna/issue209/testsuite.sh new file mode 100755 index 000000000..de9d44773 --- /dev/null +++ b/testsuite/gna/issue209/testsuite.sh @@ -0,0 +1,12 @@ +#! /bin/sh + +. ../../testenv.sh + +analyze util.vhdl +analyze_failure main.vhdl + +analyze main2.vhdl + +clean + +echo "Test successful" diff --git a/testsuite/gna/issue209/util.vhdl b/testsuite/gna/issue209/util.vhdl new file mode 100644 index 000000000..a86ceaacb --- /dev/null +++ b/testsuite/gna/issue209/util.vhdl @@ -0,0 +1,3 @@ +package Util is + type integer_list_t is array (natural range <>) of integer; +end package; diff --git a/testsuite/gna/issue212/test.vhdl b/testsuite/gna/issue212/test.vhdl new file mode 100644 index 000000000..c322888f2 --- /dev/null +++ b/testsuite/gna/issue212/test.vhdl @@ -0,0 +1,45 @@ +PACKAGE test_pkg IS + + TYPE test_record_t IS RECORD + number : integer; + END RECORD test_record_t; + + FUNCTION set_test_record_default + RETURN test_record_t; + + FUNCTION set_test_record ( + CONSTANT C_TEST : test_record_t := set_test_record_default) + RETURN test_record_t; + +END PACKAGE test_pkg; + +PACKAGE BODY test_pkg IS + + FUNCTION set_test_record_default + RETURN test_record_t IS + VARIABLE result : test_record_t; + BEGIN + result.number := 0; + RETURN result; + END set_test_record_default; + + FUNCTION set_test_record ( + CONSTANT C_TEST : test_record_t := set_test_record_default) + RETURN test_record_t IS + BEGIN + RETURN C_TEST; + END set_test_record; + +END PACKAGE BODY test_pkg; + +ENTITY test IS +END ENTITY test; + +LIBRARY work; +USE work.test_pkg.set_test_record; + +ARCHITECTURE rtl OF test IS + +BEGIN + +END ARCHITECTURE rtl; diff --git a/testsuite/gna/issue212/testsuite.sh b/testsuite/gna/issue212/testsuite.sh new file mode 100755 index 000000000..f8534f54e --- /dev/null +++ b/testsuite/gna/issue212/testsuite.sh @@ -0,0 +1,9 @@ +#! /bin/sh + +. ../../testenv.sh + +analyze test.vhdl + +clean + +echo "Test successful" |