summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/ghdl.texi5
-rw-r--r--errorout.adb7
-rw-r--r--ortho/gcc/ortho-lang.c9
-rw-r--r--sem.adb15
-rw-r--r--sem_decls.adb33
-rw-r--r--sem_expr.adb2
-rw-r--r--sem_names.adb2
-rw-r--r--sem_types.adb19
-rw-r--r--sem_types.ads5
-rw-r--r--translate/gcc/INSTALL2
-rwxr-xr-xtranslate/gcc/dist.sh2
-rw-r--r--translate/ghdldrv/ghdlrun.adb28
-rw-r--r--translate/grt/grt-avhpi.adb7
-rw-r--r--translate/grt/grt-disp_rti.adb8
-rw-r--r--translate/grt/grt-files.adb4
-rw-r--r--translate/grt/grt-images.adb7
-rw-r--r--translate/grt/grt-images.ads3
-rw-r--r--translate/grt/grt-rtis_addr.adb5
-rw-r--r--translate/grt/grt-rtis_utils.adb16
-rw-r--r--translate/grt/grt-signals.adb84
-rw-r--r--translate/grt/grt-signals.ads34
-rw-r--r--translate/trans_decls.ads10
-rw-r--r--translate/translation.adb156
-rw-r--r--version.ads2
24 files changed, 356 insertions, 109 deletions
diff --git a/doc/ghdl.texi b/doc/ghdl.texi
index 62c2447..f4cfdf1 100644
--- a/doc/ghdl.texi
+++ b/doc/ghdl.texi
@@ -376,11 +376,12 @@ the ones of the previous examples.
Let's see how to analyze and run a bigger design, such as the DLX model
suite written by Peter Ashenden which is distributed under the terms of the
-GNU General Public License.
+GNU General Public License. A copy is kept on
+@indicateurl{http://ghdl.free.fr/dlx.tar.gz}
First, untar the sources:
@smallexample
-$ tar zxvf dlx.tar.Z
+$ tar zxvf dlx.tar.gz
@end smallexample
In order not to pollute the sources with the library, it is a good idea
diff --git a/errorout.adb b/errorout.adb
index 66003b6..eed8b6f 100644
--- a/errorout.adb
+++ b/errorout.adb
@@ -980,9 +980,12 @@ package body Errorout is
Decl := Get_Type_Declarator (Def);
if Decl /= Null_Iir then
return Image_Identifier (Decl);
- else
- Decl := Get_Type_Declarator (Get_Base_Type (Def));
+ end if;
+ Decl := Get_Type_Declarator (Get_Base_Type (Def));
+ if Decl /= Null_Iir then
return "a subtype of " & Image_Identifier (Decl);
+ else
+ return "an unknown type";
end if;
end Disp_Type_Name;
diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c
index b8cdfe6..5792f50 100644
--- a/ortho/gcc/ortho-lang.c
+++ b/ortho/gcc/ortho-lang.c
@@ -23,6 +23,8 @@
#include "tree-pass.h"
#include "tree-dump.h"
+static tree type_for_size (unsigned int precision, int unsignedp);
+
const int tree_identifier_size = sizeof (struct tree_identifier);
struct binding_level GTY(())
@@ -250,13 +252,14 @@ ortho_init (void)
push_binding ();
build_common_tree_nodes (0, 0);
+ size_type_node = type_for_size (GET_MODE_BITSIZE (Pmode), 1);
+ set_sizetype (size_type_node);
+ build_common_tree_nodes_2 (0);
+
n = build_decl (TYPE_DECL, get_identifier ("int"), integer_type_node);
push_decl (n);
n = build_decl (TYPE_DECL, get_identifier ("char"), char_type_node);
push_decl (n);
- size_type_node = unsigned_type_node;
- set_sizetype (unsigned_type_node);
- build_common_tree_nodes_2 (0);
/* Create alloca builtin. */
{
diff --git a/sem.adb b/sem.adb
index 01a1953..0f4d1dd 100644
--- a/sem.adb
+++ b/sem.adb
@@ -1754,7 +1754,7 @@ package body Sem is
when Iir_Kind_Sensitized_Process_Statement =>
Kind := K_Process;
Subprg_Bod := Null_Iir;
- Subprg_Depth := 0;
+ Subprg_Depth := Iir_Depth_Top;
Depth := Iir_Depth_Impure;
when others =>
Error_Kind ("update_and_check_pure_wait(1)", Subprg);
@@ -1768,9 +1768,11 @@ package body Sem is
for I in Natural loop
Callee := Get_Nth_Element (Callees_List, I);
exit when Callee = Null_Iir;
+
+ -- Only procedures should appear in the list:
+ -- Pure functions should not be in the list.
+ -- Impure functions must have directly set Purity_State.
if Get_Kind (Callee) /= Iir_Kind_Procedure_Declaration then
- -- Pure functions should not be in the list.
- -- Impure functions must have directly set Purity_State.
Error_Kind ("update_and_check_pure_wait(3)", Callee);
end if;
@@ -1778,7 +1780,8 @@ package body Sem is
Callee_Bod := Get_Subprogram_Body (Callee);
if Callee_Bod = Null_Iir then
-- No body yet for the subprogram called.
- -- Nothing can be extracted from it, postpone the checks.
+ -- Nothing can be extracted from it, postpone the checks until
+ -- elaboration.
Has_Unknown := True;
else
-- Second loop: recurse if a state is not known.
@@ -1788,14 +1791,14 @@ package body Sem is
Update_And_Check_Pure_Wait (Callee);
end if;
-
-- Check purity only if the subprogram is not impure.
if Depth /= Iir_Depth_Impure then
Depth_Callee := Get_Impure_Depth (Callee_Bod);
-- Check purity depth.
if Depth_Callee < Subprg_Depth then
- -- The call is an impure call.
+ -- The call is an impure call because it calls an outer
+ -- subprogram (or an impure subprogram).
-- FIXME: check the compare.
Depth_Callee := Iir_Depth_Impure;
if Kind = K_Function then
diff --git a/sem_decls.adb b/sem_decls.adb
index a51d0fa..df5f6cf 100644
--- a/sem_decls.adb
+++ b/sem_decls.adb
@@ -2156,37 +2156,6 @@ package body Sem_Decls is
Set_Visible_Flag (Group, True);
end Sem_Group_Declaration;
- -- Return TRUE if FUNC can be a resolution function.
- function Can_Be_Resolution_Function (Func : Iir_Function_Declaration)
- return Boolean
- is
- Param : Iir;
- Param_Type : Iir;
- Res_Type : Iir;
- begin
- Param := Get_Interface_Declaration_Chain (Func);
-
- -- Return now if the number of parameters is not 1.
- if Param = Null_Iir or else Get_Chain (Param) /= Null_Iir then
- return False;
- end if;
- Param_Type := Get_Type (Param);
- case Get_Kind (Param_Type) is
- when Iir_Kind_Array_Type_Definition
- | Iir_Kind_Unconstrained_Array_Subtype_Definition =>
- null;
- when others =>
- return False;
- end case;
- Res_Type := Get_Return_Type (Func);
- if Get_Base_Type (Get_Element_Subtype (Param_Type))
- /= Get_Base_Type (Res_Type)
- then
- return False;
- end if;
- return True;
- end Can_Be_Resolution_Function;
-
-- Semantize every declaration of DECLS_PARENT.
-- STMTS is the concurrent statement list associated with DECLS_PARENT
-- if any, or null_iir. This is used for specification.
@@ -2247,7 +2216,7 @@ package body Sem_Decls is
end if;
if Is_Global
and then Kind = Iir_Kind_Function_Declaration
- and then Can_Be_Resolution_Function (Res)
+ and then Is_A_Resolution_Function (Res, Null_Iir)
then
Set_Resolution_Function_Flag (Res, True);
end if;
diff --git a/sem_expr.adb b/sem_expr.adb
index a0ec9b7..43be15a 100644
--- a/sem_expr.adb
+++ b/sem_expr.adb
@@ -3767,7 +3767,7 @@ package body Sem_Expr is
if Res /= Null_Iir and then Is_Overloaded (Res) then
Error_Overload (Expr);
- Disp_Overload_List (Get_Overload_List (Res), Expr);
+ Disp_Overload_List (Get_Overload_List (Get_Type (Res)), Expr);
return Null_Iir;
end if;
return Res;
diff --git a/sem_names.adb b/sem_names.adb
index 4a01133..ff0c879 100644
--- a/sem_names.adb
+++ b/sem_names.adb
@@ -1973,7 +1973,7 @@ package body Sem_Names is
when Iir_Kinds_Procedure_Declaration =>
Error_Msg_Sem ("function name is a procedure", Name);
- when Iir_Kind_Process_Statement
+ when Iir_Kinds_Process_Statement
| Iir_Kind_Component_Declaration
| Iir_Kind_Type_Conversion =>
Error_Msg_Sem
diff --git a/sem_types.adb b/sem_types.adb
index bb946a5..9b35cc6 100644
--- a/sem_types.adb
+++ b/sem_types.adb
@@ -997,6 +997,7 @@ package body Sem_Types is
is
Decl: Iir;
Decl_Type : Iir;
+ Ret_Type : Iir;
begin
-- LRM93 2.4
-- A resolution function must be a [pure] function;
@@ -1023,22 +1024,26 @@ package body Sem_Types is
end if;
-- LRM93 2.4
-- whose element type is that of the resolved signal.
+ -- The type of the return value of the function must also be that of
+ -- the signal.
+ Ret_Type := Get_Return_Type (Func);
if Get_Base_Type (Get_Element_Subtype (Decl_Type))
- /= Get_Base_Type (Atype)
+ /= Get_Base_Type (Ret_Type)
then
return False;
end if;
- -- LRM93 2.4
- -- The type of the return value of the function must also be that of
- -- the signal.
- if Get_Base_Type (Get_Return_Type (Func)) /= Get_Base_Type (Atype) then
+ if Atype /= Null_Iir
+ and then Get_Base_Type (Ret_Type) /= Get_Base_Type (Atype)
+ then
return False;
end if;
-- LRM93 2.4
-- A resolution function must be a [pure] function;
if Flags.Vhdl_Std >= Vhdl_93 and then Get_Pure_Flag (Func) = False then
- Error_Msg_Sem
- ("resolution " & Disp_Node (Func) & " must be pure", Atype);
+ if Atype /= Null_Iir then
+ Error_Msg_Sem
+ ("resolution " & Disp_Node (Func) & " must be pure", Atype);
+ end if;
return False;
end if;
return True;
diff --git a/sem_types.ads b/sem_types.ads
index 6df559d..a513794 100644
--- a/sem_types.ads
+++ b/sem_types.ads
@@ -45,4 +45,9 @@ package Sem_Types is
-- If ATYPE can have signal (eg: access or file type), then this procedure
-- returns silently.
procedure Set_Type_Has_Signal (Atype : Iir);
+
+ -- Return TRUE iff FUNC is a resolution function.
+ -- If ATYPE is not NULL_IIR, type must match.
+ function Is_A_Resolution_Function (Func: Iir; Atype: Iir) return Boolean;
+
end Sem_Types;
diff --git a/translate/gcc/INSTALL b/translate/gcc/INSTALL
index 2f5c5e1..26b0ee3 100644
--- a/translate/gcc/INSTALL
+++ b/translate/gcc/INSTALL
@@ -13,7 +13,7 @@ You must be root to install this distribution.
To install ghdl:
$ su
-# tar -C / -zxvf @TARFILE@
+# tar -C / -jxvf @TARFILE@.tar.bz2
Note: you must also have a C compiler and zlib installed.
diff --git a/translate/gcc/dist.sh b/translate/gcc/dist.sh
index 65aa920..e03e686 100755
--- a/translate/gcc/dist.sh
+++ b/translate/gcc/dist.sh
@@ -230,7 +230,7 @@ do_tar_dist ()
{
rm -rf $bindirname
mkdir $bindirname
- sed -e "s/@TARFILE@/$dir.tar/" < INSTALL > $bindirname/INSTALL
+ sed -e "s/@TARFILE@/$bindirname/" < INSTALL > $bindirname/INSTALL
ln ../../COPYING $bindirname
ln $TARINSTALL $bindirname
tar cvf $bindirname.tar $bindirname
diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb
index 0dc31f4..1d70c14 100644
--- a/translate/ghdldrv/ghdlrun.adb
+++ b/translate/ghdldrv/ghdlrun.adb
@@ -352,6 +352,8 @@ package body Ghdlrun is
Grt.Signals.Ghdl_Signal_Driving_Value_B2'Address);
Def (Trans_Decls.Ghdl_Signal_Driving_Value_E8,
Grt.Signals.Ghdl_Signal_Driving_Value_E8'Address);
+ Def (Trans_Decls.Ghdl_Signal_Driving_Value_E32,
+ Grt.Signals.Ghdl_Signal_Driving_Value_E32'Address);
Def (Trans_Decls.Ghdl_Signal_Driving_Value_I32,
Grt.Signals.Ghdl_Signal_Driving_Value_I32'Address);
Def (Trans_Decls.Ghdl_Signal_Driving_Value_I64,
@@ -398,6 +400,19 @@ package body Ghdlrun is
Def (Trans_Decls.Ghdl_Signal_Associate_E8,
Grt.Signals.Ghdl_Signal_Associate_E8'Address);
+ Def (Trans_Decls.Ghdl_Create_Signal_E32,
+ Grt.Signals.Ghdl_Create_Signal_E32'Address);
+ Def (Trans_Decls.Ghdl_Signal_Init_E32,
+ Grt.Signals.Ghdl_Signal_Init_E32'Address);
+ Def (Trans_Decls.Ghdl_Signal_Simple_Assign_E32,
+ Grt.Signals.Ghdl_Signal_Simple_Assign_E32'Address);
+ Def (Trans_Decls.Ghdl_Signal_Start_Assign_E32,
+ Grt.Signals.Ghdl_Signal_Start_Assign_E32'Address);
+ Def (Trans_Decls.Ghdl_Signal_Next_Assign_E32,
+ Grt.Signals.Ghdl_Signal_Next_Assign_E32'Address);
+ Def (Trans_Decls.Ghdl_Signal_Associate_E32,
+ Grt.Signals.Ghdl_Signal_Associate_E32'Address);
+
Def (Trans_Decls.Ghdl_Create_Signal_I32,
Grt.Signals.Ghdl_Create_Signal_I32'Address);
Def (Trans_Decls.Ghdl_Signal_Init_I32,
@@ -479,18 +494,25 @@ package body Ghdlrun is
Grt.Files.Ghdl_Text_File_Finalize'Address);
Def (Trans_Decls.Ghdl_Text_File_Open,
Grt.Files.Ghdl_Text_File_Open'Address);
+ Def (Trans_Decls.Ghdl_Text_File_Open_Status,
+ Grt.Files.Ghdl_Text_File_Open_Status'Address);
Def (Trans_Decls.Ghdl_Text_Write,
Grt.Files.Ghdl_Text_Write'Address);
Def (Trans_Decls.Ghdl_Text_Read_Length,
Grt.Files.Ghdl_Text_Read_Length'Address);
Def (Trans_Decls.Ghdl_Text_File_Close,
Grt.Files.Ghdl_Text_File_Close'Address);
- Def (Trans_Decls.Ghdl_File_Close,
- Grt.Files.Ghdl_File_Close'Address);
+
Def (Trans_Decls.Ghdl_File_Elaborate,
Grt.Files.Ghdl_File_Elaborate'Address);
+ Def (Trans_Decls.Ghdl_File_Finalize,
+ Grt.Files.Ghdl_File_Finalize'Address);
Def (Trans_Decls.Ghdl_File_Open,
Grt.Files.Ghdl_File_Open'Address);
+ Def (Trans_Decls.Ghdl_File_Open_Status,
+ Grt.Files.Ghdl_File_Open_Status'Address);
+ Def (Trans_Decls.Ghdl_File_Close,
+ Grt.Files.Ghdl_File_Close'Address);
Def (Trans_Decls.Ghdl_Write_Scalar,
Grt.Files.Ghdl_Write_Scalar'Address);
Def (Trans_Decls.Ghdl_Read_Scalar,
@@ -503,6 +525,8 @@ package body Ghdlrun is
Grt.Images.Ghdl_Image_B2'Address);
Def (Trans_Decls.Ghdl_Image_E8,
Grt.Images.Ghdl_Image_E8'Address);
+ Def (Trans_Decls.Ghdl_Image_E32,
+ Grt.Images.Ghdl_Image_E32'Address);
Def (Trans_Decls.Ghdl_Image_I32,
Grt.Images.Ghdl_Image_I32'Address);
Def (Trans_Decls.Ghdl_Image_F64,
diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb
index fc38f87..7c8b10f 100644
--- a/translate/grt/grt-avhpi.adb
+++ b/translate/grt/grt-avhpi.adb
@@ -329,7 +329,8 @@ package body Grt.Avhpi is
end if;
end;
when Ghdl_Rtik_Type_B2
- | Ghdl_Rtik_Type_E8 =>
+ | Ghdl_Rtik_Type_E8
+ | Ghdl_Rtik_Type_E32 =>
Res := (Kind => VhpiEnumTypeDeclK,
Ctxt => Ctxt,
Atype => Rti);
@@ -387,6 +388,7 @@ package body Grt.Avhpi is
| Ghdl_Rtik_Subtype_Array
| Ghdl_Rtik_Subtype_Array_Ptr
| Ghdl_Rtik_Type_E8
+ | Ghdl_Rtik_Type_E32
| Ghdl_Rtik_Type_B2 =>
Rti_To_Handle (Ch, Iterator.Ctxt, Res);
if Res.Kind /= VhpiUndefined then
@@ -581,6 +583,9 @@ package body Grt.Avhpi is
-- when Ghdl_Rtik_Type_E8 =>
-- Disp_Enum_Value
-- (Stream, Rti, Ghdl_Index_Type (Vptr.E8));
+-- when Ghdl_Rtik_Type_E32 =>
+-- Disp_Enum_Value
+-- (Stream, Rti, Ghdl_Index_Type (Vptr.E32));
-- when Ghdl_Rtik_Type_B2 =>
-- Disp_Enum_Value
-- (Stream, Rti,
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
index e9ac3e6..dded644 100644
--- a/translate/grt/grt-disp_rti.adb
+++ b/translate/grt/grt-disp_rti.adb
@@ -73,6 +73,11 @@ package body Grt.Disp_Rti is
if not Is_Sig then
Update (8);
end if;
+ when Ghdl_Rtik_Type_E32 =>
+ Disp_Enum_Value (Stream, Rti, Ghdl_Index_Type (Vptr.E32));
+ if not Is_Sig then
+ Update (32);
+ end if;
when Ghdl_Rtik_Type_B2 =>
Disp_Enum_Value (Stream, Rti,
Ghdl_Index_Type (Ghdl_B2'Pos (Vptr.B2)));
@@ -201,6 +206,7 @@ package body Grt.Disp_Rti is
Obj, Is_Sig);
when Ghdl_Rtik_Type_I32
| Ghdl_Rtik_Type_E8
+ | Ghdl_Rtik_Type_E32
| Ghdl_Rtik_Type_B2 =>
Disp_Scalar_Value (Stream, Rti, Obj, Is_Sig);
when Ghdl_Rtik_Type_Array =>
@@ -310,6 +316,8 @@ package body Grt.Disp_Rti is
Put ("ghdl_rtik_type_b2");
when Ghdl_Rtik_Type_E8 =>
Put ("ghdl_rtik_type_e8");
+ when Ghdl_Rtik_Type_E32 =>
+ Put ("ghdl_rtik_type_e32");
when Ghdl_Rtik_Type_P64 =>
Put ("ghdl_rtik_type_p64");
when Ghdl_Rtik_Type_I32 =>
diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb
index 974d557..9037fce 100644
--- a/translate/grt/grt-files.adb
+++ b/translate/grt/grt-files.adb
@@ -153,8 +153,8 @@ package body Grt.Files is
end if;
-- Copy file name and convert it to a C string (NUL terminated).
- for I in 0 .. Str.Bounds.Dim_1.Length - 1 loop
- Name (1 + Natural (I)) := Str.Base (I);
+ for I in 1 .. Str.Bounds.Dim_1.Length loop
+ Name (Natural (I)) := Str.Base (I - 1);
end loop;
Name (Name'Last) := NUL;
diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb
index 396a0ea..5f8a081 100644
--- a/translate/grt/grt-images.adb
+++ b/translate/grt/grt-images.adb
@@ -68,6 +68,13 @@ package body Grt.Images is
Return_Enum (Res, Rti, Ghdl_E8'Pos (Val));
end Ghdl_Image_E8;
+ procedure Ghdl_Image_E32
+ (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access)
+ is
+ begin
+ Return_Enum (Res, Rti, Ghdl_E32'Pos (Val));
+ end Ghdl_Image_E32;
+
procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32)
is
Str : String (1 .. 11);
diff --git a/translate/grt/grt-images.ads b/translate/grt/grt-images.ads
index fb33b63..74a7bd7 100644
--- a/translate/grt/grt-images.ads
+++ b/translate/grt/grt-images.ads
@@ -23,6 +23,8 @@ package Grt.Images is
(Res : Std_String_Ptr; Val : Ghdl_B2; Rti : Ghdl_Rti_Access);
procedure Ghdl_Image_E8
(Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access);
+ procedure Ghdl_Image_E32
+ (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access);
procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32);
procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64);
procedure Ghdl_Image_P64
@@ -32,6 +34,7 @@ package Grt.Images is
private
pragma Export (C, Ghdl_Image_B2, "__ghdl_image_b2");
pragma Export (C, Ghdl_Image_E8, "__ghdl_image_e8");
+ pragma Export (C, Ghdl_Image_E32, "__ghdl_image_e32");
pragma Export (C, Ghdl_Image_I32, "__ghdl_image_i32");
pragma Export (C, Ghdl_Image_F64, "__ghdl_image_f64");
pragma Export (C, Ghdl_Image_P64, "__ghdl_image_p64");
diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb
index 4f24fe7..64273b3 100644
--- a/translate/grt/grt-rtis_addr.adb
+++ b/translate/grt/grt-rtis_addr.adb
@@ -231,6 +231,10 @@ package body Grt.Rtis_Addr is
Align (Ghdl_Range_E8'Alignment);
Res (I) := To_Ghdl_Range_Ptr (Bounds);
Update (Ghdl_Range_E8'Size);
+ when Ghdl_Rtik_Type_E32 =>
+ Align (Ghdl_Range_E32'Alignment);
+ Res (I) := To_Ghdl_Range_Ptr (Bounds);
+ Update (Ghdl_Range_E32'Size);
when others =>
-- Bounds are not known anymore.
Bounds := Null_Address;
@@ -249,6 +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_B2 =>
return Atype;
when others =>
diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb
index 9754ada..4fd558e 100644
--- a/translate/grt/grt-rtis_utils.adb
+++ b/translate/grt/grt-rtis_utils.adb
@@ -198,6 +198,8 @@ package body Grt.Rtis_Utils is
Update (32);
when Ghdl_Rtik_Type_E8 =>
Update (8);
+ when Ghdl_Rtik_Type_E32 =>
+ Update (32);
when Ghdl_Rtik_Type_B2 =>
Update (8);
when Ghdl_Rtik_Type_F64 =>
@@ -231,6 +233,13 @@ package body Grt.Rtis_Utils is
when Dir_Downto =>
Val.E8 := Rng.E8.Left - Ghdl_E8 (Pos);
end case;
+ when Ghdl_Rtik_Type_E32 =>
+ case Rng.E32.Dir is
+ when Dir_To =>
+ Val.E32 := Rng.E32.Left + Ghdl_E32 (Pos);
+ when Dir_Downto =>
+ Val.E32 := Rng.E32.Left - Ghdl_E32 (Pos);
+ end case;
when Ghdl_Rtik_Type_B2 =>
case Pos is
when 0 =>
@@ -265,6 +274,8 @@ package body Grt.Rtis_Utils is
end;
when Ghdl_Rtik_Type_E8 =>
Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E8));
+ when Ghdl_Rtik_Type_E32 =>
+ Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E32));
when Ghdl_Rtik_Type_B2 =>
Get_Enum_Value (Vstr, Rti, Ghdl_B2'Pos (V.B2));
when others =>
@@ -348,6 +359,7 @@ package body Grt.Rtis_Utils is
Handle_Scalar (To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype);
when Ghdl_Rtik_Type_I32
| Ghdl_Rtik_Type_E8
+ | Ghdl_Rtik_Type_E32
| Ghdl_Rtik_Type_B2 =>
Handle_Scalar (Rti);
when Ghdl_Rtik_Type_Array =>
@@ -430,6 +442,8 @@ package body Grt.Rtis_Utils is
end;
when Ghdl_Rtik_Type_E8 =>
Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E8));
+ when Ghdl_Rtik_Type_E32 =>
+ Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E32));
when Ghdl_Rtik_Type_B2 =>
Get_Enum_Value
(Str, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2)));
@@ -520,6 +534,8 @@ package body Grt.Rtis_Utils is
end;
when Ghdl_Rtik_Type_E8 =>
Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E8));
+ when Ghdl_Rtik_Type_E32 =>
+ Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E32));
when Ghdl_Rtik_Type_B2 =>
Get_Enum_Value
(Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2)));
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index 5b3a12f..a165144 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -802,6 +802,77 @@ package body Grt.Signals is
(Sign, Value_Union'(Mode => Mode_E8, E8 => Val), After);
end Ghdl_Signal_Next_Assign_E8;
+ function Ghdl_Create_Signal_E32
+ (Init_Val : Ghdl_E32;
+ Resolv_Func : System.Address;
+ Resolv_Inst : System.Address)
+ return Ghdl_Signal_Ptr
+ is
+ begin
+ return Create_Signal
+ (Mode_E32, Value_Union'(Mode => Mode_E32, E32 => Init_Val),
+ Get_Current_Mode_Signal,
+ Resolv_Func, Resolv_Inst);
+ end Ghdl_Create_Signal_E32;
+
+ procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32)
+ is
+ begin
+ Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_E32, E32 => Init_Val));
+ end Ghdl_Signal_Init_E32;
+
+ procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32)
+ is
+ begin
+ Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E32, E32 => Val));
+ end Ghdl_Signal_Associate_E32;
+
+ procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Val : Ghdl_E32)
+ is
+ Trans : Transaction_Acc;
+ begin
+ if not Sign.Flags.Has_Active
+ and then Sign.Net = Net_One_Driver
+ and then Val = Sign.Value.E32
+ and then Sign.S.Drivers (0).First_Trans.Next = null
+ then
+ return;
+ end if;
+
+ Trans := new Transaction'
+ (Kind => Trans_Value,
+ Time => 0,
+ Next => null,
+ Val => Value_Union'(Mode => Mode_E32, E32 => Val));
+
+ Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+ end Ghdl_Signal_Simple_Assign_E32;
+
+ procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Rej : Std_Time;
+ Val : Ghdl_E32;
+ After : Std_Time)
+ is
+ Trans : Transaction_Acc;
+ begin
+ Trans := new Transaction'
+ (Kind => Trans_Value,
+ Time => 0,
+ Next => null,
+ Val => Value_Union'(Mode => Mode_E32, E32 => Val));
+ Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+ end Ghdl_Signal_Start_Assign_E32;
+
+ procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Val : Ghdl_E32;
+ After : Std_Time)
+ is
+ begin
+ Ghdl_Signal_Next_Assign
+ (Sign, Value_Union'(Mode => Mode_E32, E32 => Val), After);
+ end Ghdl_Signal_Next_Assign_E32;
+
function Ghdl_Create_Signal_I32
(Init_Val : Ghdl_I32;
Resolv_Func : System.Address;
@@ -1358,6 +1429,19 @@ package body Grt.Signals is
end if;
end Ghdl_Signal_Driving_Value_E8;
+ function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr)
+ return Ghdl_E32
+ is
+ Drv : Driver_Acc;
+ begin
+ Drv := Get_Driver (Sig);
+ if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+ Error ("'driving_value: no active driver in process for signal");
+ else
+ return Drv.First_Trans.Val.E32;
+ end if;
+ end Ghdl_Signal_Driving_Value_E32;
+
function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr)
return Ghdl_I32
is
diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
index c78bf52..500cd55 100644
--- a/translate/grt/grt-signals.ads
+++ b/translate/grt/grt-signals.ads
@@ -453,6 +453,25 @@ package Grt.Signals is
function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
return Ghdl_E8;
+ function Ghdl_Create_Signal_E32
+ (Init_Val : Ghdl_E32;
+ Resolv_Func : System.Address;
+ Resolv_Inst : System.Address)
+ return Ghdl_Signal_Ptr;
+ procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32);
+ procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32);
+ procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Val : Ghdl_E32);
+ procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Rej : Std_Time;
+ Val : Ghdl_E32;
+ After : Std_Time);
+ procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Val : Ghdl_E32;
+ After : Std_Time);
+ function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr)
+ return Ghdl_E32;
+
function Ghdl_Create_Signal_I32
(Init_Val : Ghdl_I32;
Resolv_Func : System.Address;
@@ -634,6 +653,21 @@ private
pragma Export (C, Ghdl_Signal_Driving_Value_E8,
"__ghdl_signal_driving_value_e8");
+ pragma Export (C, Ghdl_Create_Signal_E32,
+ "__ghdl_create_signal_e32");
+ pragma Export (C, Ghdl_Signal_Init_E32,
+ "__ghdl_signal_init_e32");
+ pragma Export (C, Ghdl_Signal_Associate_E32,
+ "__ghdl_signal_associate_e32");
+ pragma Export (C, Ghdl_Signal_Simple_Assign_E32,
+ "__ghdl_signal_simple_assign_e32");
+ pragma Export (C, Ghdl_Signal_Start_Assign_E32,
+ "__ghdl_signal_start_assign_e32");
+ pragma Export (C, Ghdl_Signal_Next_Assign_E32,
+ "__ghdl_signal_next_assign_e32");
+ pragma Export (C, Ghdl_Signal_Driving_Value_E32,
+ "__ghdl_signal_driving_value_e32");
+
pragma Export (C, Ghdl_Create_Signal_I32,
"__ghdl_create_signal_i32");
pragma Export (C, Ghdl_Signal_Init_I32,
diff --git a/translate/trans_decls.ads b/translate/trans_decls.ads
index 20498e4..6141fcd 100644
--- a/translate/trans_decls.ads
+++ b/translate/trans_decls.ads
@@ -77,6 +77,14 @@ package Trans_Decls is
Ghdl_Signal_Associate_E8 : O_Dnode;
Ghdl_Signal_Driving_Value_E8 : O_Dnode;
+ Ghdl_Create_Signal_E32 : O_Dnode;
+ Ghdl_Signal_Init_E32 : O_Dnode;
+ Ghdl_Signal_Simple_Assign_E32 : O_Dnode;
+ Ghdl_Signal_Start_Assign_E32 : O_Dnode;
+ Ghdl_Signal_Next_Assign_E32 : O_Dnode;
+ Ghdl_Signal_Associate_E32 : O_Dnode;
+ Ghdl_Signal_Driving_Value_E32 : O_Dnode;
+
Ghdl_Create_Signal_B2 : O_Dnode;
Ghdl_Signal_Init_B2 : O_Dnode;
Ghdl_Signal_Simple_Assign_B2 : O_Dnode;
@@ -190,6 +198,7 @@ package Trans_Decls is
-- 'Image attributes.
Ghdl_Image_B2 : O_Dnode;
Ghdl_Image_E8 : O_Dnode;
+ Ghdl_Image_E32 : O_Dnode;
Ghdl_Image_I32 : O_Dnode;
Ghdl_Image_P32 : O_Dnode;
Ghdl_Image_P64 : O_Dnode;
@@ -198,6 +207,7 @@ package Trans_Decls is
-- 'Value attributes
Ghdl_Value_B2 : O_Dnode;
Ghdl_Value_E8 : O_Dnode;
+ Ghdl_Value_E32 : O_Dnode;
Ghdl_Value_I32 : O_Dnode;
Ghdl_Value_P32 : O_Dnode;
Ghdl_Value_P64 : O_Dnode;
diff --git a/translate/translation.adb b/translate/translation.adb
index dfbe23a..9241f36 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -978,8 +978,12 @@ package body Translation is
Resolv_Block : Iir;
-- Parameter nodes.
Var_Instance : O_Dnode;
+
+ -- Signals
Var_Vals : O_Dnode;
+ -- Driving vector.
Var_Vec : O_Dnode;
+ -- Length of Vector.
Var_Vlen : O_Dnode;
Var_Nbr_Drv : O_Dnode;
Var_Nbr_Ports : O_Dnode;
@@ -6659,7 +6663,10 @@ package body Translation is
case Get_Kind (El) is
when Iir_Kind_Function_Declaration
| Iir_Kind_Procedure_Declaration =>
- Chap2.Translate_Subprogram_Declaration (El);
+ -- Translate only if used.
+ if Get_Info (El) /= null then
+ Chap2.Translate_Subprogram_Declaration (El);
+ end if;
when others =>
Error_Kind ("translate_protected_type_subprograms", El);
end case;
@@ -8128,10 +8135,11 @@ package body Translation is
end;
when Type_Mode_Fat_Array =>
-- a fat array.
+ D := Stabilize (Dest);
Gen_Memcpy
- (M2Addr (Get_Array_Base (Dest)),
+ (M2Addr (Get_Array_Base (D)),
M2Addr (Get_Array_Base (E2M (Src, Info, Kind))),
- Get_Object_Size (Dest, Obj_Type));
+ Get_Object_Size (D, Obj_Type));
when Type_Mode_Record
| Type_Mode_Ptr_Array =>
Gen_Memcpy
@@ -9427,6 +9435,9 @@ package body Translation is
when Type_Mode_E8 =>
Create_Subprg := Ghdl_Create_Signal_E8;
Conv := Ghdl_I32_Type;
+ when Type_Mode_E32 =>
+ Create_Subprg := Ghdl_Create_Signal_E32;
+ Conv := Ghdl_I32_Type;
when Type_Mode_I32
| Type_Mode_P32 =>
Create_Subprg := Ghdl_Create_Signal_I32;
@@ -10254,7 +10265,8 @@ package body Translation is
(Interface_List, Rinfo.Var_Instance, Wki_Instance, Itype);
-- The signal.
- El_Type := Get_Return_Type (Func);
+ El_Type := Get_Type (Get_Interface_Declaration_Chain (Func));
+ El_Type := Get_Element_Subtype (El_Type);
El_Info := Get_Info (El_Type);
case El_Info.Type_Mode is
when Type_Mode_Thin =>
@@ -10383,10 +10395,17 @@ package body Translation is
is
-- Type of the resolution function parameter.
Arr_Type : Iir;
- Base_Type, El_Type : Iir;
- El_Info : Type_Info_Acc;
+ Base_Type : Iir;
Base_Info : Type_Info_Acc;
+ -- Type of parameter element.
+ El_Type : Iir;
+ El_Info : Type_Info_Acc;
+
+ -- Type of the function return value.
+ Ret_Type : Iir;
+ Ret_Info : Type_Info_Acc;
+
-- Type and info of the array index.
Index_Type : Iir;
Index_Tinfo : Type_Info_Acc;
@@ -10421,13 +10440,16 @@ package body Translation is
return;
end if;
- El_Type := Get_Return_Type (Func);
- El_Info := Get_Info (El_Type);
+ Ret_Type := Get_Return_Type (Func);
+ Ret_Info := Get_Info (Ret_Type);
Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Func));
Base_Type := Get_Base_Type (Arr_Type);
Base_Info := Get_Info (Base_Type);
+ El_Type := Get_Element_Subtype (Arr_Type);
+ El_Info := Get_Info (El_Type);
+
Index_Type := Get_First_Element (Get_Index_Subtype_List (Arr_Type));
Index_Tinfo := Get_Info (Index_Type);
@@ -10441,7 +10463,7 @@ package body Translation is
-- A signal.
New_Var_Decl (Var_Res, Get_Identifier ("res"),
- O_Storage_Local, El_Info.Ortho_Type (Mode_Value));
+ O_Storage_Local, Ret_Info.Ortho_Type (Mode_Value));
-- I, J.
New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
@@ -10559,8 +10581,10 @@ package body Translation is
Finish_Loop_Stmt (Label);
if Finfo.Res_Interface /= O_Dnode_Null then
- Res := Lo2M (Var_Res, El_Info, Mode_Value);
- Allocate_Complex_Object (El_Type, Alloc_Stack, Res);
+ Res := Lo2M (Var_Res, Ret_Info, Mode_Value);
+ if Ret_Info.Type_Mode /= Type_Mode_Fat_Array then
+ Allocate_Complex_Object (Ret_Type, Alloc_Stack, Res);
+ end if;
end if;
-- Call the resolution function.
@@ -10574,11 +10598,17 @@ package body Translation is
Base_Info.Ortho_Ptr_Type (Mode_Value)));
if Finfo.Res_Interface = O_Dnode_Null then
- Res := E2M (New_Function_Call (Assoc), El_Info, Mode_Value);
+ Res := E2M (New_Function_Call (Assoc), Ret_Info, Mode_Value);
else
New_Procedure_Call (Assoc);
end if;
+ if El_Type /= Ret_Type then
+ Res := E2M
+ (Chap7.Translate_Implicit_Conv (M2E (Res), Ret_Type, El_Type,
+ Mode_Value, Func),
+ El_Info, Mode_Value);
+ end if;
Chap7.Set_Driving_Value (Vals, El_Type, Res);
Close_Temp;
@@ -10600,11 +10630,7 @@ package body Translation is
when Iir_Kind_Procedure_Declaration
| Iir_Kind_Function_Declaration =>
-- Translate interfaces.
- if Flag_Discard_Unused
- and then not Get_Use_Flag (El)
- then
- null;
- else
+ if not Flag_Discard_Unused or else Get_Use_Flag (El) then
Info := Add_Info (El, Kind_Subprg);
Chap2.Translate_Subprogram_Interfaces (El);
if Get_Kind (El) = Iir_Kind_Function_Declaration
@@ -10637,18 +10663,16 @@ package body Translation is
case Get_Kind (El) is
when Iir_Kind_Procedure_Declaration
| Iir_Kind_Function_Declaration =>
+ -- Translate only if used.
if Get_Info (El) /= null then
Chap2.Translate_Subprogram_Declaration (El);
Translate_Resolution_Function (El, Block);
end if;
when Iir_Kind_Function_Body
| Iir_Kind_Procedure_Body =>
- if Flag_Discard_Unused
- and then
- not Get_Use_Flag (Get_Subprogram_Specification (El))
+ if not Flag_Discard_Unused
+ or else Get_Use_Flag (Get_Subprogram_Specification (El))
then
- null;
- else
Chap2.Translate_Subprogram_Body (El);
Translate_Resolution_Function_Body
(Get_Subprogram_Specification (El), Block);
@@ -11455,6 +11479,9 @@ package body Translation is
when Type_Mode_E8 =>
Subprg := Ghdl_Signal_Associate_E8;
Conv := Ghdl_I32_Type;
+ when Type_Mode_E32 =>
+ Subprg := Ghdl_Signal_Associate_E32;
+ Conv := Ghdl_I32_Type;
when Type_Mode_I32 =>
Subprg := Ghdl_Signal_Associate_I32;
Conv := Ghdl_I32_Type;
@@ -14918,8 +14945,6 @@ package body Translation is
begin
Tinfo := Get_Info (Target_Type);
Open_Temp;
- -- FIXME: to be removed ?
- --Chap3.Translate_Type_Definition (Aggr_Type);
Targ := Stabilize (Target);
Base := Stabilize (Chap3.Get_Array_Base (Targ));
Bounds := Stabilize (Chap3.Get_Array_Bounds (Targ));
@@ -15053,6 +15078,10 @@ package body Translation is
Translate_Array_Aggregate_Gen
(Base, Bounds, Aggr, Aggr_Type, 1, Var_Index);
Close_Temp;
+
+ -- FIXME: creating aggregate subtype is expensive and rarely used.
+ -- (one of the current use - only ? - is check_array_match).
+ Chap3.Translate_Type_Definition (Aggr_Type, False);
end Translate_Array_Aggregate;
procedure Translate_Aggregate
@@ -15174,7 +15203,8 @@ package body Translation is
Res_Info := Get_Info (Res_Type);
Expr_Info := Get_Info (Expr_Type);
case Res_Info.Type_Mode is
- when Type_Mode_Array =>
+ when Type_Mode_Array
+ | Type_Mode_Ptr_Array =>
declare
E : O_Dnode;
begin
@@ -15612,9 +15642,6 @@ package body Translation is
| Iir_Kind_Simple_Aggregate
| Iir_Kind_Simple_Name_Attribute =>
Res := Translate_String_Literal (Expr);
- Res := Translate_Implicit_Conv
- (Res, Expr_Type, Res_Type, Mode_Value, Expr);
- return Res;
when Iir_Kind_Aggregate =>
declare
@@ -15700,8 +15727,6 @@ package body Translation is
when Iir_Kind_Qualified_Expression =>
-- FIXME: check type.
Res := Translate_Expression (Get_Expression (Expr), Expr_Type);
- return Translate_Implicit_Conv
- (Res, Expr_Type, Rtype, Mode_Value, Expr);
when Iir_Kind_Constant_Declaration
| Iir_Kind_Variable_Declaration
@@ -15735,11 +15760,6 @@ package body Translation is
Res := Translate_Signal (Res, Expr_Type);
end if;
end;
- if Rtype /= Null_Iir then
- Res := Translate_Implicit_Conv
- (Res, Expr_Type, Rtype, Mode_Value, Expr);
- end if;
- return Res;
when Iir_Kind_Iterator_Declaration =>
declare
@@ -15802,9 +15822,7 @@ package body Translation is
Assoc_Chain := Canon.Canon_Subprogram_Call (Expr);
Res := Translate_Function_Call
(Imp, Assoc_Chain, Get_Method_Object (Expr));
- return Translate_Implicit_Conv
- (Res, Get_Return_Type (Imp),
- Res_Type, Mode_Value, Expr);
+ Expr_Type := Get_Return_Type (Imp);
end if;
end;
@@ -15816,8 +15834,6 @@ package body Translation is
Res := Translate_Type_Conversion
(Translate_Expression (Conv_Expr), Get_Type (Conv_Expr),
Expr_Type, Expr);
- return Translate_Implicit_Conv
- (Res, Expr_Type, Res_Type, Mode_Value, Expr);
end;
when Iir_Kind_Length_Array_Attribute =>
@@ -15844,9 +15860,8 @@ package body Translation is
return Chap14.Translate_Succ_Pred_Attribute (Expr);
when Iir_Kind_Image_Attribute =>
- return Translate_Implicit_Conv
- (Chap14.Translate_Image_Attribute (Expr),
- String_Type_Definition, Res_Type, Mode_Value, Expr);
+ Res := Chap14.Translate_Image_Attribute (Expr);
+
when Iir_Kind_Value_Attribute =>
return Chap14.Translate_Value_Attribute (Expr);
@@ -15855,7 +15870,7 @@ package body Translation is
when Iir_Kind_Active_Attribute =>
return Chap14.Translate_Active_Attribute (Expr);
when Iir_Kind_Last_Value_Attribute =>
- return Chap14.Translate_Last_Value_Attribute (Expr);
+ Res := Chap14.Translate_Last_Value_Attribute (Expr);
when Iir_Kind_High_Type_Attribute =>
return Chap14.Translate_High_Type_Attribute (Get_Type (Expr));
@@ -15874,13 +15889,13 @@ package body Translation is
(Get_Prefix (Expr), Ghdl_Signal_Last_Active_Node);
when Iir_Kind_Driving_Value_Attribute =>
- return Chap14.Translate_Driving_Value_Attribute (Expr);
+ Res := Chap14.Translate_Driving_Value_Attribute (Expr);
when Iir_Kind_Driving_Attribute =>
- return Chap14.Translate_Driving_Attribute (Expr);
+ Res := Chap14.Translate_Driving_Attribute (Expr);
when Iir_Kind_Path_Name_Attribute
| Iir_Kind_Instance_Name_Attribute =>
- return Chap14.Translate_Path_Instance_Name_Attribute (Expr);
+ Res := Chap14.Translate_Path_Instance_Name_Attribute (Expr);
when Iir_Kind_Simple_Name
| Iir_Kind_Selected_Name =>
@@ -15889,6 +15904,14 @@ package body Translation is
when others =>
Error_Kind ("translate_expression", Expr);
end case;
+
+ -- Quick test to avoid useless calls.
+ if Expr_Type /= Res_Type then
+ Res := Translate_Implicit_Conv
+ (Res, Expr_Type, Res_Type, Mode_Value, Expr);
+ end if;
+
+ return Res;
end Translate_Expression;
-- Check if RNG is of the form:
@@ -19411,6 +19434,9 @@ package body Translation is
when Type_Mode_E8 =>
Subprg := Ghdl_Signal_Simple_Assign_E8;
Conv := Ghdl_I32_Type;
+ when Type_Mode_E32 =>
+ Subprg := Ghdl_Signal_Simple_Assign_E32;
+ Conv := Ghdl_I32_Type;
when Type_Mode_I32
| Type_Mode_P32 =>
Subprg := Ghdl_Signal_Simple_Assign_I32;
@@ -19533,6 +19559,9 @@ package body Translation is
when Type_Mode_E8 =>
Subprg := Ghdl_Signal_Start_Assign_E8;
Conv := Ghdl_I32_Type;
+ when Type_Mode_E32 =>
+ Subprg := Ghdl_Signal_Start_Assign_E32;
+ Conv := Ghdl_I32_Type;
when Type_Mode_I32
| Type_Mode_P32 =>
Subprg := Ghdl_Signal_Start_Assign_I32;
@@ -19699,6 +19728,9 @@ package body Translation is
when Type_Mode_E8 =>
Subprg := Ghdl_Signal_Next_Assign_E8;
Conv := Ghdl_I32_Type;
+ when Type_Mode_E32 =>
+ Subprg := Ghdl_Signal_Next_Assign_E32;
+ Conv := Ghdl_I32_Type;
when Type_Mode_I32
| Type_Mode_P32 =>
Subprg := Ghdl_Signal_Next_Assign_I32;
@@ -21014,6 +21046,9 @@ package body Translation is
when Type_Mode_E8 =>
Init_Subprg := Ghdl_Signal_Init_E8;
Conv := Ghdl_I32_Type;
+ when Type_Mode_E32 =>
+ Init_Subprg := Ghdl_Signal_Init_E32;
+ Conv := Ghdl_I32_Type;
when Type_Mode_I32
| Type_Mode_P32 =>
Init_Subprg := Ghdl_Signal_Init_I32;
@@ -22832,6 +22867,8 @@ package body Translation is
Subprg := Ghdl_Signal_Driving_Value_B2;
when Type_Mode_E8 =>
Subprg := Ghdl_Signal_Driving_Value_E8;
+ when Type_Mode_E32 =>
+ Subprg := Ghdl_Signal_Driving_Value_E32;
when Type_Mode_I32
| Type_Mode_P32 =>
Subprg := Ghdl_Signal_Driving_Value_I32;
@@ -22888,6 +22925,9 @@ package body Translation is
when Type_Mode_E8 =>
Subprg := Ghdl_Image_E8;
Conv := Ghdl_I32_Type;
+ when Type_Mode_E32 =>
+ Subprg := Ghdl_Image_E32;
+ Conv := Ghdl_I32_Type;
when Type_Mode_I32 =>
Subprg := Ghdl_Image_I32;
Conv := Ghdl_I32_Type;
@@ -22942,6 +22982,8 @@ package body Translation is
Subprg := Ghdl_Value_B2;
when Type_Mode_E8 =>
Subprg := Ghdl_Value_E8;
+ when Type_Mode_E32 =>
+ Subprg := Ghdl_Value_E32;
when Type_Mode_I32 =>
Subprg := Ghdl_Value_I32;
when Type_Mode_P64 =>
@@ -26569,6 +26611,12 @@ package body Translation is
Create_Image_Value_Subprograms
("e8", Ghdl_I32_Type, True, Ghdl_Image_E8, Ghdl_Value_E8);
+ -- procedure __ghdl_image_e32 (res : std_string_ptr_node;
+ -- val : ghdl_i32_type;
+ -- rti : ghdl_rti_access);
+ Create_Image_Value_Subprograms
+ ("e32", Ghdl_I32_Type, True, Ghdl_Image_E32, Ghdl_Value_E32);
+
-- procedure __ghdl_image_i32 (res : std_string_ptr_node;
-- val : ghdl_i32_type);
Create_Image_Value_Subprograms
@@ -26903,6 +26951,19 @@ package body Translation is
Ghdl_Signal_Associate_E8,
Ghdl_Signal_Driving_Value_E8);
+ -- function __ghdl_create_signal_enum8 (init_val : ghdl_i32_type)
+ -- return __ghdl_signal_ptr;
+ -- procedure __ghdl_signal_simple_assign_e8 (sign : __ghdl_signal_ptr;
+ -- val : __ghdl_integer);
+ Create_Signal_Subprograms ("e32", Ghdl_I32_Type,
+ Ghdl_Create_Signal_E32,
+ Ghdl_Signal_Init_E32,
+ Ghdl_Signal_Simple_Assign_E32,
+ Ghdl_Signal_Start_Assign_E32,
+ Ghdl_Signal_Next_Assign_E32,
+ Ghdl_Signal_Associate_E32,
+ Ghdl_Signal_Driving_Value_E32);
+
-- function __ghdl_create_signal_b2 (init_val : ghdl_bool_type)
-- return __ghdl_signal_ptr;
-- procedure __ghdl_signal_simple_assign_b2 (sign : __ghdl_signal_ptr;
@@ -27683,6 +27744,7 @@ package body Translation is
begin
-- Load the unit in memory to compute the dependence list.
Libraries.Load_Design_Unit (Unit, Null_Iir);
+ Update_Node_Infos;
Set_Elab_Flag (Unit, True);
Design_Units.Append (Unit);
diff --git a/version.ads b/version.ads
index 4118496..fcd1903 100644
--- a/version.ads
+++ b/version.ads
@@ -1,4 +1,4 @@
package Version is
Ghdl_Version : constant String :=
- "GHDL 0.22dev (20051220) [Sokcho edition]";
+ "GHDL 0.23dev (20060614) [Sokcho edition]";
end Version;
generated by cgit (git 2.34.1) at 2024-12-22 14:19:04 +0000