aboutsummaryrefslogtreecommitdiffstats
path: root/scripts/windows/compile-libraries.ps1
blob: 291d1be39a9dd628f6921ea2f9da500270511e70 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
# 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  (ported batch file to PowerShell)
#    Brian Davis      (contributions to the batch file)
#    Tristan Gingold  (initial batch file for compilations on Windows)
#
#  PowerShell Script: Script to compile VHDL libraries for GHDL
#
# Description:
# ------------------------------------
#  This is a PowerShell script (executable) which:
#    - sets up a compilation environment
#    - test all dependencies
#    - pre processes VHDL files with GHDLFilter
#    - analyses VHDL files with GHDL
#
# ==============================================================================
#  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
#  Copyright (C) 2015-2017 Patrick Lehmann
#
#  This program is free software: you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation, either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program.  If not, see <gnu.org/licenses>.
# ==============================================================================

# .SYNOPSIS 
# 	GHDL for Windows - Library compile script
# 	Use 'compile-libraries.ps1 -Help' to see the integrated help page
# 
# .EXAMPLE
# 	C:\PS> .\compile-libraries.ps1 -Clean
# .EXAMPLE
# 	C:\PS> .\compile-libraries.ps1 -Compile -Verbose
# .EXAMPLE
# 	C:\PS> .\compile-libraries.ps1 -VHDL2008 -SuppressWarnings
# 
[CmdletBinding()]
param(
	# Display this help"
	[switch]$Help =							$false,
	
	# Clean up all files and directories
	[switch]$Clean =						$false,
	
	# Compile all library files
	[switch]$Compile =					$false,
	
	# Set VHDL Standard to '87
	[switch]$VHDL87 =						$false,
	# Set VHDL Standard to '93
	[switch]$VHDL93 =						$false,
	# Set VHDL Standard to '08
	[switch]$VHDL2008 =					$false,
	
	# Skip warning messages. (Show errors only.)
	[switch]$SuppressWarnings = $false,
	# Halt on errors
	[switch]$HaltOnError =			$false,
	
	# Set GHDL executable
	[string]$GHDL =							"",
	# Undocumented
	[switch]$Hosted =						$false
)

# configure script here
$RelPathToRoot =			"..\.."

# ---------------------------------------------
# save parameters and working directory
$Script_ScriptDir =		$PSScriptRoot
$Script_WorkingDir =	Get-Location
$GHDLRootDir =				Convert-Path (Resolve-Path ($PSScriptRoot + "\" + $RelPathToRoot))

# set default values
$EnableDebug =        [bool]$PSCmdlet.MyInvocation.BoundParameters["Debug"]
$EnableVerbose =      [bool]$PSCmdlet.MyInvocation.BoundParameters["Verbose"] -or $EnableDebug

# load modules from GHDL's 'libraries' directory
Import-Module $PSScriptRoot\shared.psm1 -Verbose:$false -Debug:$false -ArgumentList "$Script_WorkingDir", $Hosted

# Display help if no command was selected
$Help = $Help -or (-not ($Compile -or $VHDL87 -or $VHDL93 -or $VHDL2008 -or $Clean))

if ($Help)
{	Get-Help $MYINVOCATION.MyCommand.Path -Detailed
	Exit-CompileScript
}
if ($Compile)
{	$VHDL87 =		$true
	$VHDL93 =		$true
	$VHDL2008 =	$true
}

# configure some variables: paths, executables, directory names, ...
$VHDLLibrariesSourceDirectoryName =				"libraries"
$VHDLLibrariesDestinationDirectoryName =	"lib"
$BuildDirectoryName =											"build"
$Backend =																"mcode"

# construct directories
$VHDLSourceLibraryDirectory =				"$GHDLRootDir\$VHDLLibrariesSourceDirectoryName"
$VHDLDestinationLibraryDirectory =	"$GHDLRootDir\$BuildDirectoryName\$Backend\$VHDLLibrariesDestinationDirectoryName"
# construct executables
$GHDLNewExecutable =								"$GHDLRootDir\$BuildDirectoryName\$Backend\bin\ghdl.exe"


# Library sources
$SourceFiles = @{
	"std" = @(
		"textio",								"textio-body"
	);
	"ieee" = @(
		"std_logic_1164",				"std_logic_1164-body",
		"numeric_std",					"numeric_std-body",
		"numeric_bit",					"numeric_bit-body"
	);
	"math" = @(
		"math_real",						"math_real-body",
		"math_complex",					"math_complex-body"
	);
	"std08" = @(
		"textio",								"textio-body",
		"env",									"env-body"
	);
	"ieee2008" = @(
		"std_logic_1164",				"std_logic_1164-body",
		"std_logic_textio",
		"math_real",						"math_real-body",
		"math_complex",					"math_complex-body",
		"numeric_bit",					"numeric_bit-body",
		"numeric_bit_unsigned",	"numeric_bit_unsigned-body",
		"numeric_std",					"numeric_std-body",
		"numeric_std_unsigned",	"numeric_std_unsigned-body",
		"fixed_float_types",
		"fixed_generic_pkg",		"fixed_generic_pkg-body",
		"fixed_pkg",
		"float_generic_pkg",		"float_generic_pkg-body",
		"float_pkg",
		"ieee_std_context",
		"ieee_bit_context"
	);
	"vital95" = @(
		"vital_timing",					"vital_timing-body",
		"vital_primitives",			"vital_primitives-body"
	);
	"vital2000" = @(
		"timing_p",							"timing_b",
		"prmtvs_p",							"prmtvs_b",
		"memory_p",							"memory_b"
	);
	"synopsys" = @(
		"std_logic_arith",
		"std_logic_unsigned",
		"std_logic_signed"
	);
	"synopsys8793" = @(
		"std_logic_textio",
		"std_logic_misc",				"std_logic_misc-body"
	);
	"mentor" = @(
		"std_logic_arith",			"std_logic_arith-body"
	)
}

if (-not $Hosted)
{	Write-Host "================================================================================" -ForegroundColor Yellow
	Write-Host "GHDL ($Backend) for Windows - Library compile script" -ForegroundColor Yellow
	Write-Host "================================================================================" -ForegroundColor Yellow
}

if ($Clean)
{	Write-Host "Removing all created files and directories..." -ForegroundColor Yellow
	if (Test-Path -Path $VHDLDestinationLibraryDirectory)
	{	$EnableVerbose	-and (Write-Host "  rmdir $VHDLDestinationLibraryDirectory")	| Out-Null
		Remove-Item $VHDLDestinationLibraryDirectory -Force -Recurse -ErrorAction SilentlyContinue
		if ($? -eq $false)
		{	Write-Host "[ERROR]: Cannot remove '$VHDLDestinationLibraryDirectory'." -ForegroundColor Red
			Exit-CompileScript -1
		}
	}
	if (-not ($VHDL87 -or $VHDL93 -or $VHDL2008))
	{	Exit-CompileScript	}
}

# get GHDL executable
if ($GHDL -ne "")
{	$GHDLExecutable = $GHDL								}
elseif (Test-Path env:GHDL)
{	$GHDLExecutable = $env:GHDL						}
elseif (Test-Path $GHDLNewExecutable -PathType Leaf)
{	$GHDLExecutable = $GHDLNewExecutable	}
else
{	$GHDLExecutable = "ghdl.exe"					}
	
if (-not (Test-Path $GHDLExecutable -PathType Leaf))
{	Write-Host "GHDL executable 'ghdl.exe' not found." -ForegroundColor Red
	Write-Host "Use adv. options '-GHDL' to set the GHDL executable." -ForegroundColor Yellow
	Exit-CompileScript -1
}


$ErrorCount = 0
if ($VHDL87 -or $VHDL93 -or $VHDL2008)
{	Write-Host "Compiling VHDL Libraries..."
	Write-Host "Preparing..."

	# create lib directory if it does not exist
	if (Test-Path -Path $VHDLDestinationLibraryDirectory)
	{	$EnableVerbose	-and (Write-Host "  Directory '$VHDLDestinationLibraryDirectory' already exists.")	| Out-Null
		
		# change working directory to VHDLDestinationLibraryDirectory
		$EnableVerbose	-and (Write-Host "  cd $VHDLDestinationLibraryDirectory")	| Out-Null
		Set-Location $VHDLDestinationLibraryDirectory
	
		$EnableVerbose	-and (Write-Host "  Cleaning up directory...")	| Out-Null
		Remove-Item ./* -Force -Recurse -ErrorAction SilentlyContinue
	}
	else
	{	$EnableVerbose	-and (Write-Host "  Creating directory '$VHDLDestinationLibraryDirectory'.")	| Out-Null
		New-Item -ItemType Directory -Path $VHDLDestinationLibraryDirectory -ErrorAction SilentlyContinue | Out-Null
		if (-not $?)
		{	Write-Host "[ERROR]: Cannot create destination directory '$VHDLDestinationLibraryDirectory'." -ForegroundColor Red
			Exit-CompileScript -1
		}
		
		# change working directory to VHDLDestinationLibraryDirectory
		$EnableVerbose	-and (Write-Host "  Change working directory to $VHDLDestinationLibraryDirectory")	| Out-Null
		Set-Location $VHDLDestinationLibraryDirectory
	}
	
	Write-Host
	Write-Host "Start compilation..."
}
# ============================================================================
# v87
# ============================================================================
if ($VHDL87)
{	$VHDLVersion =				"87"
	Write-Host "Compiling libraries for VHDL-$VHDLVersion" -ForegroundColor Cyan
	
	# ----------------------------------------------------------------------
	# v87\std
	# ----------------------------------------------------------------------
	$VHDLLibrary =				"std"
	Write-Host "  Compiling library '$VHDLLibrary'..." -ForegroundColor DarkCyan
	
	$LibraryDirectory = "$VHDLDestinationLibraryDirectory\$VHDLLibrary\v$VHDLVersion"
	New-LibraryDirectory $LibraryDirectory	# $EnableVerbose
	Set-Location $LibraryDirectory
	
	$VHDLSourcesIndex = "std"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C --bootstrap --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	# ----------------------------------------------------------------------
	# v87\ieee
	# ----------------------------------------------------------------------
	$VHDLLibrary =	"ieee"
	$VHDLFlavor =		"ieee"
	Write-Host "  Compiling library '$VHDLLibrary'..." -ForegroundColor DarkCyan
	
	$LibraryDirectory = "$VHDLDestinationLibraryDirectory\$VHDLFlavor\v$VHDLVersion"
	New-LibraryDirectory $LibraryDirectory	# $EnableVerbose
	Set-Location $LibraryDirectory
	
	$VHDLSourcesIndex = "ieee"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	# ----------------------------------------------------------------------
	# v87\synopsys
	# ----------------------------------------------------------------------
	$VHDLLibrary =	"ieee"
	$VHDLFlavor =		"synopsys"
	Write-Host "  Compiling library '$VHDLLibrary' ($VHDLFlavor)..." -ForegroundColor DarkCyan
	
	$LibraryDirectory = "$VHDLDestinationLibraryDirectory\$VHDLFlavor\v$VHDLVersion"
	New-LibraryDirectory $LibraryDirectory	# $EnableVerbose
	Set-Location $LibraryDirectory
	
	$VHDLSourcesIndex = "ieee"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	foreach ($SourceFile in $SourceFiles[$VHDLFlavor] + $SourceFiles["synopsys8793"])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLFlavor\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	$VHDLSourcesIndex = "vital95"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
}
# ============================================================================
# v93
# ============================================================================
if ($VHDL93)
{	$VHDLVersion =				"93"
	Write-Host "Compiling libraries for VHDL-$VHDLVersion" -ForegroundColor Cyan
	
	# ----------------------------------------------------------------------
	# v93\std
	# ----------------------------------------------------------------------
	$VHDLLibrary =				"std"
	Write-Host "  Compiling library '$VHDLLibrary'..." -ForegroundColor DarkCyan
	
	$LibraryDirectory = "$VHDLDestinationLibraryDirectory\$VHDLLibrary\v$VHDLVersion"
	New-LibraryDirectory $LibraryDirectory	# $EnableVerbose
	Set-Location $LibraryDirectory
	
	$VHDLSourcesIndex = "std"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C --bootstrap --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	# ----------------------------------------------------------------------
	# v93\ieee
	# ----------------------------------------------------------------------
	$VHDLLibrary =	"ieee"
	$VHDLFlavor =		"ieee"
	Write-Host "  Compiling library '$VHDLLibrary'..." -ForegroundColor DarkCyan
	
	$LibraryDirectory = "$VHDLDestinationLibraryDirectory\$VHDLFlavor\v$VHDLVersion"
	New-LibraryDirectory $LibraryDirectory	# $EnableVerbose
	Set-Location $LibraryDirectory
	
	$VHDLSourcesIndex = "ieee"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex] + $SourceFiles["math"])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	$VHDLSourcesIndex = "vital2000"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	# ----------------------------------------------------------------------
	# v93\synopsys
	# ----------------------------------------------------------------------
	$VHDLLibrary =	"ieee"
	$VHDLFlavor =		"synopsys"
	Write-Host "  Compiling library '$VHDLLibrary' ($VHDLFlavor)..." -ForegroundColor DarkCyan
	
	$LibraryDirectory = "$VHDLDestinationLibraryDirectory\$VHDLFlavor\v$VHDLVersion"
	New-LibraryDirectory $LibraryDirectory	# $EnableVerbose
	Set-Location $LibraryDirectory
	
	$VHDLSourcesIndex = "ieee"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex] + $SourceFiles["math"])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	foreach ($SourceFile in $SourceFiles[$VHDLFlavor] + $SourceFiles["synopsys8793"])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLFlavor\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	$VHDLSourcesIndex = "vital2000"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	# ----------------------------------------------------------------------
	# v93\mentor
	# ----------------------------------------------------------------------
	$VHDLLibrary =	"ieee"
	$VHDLFlavor =		"mentor"
	Write-Host "  Compiling library '$VHDLLibrary' ($VHDLFlavor)..." -ForegroundColor DarkCyan
	
	$LibraryDirectory = "$VHDLDestinationLibraryDirectory\$VHDLFlavor\v$VHDLVersion"
	New-LibraryDirectory $LibraryDirectory	# $EnableVerbose
	Set-Location $LibraryDirectory
	
	$VHDLSourcesIndex = "ieee"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex] + $SourceFiles["math"])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	foreach ($SourceFile in $SourceFiles[$VHDLFlavor])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLFlavor\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	$VHDLSourcesIndex = "vital2000"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
}
# ==============================================================================
# v08
# ==============================================================================
if ($VHDL2008)
{	$VHDLVersion =				"08"
	Write-Host "Compiling libraries for VHDL-$VHDLVersion" -ForegroundColor Cyan
	
	# ----------------------------------------------------------------------
	# v08\std
	# ----------------------------------------------------------------------
	$VHDLLibrary =				"std"
	Write-Host "  Compiling library '$VHDLLibrary'..." -ForegroundColor DarkCyan
	
	$LibraryDirectory = "$VHDLDestinationLibraryDirectory\$VHDLLibrary\v$VHDLVersion"
	New-LibraryDirectory $LibraryDirectory	# $EnableVerbose
	Set-Location $LibraryDirectory
	
	$VHDLSourcesIndex = "std08"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLLibrary\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C --bootstrap --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}

	# ----------------------------------------------------------------------
	# v08\ieee
	# ----------------------------------------------------------------------
	$VHDLLibrary =	"ieee"
	$VHDLFlavor =		"ieee"
	Write-Host "  Compiling library '$VHDLLibrary'..." -ForegroundColor DarkCyan
	
	$LibraryDirectory = "$VHDLDestinationLibraryDirectory\$VHDLFlavor\v$VHDLVersion"
	New-LibraryDirectory $LibraryDirectory	# $EnableVerbose
	Set-Location $LibraryDirectory
	
	$VHDLSourcesIndex = "ieee2008"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	$VHDLSourcesIndex = "vital2000"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" -frelaxed-rules --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}

	# ----------------------------------------------------------------------
	# v08\synopsys
	# ----------------------------------------------------------------------
	$VHDLLibrary =	"ieee"
	$VHDLFlavor =		"synopsys"
	Write-Host "  Compiling library '$VHDLLibrary' ($VHDLFlavor)..." -ForegroundColor DarkCyan
	
	$LibraryDirectory = "$VHDLDestinationLibraryDirectory\$VHDLFlavor\v$VHDLVersion"
	New-LibraryDirectory $LibraryDirectory	# $EnableVerbose
	Set-Location $LibraryDirectory
	
	$VHDLSourcesIndex = "ieee2008"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	foreach ($SourceFile in $SourceFiles[$VHDLFlavor])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLFlavor\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
	$VHDLSourcesIndex = "vital2000"
	foreach ($SourceFile in $SourceFiles[$VHDLSourcesIndex])
	{	Write-Host "    file: v$VHDLVersion\$SourceFile.v$VHDLVersion"
		$EnableVerbose -and	(Write-Host "      Patching file for VHDL-$VHDLVersion"																																														) | Out-Null
		$EnableDebug -and		(Write-Host "        Get-Content `"$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl`" -Encoding Ascii ``"	-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Format-VHDLSourceFile -Version `"$VHDLVersion`" ``"																						-ForegroundColor DarkGray	) | Out-Null
		$EnableDebug -and		(Write-Host "          | Out-File `"$SourceFile.v$VHDLVersion`" -Encoding Ascii"																				-ForegroundColor DarkGray	) | Out-Null
		# Patch file
		Get-Content "$VHDLSourceLibraryDirectory\$VHDLSourcesIndex\$SourceFile.vhdl" -Encoding Ascii `
			| Format-VHDLSourceFile -Version "$VHDLVersion" `
			| Out-File "$SourceFile.v$VHDLVersion" -Encoding Ascii
		
		# Analyze file
		$InvokeExpr = "$GHDLExecutable -a -C `"-P../std`" -frelaxed-rules --std=$VHDLVersion --work=$VHDLLibrary $SourceFile.v$VHDLVersion 2>&1"
		$EnableVerbose -and	(Write-Host "      Analyzing file '$SourceFile.v$VHDLVersion'"		) | Out-Null
		$EnableDebug -and		(Write-Host "        $InvokeExpr" -ForegroundColor DarkGray				) | Out-Null
		$ErrorRecordFound = Invoke-Expression $InvokeExpr | Restore-NativeCommandStream | Write-ColoredGHDLLine $SuppressWarnings "      "
		if (($LastExitCode -ne 0) -or -not $?)
		{	$ErrorCount += 1
			if ($HaltOnError)
			{	Exit-CompileScript -1		}
		}
	}
	
}	# $VHDL2008


Write-Host "--------------------------------------------------------------------------------"
Write-Host "Compiling VHDL libraries " -NoNewline
if ($ErrorCount -gt 0)
{	Write-Host "[FAILED]" -ForegroundColor Red				}
else
{	Write-Host "[SUCCESSFUL]" -ForegroundColor Green	}

Exit-CompileScript
Orig := Semantic; end if; Report_Msg (Id, Orig, +Assoc, "bounds or direction of actual don't match with %n", (1 => +Inter)); end Error_Msg; Ftype : constant Iir := Get_Type (Formal); Atype : constant Iir := Get_Type (Actual); F_Conv : constant Iir := Get_Formal_Conversion (Assoc); A_Conv : constant Iir := Get_Actual_Conversion (Assoc); F2a_Type : Iir; A2f_Type : Iir; begin -- LRM02 12.2.4 The port map aspect -- If an actual signal is associated with a port of any mode, and if -- the type of the formal is a scalar type, then it is an error if -- (after applying any conversion function or type conversion -- expression present in the actual part) the bounds and direction of -- the subtype denoted by the subtype indication of the formal are not -- identical to the bounds and direction of the subtype denoted by the -- subtype indication of the actual. -- LRM08 14.3.5 Port map aspect -- If an actual signal is associated with a port of mode IN or INOUT, -- and if the type of the formal is a scalar type, then it is an error -- if (after applying any conversion function or type conversion -- expression present in the actual part) the subtype of the actual is -- not compatible with the subtype of the formal. [...] -- -- Similarly, if an actual signal is associated with a port of mode -- OUT, INOUT, or BUFFER, and the type of the actual is a scalar type, -- then it is an error if (after applying any conversion function or -- type conversion expression present in the formal part) the subtype -- or the formal is not compatible with the subtype of the actual. if Is_Valid (F_Conv) then F2a_Type := Get_Type (F_Conv); else F2a_Type := Ftype; end if; if Is_Valid (A_Conv) then A2f_Type := Get_Type (A_Conv); else A2f_Type := Atype; end if; if Get_Mode (Inter) in Iir_In_Modes and then not Is_Scalar_Type_Compatible (A2f_Type, Ftype) then Error_Msg; end if; if Get_Mode (Inter) in Iir_Out_Modes and then not Is_Scalar_Type_Compatible (F2a_Type, Atype) then Error_Msg; end if; end Check_Port_Association_Bounds_Restrictions; -- Handle indexed name -- FORMAL is the formal name to be handled. -- BASE_ASSOC is an association_by_individual in which the formal will be -- inserted. procedure Add_Individual_Assoc_Indexed_Name (Choice : out Iir; Base_Assoc : Iir; Formal : Iir) is Index_List : constant Iir_Flist := Get_Index_List (Formal); Nbr : constant Natural := Get_Nbr_Elements (Index_List); Last_Choice : Iir; Index : Iir; Staticness : Iir_Staticness; Sub_Assoc : Iir; begin -- Find element. Sub_Assoc := Base_Assoc; for I in 0 .. Nbr - 1 loop Index := Get_Nth_Element (Index_List, I); -- Evaluate index. Staticness := Get_Expr_Staticness (Index); if Staticness = Locally then Index := Eval_Expr (Index); Set_Nth_Element (Index_List, I, Index); else Error_Msg_Sem (+Index, "index expression must be locally static"); Set_Choice_Staticness (Base_Assoc, None); end if; -- Find index in choice list. Last_Choice := Null_Iir; Choice := Get_Individual_Association_Chain (Sub_Assoc); while Choice /= Null_Iir loop case Get_Kind (Choice) is when Iir_Kind_Choice_By_Expression => if Eval_Pos (Get_Choice_Expression (Choice)) = Eval_Pos (Index) then goto Found; end if; when Iir_Kind_Choice_By_Range => declare Choice_Range : constant Iir := Get_Choice_Range (Choice); begin if Get_Expr_Staticness (Choice_Range) = Locally and then Eval_Int_In_Range (Eval_Pos (Index), Choice_Range) then -- FIXME: overlap. raise Internal_Error; end if; end; when others => Error_Kind ("add_individual_assoc_index_name", Choice); end case; Last_Choice := Choice; Choice := Get_Chain (Choice); end loop; -- If not found, append it. Choice := Create_Iir (Iir_Kind_Choice_By_Expression); Set_Choice_Expression (Choice, Index); Set_Choice_Staticness (Choice, Staticness); Location_Copy (Choice, Formal); if Last_Choice = Null_Iir then Set_Individual_Association_Chain (Sub_Assoc, Choice); else Set_Chain (Last_Choice, Choice); end if; << Found >> null; if I < Nbr - 1 then -- Create an intermediate assoc by individual. Sub_Assoc := Get_Associated_Expr (Choice); if Sub_Assoc = Null_Iir then Sub_Assoc := Create_Iir (Iir_Kind_Association_Element_By_Individual); Location_Copy (Sub_Assoc, Index); Set_Associated_Expr (Choice, Sub_Assoc); Set_Choice_Staticness (Sub_Assoc, Locally); end if; end if; end loop; end Add_Individual_Assoc_Indexed_Name; procedure Add_Individual_Assoc_Slice_Name (Choice : out Iir; Sub_Assoc : Iir; Formal : Iir) is Index : Iir; Staticness : Iir_Staticness; begin -- FIXME: handle cases such as param(5 to 6)(5) -- Find element. Index := Get_Suffix (Formal); -- Evaluate index. Staticness := Get_Expr_Staticness (Index); if Staticness = Locally then Index := Eval_Range (Index); Set_Suffix (Formal, Index); else Error_Msg_Sem (+Index, "range expression must be locally static"); Set_Choice_Staticness (Sub_Assoc, None); end if; Choice := Create_Iir (Iir_Kind_Choice_By_Range); Location_Copy (Choice, Formal); Set_Choice_Range (Choice, Index); Set_Chain (Choice, Get_Individual_Association_Chain (Sub_Assoc)); Set_Choice_Staticness (Choice, Staticness); Set_Individual_Association_Chain (Sub_Assoc, Choice); end Add_Individual_Assoc_Slice_Name; procedure Add_Individual_Assoc_Selected_Name (Choice : out Iir; Sub_Assoc : Iir; Formal : Iir) is Element : constant Iir := Get_Named_Entity (Formal); Last_Choice : Iir; begin -- Try to find the existing choice. Last_Choice := Null_Iir; Choice := Get_Individual_Association_Chain (Sub_Assoc); while Choice /= Null_Iir loop if Get_Choice_Name (Choice) = Element then return; end if; Last_Choice := Choice; Choice := Get_Chain (Choice); end loop; -- If not found, append it. Choice := Create_Iir (Iir_Kind_Choice_By_Name); Location_Copy (Choice, Formal); Set_Choice_Name (Choice, Element); if Last_Choice = Null_Iir then Set_Individual_Association_Chain (Sub_Assoc, Choice); else Set_Chain (Last_Choice, Choice); end if; end Add_Individual_Assoc_Selected_Name; -- Subroutine of Add_Individual_Association. -- Search/build the tree of choices for FORMAL, starting for IASSOC. -- The root of the tree is an association by individual node. Each node -- points to a chain of choices, whose associated expression is either an -- association by individual (and the tree continue) or an association -- by expression coming from the initial association (and this is a leaf). procedure Add_Individual_Association_1 (Iassoc : in out Iir; Formal : Iir; Last : Boolean) is Base_Assoc : constant Iir := Iassoc; Formal_Object : constant Iir := Name_To_Object (Formal); Sub : Iir; Choice : Iir; begin pragma Assert (Get_Kind (Iassoc) = Iir_Kind_Association_Element_By_Individual); -- Recurse to start from the basename of the formal. case Get_Kind (Formal_Object) is when Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name | Iir_Kind_Selected_Element => Add_Individual_Association_1 (Iassoc, Get_Prefix (Formal_Object), False); when Iir_Kinds_Interface_Object_Declaration => -- At the root of the formal. pragma Assert (Formal_Object = Get_Named_Entity (Get_Formal (Iassoc))); return; when others => Error_Kind ("add_individual_association_1", Formal); end case; -- Add the choices for the indexes/slice/element. case Get_Kind (Formal_Object) is when Iir_Kind_Indexed_Name => Add_Individual_Assoc_Indexed_Name (Choice, Iassoc, Formal_Object); when Iir_Kind_Slice_Name => Add_Individual_Assoc_Slice_Name (Choice, Iassoc, Formal_Object); when Iir_Kind_Selected_Element => Add_Individual_Assoc_Selected_Name (Choice, Iassoc, Formal_Object); when others => Error_Kind ("add_individual_association_1(3)", Formal); end case; Sub := Get_Associated_Expr (Choice); if Sub = Null_Iir then if not Last then -- Create the individual association for the choice. Sub := Create_Iir (Iir_Kind_Association_Element_By_Individual); Location_Copy (Sub, Formal); Set_Choice_Staticness (Sub, Locally); Set_Formal (Sub, Formal); Set_Associated_Expr (Choice, Sub); end if; else if Last or else Get_Kind (Sub) /= Iir_Kind_Association_Element_By_Individual then -- A final association. pragma Assert (Get_Kind (Sub) = Iir_Kind_Association_Element_By_Expression); Error_Msg_Sem (+Formal, "individual association of %n" & " conflicts with that at %l", (+Get_Interface_Of_Formal (Get_Formal (Iassoc)), +Sub)); else if Get_Choice_Staticness (Sub) /= Locally then -- Propagate error. Set_Choice_Staticness (Base_Assoc, None); end if; end if; end if; if Last then Iassoc := Choice; else Iassoc := Sub; end if; end Add_Individual_Association_1; -- Insert ASSOC into the tree of individual assoc rooted by IASSOC. -- This is done so that duplicate or missing associations are found (using -- the same routine for aggregate/case statement). procedure Add_Individual_Association (Iassoc : Iir; Assoc : Iir) is Formal : constant Iir := Get_Formal (Assoc); Res_Iass : Iir; Prev : Iir; begin -- Create the individual association for the formal. Res_Iass := Iassoc; Add_Individual_Association_1 (Res_Iass, Formal, True); Prev := Get_Associated_Expr (Res_Iass); if Prev = Null_Iir then Set_Associated_Expr (Res_Iass, Assoc); end if; end Add_Individual_Association; procedure Finish_Individual_Association1 (Assoc : Iir; Atype : Iir); procedure Finish_Individual_Assoc_Array_Subtype (Assoc : Iir; Atype : Iir; Dim : Positive) is Index_Tlist : constant Iir_Flist := Get_Index_Subtype_List (Atype); Nbr_Dims : constant Natural := Get_Nbr_Elements (Index_Tlist); Index_Type : constant Iir := Get_Nth_Element (Index_Tlist, Dim - 1); Chain : constant Iir := Get_Individual_Association_Chain (Assoc); Low, High : Iir; El_Type : Iir; El : Iir; begin Sem_Check_Continuous_Choices (Chain, Index_Type, Low, High, Get_Location (Assoc), False); if Dim < Nbr_Dims then El := Chain; while El /= Null_Iir loop pragma Assert (Get_Kind (El) = Iir_Kind_Choice_By_Expression); Finish_Individual_Assoc_Array_Subtype (Get_Associated_Expr (El), Atype, Dim + 1); El := Get_Chain (El); end loop; else El_Type := Get_Element_Subtype (Atype); El := Chain; while El /= Null_Iir loop Finish_Individual_Association1 (Get_Associated_Expr (El), El_Type); El := Get_Chain (El); end loop; end if; end Finish_Individual_Assoc_Array_Subtype; procedure Finish_Individual_Assoc_Array (Actual : Iir; Assoc : Iir; Dim : Natural) is Actual_Type : constant Iir := Get_Actual_Type (Actual); Index_Tlist : constant Iir_Flist := Get_Index_Subtype_List (Actual_Type); Actual_Index : Iir; Base_Type : Iir; Base_Index : Iir; Low, High : Iir; Chain : Iir; begin Actual_Index := Get_Nth_Element (Index_Tlist, Dim - 1); if Actual_Index /= Null_Iir then Base_Index := Actual_Index; else Base_Type := Get_Base_Type (Actual_Type); Base_Index := Get_Index_Type (Base_Type, Dim - 1); end if; Chain := Get_Individual_Association_Chain (Assoc); Sem_Choices_Range (Chain, Base_Index, Low, High, Get_Location (Assoc), True, False); Set_Individual_Association_Chain (Assoc, Chain); if Actual_Index = Null_Iir then declare Index_Constraint : Iir; Index_Subtype_Constraint : Iir; begin -- Create an index subtype. case Get_Kind (Base_Index) is when Iir_Kind_Integer_Subtype_Definition => Actual_Index := Create_Iir (Iir_Kind_Integer_Subtype_Definition); when Iir_Kind_Enumeration_Type_Definition | Iir_Kind_Enumeration_Subtype_Definition => Actual_Index := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); when others => Error_Kind ("finish_individual_assoc_array", Base_Index); end case; Location_Copy (Actual_Index, Actual); Set_Parent_Type (Actual_Index, Base_Index); Index_Constraint := Get_Range_Constraint (Base_Index); Index_Subtype_Constraint := Create_Iir (Iir_Kind_Range_Expression); Location_Copy (Index_Subtype_Constraint, Actual); Set_Range_Constraint (Actual_Index, Index_Subtype_Constraint); Set_Type_Staticness (Actual_Index, Locally); Set_Direction (Index_Subtype_Constraint, Get_Direction (Index_Constraint)); -- For ownership purpose, the bounds must be copied otherwise -- they would be referenced before being defined. This is non -- optimal but it doesn't happen often. Low := Copy_Constant (Low); High := Copy_Constant (High); case Get_Direction (Index_Constraint) is when Dir_To => Set_Left_Limit (Index_Subtype_Constraint, Low); Set_Left_Limit_Expr (Index_Subtype_Constraint, Low); Set_Right_Limit (Index_Subtype_Constraint, High); Set_Right_Limit_Expr (Index_Subtype_Constraint, High); when Dir_Downto => Set_Left_Limit (Index_Subtype_Constraint, High); Set_Left_Limit_Expr (Index_Subtype_Constraint, High); Set_Right_Limit (Index_Subtype_Constraint, Low); Set_Right_Limit_Expr (Index_Subtype_Constraint, Low); end case; Set_Expr_Staticness (Index_Subtype_Constraint, Locally); Set_Nth_Element (Get_Index_Subtype_List (Actual_Type), Dim - 1, Actual_Index); end; else declare Act_High, Act_Low : Iir; begin Get_Low_High_Limit (Get_Range_Constraint (Actual_Type), Act_Low, Act_High); if Eval_Pos (Act_Low) /= Eval_Pos (Low) or Eval_Pos (Act_High) /= Eval_Pos (High) then Error_Msg_Sem (+Assoc, "indexes of individual association mismatch"); end if; end; end if; declare Nbr_Dims : constant Natural := Get_Nbr_Elements (Index_Tlist); El_Type : Iir; El : Iir; begin if Dim = Nbr_Dims then El_Type := Get_Element_Subtype (Actual_Type); El := Chain; while El /= Null_Iir loop Finish_Individual_Association1 (Get_Associated_Expr (El), El_Type); El := Get_Chain (El); end loop; end if; end; end Finish_Individual_Assoc_Array; procedure Finish_Individual_Assoc_Record (Assoc : Iir; Atype : Iir) is El_List : constant Iir_Flist := Get_Elements_Declaration_List (Atype); Nbr_El : constant Natural := Get_Nbr_Elements (El_List); Matches : Iir_Array (0 .. Nbr_El - 1); Ch : Iir; Pos : Natural; Rec_El : Iir; begin -- Check for duplicate associations. Matches := (others => Null_Iir); Ch := Get_Individual_Association_Chain (Assoc); while Ch /= Null_Iir loop Rec_El := Get_Choice_Name (Ch); Pos := Natural (Get_Element_Position (Rec_El)); if Matches (Pos) /= Null_Iir then Error_Msg_Sem (+Ch, "individual %n already associated at %l", (+Rec_El, +Matches (Pos))); else Matches (Pos) := Ch; end if; Ch := Get_Chain (Ch); end loop; -- Check for missing associations. for I in Matches'Range loop Rec_El := Get_Nth_Element (El_List, I); if Matches (I) = Null_Iir then Error_Msg_Sem (+Assoc, "%n not associated", +Rec_El); else Finish_Individual_Association1 (Get_Associated_Expr (Matches (I)), Get_Type (Rec_El)); end if; end loop; if Get_Constraint_State (Atype) /= Fully_Constrained then -- Some (sub-)elements are unbounded, create a bounded subtype. declare Inter : constant Iir := Get_Interface_Of_Formal (Get_Formal (Assoc)); Ntype : Iir; Nel_List : Iir_Flist; Nrec_El : Iir; Rec_El_Type : Iir; Staticness : Iir_Staticness; Assoc_Expr : Iir; Assoc_Type : Iir; begin Ntype := Create_Iir (Iir_Kind_Record_Subtype_Definition); Set_Is_Ref (Ntype, True); Location_Copy (Ntype, Assoc); Set_Parent_Type (Ntype, Atype); if Get_Kind (Atype) = Iir_Kind_Record_Subtype_Definition then Set_Resolution_Indication (Ntype, Get_Resolution_Indication (Atype)); end if; if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then -- The subtype is used for signals. Set_Has_Signal_Flag (Ntype, True); end if; Nel_List := Create_Iir_Flist (Nbr_El); Set_Elements_Declaration_List (Ntype, Nel_List); Staticness := Locally; for I in Matches'Range loop Rec_El := Get_Nth_Element (El_List, I); Rec_El_Type := Get_Type (Rec_El); if (Get_Kind (Rec_El_Type) not in Iir_Kinds_Composite_Type_Definition) or else Get_Constraint_State (Rec_El_Type) = Fully_Constrained or else Matches (I) = Null_Iir -- In case of error. then Nrec_El := Rec_El; else Nrec_El := Create_Iir (Iir_Kind_Record_Element_Constraint); Ch := Matches (I); Location_Copy (Nrec_El, Ch); Set_Parent (Nrec_El, Ntype); Set_Identifier (Nrec_El, Get_Identifier (Rec_El)); pragma Assert (I = Natural (Get_Element_Position (Rec_El))); Set_Element_Position (Nrec_El, Iir_Index32 (I)); Assoc_Expr := Get_Associated_Expr (Ch); if (Get_Kind (Assoc_Expr) = Iir_Kind_Association_Element_By_Individual) then Assoc_Type := Get_Actual_Type (Assoc_Expr); Set_Subtype_Indication (Nrec_El, Assoc_Type); else Assoc_Type := Get_Type (Get_Actual (Assoc_Expr)); end if; Set_Type (Nrec_El, Assoc_Type); Append_Owned_Element_Constraint (Ntype, Nrec_El); end if; Staticness := Min (Staticness, Get_Type_Staticness (Get_Type (Nrec_El))); Set_Nth_Element (Nel_List, I, Nrec_El); end loop; Set_Type_Staticness (Ntype, Staticness); Set_Constraint_State (Ntype, Fully_Constrained); Set_Actual_Type (Assoc, Ntype); Set_Actual_Type_Definition (Assoc, Ntype); end; else Set_Actual_Type (Assoc, Atype); end if; end Finish_Individual_Assoc_Record; -- Free recursively all the choices of ASSOC. Once the type is computed -- this is not needed anymore. procedure Clean_Individual_Association (Assoc : Iir) is El, N_El : Iir; Expr : Iir; begin El := Get_Individual_Association_Chain (Assoc); Set_Individual_Association_Chain (Assoc, Null_Iir); while Is_Valid (El) loop N_El := Get_Chain (El); pragma Assert (Get_Kind (El) in Iir_Kinds_Choice); Expr := Get_Associated_Expr (El); if Get_Kind (Expr) = Iir_Kind_Association_Element_By_Individual then Clean_Individual_Association (Expr); Free_Iir (Expr); end if; Free_Iir (El); El := N_El; end loop; end Clean_Individual_Association; procedure Finish_Individual_Association1 (Assoc : Iir; Atype : Iir) is Ntype : Iir; begin if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Individual then -- End of recursion. The association is an element association, -- not an individual one. return; end if; case Get_Kind (Atype) is when Iir_Kind_Array_Subtype_Definition | Iir_Kind_Array_Type_Definition => if Get_Constraint_State (Atype) = Fully_Constrained then Finish_Individual_Assoc_Array_Subtype (Assoc, Atype, 1); Set_Actual_Type (Assoc, Atype); else Ntype := Create_Array_Subtype (Atype, Get_Location (Assoc)); Set_Index_Constraint_Flag (Ntype, True); Set_Constraint_State (Ntype, Fully_Constrained); Set_Has_Signal_Flag (Ntype, Get_Has_Signal_Flag (Atype)); Set_Actual_Type (Assoc, Ntype); Set_Actual_Type_Definition (Assoc, Ntype); Finish_Individual_Assoc_Array (Assoc, Assoc, 1); end if; when Iir_Kind_Record_Type_Definition | Iir_Kind_Record_Subtype_Definition => Finish_Individual_Assoc_Record (Assoc, Atype); when Iir_Kinds_Scalar_Type_And_Subtype_Definition => null; when others => Error_Kind ("finish_individual_association", Atype); end case; end Finish_Individual_Association1; -- Called by sem_individual_association to finish the analyze of -- individual association ASSOC: compute bounds, detect missing elements. procedure Finish_Individual_Association (Assoc : Iir) is Inter : Iir; Atype : Iir; begin -- Guard. if Get_Choice_Staticness (Assoc) /= Locally then return; end if; Inter := Get_Interface_Of_Formal (Get_Formal (Assoc)); Atype := Get_Type (Inter); Set_Whole_Association_Flag (Assoc, True); Finish_Individual_Association1 (Assoc, Atype); -- Free the hierarchy, keep only the top individual association. Clean_Individual_Association (Assoc); end Finish_Individual_Association; -- Sem individual associations of ASSOCS: -- Add an Iir_Kind_Association_Element_By_Individual before each -- group of individual association for the same formal, and call -- Finish_Individual_Association with each of these added nodes. -- -- The purpose of By_Individual association is to have the type of the -- actual (might be an array subtype), and also to be sure that all -- sub-elements are associated. For that a tree is created. The tree is -- rooted by the top Association_Element_By_Individual, which contains a -- chain of choices (like the aggregate). The child of a choice is either -- an Association_Element written by the user, or a new subtree rooted -- by another Association_Element_By_Individual. The tree doesn't -- follow all the ownership rules: the formal of sub association_element -- are directly set to the association, and the associated_expr of the -- choices are directly set to formals. -- -- This tree is temporary (used only during analysis of the individual -- association) and removed once the check is done. procedure Sem_Individual_Association (Assoc_Chain : in out Iir) is Assoc : Iir; Prev_Assoc : Iir; Iassoc : Iir_Association_Element_By_Individual; Cur_Iface : Iir; Formal : Iir; begin Iassoc := Null_Iir; Cur_Iface := Null_Iir; Prev_Assoc := Null_Iir; Assoc := Assoc_Chain; while Assoc /= Null_Iir loop Formal := Get_Formal (Assoc); if Formal /= Null_Iir then Formal := Get_Object_Prefix (Formal); end if; if Formal = Null_Iir or else Formal /= Cur_Iface then -- New formal name, analyze the current individual association -- (if any). if Iassoc /= Null_Iir then Finish_Individual_Association (Iassoc); end if; Cur_Iface := Formal; Iassoc := Null_Iir; end if; if Get_Whole_Association_Flag (Assoc) = False then -- Individual association. if Iassoc = Null_Iir then -- The first one for the interface: create a new individual -- association. Iassoc := Create_Iir (Iir_Kind_Association_Element_By_Individual); Location_Copy (Iassoc, Assoc); Set_Choice_Staticness (Iassoc, Locally); pragma Assert (Cur_Iface /= Null_Iir); Set_Formal (Iassoc, Build_Simple_Name (Cur_Iface, Get_Location (Formal))); -- Insert IASSOC. if Prev_Assoc = Null_Iir then Assoc_Chain := Iassoc; else Set_Chain (Prev_Assoc, Iassoc); end if; Set_Chain (Iassoc, Assoc); end if; -- Add this individual association to the tree. Add_Individual_Association (Iassoc, Assoc); end if; Prev_Assoc := Assoc; Assoc := Get_Chain (Assoc); end loop; -- There is maybe a remaining iassoc. if Iassoc /= Null_Iir then Finish_Individual_Association (Iassoc); end if; end Sem_Individual_Association; function Is_Conversion_Function (Assoc_Chain : Iir) return Boolean is begin -- [...] whose single parameter of the function [...] if not Is_Chain_Length_One (Assoc_Chain) then return False; end if; if Get_Kind (Assoc_Chain) /= Iir_Kind_Association_Element_By_Expression then return False; end if; -- FIXME: unfortunatly, the formal may already be set with the -- interface. -- if Get_Formal (Assoc_Chain) /= Null_Iir then -- return Null_Iir; -- end if; return True; end Is_Conversion_Function; function Is_Valid_Type_Conversion (Conv : Iir; Res_Base_Type : Iir; Param_Base_Type : Iir) return Boolean is Atype : constant Iir := Get_Type (Conv); begin return Get_Base_Type (Atype) = Res_Base_Type and then Are_Types_Closely_Related (Atype, Param_Base_Type); end Is_Valid_Type_Conversion; function Is_Valid_Function_Conversion (Call : Iir; Res_Base_Type : Iir; Param_Base_Type : Iir) return Boolean is Imp : constant Iir := Get_Implementation (Call); Res_Type : constant Iir := Get_Type (Imp); Inters : constant Iir := Get_Interface_Declaration_Chain (Imp); Param_Type : Iir; begin if Inters = Null_Iir then return False; end if; Param_Type := Get_Type (Inters); return Get_Base_Type (Res_Type) = Res_Base_Type and then Get_Base_Type (Param_Type) = Param_Base_Type; end Is_Valid_Function_Conversion; function Is_Valid_Conversion (Func : Iir; Res_Base_Type : Iir; Param_Base_Type : Iir) return Boolean is begin case Get_Kind (Func) is when Iir_Kind_Function_Call => return Is_Valid_Function_Conversion (Func, Res_Base_Type, Param_Base_Type); when Iir_Kind_Type_Conversion => return Is_Valid_Type_Conversion (Func, Res_Base_Type, Param_Base_Type); when others => Error_Kind ("is_valid_conversion", Func); end case; end Is_Valid_Conversion; function Extract_Conversion (Conv : Iir; Res_Type : Iir; Param_Type : Iir; Loc : Iir) return Iir is List : Iir_List; It : List_Iterator; Res_Base_Type : Iir; Param_Base_Type : Iir; El : Iir; Res : Iir; begin Res_Base_Type := Get_Base_Type (Res_Type); if Param_Type = Null_Iir then -- In case of error. return Null_Iir; end if; Param_Base_Type := Get_Base_Type (Param_Type); if Is_Overload_List (Conv) then List := Get_Overload_List (Conv); Res := Null_Iir; It := List_Iterate (List); while Is_Valid (It) loop El := Get_Element (It); if Is_Valid_Conversion (El, Res_Base_Type, Param_Base_Type) then if Res /= Null_Iir then raise Internal_Error; end if; Free_Iir (Conv); Res := El; end if; Next (It); end loop; else if Is_Valid_Conversion (Conv, Res_Base_Type, Param_Base_Type) then Res := Conv; else Error_Msg_Sem (+Loc, "conversion function or type does not match"); return Null_Iir; end if; end if; if Get_Kind (Res) = Iir_Kind_Function_Call then declare Imp : constant Iir := Get_Implementation (Res); Inter : constant Iir := Get_Interface_Declaration_Chain (Imp); begin if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then Error_Msg_Sem (+Loc, "interface of function must be a constant interface"); end if; if Get_Chain (Inter) /= Null_Iir then -- LRM08 6.5.7 Association lists -- In this case, the function name shall denote a function -- whose single parameter is of the type of the formal -- and [...] Error_Msg_Sem (+Loc, "conversion function must have only one parameter"); end if; end; end if; return Res; end Extract_Conversion; function Extract_In_Conversion (Conv : Iir; Res_Type : Iir; Param_Type : Iir) return Iir is Func : Iir; Assoc : Iir; begin if Conv = Null_Iir then return Null_Iir; end if; Func := Extract_Conversion (Conv, Res_Type, Param_Type, Conv); if Func = Null_Iir then return Null_Iir; end if; case Get_Kind (Func) is when Iir_Kind_Function_Call => Assoc := Get_Parameter_Association_Chain (Func); Free_Iir (Assoc); Set_Parameter_Association_Chain (Func, Null_Iir); Name_To_Method_Object (Func, Conv); return Func; when Iir_Kind_Type_Conversion => return Func; when others => Error_Kind ("extract_in_conversion", Func); end case; end Extract_In_Conversion; function Extract_Out_Conversion (Conv : Iir; Res_Type : Iir; Param_Type : Iir) return Iir is Func : Iir; begin if Conv = Null_Iir then return Null_Iir; end if; Func := Extract_Conversion (Conv, Res_Type, Param_Type, Conv); return Func; end Extract_Out_Conversion; procedure Sem_Association_Open (Assoc : Iir; Finish : Boolean; Match : out Compatibility_Level) is Formal : Iir; begin if Finish then -- LRM 4.3.3.2 Associations lists -- It is an error if an actual of open is associated with a -- formal that is associated individually. if Get_Whole_Association_Flag (Assoc) = False then Error_Msg_Sem (+Assoc, "cannot associate individually with open"); end if; Formal := Get_Formal (Assoc); if Formal /= Null_Iir then Set_Formal (Assoc, Finish_Sem_Name (Formal)); end if; end if; Match := Fully_Compatible; end Sem_Association_Open; procedure Sem_Association_Package_Type_Not_Finish (Assoc : Iir; Inter : Iir; Match : out Compatibility_Level) is Formal : constant Iir := Get_Formal (Assoc); begin if Formal = Null_Iir then -- Can be associated only once Match := Fully_Compatible; else if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol) and then Get_Identifier (Formal) = Get_Identifier (Inter) then Match := Fully_Compatible; else Match := Not_Compatible; end if; end if; end Sem_Association_Package_Type_Not_Finish; procedure Sem_Association_Package_Type_Finish (Assoc : Iir; Inter : Iir) is Formal : constant Iir := Get_Formal (Assoc); begin if Formal /= Null_Iir then pragma Assert (Get_Identifier (Formal) = Get_Identifier (Inter)); pragma Assert (Get_Named_Entity (Formal) = Inter); Set_Formal (Assoc, Finish_Sem_Name (Formal)); end if; end Sem_Association_Package_Type_Finish; procedure Sem_Association_Package (Assoc : Iir; Inter : Iir; Finish : Boolean; Match : out Compatibility_Level) is Actual : Iir; Package_Inter : Iir; begin if not Finish then Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match); return; end if; Match := Not_Compatible; Sem_Association_Package_Type_Finish (Assoc, Inter); -- Analyze actual. Actual := Get_Actual (Assoc); Actual := Sem_Denoting_Name (Actual); Set_Actual (Assoc, Actual); Actual := Get_Named_Entity (Actual); if Is_Error (Actual) then return; end if; -- LRM08 6.5.7.2 Generic map aspects -- An actual associated with a formal generic package in a -- generic map aspect shall be the name that denotes an instance -- of the uninstantiated package named in the formal generic -- package declaration [...] if Get_Kind (Actual) /= Iir_Kind_Package_Instantiation_Declaration then Error_Msg_Sem (+Assoc, "actual of association is not a package instantiation"); return; end if; Package_Inter := Get_Uninstantiated_Package_Decl (Inter); if Get_Uninstantiated_Package_Decl (Actual) /= Package_Inter then Error_Msg_Sem (+Assoc, "actual package name is not an instance of interface package"); return; end if; -- LRM08 6.5.7.2 Generic map aspects -- b) If the formal generic package declaration includes an interface -- generic map aspect in the form that includes the box (<>) symbol, -- then the instantiated package denotes by the actual may be any -- instance of the uninstantiated package named in the formal -- generic package declaration. if Get_Generic_Map_Aspect_Chain (Inter) = Null_Iir then null; else -- Other cases not yet handled. raise Internal_Error; end if; Match := Fully_Compatible; return; end Sem_Association_Package; -- Create an implicit association_element_subprogram for the declaration -- of function ID for ACTUAL_Type (a type/subtype definition). function Sem_Implicit_Operator_Association (Id : Name_Id; Actual_Type : Iir; Actual_Name : Iir) return Iir is use Sem_Scopes; -- Return TRUE if DECL is a function declaration with a comparaison -- operator profile. function Has_Comparaison_Profile (Decl : Iir) return Boolean is Inter : Iir; begin -- A function declaration. if not Is_Function_Declaration (Decl) then return False; end if; -- That returns a boolean. if (Get_Base_Type (Get_Return_Type (Decl)) /= Vhdl.Std_Package.Boolean_Type_Definition) then return False; end if; -- With 2 interfaces of type ATYPE. Inter := Get_Interface_Declaration_Chain (Decl); for I in 1 .. 2 loop if Inter = Null_Iir then return False; end if; if Get_Base_Type (Get_Type (Inter)) /= Get_Base_Type (Actual_Type) then return False; end if; Inter := Get_Chain (Inter); end loop; if Inter /= Null_Iir then return False; end if; return True; end Has_Comparaison_Profile; Interp : Name_Interpretation_Type; Decl : Iir; Res : Iir; begin Interp := Get_Interpretation (Id); while Valid_Interpretation (Interp) loop Decl := Get_Declaration (Interp); if Has_Comparaison_Profile (Decl) then Res := Create_Iir (Iir_Kind_Association_Element_Subprogram); 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_Name, "cannot find a %i declaration for type %i", (+Id, +Actual_Name)); return Null_Iir; end Sem_Implicit_Operator_Association; procedure Sem_Association_Type (Assoc : Iir; Inter : Iir; Finish : Boolean; Match : out Compatibility_Level) is Inter_Def : constant Iir := Get_Type (Inter); Actual : Iir; Actual_Type : Iir; Op_Eq, Op_Neq : Iir; begin if not Finish then Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match); return; end if; Match := Fully_Compatible; Sem_Association_Package_Type_Finish (Assoc, Inter); Actual := Get_Actual (Assoc); -- LRM08 6.5.7.2 Generic map aspects -- An actual associated with a formal generic type must be a subtype -- indication. -- FIXME: ghdl only supports type_mark! Actual := Sem_Types.Sem_Subtype_Indication (Actual); Set_Actual (Assoc, Actual); -- Set type association for analysis of reference to this interface. pragma Assert (Is_Null (Get_Associated_Type (Inter_Def))); 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_Type, Actual); if Op_Eq /= Null_Iir then Op_Neq := Sem_Implicit_Operator_Association (Std_Names.Name_Op_Inequality, Actual_Type, Actual); Set_Chain (Op_Eq, Op_Neq); Set_Subprogram_Association_Chain (Assoc, Op_Eq); end if; end Sem_Association_Type; function Has_Interface_Subprogram_Profile (Inter : Iir; Decl : Iir; Explain_Loc : Location_Type := No_Location) return Boolean is -- Handle previous assocation of interface type before full -- instantiation. function Get_Inter_Type (Inter : Iir) return Iir is Res : Iir; begin Res := Get_Type (Inter); if Get_Kind (Res) = Iir_Kind_Interface_Type_Definition then -- FIXME: recurse ? return Get_Associated_Type (Res); else return Res; end if; end Get_Inter_Type; Explain : constant Boolean := Explain_Loc /= No_Location; El_Inter, El_Decl : Iir; begin case Iir_Kinds_Interface_Subprogram_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Function_Declaration => if not Is_Function_Declaration (Decl) then if Explain then Error_Msg_Sem (Explain_Loc, " actual is not a function"); end if; return False; end if; if Get_Base_Type (Get_Inter_Type (Inter)) /= Get_Base_Type (Get_Type (Decl)) then if Explain then Error_Msg_Sem (Explain_Loc, " return type doesn't match"); end if; return False; end if; when Iir_Kind_Interface_Procedure_Declaration => if not Is_Procedure_Declaration (Decl) then if Explain then Error_Msg_Sem (Explain_Loc, " actual is not a procedure"); end if; return False; end if; end case; El_Inter := Get_Interface_Declaration_Chain (Inter); El_Decl := Get_Interface_Declaration_Chain (Decl); loop exit when Is_Null (El_Inter) and Is_Null (El_Decl); if Is_Null (El_Inter) or Is_Null (El_Decl) then if Explain then Error_Msg_Sem (Explain_Loc, " number of interfaces doesn't match"); end if; return False; end if; if Get_Base_Type (Get_Inter_Type (El_Inter)) /= Get_Base_Type (Get_Type (El_Decl)) then if Explain then Error_Msg_Sem (Explain_Loc, " type of interface %i doesn't match", +El_Inter); end if; return False; end if; El_Inter := Get_Chain (El_Inter); El_Decl := Get_Chain (El_Decl); end loop; return True; end Has_Interface_Subprogram_Profile; procedure Sem_Association_Subprogram (Assoc : Iir; Inter : Iir; Finish : Boolean; Match : out Compatibility_Level) is Discard : Boolean; pragma Unreferenced (Discard); Actual : Iir; Res : Iir; begin if not Finish then Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match); return; end if; Match := Fully_Compatible; Sem_Association_Package_Type_Finish (Assoc, Inter); Actual := Get_Actual (Assoc); -- LRM08 6.5.7.2 Generic map aspects -- An actual associated with a formal generic subprogram shall be a name -- that denotes a subprogram whose profile conforms to that of the -- formal, or the reserved word OPEN. The actual, if a predefined -- attribute name that denotes a function, shall be one of the -- predefined attributes 'IMAGE, 'VALUE, 'POS, 'VAL, 'SUCC, 'PREV, -- 'LEFTOF, or 'RIGHTOF. Sem_Name (Actual); Res := Get_Named_Entity (Actual); if Is_Error (Res) then return; end if; case Get_Kind (Res) is when Iir_Kinds_Subprogram_Declaration | Iir_Kinds_Interface_Subprogram_Declaration => if not Has_Interface_Subprogram_Profile (Inter, Res) then Error_Msg_Sem (+Assoc, "profile of %n doesn't match profile of %n", (+Actual, +Inter)); -- Explain Discard := Has_Interface_Subprogram_Profile (Inter, Res, Get_Location (Assoc)); return; end if; when Iir_Kind_Overload_List => declare Nbr_Errors : Natural; List : Iir_List; It : List_Iterator; El, R : Iir; begin Nbr_Errors := 0; R := Null_Iir; List := Get_Overload_List (Res); It := List_Iterate (List); while Is_Valid (It) loop El := Get_Element (It); if Has_Interface_Subprogram_Profile (Inter, El) then if Is_Null (R) then R := El; else 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)); else Error_Msg_Sem (+Assoc, " %n declared at %l", (+El, +El)); end if; Nbr_Errors := Nbr_Errors + 1; end if; end if; Next (It); end loop; if Is_Null (R) then Error_Msg_Sem (+Assoc, "no matching name for %n", +Inter); if True then Error_Msg_Sem (+Assoc, " these names were incompatible:"); It := List_Iterate (List); while Is_Valid (It) loop El := Get_Element (It); Error_Msg_Sem (+Assoc, " %n declared at %l", (+El, +El)); Next (It); end loop; end if; return; elsif Nbr_Errors > 0 then return; end if; Free_Overload_List (Res); Res := R; end; when others => Error_Kind ("sem_association_subprogram", Res); end case; Set_Named_Entity (Actual, Res); Vhdl.Xrefs.Xref_Name (Actual); Sem_Decls.Mark_Subprogram_Used (Res); end Sem_Association_Subprogram; procedure Sem_Association_Terminal (Assoc : Iir; Inter : Iir; Finish : Boolean; Match : out Compatibility_Level) is Actual_Name : Iir; Actual : Iir; begin if not Finish then Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match); return; end if; Match := Not_Compatible; Sem_Association_Package_Type_Finish (Assoc, Inter); -- Analyze actual. Actual_Name := Get_Actual (Assoc); Sem_Name (Actual_Name); Actual := Get_Named_Entity (Actual_Name); if Is_Error (Actual) then return; elsif Is_Overload_List (Actual) then Error_Msg_Sem (+Actual_Name, "terminal name expected"); return; else Actual := Finish_Sem_Name (Actual_Name); case Get_Kind (Get_Object_Prefix (Actual)) is when Iir_Kind_Terminal_Declaration | Iir_Kind_Interface_Terminal_Declaration => null; when others => Error_Msg_Sem (+Actual_Name, "%n is not a terminal name", +Actual); return; end case; end if; Set_Actual (Assoc, Actual); if (Get_Base_Nature (Get_Nature (Get_Named_Entity (Actual))) /= Get_Base_Nature (Get_Nature (Inter))) then Error_Msg_Sem (+Actual, "nature of actual is not the same as formal nature"); return; end if; Match := Fully_Compatible; return; end Sem_Association_Terminal; -- Associate ASSOC with interface INTERFACE -- This sets MATCH. procedure Sem_Association_By_Expression (Assoc : Iir; Inter : Iir; Formal_Name : Iir; Formal_Conv : Iir; Finish : Boolean; Match : out Compatibility_Level) is Formal_Type : Iir; Actual: Iir; Out_Conv, In_Conv : Iir; Expr : Iir; Res_Type : Iir; begin Out_Conv := Formal_Conv; if Formal_Name /= Null_Iir then Formal_Type := Get_Type (Formal_Name); else Formal_Type := Get_Type (Inter); end if; -- If the formal type is an interface type of the same interface list, -- use the associated type of the formal type to analyze the actual. if Get_Kind (Formal_Type) = Iir_Kind_Interface_Type_Definition and then (Get_Parent (Get_Type_Declarator (Formal_Type)) = Get_Parent (Inter)) then Formal_Type := Get_Associated_Type (Formal_Type); if Formal_Type = Null_Iir then -- Interface type are only allowed within generic map aspect, -- which are analyzed in one step (so Finish is true). pragma Assert (Finish); Error_Msg_Sem (+Assoc, "expression associated before its type"); Match := Not_Compatible; return; end if; end if; -- Extract conversion from actual. -- LRM08 6.5.7.1 Association lists Actual := Get_Actual (Assoc); In_Conv := Null_Iir; if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then declare -- Actual before the extraction of the conversion. Prev_Actual : constant Iir := Actual; begin -- Extract conversion and new actual (conv_expr). case Get_Kind (Actual) is when Iir_Kind_Function_Call => Expr := Get_Parameter_Association_Chain (Actual); if Is_Conversion_Function (Expr) then In_Conv := Actual; Actual := Get_Actual (Expr); end if; when Iir_Kind_Type_Conversion => if Flags.Vhdl_Std > Vhdl_87 then In_Conv := Actual; Actual := Get_Expression (Actual); end if; when others => null; end case; if Actual = Null_Iir then Match := Fully_Compatible; return; end if; -- There could be an ambiguity between a conversion and a normal -- actual expression. Check if the new actual is an object and -- if the object is of the corresponding class. if Is_Valid (In_Conv) then if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then if not Is_Signal_Object (Actual) then -- Actual is not a signal object. This is not a -- conversion but a regular association. In_Conv := Null_Iir; Actual := Prev_Actual; end if; else -- Variable: let as is. null; end if; end if; end; end if; -- 4 cases: F:out_conv, G:in_conv. -- A => B type of A = type of B -- F(A) => B type of B = type of F -- A => G(B) type of A = type of G -- F(A) => G(B) type of B = type of F, type of A = type of G if Out_Conv = Null_Iir and then In_Conv = Null_Iir then Match := Is_Expr_Compatible (Formal_Type, Actual); else Match := Fully_Compatible; if In_Conv /= Null_Iir then Match := Compatibility_Level'Min (Match, Is_Expr_Compatible (Formal_Type, In_Conv)); end if; if Out_Conv /= Null_Iir then Match := Compatibility_Level'Min (Match, Is_Expr_Compatible (Get_Type (Out_Conv), Actual)); end if; end if; if Match = Not_Compatible then if Finish and then not Is_Error (Actual) then Report_Start_Group; Error_Msg_Sem (+Assoc, "can't associate %n with %n", (+Actual, +Inter)); Error_Msg_Sem (+Assoc, "(type of %n is " & Disp_Type_Of (Actual) & ")", (1 => +Actual)); Error_Msg_Sem (+Inter, "(type of %n is " & Disp_Type_Of (Inter) & ")", +Inter); Report_End_Group; end if; return; end if; if not Finish then return; end if; -- At that point, the analysis is being finished. if Out_Conv = Null_Iir and then In_Conv = Null_Iir then Res_Type := Formal_Type; else if Out_Conv /= Null_Iir then Res_Type := Search_Compatible_Type (Get_Type (Out_Conv), Get_Type (Actual)); else Res_Type := Get_Type (Actual); end if; if In_Conv /= Null_Iir then In_Conv := Extract_In_Conversion (In_Conv, Formal_Type, Res_Type); end if; if Out_Conv /= Null_Iir then Out_Conv := Extract_Out_Conversion (Out_Conv, Res_Type, Formal_Type); end if; end if; if Res_Type = Null_Iir then -- In case of error, do not go farther. Match := Not_Compatible; return; end if; if Formal_Name /= Null_Iir then declare Formal : Iir; Conv_Assoc : Iir; begin -- Extract formal from the conversion (and unlink it from the -- conversion, as the owner of the formal is the association, not -- the conversion). Formal := Finish_Sem_Name (Get_Formal (Assoc)); case Get_Kind (Formal) is when Iir_Kind_Function_Call => pragma Assert (Formal_Conv /= Null_Iir); Set_Formal_Conversion (Assoc, Formal); Conv_Assoc := Get_Parameter_Association_Chain (Formal); Set_Parameter_Association_Chain (Formal, Null_Iir); Formal := Get_Actual (Conv_Assoc); Free_Iir (Conv_Assoc); -- Name_To_Method_Object (Func, Conv); when Iir_Kind_Type_Conversion => pragma Assert (Formal_Conv /= Null_Iir); Conv_Assoc := Formal; Set_Formal_Conversion (Assoc, Formal); Formal := Get_Expression (Formal); Set_Expression (Conv_Assoc, Null_Iir); when others => pragma Assert (Formal_Conv = Null_Iir); null; end case; Set_Formal (Assoc, Formal); -- Use the type of the formal to analyze the actual. In -- particular, the formal may be constrained while the actual is -- not. -- (but not when the formal_type is an interface type, as it -- will bring nothing more and could have been substitued by -- its associated type). Formal_Type := Get_Type (Formal); if (Out_Conv = Null_Iir and In_Conv = Null_Iir) and then Get_Kind (Formal_Type) /= Iir_Kind_Interface_Type_Definition then Res_Type := Formal_Type; end if; end; end if; -- LRM08 6.5.7 Association lists -- The formal part of a named association element may be in the form of -- a function call [...] if and only if the formal is an interface -- object, the mode of the formal is OUT, INOUT, BUFFER or LINKAGE [...] if Out_Conv /= Null_Iir and then Get_Mode (Inter) = Iir_In_Mode then Error_Msg_Sem (+Assoc, "can't use an out conversion for an in interface"); end if; -- LRM08 6.5.7 Association lists -- The actual part of an association element may be in the form of a -- function call [...] if and only if the mode of the format is IN, -- INOUT or LINKAGE [...] Set_Actual_Conversion (Assoc, In_Conv); if In_Conv /= Null_Iir and then Get_Mode (Inter) in Iir_Buffer_Mode .. Iir_Out_Mode then Error_Msg_Sem (+Assoc, "can't use an in conversion for an out/buffer interface"); end if; -- LRM08 5.3.2.2 Index constraints and discrete ranges -- e) [...] -- 3) [...] -- -- For an interface object or subelement whose mode is IN, INOUT -- or LINKAGE, if the actual part includes a conversion function -- or a type conversion, then the result type of that function -- or the type mark of the type conversion shall define a -- constraint for the index range corresponding to the index -- range of the objet, [...] -- -- For an interface object or subelement whose mode is OUT, -- BUFFER, INOUT or LINKAGE, if the formal part includes a -- conversion function or a type conversion, then the parameter -- subtype of that function or the type mark of the type -- conversion shall define a constraint for the index range -- corresponding to the index range of the object, [...] if not Is_Fully_Constrained_Type (Formal_Type) then if (Get_Mode (Inter) in Iir_In_Modes or else Get_Mode (Inter) = Iir_Linkage_Mode) and then In_Conv /= Null_Iir and then not Is_Fully_Constrained_Type (Get_Type (In_Conv)) then Error_Msg_Sem (+Assoc, "type of actual conversion must be fully constrained"); end if; if (Get_Mode (Inter) in Iir_Out_Modes or else Get_Mode (Inter) = Iir_Linkage_Mode) and then Out_Conv /= Null_Iir and then not Is_Fully_Constrained_Type (Get_Type (Out_Conv)) then Error_Msg_Sem (+Assoc, "type of formal conversion must be fully constrained"); end if; end if; -- FIXME: LRM refs -- This is somewhat wrong. A missing conversion is not an error but -- may result in a type mismatch. if Get_Mode (Inter) = Iir_Inout_Mode then if In_Conv = Null_Iir and then Out_Conv /= Null_Iir then Error_Msg_Sem (+Assoc, "out conversion without corresponding in conversion"); elsif In_Conv /= Null_Iir and then Out_Conv = Null_Iir then Error_Msg_Sem (+Assoc, "in conversion without corresponding out conversion"); end if; end if; Set_Actual (Assoc, Actual); -- Analyze actual. Expr := Sem_Expression (Actual, Res_Type); if Expr /= Null_Iir then Expr := Eval_Expr_Check_If_Static (Expr, Res_Type); Set_Actual (Assoc, Expr); if In_Conv = Null_Iir and then Out_Conv = Null_Iir then if not Eval_Is_In_Bound (Expr, Formal_Type, True) then Error_Msg_Sem (+Assoc, "actual constraints don't match formal ones"); end if; end if; end if; end Sem_Association_By_Expression; -- Associate ASSOC with interface INTERFACE -- This sets MATCH. procedure Sem_Association (Assoc : Iir; Inter : Iir; Formal : Iir; Formal_Conv : Iir; Finish : Boolean; Match : out Compatibility_Level) is begin case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is when Iir_Kinds_Interface_Object_Declaration => if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then Sem_Association_Open (Assoc, Finish, Match); else Sem_Association_By_Expression (Assoc, Inter, Formal, Formal_Conv, Finish, Match); end if; when Iir_Kind_Interface_Terminal_Declaration => if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then Sem_Association_Open (Assoc, Finish, Match); else Sem_Association_Terminal (Assoc, Inter, Finish, Match); end if; when Iir_Kind_Interface_Package_Declaration => Sem_Association_Package (Assoc, Inter, Finish, Match); when Iir_Kind_Interface_Type_Declaration => Sem_Association_Type (Assoc, Inter, Finish, Match); when Iir_Kinds_Interface_Subprogram_Declaration => Sem_Association_Subprogram (Assoc, Inter, Finish, Match); end case; end Sem_Association; procedure Sem_Association_Chain (Interface_Chain : Iir; Assoc_Chain: in out Iir; Finish: Boolean; Missing : Missing_Type; Loc : Iir; Match : out Compatibility_Level) is Assoc : Iir; Inter : Iir; -- True if -Whide is enabled (save the state). Warn_Hide_Enabled : Boolean; type Param_Assoc_Type is (None, Open, Individual, Whole); type Assoc_Array is array (Natural range <>) of Param_Assoc_Type; Nbr_Inter : constant Natural := Get_Chain_Length (Interface_Chain); Inter_Matched : Assoc_Array (0 .. Nbr_Inter - 1) := (others => None); Last_Individual : Iir; Has_Individual : Boolean; Pos : Integer; Formal : Iir; First_Named_Assoc : Iir; Last_Named_Assoc : Iir; Formal_Name : Iir; Formal_Conv : Iir; begin Match := Fully_Compatible; First_Named_Assoc := Null_Iir; Has_Individual := False; -- Clear associated type of interface type. Inter := Interface_Chain; while Inter /= Null_Iir loop if Get_Kind (Inter) = Iir_Kind_Interface_Type_Declaration then Set_Associated_Type (Get_Type (Inter), Null_Iir); end if; Inter := Get_Chain (Inter); end loop; -- Loop on every assoc element, try to match it. Inter := Interface_Chain; Last_Individual := Null_Iir; Pos := 0; -- First positional associations Assoc := Assoc_Chain; while Assoc /= Null_Iir loop Formal := Get_Formal (Assoc); exit when Formal /= Null_Iir; -- Try to match actual of ASSOC with the interface. if Inter = Null_Iir then if Finish then Error_Msg_Sem (+Assoc, "too many actuals for %n", +Loc); end if; Match := Not_Compatible; return; end if; Set_Whole_Association_Flag (Assoc, True); Sem_Association (Assoc, Inter, Null_Iir, Null_Iir, Finish, Match); if Match = Not_Compatible then return; end if; if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then Inter_Matched (Pos) := Open; else Inter_Matched (Pos) := Whole; end if; Set_Whole_Association_Flag (Assoc, True); Inter := Get_Chain (Inter); Pos := Pos + 1; Assoc := Get_Chain (Assoc); end loop; -- Then association by name. if Assoc /= Null_Iir then -- Make interfaces visible -- -- LRM08 12.3 Visibility -- A declaration is visible by selection at places that are defined -- as follows: -- j) For a formal parameter declaration of a given subprogram -- declaration: at the place of the formal part (before the -- compound delimiter =>) of a named parameter association -- element of a corresponding subprogram call. -- k) For a local generic declaration of a given component -- declaration ... -- l) For a local port declaration of a given component declaration: -- ... -- m) For a formal generic declaration of a given entity declaration: -- ... -- n) For a formal port declaration of a given entity declaration: -- ... -- o) For a formal generic declaration or a formal port declaration -- of a given block statement: ... -- p) For a formal generic declaration of a given package -- declaration: ... -- q) For a formal generic declaration of a given subprogram -- declarations: ... -- -- At a place in which a given declaration is visible by selection, -- every declaration with the same designator as the given -- declaration and that would otherwise be directly visible is -- hidden. Sem_Scopes.Open_Declarative_Region; -- Do not warn about hidding here, way to common, way useless. Warn_Hide_Enabled := Is_Warning_Enabled (Warnid_Hide); Enable_Warning (Warnid_Hide, False); Sem_Scopes.Add_Declarations_From_Interface_Chain (Interface_Chain); Enable_Warning (Warnid_Hide, Warn_Hide_Enabled); First_Named_Assoc := Assoc; loop if Formal = Null_Iir then -- Positional after named argument. Already caught by -- Sem_Actual_Of_Association_Chain (because it is called only -- once, while sem_association_chain may be called several -- times). Match := Not_Compatible; exit; end if; -- Last assoc to be cleaned up. Last_Named_Assoc := Assoc; if Finish then Sem_Name (Formal); else Sem_Name_Soft (Formal); end if; Formal_Name := Get_Named_Entity (Formal); if Is_Error (Formal_Name) then Match := Not_Compatible; -- Continue analysis in order to catch more errors. end if; Assoc := Get_Chain (Assoc); exit when Assoc = Null_Iir; Formal := Get_Formal (Assoc); end loop; -- Remove visibility by selection of interfaces. This is needed -- to correctly analyze actuals. Sem_Scopes.Close_Declarative_Region; if Match /= Not_Compatible then Assoc := First_Named_Assoc; loop Formal := Get_Formal (Assoc); Formal_Name := Get_Named_Entity (Formal); -- Extract conversion Formal_Conv := Null_Iir; case Get_Kind (Formal_Name) is when Iir_Kind_Function_Call => -- Only one actual declare Call_Assoc : constant Iir := Get_Parameter_Association_Chain (Formal_Name); begin if (Get_Kind (Call_Assoc) /= Iir_Kind_Association_Element_By_Expression) or else Get_Chain (Call_Assoc) /= Null_Iir or else Get_Formal (Call_Assoc) /= Null_Iir or else (Get_Actual_Conversion (Call_Assoc) /= Null_Iir) then if Finish then Error_Msg_Sem (+Assoc, "ill-formed formal conversion"); end if; Match := Not_Compatible; exit; end if; Formal_Conv := Formal_Name; Formal_Name := Get_Actual (Call_Assoc); end; when Iir_Kind_Type_Conversion => Formal_Conv := Formal_Name; Formal_Name := Get_Expression (Formal_Name); when Iir_Kind_Slice_Name | Iir_Kind_Indexed_Name | Iir_Kind_Selected_Element | Iir_Kind_Simple_Name => null; when others => Formal_Name := Formal; end case; case Get_Kind (Formal_Name) is when Iir_Kind_Selected_Element | Iir_Kind_Slice_Name | Iir_Kind_Indexed_Name => Inter := Get_Base_Name (Formal_Name); Set_Whole_Association_Flag (Assoc, False); when Iir_Kind_Simple_Name | Iir_Kind_Operator_Symbol => Inter := Get_Named_Entity (Formal_Name); Formal_Name := Inter; Set_Whole_Association_Flag (Assoc, True); when others => -- Error if Finish then Error_Msg_Sem (+Assoc, "formal is not a name"); end if; Match := Not_Compatible; exit; end case; -- Simplify overload list (for interface subprogram). -- FIXME: Interface must hide previous subprogram declarations, -- so there should be no need to filter. if Is_Overload_List (Inter) then declare List : constant Iir_List := Get_Overload_List (Inter); It : List_Iterator; Filtered_Inter : Iir; El : Iir; begin Filtered_Inter := Null_Iir; It := List_Iterate (List); while Is_Valid (It) loop El := Get_Element (It); if Get_Kind (El) in Iir_Kinds_Interface_Declaration and then Get_Parent (El) = Get_Parent (Interface_Chain) then Add_Result (Filtered_Inter, El); end if; Next (It); end loop; Free_Overload_List (Inter); Inter := Filtered_Inter; pragma Assert (Get_Kind (Formal) = Iir_Kind_Simple_Name or else Get_Kind (Formal) = Iir_Kind_Operator_Symbol); Set_Named_Entity (Formal, Inter); if Inter = Null_Iir then if Finish then Error_Msg_Sem (+Assoc, "no interface %i for %n", (+Formal, +Loc)); end if; Match := Not_Compatible; exit; end if; if Is_Overload_List (Inter) then if Finish then Error_Msg_Sem (+Assoc, "ambiguous formal name"); end if; Match := Not_Compatible; exit; end if; end; end if; if Get_Kind (Inter) not in Iir_Kinds_Interface_Declaration or else Interface_Chain = Null_Iir or else Get_Parent (Inter) /= Get_Parent (Interface_Chain) then if Finish then Error_Msg_Sem (+Formal, "%n is not an interface name", +Inter); end if; Match := Not_Compatible; exit; end if; -- LRM 4.3.2.2 Association Lists -- The formal part of a named element association may be -- in the form of a function call, [...], if and only -- if the mode of the formal is OUT, INOUT, BUFFER, or -- LINKAGE, and the actual is not OPEN. if Formal_Conv /= Null_Iir and then (Get_Kind (Inter) not in Iir_Kinds_Interface_Object_Declaration or else Get_Mode (Inter) = Iir_In_Mode) then if Finish then Error_Msg_Sem (+Assoc, "formal conversion allowed only for interface object"); end if; Match := Not_Compatible; exit; end if; -- Find the Interface. declare Inter1 : Iir; begin Inter1 := Interface_Chain; Pos := 0; while Inter1 /= Null_Iir loop exit when Inter = Inter1; Inter1 := Get_Chain (Inter1); Pos := Pos + 1; end loop; if Inter1 = Null_Iir then if Finish then Error_Msg_Sem (+Assoc, "no corresponding interface for %i", +Inter); end if; Match := Not_Compatible; exit; end if; end; Sem_Association (Assoc, Inter, Formal_Name, Formal_Conv, Finish, Match); exit when Match = Not_Compatible; if Get_Whole_Association_Flag (Assoc) then -- Whole association. Last_Individual := Null_Iir; if Inter_Matched (Pos) = None then if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then Inter_Matched (Pos) := Open; else Inter_Matched (Pos) := Whole; end if; else if Finish then Error_Msg_Sem (+Assoc, "%n already associated", +Inter); end if; Match := Not_Compatible; exit; end if; else -- Individual association. Has_Individual := True; if Inter_Matched (Pos) /= Whole then if Finish and then Inter_Matched (Pos) = Individual and then Last_Individual /= Inter then Error_Msg_Sem (+Assoc, "non consecutive individual association for %n", +Inter); Match := Not_Compatible; exit; end if; Last_Individual := Inter; Inter_Matched (Pos) := Individual; else if Finish then Error_Msg_Sem (+Assoc, "%n already associated", +Inter); Match := Not_Compatible; exit; end if; end if; end if; Assoc := Get_Chain (Assoc); exit when Assoc = Null_Iir; end loop; end if; if Finish and Has_Individual and Match /= Not_Compatible then Sem_Individual_Association (Assoc_Chain); end if; if not Finish then -- Always cleanup if not finishing: there can be other tries in -- case of overloading. Assoc := First_Named_Assoc; while Assoc /= Null_Iir loop Formal := Get_Formal (Assoc); -- User may have used by position assoc after named -- assocs. if Is_Valid (Formal) then Sem_Name_Clean (Formal); end if; exit when Assoc = Last_Named_Assoc; Assoc := Get_Chain (Assoc); end loop; end if; if Match = Not_Compatible then return; end if; end if; if Missing = Missing_Allowed then -- No need to check for missing associations. return; end if; -- LRM93 8.6 Procedure Call Statement -- For each formal parameter of a procedure, a procedure call must -- specify exactly one corresponding actual parameter. -- This actual parameter is specified either explicitly, by an -- association element (other than the actual OPEN) in the association -- list, or in the absence of such an association element, by a default -- expression (see Section 4.3.3.2). -- LRM93 7.3.3 Function Calls -- For each formal parameter of a function, a function call must -- specify exactly one corresponding actual parameter. -- This actual parameter is specified either explicitly, by an -- association element (other than the actual OPEN) in the association -- list, or in the absence of such an association element, by a default -- expression (see Section 4.3.3.2). -- LRM93 1.1.1.2 / LRM08 6.5.6.3 Port clauses -- A port of mode IN may be unconnected or unassociated only if its -- declaration includes a default expression. -- A port of any mode other than IN may be unconnected or unassociated -- as long as its type is not an unconstrained array type. -- LRM08 6.5.6.2 Generic clauses -- It is an error if no such actual [instantiated package] is specified -- for a given formal generic package (either because the formal generic -- is unassociated or because the actual is OPEN). Inter := Interface_Chain; Pos := 0; while Inter /= Null_Iir loop if Inter_Matched (Pos) <= Open then if Sem_Check_Missing_Association (Inter, Missing, Finish, Loc) then Match := Not_Compatible; if not Finish then return; end if; end if; end if; Inter := Get_Chain (Inter); Pos := Pos + 1; end loop; end Sem_Association_Chain; function Sem_Check_Missing_Association (Inter : Iir; Missing : Missing_Type; Finish : Boolean; Loc : Iir) return Boolean is Err : Boolean; begin -- Interface is unassociated (none or open). Err := False; case Get_Kind (Inter) is when Iir_Kinds_Interface_Object_Declaration => case Missing is when Missing_Parameter | Missing_Generic => if Get_Mode (Inter) /= Iir_In_Mode or else Get_Default_Value (Inter) = Null_Iir then Err := True; if Finish then Error_Msg_Sem (+Loc, "no actual for %n", +Inter); else return True; end if; end if; when Missing_Port => case Get_Mode (Inter) is when Iir_In_Mode => -- No overloading for components/entities. pragma Assert (Finish); if Get_Default_Value (Inter) = Null_Iir then Error_Msg_Sem (+Loc, "%n of mode IN must be connected", +Inter); Err := True; end if; when Iir_Out_Mode | Iir_Linkage_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => -- No overloading for components/entities. pragma Assert (Finish); if not Is_Fully_Constrained_Type (Get_Type (Inter)) then Error_Msg_Sem (+Loc, "unconstrained %n must be connected", +Inter); Err := True; end if; when Iir_Unknown_Mode => raise Internal_Error; end case; when Missing_Allowed => null; end case; when Iir_Kind_Interface_Package_Declaration => if Get_Generic_Map_Aspect_Chain (Inter) = Null_Iir then Error_Msg_Sem (+Loc, "%n must be associated", +Inter); Err := True; end if; when Iir_Kind_Interface_Function_Declaration | Iir_Kind_Interface_Procedure_Declaration => Error_Msg_Sem (+Loc, "%n must be associated", +Inter); Err := True; when others => Error_Kind ("sem_association_chain", Inter); end case; return Err; end Sem_Check_Missing_Association; end Vhdl.Sem_Assocs;