diff options
| -rw-r--r-- | canon.adb | 3 | ||||
| -rw-r--r-- | doc/ghdl.1 | 108 | ||||
| -rw-r--r-- | doc/ghdl.texi | 75 | ||||
| -rw-r--r-- | iirs.adb | 82 | ||||
| -rw-r--r-- | iirs.ads | 39 | ||||
| -rw-r--r-- | ortho/mcode/binary_file-memory.adb | 23 | ||||
| -rw-r--r-- | ortho/mcode/binary_file-memory.ads | 3 | ||||
| -rw-r--r-- | ortho/mcode/ortho_code-decls.adb | 1 | ||||
| -rw-r--r-- | sem.adb | 18 | ||||
| -rw-r--r-- | sem_assocs.adb | 12 | ||||
| -rw-r--r-- | sem_decls.adb | 1 | ||||
| -rw-r--r-- | sem_expr.adb | 5 | ||||
| -rw-r--r-- | sem_names.adb | 8 | ||||
| -rw-r--r-- | sem_specs.adb | 13 | ||||
| -rw-r--r-- | translate/ghdldrv/foreigns.adb | 64 | ||||
| -rw-r--r-- | translate/ghdldrv/foreigns.ads | 5 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 64 | ||||
| -rw-r--r-- | translate/grt/Makefile.inc | 5 | ||||
| -rw-r--r-- | translate/grt/grt-avhpi.adb | 2 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_addr.adb | 2 | ||||
| -rw-r--r-- | translate/grt/grt-signals.ads | 4 | ||||
| -rw-r--r-- | translate/grt/grt-vpi.adb | 199 | ||||
| -rw-r--r-- | translate/trans_be.adb | 2 | ||||
| -rw-r--r-- | translate/translation.adb | 208 | ||||
| -rw-r--r-- | translate/translation.ads | 24 |
25 files changed, 783 insertions, 187 deletions
@@ -226,7 +226,8 @@ package body Canon is | Iir_Kind_Constant_Interface_Declaration | Iir_Kind_Iterator_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration => + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_File_Declaration => null; when Iir_Kind_Left_Array_Attribute diff --git a/doc/ghdl.1 b/doc/ghdl.1 new file mode 100644 index 000000000..d65bf68ad --- /dev/null +++ b/doc/ghdl.1 @@ -0,0 +1,108 @@ +.\" Hey, EMACS: -*- nroff -*- +.\" First parameter, NAME, should be all caps +.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection +.\" other parameters are allowed: see man(7), man(1) +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp <n> insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.TH "GHDL" "1" "Jun 24, 2006" "" "" +.SH "NAME" +ghdl \- VHDL compiler/simulator +.SH "SYNOPSIS" +.B ghdl +.RI [ command ] " " [ options ] " files" ... +.br +.SH "DESCRIPTION" +This manual page documents briefly the +.B ghdl +command. +This manual page was written for user of man, but is not as complete as the +reference documentation. +.PP +Instead, users should read the GHDL texinfo manual +.SH "OPTIONS" +This program follows the usual GNU command line syntax, with long +options starting with two dashes (`\-'). +A summary of the main modes and options is included below. +For a complete description, refer to the GHDL texinfo manual. +.PP +Basic commands: +.TP +.B \-a +Analysis, i.e. \fIghdl \-a file.vhdl\fP +.TP +.B \-e +Elabortation, i.e. \fIghdl \-e unit_name\fP +.TP +.B \-r +Run: run the simulation, i.e. \fIghdl \-r unit_name\fP +.TP +.B \-s +Syntax\-check, i.e. \fIghdl \-s file.vhdl\fP +.TP +.B \-\-clean +Clean: remove generated files, i.e. \fIghdl \-\-clean\fP +.TP +.B \-h, \-\-help +Help, i.e. \fIghdl \-\-help\fP +.TP +.B \-\-version +Version, i.e. \fIghdl \-\-version\fP +.PP +Basic options: +.TP +.B \-\-work=NAME +Name of the WORK library, i.e. \fI ghdl \-a \-\-work=foo foo.vhdl\fP +.TP +.B \-\-std=STD +Which VHDL standard (87|93|93c|00|02), i.e. \fIghdl \-a \-\-std=87 old.vhdl\fP +.TP +.B \-\-ieee=VER +Which IEEE library (none|standard|synopsys|mentor), i.e. \fIghdl \-a \-\-ieee=synopsys broken.vhdl\fP +.TP +.B \-\-no\-vital\-checks +Disable VITAL restriction checking, i.e. \fIghdl \-a \-\-no\-vital\-checks unsupported_vital.vhdl\fP +.PP +There are many more modes and options; +please consult the documentation. +.PP +Executables created by GHDL have addition simulation options. The +most important ones are listed below: +.TP +.B \-\-help +Show options for simulation and execution. +.TP +.B \-\-assert\-level=LEVEL +Assert level at which to stop simulation (none|note|warning|error|failure), i.e. \fI./touchy_design \-\-assert\-level=note\fB +.TP +.B \-\-stop\-time=TIME +Stop simuation after TIME, i.e. \fI./design \-\-stop\-time=50ns +.TP +.B \-\-vcd=FILENAME +Dump VCD to FILENAME (a waveform dump, viewable with\-\-for instance\-\-\fBgtkwave\fP), i.e. \fI./design \-\-vcd=design.vcd +.TP +.B \-\-sdf=[TYPE=]PATH=FILENAME +Back annotate SDF onto design using TYPE (min|typ|max), instance PATH, and SDF file FILENAME, i.e. \fI./sdf_design \-\-sdf=typ=top/inst=inst.sdf\fP + +.SH "SEE ALSO" +.TP +.B gtkwave (1) +.PP +.br +The texinfo manual fully documents GHDL. You may also browse it at +\fB<http://ghdl.free.fr/ghdl/index.html>\fP. +.SH "AUTHOR" +This manual page was written by Wesley J. Landaker +<wjl@icecavern.net>, for the Debian project (but may be used by +others). It is released under the same terms as GHDL, i.e. the GNU +General Public License. It was modified by Tristan Gingold to include +it in the GHDL sources. diff --git a/doc/ghdl.texi b/doc/ghdl.texi index e704221c9..e83a0ac55 100644 --- a/doc/ghdl.texi +++ b/doc/ghdl.texi @@ -11,7 +11,7 @@ @titlepage @title GHDL guide @subtitle GHDL, a VHDL compiler -@subtitle For GHDL version 0.22 (Sokcho edition) +@subtitle For GHDL version 0.25 (Sokcho edition) @author Tristan Gingold @c The following two commands start the copyright page. @page @@ -163,10 +163,14 @@ or @code{C++}. Therefore, the compiled code should be faster and the analysis time should be shorter than with a compiler using an intermediary language. +The Windows(TM) version of @code{GHDL} is not based on @code{GCC} but on +an internal code generator. + The current version of @code{GHDL} does not contain any graphical viewer: you cannot see signal waves. You can still check with a test bench. The current version can produce a @code{VCD} file which can be -viewed with a wave viewer. +viewed with a wave viewer, as well as @code{ghw} files to be viewed by +@samp{gtkwave}. @code{GHDL} aims at implementing @code{VHDL} as defined by IEEE 1076. It supports most of the 1987 standard and most features added by the @@ -217,9 +221,10 @@ file in VHDL terms. @smallexample $ ghdl -a hello.vhdl @end smallexample -This command generates a file @file{hello.o}, which is the object file -corresponding to your VHDL program. This command also creates or updates -a file @file{work-obj93.cf}, which describes the library @samp{work}. +This command creates or updates a file @file{work-obj93.cf}, which +describes the library @samp{work}. On GNU/Linux, this command generates a +file @file{hello.o}, which is the object file corresponding to your +VHDL program. The object file is not created on Windows. Then, you have to build an executable file. @smallexample @@ -229,7 +234,8 @@ The @samp{-e} option means @dfn{elaborate}. With this option, @code{GHDL} creates code in order to elaborate a design, with the @samp{hello} entity at the top of the hierarchy. -The result is an executable program called @file{hello} which can be run: +On GNU/Linux, the result is an executable program called @file{hello} +which can be run: @smallexample $ ghdl -r hello_world @end smallexample @@ -238,7 +244,12 @@ or directly: $ ./hello_world @end smallexample -and which should display: +On Windows, no file is created. The simulation is launched using this command: +@smallexample +> ghdl -r hello_world +@end smallexample + +The result of the simulation appears on the screen: @smallexample Hello world! @end smallexample @@ -558,10 +569,13 @@ $ ghdl -a -g my_design.vhdl $ ghdl -e [@var{options}] @var{primary_unit} [@var{secondary_unit}] @end smallexample -The @dfn{elaboration} command creates an executable containing the -code of the @code{VHDL} sources, the elaboration code and simulation -code to execute a design hiearachy. The elaboration command is selected -with @var{-e} switch, and must be followed by either: +On GNU/Linux the @dfn{elaboration} command creates an executable +containing the code of the @code{VHDL} sources, the elaboration code +and simulation code to execute a design hiearachy. On Windows this +command elaborates the design but does not generate anything. + +The elaboration command is selected with @var{-e} switch, and must be +followed by either: @itemize @bullet @item a name of a configuration unit @@ -576,9 +590,10 @@ option, as described in @ref{GHDL options}. @xref{Top entity}, for the restrictions on the root design of a hierarchy. -The file name of the executable is the name of the primary unit, or for -the later case, the concatenation of the name of the primary unit, a -dash, and the name of the secondary unit (or architecture). +On GNU/Linux the file name of the executable is the name of the +primary unit, or for the later case, the concatenation of the name of +the primary unit, a dash, and the name of the secondary unit (or +architecture). On Windows there is no executable generated. The @option{-o} followed by a file name can override the default executable file name. @@ -603,9 +618,10 @@ Run (or simulate) an elaborated design hierarchy. $ ghdl -r @var{primary_unit} [@var{secondary_unit}] [@var{simulation_options}] @end smallexample -The arguments are the same as the @xref{Elaboration command}. This command -simply build the filename of the executable and execute it. You may also -directly execute the program. +The arguments are the same as the @xref{Elaboration command}. + +On GNU/Linux this command simply build the filename of the executable +and execute it. You may also directly execute the program. This command exists for three reasons: @itemize @bullet{} @@ -614,10 +630,12 @@ You don't have to create the executable program name. @item It is coherent with the @samp{-a} and @samp{-e} commands. @item -It will work with future implementations, where the code is generated in +It works with the Windows implementation, where the code is generated in memory. @end itemize +On Windows this command elaborate and launch the simulation. + @xref{Simulation and run time}, for details on options. @node Elaborate and run command, Bind command, Run command, Building commands @@ -644,6 +662,8 @@ Bind a design unit and prepare the link step. $ ghdl --bind [@var{options}] @var{primary_unit} [@var{secondary_unit}] @end smallexample +This command is only available on GNU/Linux. + This performs only the first stage of the elaboration command; the list of objects files is created but the executable is not built. This command should be used only when the main entry point is not ghdl. @@ -672,6 +692,8 @@ Disp files which will be linked. $ ghdl --list-link @var{primary_unit} [@var{secondary_unit}] @end smallexample +This command is only available on GNU/Linux. + This command may be used only after a bind command. GHDL displays all the files which will be linked to create an executable. This command is intended to add object files in a link of an foreign program. @@ -683,7 +705,7 @@ intended to add object files in a link of an foreign program. Analyze files but do not generate code. @smallexample -$ ghdl -a [@var{options}] @var{files} +$ ghdl -s [@var{options}] @var{files} @end smallexample This command may be used to check the syntax of files. It does not update @@ -695,13 +717,19 @@ the library. @cindex @option{-c} command Analyze files and elaborate in the same time. +On GNU/Linux: @smallexample $ ghdl -c [@var{options}] @var{file}@dots{} -e @var{primary_unit} [@var{secondary_unit}] @end smallexample +On Windows: +@smallexample +$ ghdl -c [@var{options}] @var{file}@dots{} -r @var{primary_unit} [@var{secondary_unit}] +@end smallexample + This command combines analyze and elaboration: @var{file}s are analyzed and the unit is then elaborated. However, code is only generated during the -elaboration. +elaboration. On Windows the simulation is launched. To be more precise, the files are first parsed, and then the elaboration drives the analysis. Therefore, there is no analysis order, and you don't @@ -878,6 +906,9 @@ displays the commands executed. @node Passing options to other programs, GHDL warnings, GHDL options, Invoking GHDL @comment node-name, next, previous, up @section Passing options to other programs + +These options are only available on GNU/Linux. + For many commands, @code{GHDL} acts as a driver: it invokes programs to perform the command. You can pass arbritrary options to these programs. @@ -1671,6 +1702,8 @@ Display a short description of the options accepted by the run time library. @section Debugging VHDL programs @cindex debugging @cindex @code{__ghdl_fatal} +Debugging VHDL programs usign @code{GDB} is possible only on GNU/Linux systems. + @code{GDB} is a general purpose debugger for programs compiled by @code{GCC}. Currently, there is no VHDL support for @code{GDB}. It may be difficult to inspect variables or signals in @code{GDB}, however, @code{GDB} is @@ -1949,6 +1982,8 @@ web, but they cannot be included in GHDL. @cindex foreign @cindex VHPI @cindex VHPIDIRECT +Interfacing with foreign languages is possible only on GNU/Linux systems. + You can define a subprogram in a foreign language (such as @code{C} or @code{Ada}) and import it in a VHDL design. @@ -449,14 +449,6 @@ package body Iirs is | Iir_Kind_Pred_Attribute | Iir_Kind_Leftof_Attribute | Iir_Kind_Rightof_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute | Iir_Kind_Delayed_Attribute | Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute @@ -473,6 +465,14 @@ package body Iirs is | Iir_Kind_Simple_Name_Attribute | Iir_Kind_Instance_Name_Attribute | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute | Iir_Kind_Attribute_Name => return Format_Short; when Iir_Kind_Design_File @@ -2276,14 +2276,6 @@ package body Iirs is | Iir_Kind_Pred_Attribute | Iir_Kind_Leftof_Attribute | Iir_Kind_Rightof_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute | Iir_Kind_Delayed_Attribute | Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute @@ -2298,6 +2290,14 @@ package body Iirs is | Iir_Kind_Simple_Name_Attribute | Iir_Kind_Instance_Name_Attribute | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute | Iir_Kind_Attribute_Name => null; when others => @@ -5326,14 +5326,6 @@ package body Iirs is | Iir_Kind_Pred_Attribute | Iir_Kind_Leftof_Attribute | Iir_Kind_Rightof_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute | Iir_Kind_Delayed_Attribute | Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute @@ -5348,6 +5340,14 @@ package body Iirs is | Iir_Kind_Simple_Name_Attribute | Iir_Kind_Instance_Name_Attribute | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute | Iir_Kind_Attribute_Name => null; when others => @@ -5654,14 +5654,6 @@ package body Iirs is | Iir_Kind_Pred_Attribute | Iir_Kind_Leftof_Attribute | Iir_Kind_Rightof_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute | Iir_Kind_Delayed_Attribute | Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute @@ -5676,6 +5668,14 @@ package body Iirs is | Iir_Kind_Simple_Name_Attribute | Iir_Kind_Instance_Name_Attribute | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute | Iir_Kind_Attribute_Name => null; when others => @@ -5724,10 +5724,10 @@ package body Iirs is | Iir_Kind_Right_Array_Attribute | Iir_Kind_High_Array_Attribute | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute => + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute => null; when others => Failed ("Index_Subtype", Target); @@ -5757,18 +5757,18 @@ package body Iirs is | Iir_Kind_Pred_Attribute | Iir_Kind_Leftof_Attribute | Iir_Kind_Rightof_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute | Iir_Kind_Left_Array_Attribute | Iir_Kind_Right_Array_Attribute | Iir_Kind_High_Array_Attribute | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute | Iir_Kind_Length_Array_Attribute | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute => + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute => null; when others => Failed ("Parameter", Target); @@ -2646,14 +2646,6 @@ package Iirs is Iir_Kind_Pred_Attribute, -- scalar_type_attribute Iir_Kind_Leftof_Attribute, -- scalar_type_attribute Iir_Kind_Rightof_Attribute, -- scalar_type_attribute - Iir_Kind_Left_Array_Attribute, -- array_attribute - Iir_Kind_Right_Array_Attribute, -- array_attribute - Iir_Kind_High_Array_Attribute, -- array_attribute - Iir_Kind_Low_Array_Attribute, -- array_attribute - Iir_Kind_Range_Array_Attribute, -- array_attribute - Iir_Kind_Reverse_Range_Array_Attribute, -- array_attribute - Iir_Kind_Length_Array_Attribute, -- array_attribute - Iir_Kind_Ascending_Array_Attribute, -- array_attribute Iir_Kind_Delayed_Attribute, -- signal_attribute Iir_Kind_Stable_Attribute, -- signal_attribute Iir_Kind_Quiet_Attribute, -- signal_attribute @@ -2670,6 +2662,14 @@ package Iirs is Iir_Kind_Simple_Name_Attribute, Iir_Kind_Instance_Name_Attribute, Iir_Kind_Path_Name_Attribute, + Iir_Kind_Left_Array_Attribute, -- array_attribute + Iir_Kind_Right_Array_Attribute, -- array_attribute + Iir_Kind_High_Array_Attribute, -- array_attribute + Iir_Kind_Low_Array_Attribute, -- array_attribute + Iir_Kind_Length_Array_Attribute, -- array_attribute + Iir_Kind_Ascending_Array_Attribute, -- array_attribute + Iir_Kind_Range_Array_Attribute, -- array_attribute + Iir_Kind_Reverse_Range_Array_Attribute, -- array_attribute Iir_Kind_Attribute_Name ); @@ -3205,14 +3205,6 @@ package Iirs is --Iir_Kind_Pred_Attribute --Iir_Kind_Leftof_Attribute --Iir_Kind_Rightof_Attribute - --Iir_Kind_Left_Array_Attribute - --Iir_Kind_Right_Array_Attribute - --Iir_Kind_High_Array_Attribute - --Iir_Kind_Low_Array_Attribute - --Iir_Kind_Range_Array_Attribute - --Iir_Kind_Reverse_Range_Array_Attribute - --Iir_Kind_Length_Array_Attribute - --Iir_Kind_Ascending_Array_Attribute --Iir_Kind_Delayed_Attribute --Iir_Kind_Stable_Attribute --Iir_Kind_Quiet_Attribute @@ -3228,7 +3220,14 @@ package Iirs is --Iir_Kind_Structure_Attribute --Iir_Kind_Simple_Name_Attribute --Iir_Kind_Instance_Name_Attribute - Iir_Kind_Path_Name_Attribute; + --Iir_Kind_Path_Name_Attribute + --Iir_Kind_Left_Array_Attribute + --Iir_Kind_Right_Array_Attribute + --Iir_Kind_High_Array_Attribute + --Iir_Kind_Low_Array_Attribute + --Iir_Kind_Length_Array_Attribute + Iir_Kind_Ascending_Array_Attribute; + subtype Iir_Kinds_Attribute is Iir_Kind range Iir_Kind_Base_Attribute .. @@ -3254,10 +3253,10 @@ package Iirs is --Iir_Kind_Right_Array_Attribute --Iir_Kind_High_Array_Attribute --Iir_Kind_Low_Array_Attribute - --Iir_Kind_Range_Array_Attribute - --Iir_Kind_Reverse_Range_Array_Attribute --Iir_Kind_Length_Array_Attribute - Iir_Kind_Ascending_Array_Attribute; + --Iir_Kind_Ascending_Array_Attribute + --Iir_Kind_Range_Array_Attribute + Iir_Kind_Reverse_Range_Array_Attribute; subtype Iir_Kinds_Signal_Attribute is Iir_Kind range Iir_Kind_Delayed_Attribute .. diff --git a/ortho/mcode/binary_file-memory.adb b/ortho/mcode/binary_file-memory.adb index c094e05ac..6e25f670d 100644 --- a/ortho/mcode/binary_file-memory.adb +++ b/ortho/mcode/binary_file-memory.adb @@ -32,10 +32,18 @@ package body Binary_File.Memory is Set_Section (Sym, Sect_Abs); end Set_Symbol_Address; - procedure Write_Memory_Init + procedure Write_Memory_Init is + begin + Create_Section (Sect_Abs, "*ABS*", Section_Exec); + Sect_Abs.Vaddr := 0; + end Write_Memory_Init; + + procedure Write_Memory_Relocate (Error : out Boolean) is use SSE; Sect : Section_Acc; + Rel : Reloc_Acc; + N_Rel : Reloc_Acc; begin -- Relocate section in memory. Sect := Section_Chain; @@ -49,23 +57,12 @@ package body Binary_File.Memory is --Sect.Data := new Byte_Array (1 .. 0); end if; end if; - if Sect.Data_Max > 0 then + if Sect.Data_Max > 0 and Sect /= Sect_Abs then Sect.Vaddr := To_Integer (Sect.Data (0)'Address); end if; Sect := Sect.Next; end loop; - Create_Section (Sect_Abs, "*ABS*", Section_Exec); - Sect_Abs.Vaddr := 0; - end Write_Memory_Init; - - procedure Write_Memory_Relocate (Error : out Boolean) - is - use SSE; - Sect : Section_Acc; - Rel : Reloc_Acc; - N_Rel : Reloc_Acc; - begin -- Do all relocations. Sect := Section_Chain; Error := False; diff --git a/ortho/mcode/binary_file-memory.ads b/ortho/mcode/binary_file-memory.ads index 5238fa0cd..a205da527 100644 --- a/ortho/mcode/binary_file-memory.ads +++ b/ortho/mcode/binary_file-memory.ads @@ -16,7 +16,10 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. package Binary_File.Memory is + + -- Must be called before set_symbol_address. procedure Write_Memory_Init; procedure Set_Symbol_Address (Sym : Symbol; Addr : System.Address); + procedure Write_Memory_Relocate (Error : out Boolean); end Binary_File.Memory; diff --git a/ortho/mcode/ortho_code-decls.adb b/ortho/mcode/ortho_code-decls.adb index 44a2595f5..0a8b02cf3 100644 --- a/ortho/mcode/ortho_code-decls.adb +++ b/ortho/mcode/ortho_code-decls.adb @@ -322,6 +322,7 @@ package body Ortho_Code.Decls is procedure New_Const_Value (Cst : O_Dnode; Val : O_Cnode) is begin if Dnodes.Table (Cst).Info2 /= 0 then + -- Value was already set. raise Syntax_Error; end if; Dnodes.Table (Cst).Info2 := Int32 (Val); @@ -487,6 +487,21 @@ package body Sem is when others => -- Expression. Set_Collapse_Signal_Flag (El, False); + + -- If there is an IN conversion, re-integrate it into + -- the actual. + declare + In_Conv : Iir; + begin + In_Conv := Get_In_Conversion (El); + if In_Conv /= Null_Iir then + Set_In_Conversion (El, Null_Iir); + Set_Expr_Staticness + (In_Conv, Get_Expr_Staticness (Actual)); + Actual := In_Conv; + Set_Actual (El, Actual); + end if; + end; if Flags.Vhdl_Std >= Vhdl_93c then -- LRM93 1.1.1.2 Ports -- Moreover, the ports of a block may be associated @@ -1079,6 +1094,9 @@ package body Sem is | Iir_Kind_Variable_Interface_Declaration | Iir_Kind_Signal_Interface_Declaration | Iir_Kind_File_Interface_Declaration => + if Get_Identifier (Left) /= Get_Identifier (Right) then + return False; + end if; if Get_Lexical_Layout (Left) /= Get_Lexical_Layout (Right) or else Get_Mode (Left) /= Get_Mode (Right) then diff --git a/sem_assocs.adb b/sem_assocs.adb index 3239d9247..09fc2c975 100644 --- a/sem_assocs.adb +++ b/sem_assocs.adb @@ -1118,6 +1118,10 @@ package body Sem_Assocs is 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); @@ -1359,7 +1363,9 @@ package body Sem_Assocs is end if; if Res_Type = Null_Iir then - raise Internal_Error; + -- In case of error, do not go farther. + Match := False; + return; end if; if Get_Formal (Assoc) /= Null_Iir then @@ -1569,9 +1575,7 @@ package body Sem_Assocs is end if; if Finish then Sem_Association (Assoc, Inter, True, Match); - if not Match then - raise Internal_Error; - end if; + -- MATCH can be false du to errors. end if; else -- Not found. diff --git a/sem_decls.adb b/sem_decls.adb index df5f6cf73..7a46c79f8 100644 --- a/sem_decls.adb +++ b/sem_decls.adb @@ -995,6 +995,7 @@ package body Sem_Decls is Def := Create_Iir (Iir_Kind_Incomplete_Type_Definition); Location_Copy (Def, Decl); Set_Type (Decl, Def); + Set_Base_Type (Def, Def); Set_Signal_Type_Flag (Def, True); Set_Type_Declarator (Def, Decl); Set_Visible_Flag (Decl, True); diff --git a/sem_expr.adb b/sem_expr.adb index 43be15a37..acc2daeb5 100644 --- a/sem_expr.adb +++ b/sem_expr.adb @@ -167,7 +167,8 @@ package body Sem_Expr is | Iir_Kind_Library_Declaration | Iir_Kind_Library_Clause | Iir_Kind_Component_Declaration - | Iir_Kinds_Procedure_Declaration => + | Iir_Kinds_Procedure_Declaration + | Iir_Kind_Range_Array_Attribute => Error_Msg_Sem (Disp_Node (Expr) & " not allowed in an expression", Loc); return Null_Iir; @@ -1801,7 +1802,7 @@ package body Sem_Expr is return; end if; Set_Expression (Choice, Expr); - if Get_Expr_Staticness (Expr) > Locally then + if Get_Expr_Staticness (Expr) < Locally then Error_Msg_Sem ("choice must be locally static expression", Expr); return; end if; diff --git a/sem_names.adb b/sem_names.adb index 5feaead10..a390c4d0d 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -2376,9 +2376,13 @@ package body Sem_Names is -- At least, this type is valid; and even if the array was -- constrained, the base type would be the same. end if; - when Iir_Kind_Process_Statement => + when Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Process_Statement => Error_Msg_Sem - (Disp_Node (Prefix) & " is not an appropriate attribute prefix", + (Disp_Node (Prefix) & " is not an appropriate prefix for '" + & Name_Table.Image (Get_Attribute_Identifier (Attr)) + & " attribute", Attr); return Error_Mark; when others => diff --git a/sem_specs.adb b/sem_specs.adb index 179108103..cd8682157 100644 --- a/sem_specs.adb +++ b/sem_specs.adb @@ -1264,15 +1264,20 @@ package body Sem_Specs is (Parent_Stmts : Iir; Conf : Iir_Configuration_Specification) is Primary_Entity_Aspect : Iir; + Component : Iir; begin Sem_Component_Specification (Parent_Stmts, Conf, Primary_Entity_Aspect); + Component := Get_Component_Name (Conf); + + -- Return now in case of error. + if Get_Kind (Component) /= Iir_Kind_Component_Declaration then + return; + end if; -- Extend scope of component interface declaration. Sem_Scopes.Open_Scope_Extension; - Sem_Scopes.Add_Component_Declarations (Get_Component_Name (Conf)); + Sem_Scopes.Add_Component_Declarations (Component); Sem_Binding_Indication (Get_Binding_Indication (Conf), - Get_Component_Name (Conf), - Conf, - Primary_Entity_Aspect); + Component, Conf, Primary_Entity_Aspect); -- FIXME: check default port and generic association. Sem_Scopes.Close_Scope_Extension; end Sem_Configuration_Specification; diff --git a/translate/ghdldrv/foreigns.adb b/translate/ghdldrv/foreigns.adb new file mode 100644 index 000000000..15e3dd009 --- /dev/null +++ b/translate/ghdldrv/foreigns.adb @@ -0,0 +1,64 @@ +with Interfaces.C; use Interfaces.C; + +package body Foreigns is + function Sin (Arg : double) return double; + pragma Import (C, Sin); + + function Log (Arg : double) return double; + pragma Import (C, Log); + + function Exp (Arg : double) return double; + pragma Import (C, Exp); + + function Sqrt (Arg : double) return double; + pragma Import (C, Sqrt); + + function Asin (Arg : double) return double; + pragma Import (C, Asin); + + function Acos (Arg : double) return double; + pragma Import (C, Acos); + + function Asinh (Arg : double) return double; + pragma Import (C, Asinh); + + function Acosh (Arg : double) return double; + pragma Import (C, Acosh); + + function Atanh (X : double) return double; + pragma Import (C, Atanh); + + function Atan2 (X, Y : double) return double; + pragma Import (C, Atan2); + + type String_Cacc is access constant String; + type Foreign_Record is record + Name : String_Cacc; + Addr : Address; + end record; + + + Foreign_Arr : constant array (Natural range <>) of Foreign_Record := + ( + (new String'("sin"), Sin'Address), + (new String'("log"), Log'Address), + (new String'("exp"), Exp'Address), + (new String'("sqrt"), Sqrt'Address), + (new String'("asin"), Asin'Address), + (new String'("acos"), Acos'Address), + (new String'("asinh"), Asinh'Address), + (new String'("acosh"), Acosh'Address), + (new String'("atanh"), Atanh'Address), + (new String'("atan2"), Atan2'Address) + ); + + function Find_Foreign (Name : String) return Address is + begin + for I in Foreign_Arr'Range loop + if Foreign_Arr(I).Name.all = Name then + return Foreign_Arr(I).Addr; + end if; + end loop; + return Null_Address; + end Find_Foreign; +end Foreigns; diff --git a/translate/ghdldrv/foreigns.ads b/translate/ghdldrv/foreigns.ads new file mode 100644 index 000000000..5759ae4f5 --- /dev/null +++ b/translate/ghdldrv/foreigns.ads @@ -0,0 +1,5 @@ +with System; use System; + +package Foreigns is + function Find_Foreign (Name : String) return Address; +end Foreigns; diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index 1d70c141b..b08ac82c7 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -47,6 +47,7 @@ with Trans_Be; with Translation; with Std_Names; with Ieee.Std_Logic_1164; +with Interfaces.C; with Binary_File.Elf; @@ -70,9 +71,14 @@ with Grt.Values; with Grt.Names; with Ghdlcomp; +with Foreigns; package body Ghdlrun is - Snap_Filename : String_Access := null; + Snap_Filename : GNAT.OS_Lib.String_Access := null; + + procedure Foreign_Hook (Decl : Iir; + Info : Translation.Foreign_Info_Type; + Ortho : O_Dnode); procedure Compile_Init (Analyze_Only : Boolean) is begin @@ -82,6 +88,8 @@ package body Ghdlrun is return; end if; + Translation.Foreign_Hook := Foreign_Hook'Access; + -- Initialize. Back_End.Finish_Compilation := Trans_Be.Finish_Compilation'Access; @@ -92,6 +100,7 @@ package body Ghdlrun is Libraries.Load_Std_Library; Ortho_Mcode.Init; + Binary_File.Memory.Write_Memory_Init; Translation.Initialize; Canon.Canon_Flag_Add_Labels := True; @@ -237,6 +246,34 @@ package body Ghdlrun is return Conv (Get_Symbol_Vaddr (Get_Decl_Symbol (Decl))); end Get_Address; + procedure Foreign_Hook (Decl : Iir; + Info : Translation.Foreign_Info_Type; + Ortho : O_Dnode) + is + use Translation; + Res : Address; + begin + case Info.Kind is + when Foreign_Vhpidirect => + declare + Name : String := Name_Table.Name_Buffer (Info.Subprg_First + .. Info.Subprg_Last); + begin + Res := Foreigns.Find_Foreign (Name); + if Res /= Null_Address then + Def (Ortho, Res); + else + Error_Msg_Sem ("unknown foreign VHPIDIRECT '" & Name & "'", + Decl); + end if; + end; + when Foreign_Intrinsic => + null; + when Foreign_Unknown => + null; + end case; + end Foreign_Hook; + procedure Run is use Binary_File; @@ -257,8 +294,6 @@ package body Ghdlrun is raise Compile_Error; end if; - Binary_File.Memory.Write_Memory_Init; - Ortho_Code.Abi.Link_Intrinsics; Def (Trans_Decls.Ghdl_Memcpy, @@ -467,17 +502,6 @@ package body Ghdlrun is Grt.Rtis.Ghdl_Rti_Top_Instance'Address); Def (Trans_Decls.Ghdl_Rti_Top_Ptr, Grt.Rtis.Ghdl_Rti_Top_Ptr'Address); - Std_Standard_Boolean_RTI_Ptr := - Get_Address (Trans_Decls.Std_Standard_Boolean_Rti); - Std_Standard_Bit_RTI_Ptr := - Get_Address (Trans_Decls.Std_Standard_Bit_Rti); - if Ieee.Std_Logic_1164.Resolved /= Null_Iir then - Decl := Translation.Get_Resolv_Ortho_Decl - (Ieee.Std_Logic_1164.Resolved); - if Decl /= O_Dnode_Null then - Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address (Decl); - end if; - end if; Def (Trans_Decls.Ghdl_Protected_Enter, Grt.Processes.Ghdl_Protected_Enter'Address); @@ -555,6 +579,18 @@ package body Ghdlrun is raise Compile_Error; end if; + Std_Standard_Boolean_RTI_Ptr := + Get_Address (Trans_Decls.Std_Standard_Boolean_Rti); + Std_Standard_Bit_RTI_Ptr := + Get_Address (Trans_Decls.Std_Standard_Bit_Rti); + if Ieee.Std_Logic_1164.Resolved /= Null_Iir then + Decl := Translation.Get_Resolv_Ortho_Decl + (Ieee.Std_Logic_1164.Resolved); + if Decl /= O_Dnode_Null then + Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address (Decl); + end if; + end if; + Flag_String := Flags.Flag_String; Elaborate_Proc := Conv (Get_Address (Trans_Decls.Ghdl_Elaborate)); diff --git a/translate/grt/Makefile.inc b/translate/grt/Makefile.inc index 584ed55de..2d9d60e84 100644 --- a/translate/grt/Makefile.inc +++ b/translate/grt/Makefile.inc @@ -52,6 +52,11 @@ ifeq ($(filter-out x86_64 linux,$(arch) $(osys)),) GRT_TARGET_OBJS=amd64.o linux.o times.o GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS) endif +ifeq ($(filter-out i%86 freebsd%,$(arch) $(osys)),) + GRT_TARGET_OBJS=i386.o linux.o times.o + GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS) + ADAC=gnatgcc +endif ifeq ($(filter-out sparc solaris%,$(arch) $(osys)),) GRT_TARGET_OBJS=sparc.o linux.o times.o GRT_EXTRA_LIB=-ldl -lm diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb index 7c8b10f5a..4b4086f03 100644 --- a/translate/grt/grt-avhpi.adb +++ b/translate/grt/grt-avhpi.adb @@ -330,7 +330,7 @@ package body Grt.Avhpi is end; when Ghdl_Rtik_Type_B2 | Ghdl_Rtik_Type_E8 - | Ghdl_Rtik_Type_E32 => + | Ghdl_Rtik_Type_E32 => Res := (Kind => VhpiEnumTypeDeclK, Ctxt => Ctxt, Atype => Rti); diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb index 64273b3f3..84d7c3a5c 100644 --- a/translate/grt/grt-rtis_addr.adb +++ b/translate/grt/grt-rtis_addr.adb @@ -253,7 +253,7 @@ package body Grt.Rtis_Addr is return To_Ghdl_Rti_Access (To_Ghdl_Rtin_Subtype_Array_Acc (Atype).Basetype); when Ghdl_Rtik_Type_E8 - | Ghdl_Rtik_Type_E32 + | Ghdl_Rtik_Type_E32 | Ghdl_Rtik_Type_B2 => return Atype; when others => diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads index 500cd55a0..69cee8c9e 100644 --- a/translate/grt/grt-signals.ads +++ b/translate/grt/grt-signals.ads @@ -382,6 +382,10 @@ package Grt.Signals is -- Update signals. procedure Update_Signals; + -- Set the effective value of signal SIG to VAL. + -- If the value is different from the previous one, resume processes. + procedure Set_Effective_Value (Sig : Ghdl_Signal_Ptr; Val : Value_Union); + -- Add PROC in the list of processes to be resumed in case of event on -- SIG. procedure Resume_Process_If_Event diff --git a/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb index f8113069c..f2c30b60c 100644 --- a/translate/grt/grt-vpi.adb +++ b/translate/grt/grt-vpi.adb @@ -507,6 +507,189 @@ package body Grt.Vpi is end vpi_get_value; ------------------------------------------------------------------------ + -- void vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value, + -- p_vpi_time when, int flags) + -- Alter the simulation value of an object. + -- see IEEE 1364-2001, chapter 27.14, page 675 + -- FIXME + + procedure ii_vpi_put_value_bin_str_B2 (SigPtr : Ghdl_Signal_Ptr; + Value : Character) + is + Tempval : Value_Union; + begin + -- use the Set_Effective_Value procedure to update the signal + case Value is + when '0' => + Tempval.B2 := false; + when '1' => + Tempval.B2 := true; + when others => + dbgPut_Line("ii_vpi_put_value_bin_str_B2: " + & "wrong character - signal wont be set"); + return; + end case; + SigPtr.Driving_Value := Tempval; + Set_Effective_Value (SigPtr, Tempval); + end ii_vpi_put_value_bin_str_B2; + + procedure ii_vpi_put_value_bin_str_E8 (SigPtr : Ghdl_Signal_Ptr; + Value : Character) + is + Tempval : Value_Union; + begin + case Value is + when 'U' => + Tempval.E8 := 0; + when 'X' => + Tempval.E8 := 1; + when '0' => + Tempval.E8 := 2; + when '1' => + Tempval.E8 := 3; + when 'Z' => + Tempval.E8 := 4; + when 'W' => + Tempval.E8 := 5; + when 'L' => + Tempval.E8 := 6; + when 'H' => + Tempval.E8 := 7; + when '-' => + Tempval.E8 := 8; + when others => + dbgPut_Line("ii_vpi_put_value_bin_str_B8: " + & "wrong character - signal wont be set"); + return; + end case; + SigPtr.Driving_Value := Tempval; + Set_Effective_Value (SigPtr, Tempval); + end ii_vpi_put_value_bin_str_E8; + + + procedure ii_vpi_put_value_bin_str(Obj : VhpiHandleT; + ValueStr : Ghdl_C_String) + is + Info : Verilog_Wire_Info; + Len : Ghdl_Index_Type; + begin + -- Check the Obj type. + -- * The vpiHandle has a reference (field Ref) to a VhpiHandleT + -- when it doesnt come from a callback. + case Vhpi_Get_Kind(Obj) is + when VhpiPortDeclK + | VhpiSigDeclK => + null; + when others => + return; + end case; + + -- The following code segment was copied from the + -- ii_vpi_get_value function. + -- Get verilog compat info. + Get_Verilog_Wire (Obj, Info); + if Info.Kind = Vcd_Bad then + return; + end if; + + if Info.Irange = null then + Len := 1; + else + Len := Info.Irange.I32.Len; + end if; + + -- Step 1: convert vpi object to internal format. + -- p_vpi_handle -> Ghdl_Signal_Ptr + -- To_Signal_Arr_Ptr (Info.Addr) does part of the magic + + -- Step 2: convert datum to appropriate type. + -- Ghdl_C_String -> Value_Union + + -- Step 3: assigns value to object using Set_Effective_Value + -- call (from grt-signals) + -- Set_Effective_Value(sig_ptr, conv_value); + + + -- Took the skeleton from ii_vpi_get_value function + -- This point of the function must convert the string value to the + -- native ghdl format. + case Info.Kind is + when Vcd_Bad => + return; + when Vcd_Bit + | Vcd_Bool + | Vcd_Bitvector => + for J in 0 .. Len - 1 loop + ii_vpi_put_value_bin_str_B2( + To_Signal_Arr_Ptr(Info.Addr)(J), ValueStr(Integer(J+1))); + end loop; + when Vcd_Stdlogic + | Vcd_Stdlogic_Vector => + for J in 0 .. Len - 1 loop + ii_vpi_put_value_bin_str_E8( + To_Signal_Arr_Ptr(Info.Addr)(J), ValueStr(Integer(J+1))); + end loop; + when Vcd_Integer32 => + null; + end case; + + -- Always return null, because this simulation kernel cannot send + -- a handle to the event back. + return; + end ii_vpi_put_value_bin_str; + + + -- vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value, + -- p_vpi_time when, int flags) + function vpi_put_value (aObj: vpiHandle; + aValue: p_vpi_value; + aWhen: p_vpi_time; + aFlags: integer) + return vpiHandle + is + pragma Unreferenced (aWhen); + pragma Unreferenced (aFlags); + begin + -- A very simple write procedure for VPI. + -- Basically, it accepts bin_str values and converts to appropriate + -- types (only std_logic and bit values and vectors). + + -- It'll use Set_Effective_Value procedure to update signals + + -- Ignoring aWhen and aFlags, for now. + + -- Checks the format of aValue. Only vpiBinStrVal will be accepted + -- for now. + case aValue.Format is + when vpiObjTypeVal=> + dbgPut_Line ("vpi_put_value: vpiObjTypeVal"); + when vpiBinStrVal=> + ii_vpi_put_value_bin_str(aObj.Ref, aValue.Str); + dbgPut_Line ("vpi_put_value: vpiBinStrVal"); + when vpiOctStrVal=> + dbgPut_Line ("vpi_put_value: vpiNet, vpiOctStrVal"); + when vpiDecStrVal=> + dbgPut_Line ("vpi_put_value: vpiNet, vpiDecStrVal"); + when vpiHexStrVal=> + dbgPut_Line ("vpi_put_value: vpiNet, vpiHexStrVal"); + when vpiScalarVal=> + dbgPut_Line ("vpi_put_value: vpiNet, vpiScalarVal"); + when vpiIntVal=> + dbgPut_Line ("vpi_put_value: vpiIntVal"); + when vpiRealVal=> dbgPut_Line("vpi_put_value: vpiRealVal"); + when vpiStringVal=> dbgPut_Line("vpi_put_value: vpiStringVal"); + when vpiTimeVal=> dbgPut_Line("vpi_put_value: vpiTimeVal"); + when vpiVectorVal=> dbgPut_Line("vpi_put_value: vpiVectorVal"); + when vpiStrengthVal=> dbgPut_Line("vpi_put_value: vpiStrengthVal"); + when others=> dbgPut_Line("vpi_put_value: unknown mFormat"); + end case; + + -- Must return a scheduled event caused by vpi_put_value() + -- Still dont know how to do it. + return null; + end vpi_put_value; + + ------------------------------------------------------------------------ -- void vpi_get_time(vpiHandle obj, s_vpi_time*t); -- see IEEE 1364-2001, page xxx Sim_Time : Std_Time; @@ -631,22 +814,6 @@ package body Grt.Vpi is return 0; end vpi_mcd_open; - -- vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value, - -- p_vpi_time when, int flags) - function vpi_put_value (aObj: vpiHandle; - aValue: p_vpi_value; - aWhen: p_vpi_time; - aFlags: integer) - return vpiHandle - is - pragma Unreferenced (aObj); - pragma Unreferenced (aValue); - pragma Unreferenced (aWhen); - pragma Unreferenced (aFlags); - begin - return null; - end vpi_put_value; - -- void vpi_register_systf(const struct t_vpi_systf_data*ss) procedure vpi_register_systf(aSs: System.Address) is diff --git a/translate/trans_be.adb b/translate/trans_be.adb index 60d886c1a..405821749 100644 --- a/translate/trans_be.adb +++ b/translate/trans_be.adb @@ -144,6 +144,6 @@ package body Trans_Be is Error_Kind ("sem_foreign", Decl); end case; -- Let is generate error messages. - Fi := Translate_Foreign_Id (Decl, False); + Fi := Translate_Foreign_Id (Decl); end Sem_Foreign; end Trans_Be; diff --git a/translate/translation.adb b/translate/translation.adb index ff38401f0..37a1074f0 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -2897,15 +2897,13 @@ package body Translation is end if; end Create_Temp; - function Translate_Foreign_Id (Decl : Iir; Extract_Name : Boolean) - return Foreign_Info_Type + function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type is use Name_Table; Attr : Iir_Attribute_Value; Spec : Iir_Attribute_Specification; Attr_Decl : Iir; Expr : Iir; - P : Natural; begin -- Look for 'FOREIGN. Attr := Get_Attribute_Value_Chain (Decl); @@ -2972,27 +2970,60 @@ package body Translation is if Name_Length >= 10 and then Name_Buffer (1 .. 10) = "VHPIDIRECT" then - P := 11; + declare + P : Natural; + Sf, Sl : Natural; + Lf, Ll : Natural; + begin + P := 11; - -- Skip spaces. - while P <= Name_Length and then Name_Buffer (P) = ' ' loop + -- Skip spaces. + while P <= Name_Length and then Name_Buffer (P) = ' ' loop + P := P + 1; + end loop; + if P > Name_Length then + Error_Msg_Sem + ("missing subprogram/library name after VHPIDIRECT", Spec); + end if; + -- Extract library. + Lf := P; + while P < Name_Length and then Name_Buffer (P) /= ' ' loop + P := P + 1; + end loop; + Ll := P; + -- Extract subprogram. P := P + 1; - end loop; - if Extract_Name then + while P <= Name_Length and then Name_Buffer (P) = ' ' loop + P := P + 1; + end loop; + Sf := P; + while P < Name_Length and then Name_Buffer (P) /= ' ' loop + P := P + 1; + end loop; + Sl := P; + if P < Name_Length then + Error_Msg_Sem ("garbage at end of VHPIDIRECT", Spec); + end if; + + -- Accept empty library. + if Sf > Name_Length then + Sf := Lf; + Sl := Ll; + Lf := 0; + Ll := 0; + end if; + return Foreign_Info_Type' (Kind => Foreign_Vhpidirect, - Subprg => Get_Identifier (Name_Buffer (P .. Name_Length)), - Lib => Null_Identifier); - else - return Foreign_Info_Type'(Kind => Foreign_Vhpidirect, - Subprg => O_Ident_Nul, - Lib => Null_Identifier); - end if; + Lib_First => Lf, + Lib_Last => Ll, + Subprg_First => Sf, + Subprg_Last => Sl); + end; elsif Name_Length = 14 and then Name_Buffer (1 .. 14) = "GHDL intrinsic" then - return Foreign_Info_Type'(Kind => Foreign_Intrinsic, - Subprg => Create_Identifier); + return Foreign_Info_Type'(Kind => Foreign_Intrinsic); else Error_Msg_Sem ("value of 'FOREIGN attribute does not begin with VHPIDIRECT", @@ -4640,6 +4671,7 @@ package body Translation is Rtype : Iir; Id : O_Ident; Storage : O_Storage; + Foreign : Foreign_Info_Type := Foreign_Bad; begin Info := Get_Info (Spec); Info.Res_Interface := O_Dnode_Null; @@ -4650,20 +4682,18 @@ package body Translation is Push_Subprg_Identifier (Spec, Mark); if Get_Foreign_Flag (Spec) then - declare - Fi : Foreign_Info_Type; - begin - Fi := Translate_Foreign_Id (Spec, True); - case Fi.Kind is - when Foreign_Unknown => - Id := Create_Identifier; - when Foreign_Intrinsic => - Id := Fi.Subprg; - when Foreign_Vhpidirect => - Id := Fi.Subprg; - end case; - Storage := O_Storage_External; - end; + Foreign := Translate_Foreign_Id (Spec); + case Foreign.Kind is + when Foreign_Unknown => + Id := Create_Identifier; + when Foreign_Intrinsic => + Id := Create_Identifier; + when Foreign_Vhpidirect => + Id := Get_Identifier + (Name_Table.Name_Buffer (Foreign.Subprg_First + .. Foreign.Subprg_Last)); + end case; + Storage := O_Storage_External; else Id := Create_Identifier; Storage := Global_Storage; @@ -4778,6 +4808,10 @@ package body Translation is end loop; Finish_Subprogram_Decl (Interface_List, Info.Ortho_Func); + if Get_Foreign_Flag (Spec) and then Foreign_Hook /= null then + Foreign_Hook.all (Spec, Foreign, Info.Ortho_Func); + end if; + Save_Local_Identifier (Info.Subprg_Local_Id); Pop_Identifier_Prefix (Mark); end Translate_Subprogram_Declaration; @@ -4804,7 +4838,7 @@ package body Translation is Old_Subprogram : Iir; Mark : Id_Mark_Type; Final : Boolean; - Is_Func : Boolean; + Is_Ortho_Func : Boolean; -- Set for a public method. In this case, the lock must be acquired -- and retained. @@ -4877,8 +4911,8 @@ package body Translation is Chap3.Call_Ghdl_Protected_Procedure (Get_Method_Type (Spec), Ghdl_Protected_Enter); end if; - Is_Func := Is_Subprogram_Ortho_Function (Spec); - if Is_Func then + Is_Ortho_Func := Is_Subprogram_Ortho_Function (Spec); + if Is_Ortho_Func then New_Var_Decl (Info.Subprg_Result, Get_Identifier ("RESULT"), O_Storage_Local, @@ -4906,7 +4940,7 @@ package body Translation is Chap3.Call_Ghdl_Protected_Procedure (Get_Method_Type (Spec), Ghdl_Protected_Leave); end if; - if Is_Func then + if Is_Ortho_Func then New_Return_Stmt (New_Obj_Value (Info.Subprg_Result)); end if; end if; @@ -13218,6 +13252,7 @@ package body Translation is Res : O_Cnode; begin Lit_Type := Get_Type (Str); + Chap3.Translate_Anonymous_Type_Definition (Lit_Type, True); Start_Array_Aggr (List, Get_Ortho_Type (Lit_Type, Mode_Value)); @@ -13230,6 +13265,86 @@ package body Translation is return Res; end Translate_Static_String_Literal; + -- Some strings literal have an unconstrained array type, + -- eg: 'image of constant. Its type is not constrained + -- because it is not so in VHDL! + function Translate_Static_Unconstrained_String_Literal (Str : Iir) + return O_Cnode + is + use Name_Table; + + Lit_Type : Iir; + Element_Type : Iir; + Index_Type : Iir; + Val_Aggr : O_Array_Aggr_List; + Bound_Aggr : O_Record_Aggr_List; + Index_Aggr : O_Record_Aggr_List; + Res_Aggr : O_Record_Aggr_List; + Res : O_Cnode; + Str_Type : O_Tnode; + Type_Info : Type_Info_Acc; + Index_Type_Info : Type_Info_Acc; + Len : Int32; + Val : Var_Acc; + Bound : Var_Acc; + begin + Lit_Type := Get_Type (Str); + Type_Info := Get_Info (Get_Base_Type (Lit_Type)); + + -- Create the string value. + Len := Get_String_Length (Str); + Str_Type := New_Constrained_Array_Type + (Type_Info.T.Base_Type (Mode_Value), + New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Len))); + + Start_Array_Aggr (Val_Aggr, Str_Type); + Element_Type := Get_Element_Subtype (Lit_Type); + Translate_Static_String_Literal_Inner (Val_Aggr, Str, Element_Type); + Finish_Array_Aggr (Val_Aggr, Res); + + Val := Create_Global_Const + (Create_Uniq_Identifier, Str_Type, O_Storage_Private, Res); + + -- Create the string bound. + Index_Type := Get_First_Element (Get_Index_Subtype_List (Lit_Type)); + Index_Type_Info := Get_Info (Index_Type); + Start_Record_Aggr (Bound_Aggr, Type_Info.T.Bounds_Type); + Start_Record_Aggr (Index_Aggr, Index_Type_Info.T.Range_Type); + New_Record_Aggr_El + (Index_Aggr, + New_Signed_Literal (Index_Type_Info.Ortho_Type (Mode_Value), 0)); + New_Record_Aggr_El + (Index_Aggr, + New_Signed_Literal (Index_Type_Info.Ortho_Type (Mode_Value), + Integer_64 (Len - 1))); + New_Record_Aggr_El + (Index_Aggr, Ghdl_Dir_To_Node); + New_Record_Aggr_El + (Index_Aggr, + New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Len))); + Finish_Record_Aggr (Index_Aggr, Res); + New_Record_Aggr_El (Bound_Aggr, Res); + Finish_Record_Aggr (Bound_Aggr, Res); + Bound := Create_Global_Const + (Create_Uniq_Identifier, Type_Info.T.Bounds_Type, + O_Storage_Private, Res); + + -- The descriptor. + Start_Record_Aggr (Res_Aggr, Type_Info.Ortho_Type (Mode_Value)); + New_Record_Aggr_El + (Res_Aggr, + New_Global_Address (Get_Var_Label (Val), + Type_Info.T.Base_Ptr_Type (Mode_Value))); + New_Record_Aggr_El + (Res_Aggr, + New_Global_Address (Get_Var_Label (Bound), + Type_Info.T.Bounds_Ptr_Type)); + Finish_Record_Aggr (Res_Aggr, Res); + Free_Var (Val); + Free_Var (Bound); + return Res; + end Translate_Static_Unconstrained_String_Literal; + -- Only for Strings of STD.Character. function Translate_Static_String (Str_Type : Iir; Str_Ident : Name_Id) return O_Cnode @@ -13284,7 +13399,13 @@ package body Translation is begin case Get_Kind (Str) is when Iir_Kind_String_Literal => - Res := Translate_Static_String_Literal (Str); + if Get_Kind (Get_Type (Str)) + = Iir_Kind_Array_Subtype_Definition + then + Res := Translate_Static_String_Literal (Str); + else + Res := Translate_Static_Unconstrained_String_Literal (Str); + end if; when Iir_Kind_Bit_String_Literal => Res := Translate_Static_Bit_String_Literal (Str); when Iir_Kind_Simple_Aggregate => @@ -25325,9 +25446,22 @@ package body Translation is when Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration => Add_Rti_Node (Generate_Type_Decl (Decl)); + when Iir_Kind_Constant_Declaration => + -- Do not generate RTIs for full declarations. + -- (RTI will be generated for the deferred declaration). + if Get_Deferred_Declaration (Decl) = Null_Iir + or else Get_Deferred_Declaration_Flag (Decl) + then + declare + Info : Object_Info_Acc; + begin + Info := Get_Info (Decl); + Generate_Object (Decl, Info.Object_Rti); + Add_Rti_Node (Info.Object_Rti); + end; + end if; when Iir_Kind_Signal_Declaration | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Constant_Declaration | Iir_Kind_Constant_Interface_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_File_Declaration diff --git a/translate/translation.ads b/translate/translation.ads index 2b885a8da..55af06967 100644 --- a/translate/translation.ads +++ b/translate/translation.ads @@ -17,8 +17,6 @@ -- 02111-1307, USA. with Iirs; use Iirs; with Ortho_Nodes; -with Ortho_Ident; use Ortho_Ident; -with Types; use Types; package Translation is -- Initialize the package: create internal nodes. @@ -69,20 +67,21 @@ package Translation is type Foreign_Info_Type (Kind : Foreign_Kind_Type := Foreign_Unknown) is record - Subprg : O_Ident; - case Kind is when Foreign_Unknown => null; when Foreign_Vhpidirect => - Lib : Name_Id; + -- Positions in name_table.name_buffer. + Lib_First : Natural; + Lib_Last : Natural; + Subprg_First : Natural; + Subprg_Last : Natural; when Foreign_Intrinsic => null; end case; end record; - Foreign_Bad : constant Foreign_Info_Type := (Kind => Foreign_Unknown, - Subprg => O_Ident_Nul); + Foreign_Bad : constant Foreign_Info_Type := (Kind => Foreign_Unknown); -- Return a foreign_info for DECL. -- Can generate error messages, if the attribute expression is ill-formed. @@ -90,7 +89,12 @@ package Translation is -- Otherwise, only KIND discriminent is set. -- EXTRACT_NAME should be set only inside translation itself, since the -- name can be based on the prefix. - function Translate_Foreign_Id (Decl : Iir; Extract_Name : Boolean) - return Foreign_Info_Type; - + function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type; + + -- If not null, this procedure is called when a foreign subprogram is + -- created. + type Foreign_Hook_Access is access procedure (Decl : Iir; + Info : Foreign_Info_Type; + Ortho : Ortho_Nodes.O_Dnode); + Foreign_Hook : Foreign_Hook_Access := null; end Translation; |