diff options
Diffstat (limited to 'translate')
| -rw-r--r-- | translate/ghdldrv/Makefile | 2 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 53 | ||||
| -rw-r--r-- | translate/grt/grt-avhpi.adb | 8 | ||||
| -rw-r--r-- | translate/grt/grt-disp.adb | 8 | ||||
| -rw-r--r-- | translate/grt/grt-disp_rti.adb | 16 | ||||
| -rw-r--r-- | translate/grt/grt-images.adb | 23 | ||||
| -rw-r--r-- | translate/grt/grt-images.ads | 15 | ||||
| -rw-r--r-- | translate/grt/grt-lib.ads | 2 | ||||
| -rw-r--r-- | translate/grt/grt-rtis.ads | 2 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_addr.adb | 6 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_utils.adb | 24 | ||||
| -rw-r--r-- | translate/grt/grt-signals.adb | 98 | ||||
| -rw-r--r-- | translate/grt/grt-signals.ads | 54 | ||||
| -rw-r--r-- | translate/grt/grt-stats.adb | 2 | ||||
| -rw-r--r-- | translate/grt/grt-std_logic_1164.adb | 98 | ||||
| -rw-r--r-- | translate/grt/grt-std_logic_1164.ads | 107 | ||||
| -rw-r--r-- | translate/grt/grt-types.ads | 40 | ||||
| -rw-r--r-- | translate/grt/grt-values.adb | 8 | ||||
| -rw-r--r-- | translate/grt/grt-values.ads | 6 | ||||
| -rw-r--r-- | translate/grt/grt-vcd.adb | 12 | ||||
| -rw-r--r-- | translate/grt/grt-vpi.adb | 24 | ||||
| -rw-r--r-- | translate/grt/grt-waves.adb | 22 | ||||
| -rw-r--r-- | translate/trans_decls.ads | 29 | ||||
| -rw-r--r-- | translate/translation.adb | 820 |
24 files changed, 1055 insertions, 424 deletions
diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile index 9dd86b6..fc24312 100644 --- a/translate/ghdldrv/Makefile +++ b/translate/ghdldrv/Makefile @@ -155,7 +155,7 @@ grt.links: install.all: install.v87 install.v93 install.standard install.mcode: - $(MAKE) GHDL=ghdl_mcode install.v87 install.v93 # install.v08 + $(MAKE) GHDL=ghdl_mcode install.v87 install.v93 install.v08 install.simul: $(MAKE) GHDL=ghdl_simul install.v87 install.v93 install.v08 diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index cded351..cc01c83 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -59,6 +59,7 @@ with Grt.Types; with Grt.Images; with Grt.Values; with Grt.Names; +with Grt.Std_Logic_1164; with Ghdlcomp; with Foreigns; @@ -335,8 +336,8 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Signal_Driving, Grt.Signals.Ghdl_Signal_Driving'Address); - Def (Trans_Decls.Ghdl_Signal_Driving_Value_B2, - Grt.Signals.Ghdl_Signal_Driving_Value_B2'Address); + Def (Trans_Decls.Ghdl_Signal_Driving_Value_B1, + Grt.Signals.Ghdl_Signal_Driving_Value_B1'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, @@ -366,18 +367,18 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Signal_Direct_Assign, Grt.Signals.Ghdl_Signal_Direct_Assign'Address); - Def (Trans_Decls.Ghdl_Create_Signal_B2, - Grt.Signals.Ghdl_Create_Signal_B2'Address); - Def (Trans_Decls.Ghdl_Signal_Init_B2, - Grt.Signals.Ghdl_Signal_Init_B2'Address); - Def (Trans_Decls.Ghdl_Signal_Simple_Assign_B2, - Grt.Signals.Ghdl_Signal_Simple_Assign_B2'Address); - Def (Trans_Decls.Ghdl_Signal_Start_Assign_B2, - Grt.Signals.Ghdl_Signal_Start_Assign_B2'Address); - Def (Trans_Decls.Ghdl_Signal_Next_Assign_B2, - Grt.Signals.Ghdl_Signal_Next_Assign_B2'Address); - Def (Trans_Decls.Ghdl_Signal_Associate_B2, - Grt.Signals.Ghdl_Signal_Associate_B2'Address); + Def (Trans_Decls.Ghdl_Create_Signal_B1, + Grt.Signals.Ghdl_Create_Signal_B1'Address); + Def (Trans_Decls.Ghdl_Signal_Init_B1, + Grt.Signals.Ghdl_Signal_Init_B1'Address); + Def (Trans_Decls.Ghdl_Signal_Simple_Assign_B1, + Grt.Signals.Ghdl_Signal_Simple_Assign_B1'Address); + Def (Trans_Decls.Ghdl_Signal_Start_Assign_B1, + Grt.Signals.Ghdl_Signal_Start_Assign_B1'Address); + Def (Trans_Decls.Ghdl_Signal_Next_Assign_B1, + Grt.Signals.Ghdl_Signal_Next_Assign_B1'Address); + Def (Trans_Decls.Ghdl_Signal_Associate_B1, + Grt.Signals.Ghdl_Signal_Associate_B1'Address); Def (Trans_Decls.Ghdl_Create_Signal_E8, Grt.Signals.Ghdl_Create_Signal_E8'Address); @@ -502,8 +503,8 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_File_Endfile, Grt.Files.Ghdl_File_Endfile'Address); - Def (Trans_Decls.Ghdl_Image_B2, - Grt.Images.Ghdl_Image_B2'Address); + Def (Trans_Decls.Ghdl_Image_B1, + Grt.Images.Ghdl_Image_B1'Address); Def (Trans_Decls.Ghdl_Image_E8, Grt.Images.Ghdl_Image_E8'Address); Def (Trans_Decls.Ghdl_Image_E32, @@ -517,8 +518,8 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Image_P32, Grt.Images.Ghdl_Image_P32'Address); - Def (Trans_Decls.Ghdl_Value_B2, - Grt.Values.Ghdl_Value_B2'Address); + Def (Trans_Decls.Ghdl_Value_B1, + Grt.Values.Ghdl_Value_B1'Address); Def (Trans_Decls.Ghdl_Value_E8, Grt.Values.Ghdl_Value_E8'Address); Def (Trans_Decls.Ghdl_Value_E32, @@ -537,6 +538,22 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Get_Instance_Name, Grt.Names.Ghdl_Get_Instance_Name'Address); + Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Eq, + Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Eq'Address); + Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Ne, + Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Ne'Address); + Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Lt, + Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Lt'Address); + Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Le, + Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Le'Address); + + Def (Trans_Decls.Ghdl_To_String_I32, + Grt.Images.Ghdl_To_String_I32'Address); + Def (Trans_Decls.Ghdl_To_String_F64, + Grt.Images.Ghdl_To_String_F64'Address); + Def (Trans_Decls.Ghdl_To_String_F64_Digits, + Grt.Images.Ghdl_To_String_F64_Digits'Address); + -- Find untruncated_text_read, if any. Decl := Find_Untruncated_Text_Read; if Decl /= O_Dnode_Null then diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb index 7af940c..b935fd9 100644 --- a/translate/grt/grt-avhpi.adb +++ b/translate/grt/grt-avhpi.adb @@ -369,7 +369,7 @@ package body Grt.Avhpi is Res := (Kind => VhpiArrayTypeDeclK, Ctxt => Ctxt, Atype => Rti); - when Ghdl_Rtik_Type_B2 + when Ghdl_Rtik_Type_B1 | Ghdl_Rtik_Type_E8 | Ghdl_Rtik_Type_E32 => Res := (Kind => VhpiEnumTypeDeclK, @@ -437,7 +437,7 @@ package body Grt.Avhpi is | Ghdl_Rtik_Subtype_Array | Ghdl_Rtik_Type_E8 | Ghdl_Rtik_Type_E32 - | Ghdl_Rtik_Type_B2 + | Ghdl_Rtik_Type_B1 | Ghdl_Rtik_Subtype_Scalar => Rti_To_Handle (Ch, Iterator.Ctxt, Res); if Res.Kind /= VhpiUndefined then @@ -637,10 +637,10 @@ package body Grt.Avhpi is -- when Ghdl_Rtik_Type_E32 => -- Disp_Enum_Value -- (Stream, Rti, Ghdl_Index_Type (Vptr.E32)); --- when Ghdl_Rtik_Type_B2 => +-- when Ghdl_Rtik_Type_B1 => -- Disp_Enum_Value -- (Stream, Rti, --- Ghdl_Index_Type (Ghdl_B2'Pos (Vptr.B2))); +-- Ghdl_Index_Type (Ghdl_B1'Pos (Vptr.B1))); when others => Add ('?'); end case; diff --git a/translate/grt/grt-disp.adb b/translate/grt/grt-disp.adb index 12e9fdc..e68b116 100644 --- a/translate/grt/grt-disp.adb +++ b/translate/grt/grt-disp.adb @@ -188,8 +188,8 @@ package body Grt.Disp is is begin case Mode is - when Mode_B2 => - Put (" b2"); + when Mode_B1 => + Put (" b1"); when Mode_E8 => Put (" e8"); when Mode_E32 => @@ -206,8 +206,8 @@ package body Grt.Disp is procedure Disp_Value (Value : Value_Union; Mode : Mode_Type) is begin case Mode is - when Mode_B2 => - if Value.B2 then + when Mode_B1 => + if Value.B1 then Put ("T"); else Put ("F"); diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb index 5fc6dbd..08d27da 100644 --- a/translate/grt/grt-disp_rti.adb +++ b/translate/grt/grt-disp_rti.adb @@ -85,9 +85,9 @@ package body Grt.Disp_Rti is if not Is_Sig then Update (32); end if; - when Ghdl_Rtik_Type_B2 => + when Ghdl_Rtik_Type_B1 => Disp_Enum_Value (Stream, Rti, - Ghdl_Index_Type (Ghdl_B2'Pos (Vptr.B2))); + Ghdl_Index_Type (Ghdl_B1'Pos (Vptr.B1))); if not Is_Sig then Update (8); end if; @@ -226,7 +226,7 @@ package body Grt.Disp_Rti is when Ghdl_Rtik_Type_I32 | Ghdl_Rtik_Type_E8 | Ghdl_Rtik_Type_E32 - | Ghdl_Rtik_Type_B2 => + | Ghdl_Rtik_Type_B1 => Disp_Scalar_Value (Stream, Rti, Obj, Is_Sig); when Ghdl_Rtik_Type_Array => Disp_Array_Value (Stream, To_Ghdl_Rtin_Type_Array_Acc (Rti), Ctxt, @@ -321,8 +321,8 @@ package body Grt.Disp_Rti is when Ghdl_Rtik_For_Generate => Put ("ghdl_rtik_for_generate"); - when Ghdl_Rtik_Type_B2 => - Put ("ghdl_rtik_type_b2"); + when Ghdl_Rtik_Type_B1 => + Put ("ghdl_rtik_type_b1"); when Ghdl_Rtik_Type_E8 => Put ("ghdl_rtik_type_e8"); when Ghdl_Rtik_Type_E32 => @@ -418,7 +418,7 @@ package body Grt.Disp_Rti is Disp_Scalar_Type_Name (Rti.Basetype); end if; end; - when Ghdl_Rtik_Type_B2 + when Ghdl_Rtik_Type_B1 | Ghdl_Rtik_Type_E8 | Ghdl_Rtik_Type_E32 => Disp_Name (To_Ghdl_Rtin_Type_Enum_Acc (Def).Name); @@ -520,7 +520,7 @@ package body Grt.Disp_Rti is end; --Disp_Scalar_Subtype_Name (To_Ghdl_Rtin_Scalsubtype_Acc (Def), -- Base); - when Ghdl_Rtik_Type_B2 + when Ghdl_Rtik_Type_B1 | Ghdl_Rtik_Type_E8 | Ghdl_Rtik_Type_E32 => Disp_Name (To_Ghdl_Rtin_Type_Enum_Acc (Def).Name); @@ -994,7 +994,7 @@ package body Grt.Disp_Rti is Disp_Attribute (To_Ghdl_Rtin_Object_Acc (Rti), Ctxt, Indent); when Ghdl_Rtik_Instance => Disp_Instance (To_Ghdl_Rtin_Instance_Acc (Rti), Ctxt, Indent); - when Ghdl_Rtik_Type_B2 + when Ghdl_Rtik_Type_B1 | Ghdl_Rtik_Type_E8 | Ghdl_Rtik_Type_E32 => Disp_Type_Enum_Decl (To_Ghdl_Rtin_Type_Enum_Acc (Rti), Indent); diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb index 7d98940..e3d66c1 100644 --- a/translate/grt/grt-images.adb +++ b/translate/grt/grt-images.adb @@ -63,12 +63,12 @@ package body Grt.Images is Return_String (Res, Str (1 .. strlen (Str))); end Return_Enum; - procedure Ghdl_Image_B2 - (Res : Std_String_Ptr; Val : Ghdl_B2; Rti : Ghdl_Rti_Access) + procedure Ghdl_Image_B1 + (Res : Std_String_Ptr; Val : Ghdl_B1; Rti : Ghdl_Rti_Access) is begin - Return_Enum (Res, Rti, Ghdl_B2'Pos (Val)); - end Ghdl_Image_B2; + Return_Enum (Res, Rti, Ghdl_B1'Pos (Val)); + end Ghdl_Image_B1; procedure Ghdl_Image_E8 (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access) @@ -150,6 +150,21 @@ package body Grt.Images is Return_String (Res, Str (1 .. P)); end Ghdl_Image_F64; + procedure Ghdl_To_String_I32 (Res : Std_String_Ptr; Val : Ghdl_I32) + renames Ghdl_Image_I32; + procedure Ghdl_To_String_F64 (Res : Std_String_Ptr; Val : Ghdl_F64) + renames Ghdl_Image_F64; + + procedure Ghdl_To_String_F64_Digits + (Res : Std_String_Ptr; Val : Ghdl_F64; Nbr_Digits : Ghdl_I32) + is + Str : String_Real_Digits; + P : Natural; + begin + To_String (Str, P, Val, Nbr_Digits); + Return_String (Res, Str (1 .. P)); + end Ghdl_To_String_F64_Digits; + -- procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64) -- is -- -- Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1) diff --git a/translate/grt/grt-images.ads b/translate/grt/grt-images.ads index 625082f..cd97fe9 100644 --- a/translate/grt/grt-images.ads +++ b/translate/grt/grt-images.ads @@ -29,8 +29,8 @@ package Grt.Images is -- For all images procedures, the result is allocated on the secondary -- stack. - procedure Ghdl_Image_B2 - (Res : Std_String_Ptr; Val : Ghdl_B2; Rti : Ghdl_Rti_Access); + procedure Ghdl_Image_B1 + (Res : Std_String_Ptr; Val : Ghdl_B1; Rti : Ghdl_Rti_Access); procedure Ghdl_Image_E8 (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access); procedure Ghdl_Image_E32 @@ -41,12 +41,21 @@ package Grt.Images is (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access); procedure Ghdl_Image_P32 (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access); + + procedure Ghdl_To_String_I32 (Res : Std_String_Ptr; Val : Ghdl_I32); + procedure Ghdl_To_String_F64 (Res : Std_String_Ptr; Val : Ghdl_F64); + procedure Ghdl_To_String_F64_Digits + (Res : Std_String_Ptr; Val : Ghdl_F64; Nbr_Digits : Ghdl_I32); private - pragma Export (Ada, Ghdl_Image_B2, "__ghdl_image_b2"); + pragma Export (Ada, Ghdl_Image_B1, "__ghdl_image_b1"); 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"); pragma Export (C, Ghdl_Image_P32, "__ghdl_image_p32"); + + pragma Export (C, Ghdl_To_String_I32, "__ghdl_to_string_i32"); + pragma Export (C, Ghdl_To_String_F64, "__ghdl_to_string_f64"); + pragma Export (C, Ghdl_To_String_F64_Digits, "__ghdl_to_string_f64_digits"); end Grt.Images; diff --git a/translate/grt/grt-lib.ads b/translate/grt/grt-lib.ads index 2c75a90..b0dc0a3 100644 --- a/translate/grt/grt-lib.ads +++ b/translate/grt/grt-lib.ads @@ -90,7 +90,7 @@ package Grt.Lib is return Ghdl_Real; type Ghdl_Std_Ulogic_Boolean_Array_Type is array (Ghdl_E8 range 0 .. 8) - of Ghdl_B2; + of Ghdl_B1; Ghdl_Std_Ulogic_To_Boolean_Array : constant Ghdl_Std_Ulogic_Boolean_Array_Type := (False, -- U diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads index 924b2e0..c441b40 100644 --- a/translate/grt/grt-rtis.ads +++ b/translate/grt/grt-rtis.ads @@ -52,7 +52,7 @@ package Grt.Rtis is Ghdl_Rtik_Guard, Ghdl_Rtik_Component, -- 20 Ghdl_Rtik_Attribute, - Ghdl_Rtik_Type_B2, -- Enum + Ghdl_Rtik_Type_B1, -- Enum Ghdl_Rtik_Type_E8, Ghdl_Rtik_Type_E32, Ghdl_Rtik_Type_I32, -- 25 Scalar diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb index f40e400..70a0e21 100644 --- a/translate/grt/grt-rtis_addr.adb +++ b/translate/grt/grt-rtis_addr.adb @@ -153,8 +153,8 @@ package body Grt.Rtis_Addr is is begin case Base_Type.Kind is - when Ghdl_Rtik_Type_B2 => - return Rng.B2.Len; + when Ghdl_Rtik_Type_B1 => + return Rng.B1.Len; when Ghdl_Rtik_Type_E8 => return Rng.E8.Len; when Ghdl_Rtik_Type_E32 => @@ -266,7 +266,7 @@ package body Grt.Rtis_Addr is (To_Ghdl_Rtin_Subtype_Array_Acc (Atype).Basetype); when Ghdl_Rtik_Type_E8 | Ghdl_Rtik_Type_E32 - | Ghdl_Rtik_Type_B2 => + | Ghdl_Rtik_Type_B1 => return Atype; when others => Internal_Error ("rtis_addr.get_base_type"); diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb index 556ba89..4df5d6f 100644 --- a/translate/grt/grt-rtis_utils.adb +++ b/translate/grt/grt-rtis_utils.adb @@ -198,7 +198,7 @@ package body Grt.Rtis_Utils is Update (8); when Ghdl_Rtik_Type_E32 => Update (32); - when Ghdl_Rtik_Type_B2 => + when Ghdl_Rtik_Type_B1 => Update (8); when Ghdl_Rtik_Type_F64 => Update (64); @@ -238,14 +238,14 @@ package body Grt.Rtis_Utils is when Dir_Downto => Val.E32 := Rng.E32.Left - Ghdl_E32 (Pos); end case; - when Ghdl_Rtik_Type_B2 => + when Ghdl_Rtik_Type_B1 => case Pos is when 0 => - Val.B2 := Rng.B2.Left; + Val.B1 := Rng.B1.Left; when 1 => - Val.B2 := Rng.B2.Right; + Val.B1 := Rng.B1.Right; when others => - Val.B2 := False; + Val.B1 := False; end case; when others => Internal_Error ("grt.rtis_utils.range_pos_to_val"); @@ -274,8 +274,8 @@ package body Grt.Rtis_Utils is 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 Ghdl_Rtik_Type_B1 => + Get_Enum_Value (Vstr, Rti, Ghdl_B1'Pos (V.B1)); when others => Append (Vstr, '?'); end case; @@ -363,7 +363,7 @@ package body Grt.Rtis_Utils is when Ghdl_Rtik_Type_I32 | Ghdl_Rtik_Type_E8 | Ghdl_Rtik_Type_E32 - | Ghdl_Rtik_Type_B2 => + | Ghdl_Rtik_Type_B1 => Handle_Scalar (Rti); when Ghdl_Rtik_Type_Array => Handle_Array (To_Ghdl_Rtin_Type_Array_Acc (Rti), @@ -423,9 +423,9 @@ package body Grt.Rtis_Utils is 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 => + when Ghdl_Rtik_Type_B1 => Get_Enum_Value - (Str, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2))); + (Str, Type_Rti, Ghdl_Index_Type (Ghdl_B1'Pos (Value.B1))); when Ghdl_Rtik_Type_F64 => declare S : String (1 .. 32); @@ -527,9 +527,9 @@ package body Grt.Rtis_Utils is 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 => + when Ghdl_Rtik_Type_B1 => Get_Enum_Value - (Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2))); + (Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B1'Pos (Value.B1))); when others => Internal_Error ("grt.rtis_utils.get_value(rstr)"); end case; diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb index 8b8953e..9698d81 100644 --- a/translate/grt/grt-signals.adb +++ b/translate/grt/grt-signals.adb @@ -429,8 +429,8 @@ package body Grt.Signals is is begin case Mode is - when Mode_B2 => - Targ.B2 := Val.B2; + when Mode_B1 => + Targ.B1 := Val.B1; when Mode_E8 => Targ.E8 := Val.E8; when Mode_E32 => @@ -449,8 +449,8 @@ package body Grt.Signals is is begin case Mode is - when Mode_B2 => - return Left.B2 = Right.B2; + when Mode_B1 => + return Left.B1 = Right.B1; when Mode_E8 => return Left.E8 = Right.E8; when Mode_E32 => @@ -591,8 +591,8 @@ package body Grt.Signals is -- FIXME: can be a bound-error too! if Trans.Kind = Trans_Value then case Sign.Mode is - when Mode_B2 => - Driver.Last_Trans.Val_Ptr.B2 := Trans.Val.B2; + when Mode_B1 => + Driver.Last_Trans.Val_Ptr.B1 := Trans.Val.B1; when Mode_E8 => Driver.Last_Trans.Val_Ptr.E8 := Trans.Val.E8; when Mode_E32 => @@ -902,37 +902,37 @@ package body Grt.Signals is Sig.Driving_Value := Val; end Ghdl_Signal_Associate; - function Ghdl_Create_Signal_B2 - (Init_Val : Ghdl_B2; + function Ghdl_Create_Signal_B1 + (Init_Val : Ghdl_B1; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal - (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => Init_Val), + (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => Init_Val), Get_Current_Mode_Signal, Resolv_Func, Resolv_Inst); - end Ghdl_Create_Signal_B2; + end Ghdl_Create_Signal_B1; - procedure Ghdl_Signal_Init_B2 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B2) is + procedure Ghdl_Signal_Init_B1 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B1) is begin - Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_B2, B2 => Init_Val)); - end Ghdl_Signal_Init_B2; + Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_B1, B1 => Init_Val)); + end Ghdl_Signal_Init_B1; - procedure Ghdl_Signal_Associate_B2 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B2) is + procedure Ghdl_Signal_Associate_B1 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1) is begin - Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_B2, B2 => Val)); - end Ghdl_Signal_Associate_B2; + Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_B1, B1 => Val)); + end Ghdl_Signal_Associate_B1; - procedure Ghdl_Signal_Simple_Assign_B2 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_B2) + procedure Ghdl_Signal_Simple_Assign_B1 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_B1) is Trans : Transaction_Acc; begin if not Sign.Has_Active and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.B2 + and then Val = Sign.Value.B1 and then Sign.S.Drivers (0).First_Trans.Next = null then return; @@ -943,14 +943,14 @@ package body Grt.Signals is Line => 0, Time => 0, Next => null, - Val => Value_Union'(Mode => Mode_B2, B2 => Val)); + Val => Value_Union'(Mode => Mode_B1, B1 => Val)); Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); - end Ghdl_Signal_Simple_Assign_B2; + end Ghdl_Signal_Simple_Assign_B1; - procedure Ghdl_Signal_Start_Assign_B2 (Sign : Ghdl_Signal_Ptr; + procedure Ghdl_Signal_Start_Assign_B1 (Sign : Ghdl_Signal_Ptr; Rej : Std_Time; - Val : Ghdl_B2; + Val : Ghdl_B1; After : Std_Time) is Trans : Transaction_Acc; @@ -960,18 +960,18 @@ package body Grt.Signals is Line => 0, Time => 0, Next => null, - Val => Value_Union'(Mode => Mode_B2, B2 => Val)); + Val => Value_Union'(Mode => Mode_B1, B1 => Val)); Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); - end Ghdl_Signal_Start_Assign_B2; + end Ghdl_Signal_Start_Assign_B1; - procedure Ghdl_Signal_Next_Assign_B2 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_B2; + procedure Ghdl_Signal_Next_Assign_B1 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_B1; After : Std_Time) is begin Ghdl_Signal_Next_Assign - (Sign, Value_Union'(Mode => Mode_B2, B2 => Val), After); - end Ghdl_Signal_Next_Assign_B2; + (Sign, Value_Union'(Mode => Mode_B1, B1 => Val), After); + end Ghdl_Signal_Next_Assign_B1; function Ghdl_Create_Signal_E8 (Init_Val : Ghdl_E8; @@ -1416,9 +1416,9 @@ package body Grt.Signals is when others => Internal_Error ("ghdl_create_signal_attribute"); end case; - -- Note: bit and boolean are both mode_b2. + -- Note: bit and boolean are both mode_b1. Res := Create_Signal - (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => True), + (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => True), Mode, null, Null_Address); Sig_Rti := null; Last_Implicit_Signal := Res; @@ -1488,7 +1488,7 @@ package body Grt.Signals is Sig_Rti := To_Ghdl_Rtin_Object_Acc (To_Ghdl_Rti_Access (Guard_Rti'Address)); Res := Create_Signal - (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => Proc.all (This)), + (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => Proc.all (This)), Mode_Guard, null, Null_Address); Sig_Rti := null; Res.S.Guard_Func := Proc; @@ -1644,7 +1644,7 @@ package body Grt.Signals is (Func, Instance, Src, Src_Len, Dst, Dst_Len, Mode_Conv_Out); end Ghdl_Signal_Out_Conversion; - function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B2 + function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B1 is Drv : Driver_Acc; begin @@ -1660,7 +1660,7 @@ package body Grt.Signals is end if; end Ghdl_Signal_Driving; - function Ghdl_Signal_Driving_Value_B2 (Sig : Ghdl_Signal_Ptr) return Ghdl_B2 + function Ghdl_Signal_Driving_Value_B1 (Sig : Ghdl_Signal_Ptr) return Ghdl_B1 is Drv : Driver_Acc; begin @@ -1668,9 +1668,9 @@ package body Grt.Signals is 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.B2; + return Drv.First_Trans.Val.B1; end if; - end Ghdl_Signal_Driving_Value_B2; + end Ghdl_Signal_Driving_Value_B1; function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr) return Ghdl_E8 @@ -2981,7 +2981,7 @@ package body Grt.Signals is Sig := Propagation.Table (I).Sig; Set_Guard_Activity (Sig); if Sig.Active then - Sig.Driving_Value.B2 := + Sig.Driving_Value.B1 := Sig.S.Guard_Func.all (Sig.S.Guard_Instance); Set_Effective_Value (Sig, Sig.Driving_Value); end if; @@ -2991,14 +2991,14 @@ package body Grt.Signals is Set_Stable_Quiet_Activity (Propagation.Table (I).Kind, Sig); if Sig.Active then Sig.Driving_Value := - Value_Union'(Mode => Mode_B2, B2 => False); + Value_Union'(Mode => Mode_B1, B1 => False); -- Set driver. Trans := new Transaction' (Kind => Trans_Value, Line => 0, Time => Current_Time + Sig.S.Time, Next => null, - Val => Value_Union'(Mode => Mode_B2, B2 => True)); + Val => Value_Union'(Mode => Mode_B1, B1 => True)); if Sig.S.Attr_Trans.Next /= null then Free (Sig.S.Attr_Trans.Next); end if; @@ -3030,8 +3030,8 @@ package body Grt.Signals is if Sig.Ports (I).Active then Mark_Active (Sig); Set_Effective_Value - (Sig, Value_Union'(Mode => Mode_B2, - B2 => not Sig.Value.B2)); + (Sig, Value_Union'(Mode => Mode_B1, + B1 => not Sig.Value.B1)); exit; end if; end loop; @@ -3297,7 +3297,7 @@ package body Grt.Signals is when Imp_Guard => -- Guard signal is active iff one of its dependence is active. Sig := Propagation.Table (I).Sig; - Sig.Driving_Value.B2 := + Sig.Driving_Value.B1 := Sig.S.Guard_Func.all (Sig.S.Guard_Instance); Sig.Value := Sig.Driving_Value; when Imp_Stable @@ -3356,12 +3356,12 @@ package body Grt.Signals is procedure Init is begin - Signal_End := new Ghdl_Signal'(Value => (Mode => Mode_B2, - B2 => False), - Driving_Value => (Mode => Mode_B2, - B2 => False), - Last_Value => (Mode => Mode_B2, - B2 => False), + Signal_End := new Ghdl_Signal'(Value => (Mode => Mode_B1, + B1 => False), + Driving_Value => (Mode => Mode_B1, + B1 => False), + Last_Value => (Mode => Mode_B1, + B1 => False), Last_Event => 0, Last_Active => 0, Event => False, @@ -3369,7 +3369,7 @@ package body Grt.Signals is Has_Active => False, Is_Direct_Active => False, Sig_Kind => Kind_Signal_No, - Mode => Mode_B2, + Mode => Mode_B1, Flags => (Propag => Propag_None, Is_Dumped => False, diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads index 875d876..d792f16 100644 --- a/translate/grt/grt-signals.ads +++ b/translate/grt/grt-signals.ads @@ -83,7 +83,7 @@ package Grt.Signals is -- Function access type used to evaluate the guard expression. type Guard_Func_Acc is access function (This : System.Address) - return Ghdl_B2; + return Ghdl_B1; pragma Convention (C, Guard_Func_Acc); -- Simply linked list of processes to be resumed in case of events. @@ -544,25 +544,25 @@ package Grt.Signals is Rej : Std_Time; After : Std_Time); - function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B2; + function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B1; - function Ghdl_Create_Signal_B2 (Init_Val : Ghdl_B2; + function Ghdl_Create_Signal_B1 (Init_Val : Ghdl_B1; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr; - procedure Ghdl_Signal_Init_B2 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B2); - procedure Ghdl_Signal_Associate_B2 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B2); - procedure Ghdl_Signal_Simple_Assign_B2 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_B2); - procedure Ghdl_Signal_Start_Assign_B2 (Sign : Ghdl_Signal_Ptr; + procedure Ghdl_Signal_Init_B1 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B1); + procedure Ghdl_Signal_Associate_B1 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1); + procedure Ghdl_Signal_Simple_Assign_B1 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_B1); + procedure Ghdl_Signal_Start_Assign_B1 (Sign : Ghdl_Signal_Ptr; Rej : Std_Time; - Val : Ghdl_B2; + Val : Ghdl_B1; After : Std_Time); - procedure Ghdl_Signal_Next_Assign_B2 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_B2; + procedure Ghdl_Signal_Next_Assign_B1 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_B1; After : Std_Time); - function Ghdl_Signal_Driving_Value_B2 (Sig : Ghdl_Signal_Ptr) - return Ghdl_B2; + function Ghdl_Signal_Driving_Value_B1 (Sig : Ghdl_Signal_Ptr) + return Ghdl_B1; function Ghdl_Create_Signal_E8 (Init_Val : Ghdl_E8; Resolv_Func : Resolver_Acc; @@ -781,20 +781,20 @@ private pragma Export (Ada, Ghdl_Signal_Driving, "__ghdl_signal_driving"); - pragma Export (Ada, Ghdl_Create_Signal_B2, - "__ghdl_create_signal_b2"); - pragma Export (Ada, Ghdl_Signal_Init_B2, - "__ghdl_signal_init_b2"); - pragma Export (Ada, Ghdl_Signal_Associate_B2, - "__ghdl_signal_associate_b2"); - pragma Export (Ada, Ghdl_Signal_Simple_Assign_B2, - "__ghdl_signal_simple_assign_b2"); - pragma Export (Ada, Ghdl_Signal_Start_Assign_B2, - "__ghdl_signal_start_assign_b2"); - pragma Export (Ada, Ghdl_Signal_Next_Assign_B2, - "__ghdl_signal_next_assign_b2"); - pragma Export (Ada, Ghdl_Signal_Driving_Value_B2, - "__ghdl_signal_driving_value_b2"); + pragma Export (Ada, Ghdl_Create_Signal_B1, + "__ghdl_create_signal_b1"); + pragma Export (Ada, Ghdl_Signal_Init_B1, + "__ghdl_signal_init_b1"); + pragma Export (Ada, Ghdl_Signal_Associate_B1, + "__ghdl_signal_associate_b1"); + pragma Export (Ada, Ghdl_Signal_Simple_Assign_B1, + "__ghdl_signal_simple_assign_b1"); + pragma Export (Ada, Ghdl_Signal_Start_Assign_B1, + "__ghdl_signal_start_assign_b1"); + pragma Export (Ada, Ghdl_Signal_Next_Assign_B1, + "__ghdl_signal_next_assign_b1"); + pragma Export (Ada, Ghdl_Signal_Driving_Value_B1, + "__ghdl_signal_driving_value_b1"); pragma Export (C, Ghdl_Create_Signal_E8, "__ghdl_create_signal_e8"); diff --git a/translate/grt/grt-stats.adb b/translate/grt/grt-stats.adb index 97f46c2..5bc046d 100644 --- a/translate/grt/grt-stats.adb +++ b/translate/grt/grt-stats.adb @@ -200,7 +200,7 @@ package body Grt.Stats is Mode_Counts : Mode_Array; type Mode_Name_Type is array (Mode_Type) of String (1 .. 4); - Mode_Names : constant Mode_Name_Type := (Mode_B2 => "B2: ", + Mode_Names : constant Mode_Name_Type := (Mode_B1 => "B1: ", Mode_E8 => "E8: ", Mode_E32 => "E32:", Mode_I32 => "I32:", diff --git a/translate/grt/grt-std_logic_1164.adb b/translate/grt/grt-std_logic_1164.adb new file mode 100644 index 0000000..49d96e7 --- /dev/null +++ b/translate/grt/grt-std_logic_1164.adb @@ -0,0 +1,98 @@ +-- GHDL Run Time (GRT) std_logic_1664 subprograms. +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +with Grt.Lib; + +package body Grt.Std_Logic_1164 is + Assert_Msg : constant String := + "STD_LOGIC_1164: '-' operand for matching ordering operator"; + + Assert_Msg_Bound : constant Std_String_Bound := + (Dim_1 => (Left => 1, Right => Assert_Msg'Length, Dir => Dir_To, + Length => Assert_Msg'Length)); + + Assert_Msg_Str : aliased constant Std_String := + (Base => To_Std_String_Basep (Assert_Msg'Address), + Bounds => To_Std_String_Boundp (Assert_Msg_Bound'Address)); + + Filename : constant String := "std_logic_1164.vhdl" & NUL; + Loc : aliased constant Ghdl_Location := + (Filename => To_Ghdl_C_String (Filename'Address), + Line => 58, + Col => 3); + + procedure Assert_Not_Match (V : Std_Ulogic) + is + use Grt.Lib; + begin + if V = '-' then + -- FIXME: assert disabled for ieee. + Ghdl_Assert_Failed + (To_Std_String_Ptr (Assert_Msg_Str'Address), Error_Severity, + To_Ghdl_Location_Ptr (Loc'Address), null); + end if; + end Assert_Not_Match; + + function Ghdl_Std_Ulogic_Match_Eq (L, R : Ghdl_E8) return Ghdl_E8 + is + Left : constant Std_Ulogic := Std_Ulogic'Val (L); + Right : constant Std_Ulogic := Std_Ulogic'Val (R); + begin + Assert_Not_Match (Left); + Assert_Not_Match (Right); + return Std_Ulogic'Pos (Match_Eq_Table (Left, Right)); + end Ghdl_Std_Ulogic_Match_Eq; + + function Ghdl_Std_Ulogic_Match_Ne (L, R : Ghdl_E8) return Ghdl_E8 + is + Left : constant Std_Ulogic := Std_Ulogic'Val (L); + Right : constant Std_Ulogic := Std_Ulogic'Val (R); + begin + Assert_Not_Match (Left); + Assert_Not_Match (Right); + return Std_Ulogic'Pos (Not_Table (Match_Eq_Table (Left, Right))); + end Ghdl_Std_Ulogic_Match_Ne; + + function Ghdl_Std_Ulogic_Match_Lt (L, R : Ghdl_E8) return Ghdl_E8 + is + Left : constant Std_Ulogic := Std_Ulogic'Val (L); + Right : constant Std_Ulogic := Std_Ulogic'Val (R); + begin + Assert_Not_Match (Left); + Assert_Not_Match (Right); + return Std_Ulogic'Pos (Match_Lt_Table (Left, Right)); + end Ghdl_Std_Ulogic_Match_Lt; + + function Ghdl_Std_Ulogic_Match_Le (L, R : Ghdl_E8) return Ghdl_E8 + is + Left : constant Std_Ulogic := Std_Ulogic'Val (L); + Right : constant Std_Ulogic := Std_Ulogic'Val (R); + begin + Assert_Not_Match (Left); + Assert_Not_Match (Right); + return Std_Ulogic'Pos (Or_Table (Match_Lt_Table (Left, Right), + Match_Eq_Table (Left, Right))); + end Ghdl_Std_Ulogic_Match_Le; +end Grt.Std_Logic_1164; diff --git a/translate/grt/grt-std_logic_1164.ads b/translate/grt/grt-std_logic_1164.ads new file mode 100644 index 0000000..d6b1b7d --- /dev/null +++ b/translate/grt/grt-std_logic_1164.ads @@ -0,0 +1,107 @@ +-- GHDL Run Time (GRT) std_logic_1664 subprograms. +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +with Grt.Types; use Grt.Types; + +package Grt.Std_Logic_1164 is + type Std_Ulogic is ('U', 'X', '0', '1', 'Z', 'W','L', 'H', '-'); + + type Stdlogic_Table_2d is array (Std_Ulogic, Std_Ulogic) of Std_Ulogic; + type Stdlogic_Table_1d is array (Std_Ulogic) of Std_Ulogic; + + -- LRM08 9.2.3 Relational operators + Match_Eq_Table : constant Stdlogic_Table_2d := + --UX01ZWLH- + ("UUUUUUUU1", + "UXXXXXXX1", + "UX10XX101", + "UX01XX011", + "UXXXXXXX1", + "UXXXXXXX1", + "UX10XX101", + "UX01XX011", + "111111111"); + + Match_Lt_Table : constant Stdlogic_Table_2d := + --UX01ZWLH- + ("UUUUUUUUX", + "UXXXXXXXX", + "UX01XX01X", + "UX00XX00X", + "UXXXXXXXX", + "UXXXXXXXX", + "UX01XX01X", + "UX00XX00X", + "XXXXXXXXX"); + + And_Table : constant Stdlogic_Table_2d := + --UX01ZWLH- + ("UU0UUU0UX", -- U + "UX0XXX0XX", -- X + "000000000", -- 0 + "UX01XX01X", -- 1 + "UX0XXX0XX", -- Z + "UX0XXX0XX", -- W + "000000000", -- L + "UX01XX01X", -- H + "UX0XXX0XX"); -- - + + Or_Table : constant Stdlogic_Table_2d := + --UX01ZWLH- + ("UUU1UUU1U", -- U + "UXX1XXX1X", -- X + "UX01XX01X", -- 0 + "111111111", -- 1 + "UXX1XXX1X", -- Z + "UXX1XXX1X", -- W + "UX01XX01X", -- L + "111111111", -- H + "UXX1XXX1X"); -- - + + Xor_Table : constant Stdlogic_Table_2d := + --UX01ZWLH- + ("UUUUUUUUU", -- U + "UXXXXXXXX", -- X + "UX01XX01X", -- 0 + "UX10XX10X", -- 1 + "UXXXXXXXX", -- Z + "UXXXXXXXX", -- W + "UX01XX01X", -- L + "UX10XX10X", -- H + "UXXXXXXXX"); -- - + + Not_Table : constant Stdlogic_Table_1d := "UX10XX10X"; + + function Ghdl_Std_Ulogic_Match_Eq (L, R : Ghdl_E8) return Ghdl_E8; + function Ghdl_Std_Ulogic_Match_Ne (L, R : Ghdl_E8) return Ghdl_E8; + function Ghdl_Std_Ulogic_Match_Lt (L, R : Ghdl_E8) return Ghdl_E8; + function Ghdl_Std_Ulogic_Match_Le (L, R : Ghdl_E8) return Ghdl_E8; + -- For Gt and Ge, use Lt and Le with swapped parameters. +private + pragma Export (C, Ghdl_Std_Ulogic_Match_Eq, "__ghdl_std_ulogic_match_eq"); + pragma Export (C, Ghdl_Std_Ulogic_Match_Ne, "__ghdl_std_ulogic_match_ne"); + pragma Export (C, Ghdl_Std_Ulogic_Match_Lt, "__ghdl_std_ulogic_match_lt"); + pragma Export (C, Ghdl_Std_Ulogic_Match_Le, "__ghdl_std_ulogic_match_le"); +end Grt.Std_Logic_1164; diff --git a/translate/grt/grt-types.ads b/translate/grt/grt-types.ads index 3b86c20..18ea2b9 100644 --- a/translate/grt/grt-types.ads +++ b/translate/grt/grt-types.ads @@ -30,7 +30,7 @@ with Interfaces; use Interfaces; package Grt.Types is pragma Preelaborate (Grt.Types); - type Ghdl_B2 is new Boolean; + type Ghdl_B1 is new Boolean; type Ghdl_E8 is new Unsigned_8; type Ghdl_U32 is new Unsigned_32; subtype Ghdl_E32 is Ghdl_U32; @@ -67,17 +67,24 @@ package Grt.Types is subtype Std_Character is Character; type Std_String_Uncons is array (Ghdl_Index_Type range <>) of Std_Character; subtype Std_String_Base is Std_String_Uncons (Ghdl_Index_Type); - type Std_String_Basep is access Std_String_Base; + type Std_String_Basep is access all Std_String_Base; + function To_Std_String_Basep is new Ada.Unchecked_Conversion + (Source => Address, Target => Std_String_Basep); type Std_String_Bound is record Dim_1 : Std_Integer_Trt; end record; - type Std_String_Boundp is access Std_String_Bound; + type Std_String_Boundp is access all Std_String_Bound; + function To_Std_String_Boundp is new Ada.Unchecked_Conversion + (Source => Address, Target => Std_String_Boundp); type Std_String is record Base : Std_String_Basep; Bounds : Std_String_Boundp; end record; + type Std_String_Ptr is access all Std_String; + function To_Std_String_Ptr is new Ada.Unchecked_Conversion + (Source => Address, Target => Std_String_Ptr); -- An unconstrained array. -- It is in fact a fat pointer to the base and the bounds. @@ -89,8 +96,6 @@ package Grt.Types is function To_Ghdl_Uc_Array_Acc is new Ada.Unchecked_Conversion (Source => Address, Target => Ghdl_Uc_Array_Acc); - type Std_String_Ptr is access all Std_String; - -- Verilog types. type Ghdl_Logic32 is record @@ -145,6 +150,8 @@ package Grt.Types is Col : Integer; end record; type Ghdl_Location_Ptr is access Ghdl_Location; + function To_Ghdl_Location_Ptr is new Ada.Unchecked_Conversion + (Source => Address, Target => Ghdl_Location_Ptr); -- Signal index. type Sig_Table_Index is new Integer; @@ -156,16 +163,16 @@ package Grt.Types is -- Simple values, used for signals. type Mode_Type is - (Mode_B2, Mode_E8, Mode_E32, Mode_I32, Mode_I64, Mode_F64); + (Mode_B1, Mode_E8, Mode_E32, Mode_I32, Mode_I64, Mode_F64); - type Ghdl_B2_Array is array (Ghdl_Index_Type range <>) of Ghdl_B2; + type Ghdl_B1_Array is array (Ghdl_Index_Type range <>) of Ghdl_B1; type Ghdl_E8_Array is array (Ghdl_Index_Type range <>) of Ghdl_E8; type Ghdl_I32_Array is array (Ghdl_Index_Type range <>) of Ghdl_I32; - type Value_Union (Mode : Mode_Type := Mode_B2) is record + type Value_Union (Mode : Mode_Type := Mode_B1) is record case Mode is - when Mode_B2 => - B2 : Ghdl_B2; + when Mode_B1 => + B1 : Ghdl_B1; when Mode_E8 => E8 : Ghdl_E8; when Mode_E32 => @@ -185,9 +192,9 @@ package Grt.Types is (Source => Address, Target => Ghdl_Value_Ptr); -- Ranges. - type Ghdl_Range_B2 is record - Left : Ghdl_B2; - Right : Ghdl_B2; + type Ghdl_Range_B1 is record + Left : Ghdl_B1; + Right : Ghdl_B1; Dir : Ghdl_Dir_Type; Len : Ghdl_Index_Type; end record; @@ -226,11 +233,10 @@ package Grt.Types is Dir : Ghdl_Dir_Type; end record; - type Ghdl_Range_Type (K : Mode_Type := Mode_B2) - is record + type Ghdl_Range_Type (K : Mode_Type := Mode_B1) is record case K is - when Mode_B2 => - B2 : Ghdl_Range_B2; + when Mode_B1 => + B1 : Ghdl_Range_B1; when Mode_E8 => E8 : Ghdl_Range_E8; when Mode_E32 => diff --git a/translate/grt/grt-values.adb b/translate/grt/grt-values.adb index 2715d51..209f658 100644 --- a/translate/grt/grt-values.adb +++ b/translate/grt/grt-values.adb @@ -118,12 +118,12 @@ package body Grt.Values is Error_E ("'"); end Ghdl_Value_Enum; - function Ghdl_Value_B2 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) - return Ghdl_B2 + function Ghdl_Value_B1 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) + return Ghdl_B1 is begin - return Ghdl_B2'Val (Ghdl_Value_Enum (Str, Rti)); - end Ghdl_Value_B2; + return Ghdl_B1'Val (Ghdl_Value_Enum (Str, Rti)); + end Ghdl_Value_B1; function Ghdl_Value_E8 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) return Ghdl_E8 diff --git a/translate/grt/grt-values.ads b/translate/grt/grt-values.ads index 70a6581..8df8c3f 100644 --- a/translate/grt/grt-values.ads +++ b/translate/grt/grt-values.ads @@ -44,8 +44,8 @@ package Grt.Values is Lit_End : out Ghdl_Index_Type; Unit_Pos : out Ghdl_Index_Type); - function Ghdl_Value_B2 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) - return Ghdl_B2; + function Ghdl_Value_B1 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) + return Ghdl_B1; function Ghdl_Value_E8 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) return Ghdl_E8; function Ghdl_Value_E32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) @@ -58,7 +58,7 @@ package Grt.Values is function Ghdl_Value_P32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) return Ghdl_I32; private - pragma Export (Ada, Ghdl_Value_B2, "__ghdl_value_b2"); + pragma Export (Ada, Ghdl_Value_B1, "__ghdl_value_b1"); pragma Export (C, Ghdl_Value_E8, "__ghdl_value_e8"); pragma Export (C, Ghdl_Value_E32, "__ghdl_value_e32"); pragma Export (C, Ghdl_Value_I32, "__ghdl_value_i32"); diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb index 44e2fda..d4a9ea0 100644 --- a/translate/grt/grt-vcd.adb +++ b/translate/grt/grt-vcd.adb @@ -315,7 +315,7 @@ package body Grt.Vcd is Sig_Addr := Avhpi_Get_Address (Sig); Info.Kind := Vcd_Bad; case Rti.Kind is - when Ghdl_Rtik_Type_B2 + when Ghdl_Rtik_Type_B1 | Ghdl_Rtik_Type_E8 | Ghdl_Rtik_Subtype_Scalar => Info.Kind := Rti_To_Vcd_Kind (Rti); @@ -499,7 +499,7 @@ package body Grt.Vcd is end Vcd_Put_Hierarchy; - procedure Vcd_Put_Bit (V : Ghdl_B2) + procedure Vcd_Put_Bit (V : Ghdl_B1) is C : Character; begin @@ -647,7 +647,7 @@ package body Grt.Vcd is case V.Kind is when Vcd_Bit | Vcd_Bool => - Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(0).Value.B2); + Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(0).Value.B1); when Vcd_Stdlogic => Vcd_Put_Stdlogic (To_Signal_Arr_Ptr (Addr)(0).Value.E8); when Vcd_Integer32 => @@ -661,7 +661,7 @@ package body Grt.Vcd is when Vcd_Bitvector => Vcd_Putc ('b'); for J in 0 .. Len - 1 loop - Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(J).Value.B2); + Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(J).Value.B1); end loop; Vcd_Putc (' '); when Vcd_Stdlogic_Vector => @@ -678,7 +678,7 @@ package body Grt.Vcd is when Vcd_Bit | Vcd_Bool => Vcd_Put_Bit - (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.B2); + (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.B1); when Vcd_Stdlogic => Vcd_Put_Stdlogic (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E8); @@ -696,7 +696,7 @@ package body Grt.Vcd is Vcd_Putc ('b'); for J in 0 .. Len - 1 loop Vcd_Put_Bit - (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.B2); + (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.B1); end loop; Vcd_Putc (' '); when Vcd_Stdlogic_Vector => diff --git a/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb index 5d07dde..9b77319 100644 --- a/translate/grt/grt-vpi.adb +++ b/translate/grt/grt-vpi.adb @@ -360,7 +360,7 @@ package body Grt.Vpi is -- see IEEE 1364-2001, chapter 27.14, page 675 Tmpstring3idx : integer; Tmpstring3 : String (1 .. 1024); - procedure ii_vpi_get_value_bin_str_B2 (Val : Ghdl_B2) + procedure ii_vpi_get_value_bin_str_B1 (Val : Ghdl_B1) is begin case Val is @@ -370,7 +370,7 @@ package body Grt.Vpi is Tmpstring3 (Tmpstring3idx) := '0'; end case; Tmpstring3idx := Tmpstring3idx + 1; - end ii_vpi_get_value_bin_str_B2; + end ii_vpi_get_value_bin_str_B1; procedure ii_vpi_get_value_bin_str_E8 (Val : Ghdl_E8) is @@ -424,8 +424,8 @@ package body Grt.Vpi is | Vcd_Bool | Vcd_Bitvector => for J in 0 .. Len - 1 loop - ii_vpi_get_value_bin_str_B2 - (To_Signal_Arr_Ptr (Info.Addr)(J).Value.B2); + ii_vpi_get_value_bin_str_B1 + (To_Signal_Arr_Ptr (Info.Addr)(J).Value.B1); end loop; when Vcd_Stdlogic | Vcd_Stdlogic_Vector => @@ -444,8 +444,8 @@ package body Grt.Vpi is | Vcd_Bool | Vcd_Bitvector => for J in 0 .. Len - 1 loop - ii_vpi_get_value_bin_str_B2 - (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.B2); + ii_vpi_get_value_bin_str_B1 + (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.B1); end loop; when Vcd_Stdlogic | Vcd_Stdlogic_Vector => @@ -519,7 +519,7 @@ package body Grt.Vpi is -- see IEEE 1364-2001, chapter 27.14, page 675 -- FIXME - procedure ii_vpi_put_value_bin_str_B2 (SigPtr : Ghdl_Signal_Ptr; + procedure ii_vpi_put_value_bin_str_B1 (SigPtr : Ghdl_Signal_Ptr; Value : Character) is Tempval : Value_Union; @@ -527,17 +527,17 @@ package body Grt.Vpi is -- use the Set_Effective_Value procedure to update the signal case Value is when '0' => - Tempval.B2 := false; + Tempval.B1 := false; when '1' => - Tempval.B2 := true; + Tempval.B1 := true; when others => - dbgPut_Line("ii_vpi_put_value_bin_str_B2: " + dbgPut_Line("ii_vpi_put_value_bin_str_B1: " & "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; + end ii_vpi_put_value_bin_str_B1; procedure ii_vpi_put_value_bin_str_E8 (SigPtr : Ghdl_Signal_Ptr; Value : Character) @@ -626,7 +626,7 @@ package body Grt.Vpi is | Vcd_Bool | Vcd_Bitvector => for J in 0 .. Len - 1 loop - ii_vpi_put_value_bin_str_B2( + ii_vpi_put_value_bin_str_B1( To_Signal_Arr_Ptr(Info.Addr)(J), ValueStr(Integer(J+1))); end loop; when Vcd_Stdlogic diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb index 1aa71bd..63bdb9a 100644 --- a/translate/grt/grt-waves.adb +++ b/translate/grt/grt-waves.adb @@ -224,8 +224,8 @@ package body Grt.Waves is procedure Write_Value (Value : Value_Union; Mode : Mode_Type) is begin case Mode is - when Mode_B2 => - Wave_Put_Byte (Ghdl_B2'Pos (Value.B2)); + when Mode_B1 => + Wave_Put_Byte (Ghdl_B1'Pos (Value.B1)); when Mode_E8 => Wave_Put_Byte (Ghdl_E8'Pos (Value.E8)); when Mode_E32 => @@ -543,7 +543,7 @@ package body Grt.Waves is Depth : Ghdl_Rti_Depth; begin case Rti.Kind is - when Ghdl_Rtik_Type_B2 + when Ghdl_Rtik_Type_B1 | Ghdl_Rtik_Type_E8 => N_Ctxt := Null_Context; when Ghdl_Rtik_Port @@ -625,7 +625,7 @@ package body Grt.Waves is -- First, create all the types it depends on. case Rti.Kind is - when Ghdl_Rtik_Type_B2 + when Ghdl_Rtik_Type_B1 | Ghdl_Rtik_Type_E8 => declare Enum : Ghdl_Rtin_Type_Enum_Acc; @@ -798,8 +798,8 @@ package body Grt.Waves is Addr := Avhpi_Get_Address (Iter); case Get_Base_Type (Rti).Kind is - when Ghdl_Rtik_Type_B2 => - Mode := Mode_B2; + when Ghdl_Rtik_Type_B1 => + Mode := Mode_B1; when Ghdl_Rtik_Type_E8 => Mode := Mode_E8; when Ghdl_Rtik_Type_E32 => @@ -1191,11 +1191,11 @@ package body Grt.Waves is Kind := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype.Kind; end if; case Kind is - when Ghdl_Rtik_Type_B2 => + when Ghdl_Rtik_Type_B1 => Wave_Put_Byte (Ghdl_Rtik'Pos (Kind) - + Ghdl_Dir_Type'Pos (Rng.B2.Dir) * 16#80#); - Wave_Put_Byte (Ghdl_B2'Pos (Rng.B2.Left)); - Wave_Put_Byte (Ghdl_B2'Pos (Rng.B2.Right)); + + Ghdl_Dir_Type'Pos (Rng.B1.Dir) * 16#80#); + Wave_Put_Byte (Ghdl_B1'Pos (Rng.B1.Left)); + Wave_Put_Byte (Ghdl_B1'Pos (Rng.B1.Right)); when Ghdl_Rtik_Type_E8 => Wave_Put_Byte (Ghdl_Rtik'Pos (Kind) + Ghdl_Dir_Type'Pos (Rng.E8.Dir) * 16#80#); @@ -1266,7 +1266,7 @@ package body Grt.Waves is -- Kind. Wave_Put_Byte (Ghdl_Rtik'Pos (Rti.Kind)); case Rti.Kind is - when Ghdl_Rtik_Type_B2 + when Ghdl_Rtik_Type_B1 | Ghdl_Rtik_Type_E8 => declare Enum : Ghdl_Rtin_Type_Enum_Acc; diff --git a/translate/trans_decls.ads b/translate/trans_decls.ads index 20cc445..88e09af 100644 --- a/translate/trans_decls.ads +++ b/translate/trans_decls.ads @@ -91,13 +91,13 @@ package Trans_Decls is 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; - Ghdl_Signal_Start_Assign_B2 : O_Dnode; - Ghdl_Signal_Next_Assign_B2 : O_Dnode; - Ghdl_Signal_Associate_B2 : O_Dnode; - Ghdl_Signal_Driving_Value_B2 : O_Dnode; + Ghdl_Create_Signal_B1 : O_Dnode; + Ghdl_Signal_Init_B1 : O_Dnode; + Ghdl_Signal_Simple_Assign_B1 : O_Dnode; + Ghdl_Signal_Start_Assign_B1 : O_Dnode; + Ghdl_Signal_Next_Assign_B1 : O_Dnode; + Ghdl_Signal_Associate_B1 : O_Dnode; + Ghdl_Signal_Driving_Value_B1 : O_Dnode; Ghdl_Create_Signal_I32 : O_Dnode; Ghdl_Signal_Init_I32 : O_Dnode; @@ -196,7 +196,7 @@ package Trans_Decls is Ghdl_File_Endfile : O_Dnode; -- 'Image attributes. - Ghdl_Image_B2 : O_Dnode; + Ghdl_Image_B1 : O_Dnode; Ghdl_Image_E8 : O_Dnode; Ghdl_Image_E32 : O_Dnode; Ghdl_Image_I32 : O_Dnode; @@ -205,7 +205,7 @@ package Trans_Decls is Ghdl_Image_F64 : O_Dnode; -- 'Value attributes - Ghdl_Value_B2 : O_Dnode; + Ghdl_Value_B1 : O_Dnode; Ghdl_Value_E8 : O_Dnode; Ghdl_Value_E32 : O_Dnode; Ghdl_Value_I32 : O_Dnode; @@ -220,6 +220,17 @@ package Trans_Decls is -- For PSL. Ghdl_Std_Ulogic_To_Boolean_Array : O_Dnode; + -- For std_logic_1164 (vhdl 2008). + Ghdl_Std_Ulogic_Match_Eq : O_Dnode; + Ghdl_Std_Ulogic_Match_Ne : O_Dnode; + Ghdl_Std_Ulogic_Match_Lt : O_Dnode; + Ghdl_Std_Ulogic_Match_Le : O_Dnode; + + -- For To_String (vhdl 2008). + Ghdl_To_String_I32 : O_Dnode; + Ghdl_To_String_F64 : O_Dnode; + Ghdl_To_String_F64_Digits : O_Dnode; + -- Register a package Ghdl_Rti_Add_Package : O_Dnode; Ghdl_Rti_Add_Top : O_Dnode; diff --git a/translate/translation.adb b/translate/translation.adb index ebc4838..ecae9d7 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -61,17 +61,14 @@ package body Translation is Std_String_Ptr_Node : O_Tnode; Std_String_Node : O_Tnode; - -- Ortho type for std.integer. - Std_Integer_Type_Node : O_Tnode; + -- Ortho type for std.standard.integer. + Std_Integer_Otype : O_Tnode; - -- Ortho type for std.real. - Std_Real_Type_Node : O_Tnode; + -- Ortho type for std.standard.real. + Std_Real_Otype : O_Tnode; - -- Ortho type node for std.time. - Std_Time_Type : O_Tnode; - - -- Ortho type for std.file_open_status. - Std_File_Open_Status_Type : O_Tnode; + -- Ortho type node for std.standard.time. + Std_Time_Otype : O_Tnode; -- Node for the variable containing the current filename. Current_Filename_Node : O_Dnode := O_Dnode_Null; @@ -645,7 +642,7 @@ package body Translation is Ghdl_Rtik_Guard : O_Cnode; Ghdl_Rtik_Component : O_Cnode; Ghdl_Rtik_Attribute : O_Cnode; - Ghdl_Rtik_Type_B2 : O_Cnode; + Ghdl_Rtik_Type_B1 : O_Cnode; Ghdl_Rtik_Type_E8 : O_Cnode; Ghdl_Rtik_Type_E32 : O_Cnode; Ghdl_Rtik_Type_I32 : O_Cnode; @@ -910,7 +907,7 @@ package body Translation is -- Unknown mode. Type_Mode_Unknown, -- Boolean type, with 2 elements. - Type_Mode_B2, + Type_Mode_B1, -- Enumeration with at most 256 elements. Type_Mode_E8, -- Enumeration with more than 256 elements. @@ -941,10 +938,10 @@ package body Translation is Type_Mode_Fat_Array); subtype Type_Mode_Scalar is Type_Mode_Type - range Type_Mode_B2 .. Type_Mode_F64; + range Type_Mode_B1 .. Type_Mode_F64; subtype Type_Mode_Non_Composite is Type_Mode_Type - range Type_Mode_B2 .. Type_Mode_Fat_Acc; + range Type_Mode_B1 .. Type_Mode_Fat_Acc; -- Composite types, with the vhdl meaning: record and arrays. subtype Type_Mode_Composite is Type_Mode_Type @@ -956,7 +953,7 @@ package body Translation is -- Thin types, ie types whose length is a scalar. subtype Type_Mode_Thin is Type_Mode_Type - range Type_Mode_B2 .. Type_Mode_Acc; + range Type_Mode_B1 .. Type_Mode_Acc; -- Fat types, ie types whose length is longer than a scalar. subtype Type_Mode_Fat is Type_Mode_Type @@ -965,7 +962,7 @@ package body Translation is -- These parameters are passed by value, ie the argument of the subprogram -- is the value of the object. subtype Type_Mode_By_Value is Type_Mode_Type - range Type_Mode_B2 .. Type_Mode_Acc; + range Type_Mode_B1 .. Type_Mode_Acc; -- These parameters are passed by copy, ie a copy of the object is created -- and the reference of the copy is passed. If the object is not @@ -6093,7 +6090,7 @@ package body Translation is (Info.Ortho_Type (Mode_Value), Translate_Enumeration_Literal (False_Lit), False_Node, Translate_Enumeration_Literal (True_Lit), True_Node); - Info.Type_Mode := Type_Mode_B2; + Info.Type_Mode := Type_Mode_B1; Set_Ortho_Expr (False_Lit, False_Node); Set_Ortho_Expr (True_Lit, True_Node); Info.T.Nocheck_Low := True; @@ -7741,7 +7738,7 @@ package body Translation is is begin case Mode is - when Type_Mode_B2 => + when Type_Mode_B1 => declare V : Iir_Int32; begin @@ -10012,8 +10009,8 @@ package body Translation is end if; case Type_Info.Type_Mode is - when Type_Mode_B2 => - Create_Subprg := Ghdl_Create_Signal_B2; + when Type_Mode_B1 => + Create_Subprg := Ghdl_Create_Signal_B1; Conv := Ghdl_Bool_Type; when Type_Mode_E8 => Create_Subprg := Ghdl_Create_Signal_E8; @@ -10348,7 +10345,7 @@ package body Translation is | Iir_Kind_Quiet_Attribute => Param := Get_Parameter (Decl); if Param = Null_Iir then - Val := New_Lit (New_Signed_Literal (Std_Time_Type, 0)); + Val := New_Lit (New_Signed_Literal (Std_Time_Otype, 0)); else Val := Chap7.Translate_Expression (Param); end if; @@ -10385,7 +10382,7 @@ package body Translation is (Assoc, New_Convert_Ov (New_Value (M2Lv (Data.Pfx)), Ghdl_Signal_Ptr)); if Data.Param = Null_Iir then - Val := New_Lit (New_Signed_Literal (Std_Time_Type, 0)); + Val := New_Lit (New_Signed_Literal (Std_Time_Otype, 0)); else Val := Chap7.Translate_Expression (Data.Param); end if; @@ -10840,6 +10837,7 @@ package body Translation is Create_File_Object (Decl); when Iir_Kind_Attribute_Declaration => + -- Useless as attribute declarations have a type mark. Chap3.Translate_Object_Subtype (Decl); when Iir_Kind_Attribute_Specification => @@ -12048,7 +12046,8 @@ package body Translation is El : Iir; begin Val := Create_Temp_Init - (Std_Time_Type, Chap7.Translate_Expression (Get_Expression (Spec))); + (Std_Time_Otype, + Chap7.Translate_Expression (Get_Expression (Spec))); for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; @@ -12146,8 +12145,8 @@ package body Translation is begin Type_Info := Get_Info (Formal_Type); case Type_Info.Type_Mode is - when Type_Mode_B2 => - Subprg := Ghdl_Signal_Associate_B2; + when Type_Mode_B1 => + Subprg := Ghdl_Signal_Associate_B1; Conv := Ghdl_Bool_Type; when Type_Mode_E8 => Subprg := Ghdl_Signal_Associate_E8; @@ -14996,14 +14995,13 @@ package body Translation is Loc : Iir) return O_Enode is + Ret_Type : constant Iir := Get_Return_Type (Imp); + Kind : constant Iir_Predefined_Functions := + Get_Implicit_Definition (Imp); Arr_El1 : O_Enode; Arr_El2 : O_Enode; - Ret_Type : Iir; Res : O_Enode; - Kind : Iir_Predefined_Functions; begin - Ret_Type := Get_Return_Type (Imp); - Kind := Get_Implicit_Definition (Imp); case Kind is when Iir_Predefined_Element_Array_Concat | Iir_Predefined_Element_Element_Concat => @@ -15023,6 +15021,74 @@ package body Translation is (Res, Ret_Type, Res_Type, Mode_Value, Loc); end Translate_Concat_Operator; + function Translate_Scalar_Min_Max + (Op : ON_Op_Kind; + Left, Right : Iir; + Res_Type : Iir) + return O_Enode + is + Res_Otype : constant O_Tnode := + Get_Ortho_Type (Res_Type, Mode_Value); + Res, L, R : O_Dnode; + If_Blk : O_If_Block; + begin + -- Create a variable for the result. + Res := Create_Temp (Res_Otype); + + Open_Temp; + L := Create_Temp_Init + (Res_Otype, Translate_Expression (Left, Res_Type)); + R := Create_Temp_Init + (Res_Otype, Translate_Expression (Right, Res_Type)); + + Start_If_Stmt (If_Blk, New_Compare_Op (Op, + New_Obj_Value (L), + New_Obj_Value (R), + Ghdl_Bool_Type)); + New_Assign_Stmt (New_Obj (Res), New_Obj_Value (L)); + New_Else_Stmt (If_Blk); + New_Assign_Stmt (New_Obj (Res), New_Obj_Value (R)); + Finish_If_Stmt (If_Blk); + Close_Temp; + + return New_Obj_Value (Res); + end Translate_Scalar_Min_Max; + + function Translate_Std_Ulogic_Match (Func : O_Dnode; + L, R : O_Enode; + Res_Type : O_Tnode) + return O_Enode + is + Constr : O_Assoc_List; + begin + Start_Association (Constr, Func); + New_Association (Constr, New_Convert_Ov (L, Ghdl_I32_Type)); + New_Association (Constr, New_Convert_Ov (R, Ghdl_I32_Type)); + return New_Convert_Ov (New_Function_Call (Constr), Res_Type); + end Translate_Std_Ulogic_Match; + + function Translate_To_String + (Subprg : O_Dnode; Val : O_Enode; Arg2 : O_Enode) + return O_Enode + is + Res : O_Dnode; + Assoc : O_Assoc_List; + begin + Res := Create_Temp (Std_String_Node); + Create_Temp_Stack2_Mark; + Start_Association (Assoc, Subprg); + New_Association (Assoc, + New_Address (New_Obj (Res), Std_String_Ptr_Node)); + New_Association (Assoc, Val); + if Arg2 /= O_Enode_Null then + New_Association (Assoc, Arg2); + end if; + --New_Association + --(Assoc, New_Lit (Rtis.New_Rti_Address (Pinfo.Type_Rti))); + New_Procedure_Call (Assoc); + return New_Address (New_Obj (Res), Std_String_Ptr_Node); + end Translate_To_String; + function Translate_Predefined_Operator (Imp : Iir_Implicit_Function_Declaration; Left, Right : Iir; @@ -15030,9 +15096,10 @@ package body Translation is Loc : Iir) return O_Enode is + Kind : constant Iir_Predefined_Functions := + Get_Implicit_Definition (Imp); Left_Tree : O_Enode; Right_Tree : O_Enode; - Kind : Iir_Predefined_Functions; Left_Type : Iir; Right_Type : Iir; Res_Otype : O_Tnode; @@ -15040,11 +15107,35 @@ package body Translation is Inter : Iir; Res : O_Enode; begin - Kind := Get_Implicit_Definition (Imp); - if Iir_Predefined_Shortcut_P (Kind) then - return Translate_Shortcut_Operator (Imp, Left, Right); - end if; + case Kind is + when Iir_Predefined_Bit_And + | Iir_Predefined_Bit_Or + | Iir_Predefined_Bit_Nand + | Iir_Predefined_Bit_Nor + | Iir_Predefined_Boolean_And + | Iir_Predefined_Boolean_Or + | Iir_Predefined_Boolean_Nand + | Iir_Predefined_Boolean_Nor => + -- Right operand of shortcur operators may not be evaluated. + return Translate_Shortcut_Operator (Imp, Left, Right); + + when Iir_Predefined_Enum_Minimum + | Iir_Predefined_Integer_Minimum + | Iir_Predefined_Floating_Minimum + | Iir_Predefined_Physical_Minimum => + -- Operands of min/max are evaluated in a declare block. + return Translate_Scalar_Min_Max (ON_Le, Left, Right, Res_Type); + when Iir_Predefined_Enum_Maximum + | Iir_Predefined_Integer_Maximum + | Iir_Predefined_Floating_Maximum + | Iir_Predefined_Physical_Maximum => + -- Operands of min/max are evaluated in a declare block. + return Translate_Scalar_Min_Max (ON_Ge, Left, Right, Res_Type); + when others => + null; + end case; + -- Evaluate parameters. Res_Otype := Get_Ortho_Type (Res_Type, Mode_Value); Inter := Get_Interface_Declaration_Chain (Imp); if Left = Null_Iir then @@ -15100,6 +15191,10 @@ package body Translation is | Iir_Predefined_Boolean_Xnor => return New_Monadic_Op (ON_Not, New_Dyadic_Op (ON_Xor, Left_Tree, Right_Tree)); + when Iir_Predefined_Bit_Condition => + return New_Compare_Op + (ON_Eq, Left_Tree, New_Lit (Get_Ortho_Expr (Bit_1)), + Std_Boolean_Type_Node); when Iir_Predefined_Integer_Identity | Iir_Predefined_Floating_Identity @@ -15224,12 +15319,12 @@ package body Translation is when Iir_Predefined_Floating_Exp => Res := Translate_Lib_Operator - (New_Convert_Ov (Left_Tree, Std_Real_Type_Node), + (New_Convert_Ov (Left_Tree, Std_Real_Otype), Right_Tree, Ghdl_Real_Exp); return New_Convert_Ov (Res, Res_Otype); when Iir_Predefined_Integer_Exp => Res := Translate_Lib_Operator - (New_Convert_Ov (Left_Tree, Std_Integer_Type_Node), + (New_Convert_Ov (Left_Tree, Std_Integer_Otype), Right_Tree, Ghdl_Integer_Exp); return New_Convert_Ov (Res, Res_Otype); @@ -15307,6 +15402,47 @@ package body Translation is when Iir_Predefined_Now_Function => return New_Obj_Value (Ghdl_Now); + when Iir_Predefined_Std_Ulogic_Match_Equality => + return Translate_Std_Ulogic_Match + (Ghdl_Std_Ulogic_Match_Eq, + Left_Tree, Right_Tree, Res_Otype); + when Iir_Predefined_Std_Ulogic_Match_Inequality => + return Translate_Std_Ulogic_Match + (Ghdl_Std_Ulogic_Match_Ne, + Left_Tree, Right_Tree, Res_Otype); + when Iir_Predefined_Std_Ulogic_Match_Less => + return Translate_Std_Ulogic_Match + (Ghdl_Std_Ulogic_Match_Lt, + Left_Tree, Right_Tree, Res_Otype); + when Iir_Predefined_Std_Ulogic_Match_Less_Equal => + return Translate_Std_Ulogic_Match + (Ghdl_Std_Ulogic_Match_Le, + Left_Tree, Right_Tree, Res_Otype); + when Iir_Predefined_Std_Ulogic_Match_Greater => + return Translate_Std_Ulogic_Match + (Ghdl_Std_Ulogic_Match_Le, + Right_Tree, Left_Tree, Res_Otype); + when Iir_Predefined_Std_Ulogic_Match_Greater_Equal => + return Translate_Std_Ulogic_Match + (Ghdl_Std_Ulogic_Match_Lt, + Right_Tree, Left_Tree, Res_Otype); + + when Iir_Predefined_Integer_To_String => + case Get_Info (Left_Type).Type_Mode is + when Type_Mode_I32 => + return Translate_To_String + (Ghdl_To_String_I32, + New_Convert_Ov (Left_Tree, Ghdl_I32_Type), + O_Enode_Null); + when others => + raise Internal_Error; + end case; + when Iir_Predefined_Real_To_String_Digits => + return Translate_To_String + (Ghdl_To_String_F64_Digits, + New_Convert_Ov (Left_Tree, Ghdl_Real_Type), + New_Convert_Ov (Right_Tree, Ghdl_I32_Type)); + when others => Ada.Text_IO.Put_Line ("translate_predefined_operator(2): cannot handle " @@ -18463,7 +18599,7 @@ package body Translation is -- Create function. if Kind = Iir_Predefined_Read_Length then Start_Function_Decl - (Inter_List, Name, Global_Storage, Std_Integer_Type_Node); + (Inter_List, Name, Global_Storage, Std_Integer_Otype); else Start_Procedure_Decl (Inter_List, Name, Global_Storage); end if; @@ -18525,7 +18661,7 @@ package body Translation is Translate_Rw_Array (Chap3.Get_Array_Base (Var), Etype, Var_Len, Ghdl_Read_Scalar); New_Return_Stmt (New_Convert_Ov (New_Obj_Value (Var_Len), - Std_Integer_Type_Node)); + Std_Integer_Otype)); Close_Temp; end; when others => @@ -18553,26 +18689,133 @@ package body Translation is procedure Translate_Implicit_Subprogram (Subprg : Iir; Infos : in out Implicit_Subprogram_Infos) is - Kind : Iir_Predefined_Functions; + Kind : constant Iir_Predefined_Functions := + Get_Implicit_Definition (Subprg); begin - Kind := Get_Implicit_Definition (Subprg); if Predefined_To_Onop (Kind) /= ON_Nil then -- Intrinsic. return; end if; case Kind is - when Iir_Predefined_Access_Equality - | Iir_Predefined_Access_Inequality => + when Iir_Predefined_Error => + raise Internal_Error; + when Iir_Predefined_Boolean_And + | Iir_Predefined_Boolean_Or + | Iir_Predefined_Boolean_Xor + | Iir_Predefined_Boolean_Not + | Iir_Predefined_Enum_Equality + | Iir_Predefined_Enum_Inequality + | Iir_Predefined_Enum_Less + | Iir_Predefined_Enum_Less_Equal + | Iir_Predefined_Enum_Greater + | Iir_Predefined_Enum_Greater_Equal + | Iir_Predefined_Bit_And + | Iir_Predefined_Bit_Or + | Iir_Predefined_Bit_Xor + | Iir_Predefined_Bit_Not + | Iir_Predefined_Integer_Equality + | Iir_Predefined_Integer_Inequality + | Iir_Predefined_Integer_Less + | Iir_Predefined_Integer_Less_Equal + | Iir_Predefined_Integer_Greater + | Iir_Predefined_Integer_Greater_Equal + | Iir_Predefined_Integer_Negation + | Iir_Predefined_Integer_Absolute + | Iir_Predefined_Integer_Plus + | Iir_Predefined_Integer_Minus + | Iir_Predefined_Integer_Mul + | Iir_Predefined_Integer_Div + | Iir_Predefined_Integer_Mod + | Iir_Predefined_Integer_Rem + | Iir_Predefined_Floating_Equality + | Iir_Predefined_Floating_Inequality + | Iir_Predefined_Floating_Less + | Iir_Predefined_Floating_Less_Equal + | Iir_Predefined_Floating_Greater + | Iir_Predefined_Floating_Greater_Equal + | Iir_Predefined_Floating_Negation + | Iir_Predefined_Floating_Absolute + | Iir_Predefined_Floating_Plus + | Iir_Predefined_Floating_Minus + | Iir_Predefined_Floating_Mul + | Iir_Predefined_Floating_Div + | Iir_Predefined_Physical_Equality + | Iir_Predefined_Physical_Inequality + | Iir_Predefined_Physical_Less + | Iir_Predefined_Physical_Less_Equal + | Iir_Predefined_Physical_Greater + | Iir_Predefined_Physical_Greater_Equal + | Iir_Predefined_Physical_Negation + | Iir_Predefined_Physical_Absolute + | Iir_Predefined_Physical_Plus + | Iir_Predefined_Physical_Minus => + pragma Assert (Predefined_To_Onop (Kind) /= ON_Nil); + return; + + when Iir_Predefined_Boolean_Nand + | Iir_Predefined_Boolean_Nor + | Iir_Predefined_Boolean_Xnor + | Iir_Predefined_Bit_Nand + | Iir_Predefined_Bit_Nor + | Iir_Predefined_Bit_Xnor + | Iir_Predefined_Bit_Match_Equality + | Iir_Predefined_Bit_Match_Inequality + | Iir_Predefined_Bit_Match_Less + | Iir_Predefined_Bit_Match_Less_Equal + | Iir_Predefined_Bit_Match_Greater + | Iir_Predefined_Bit_Match_Greater_Equal + | Iir_Predefined_Bit_Condition + | Iir_Predefined_Boolean_Rising_Edge + | Iir_Predefined_Boolean_Falling_Edge + | Iir_Predefined_Bit_Rising_Edge + | Iir_Predefined_Bit_Falling_Edge => -- Intrinsic. null; - when Iir_Predefined_Deallocate => + + when Iir_Predefined_Enum_Minimum + | Iir_Predefined_Enum_Maximum + | Iir_Predefined_Enum_To_String => -- Intrinsic. null; + when Iir_Predefined_Integer_Identity - | Iir_Predefined_Integer_Exp => + | Iir_Predefined_Integer_Exp + | Iir_Predefined_Integer_Minimum + | Iir_Predefined_Integer_Maximum + | Iir_Predefined_Integer_To_String => -- Intrinsic. null; + when Iir_Predefined_Universal_R_I_Mul + | Iir_Predefined_Universal_I_R_Mul + | Iir_Predefined_Universal_R_I_Div => + -- Intrinsic + null; + + when Iir_Predefined_Physical_Identity + | Iir_Predefined_Physical_Minimum + | Iir_Predefined_Physical_Maximum + | Iir_Predefined_Physical_To_String + | Iir_Predefined_Time_To_String_Unit => + null; + + when Iir_Predefined_Physical_Integer_Mul + | Iir_Predefined_Physical_Integer_Div + | Iir_Predefined_Integer_Physical_Mul + | Iir_Predefined_Physical_Real_Mul + | Iir_Predefined_Physical_Real_Div + | Iir_Predefined_Real_Physical_Mul + | Iir_Predefined_Physical_Physical_Div => + null; + + when Iir_Predefined_Floating_Exp + | Iir_Predefined_Floating_Identity + | Iir_Predefined_Floating_Minimum + | Iir_Predefined_Floating_Maximum + | Iir_Predefined_Floating_To_String + | Iir_Predefined_Real_To_String_Digits + | Iir_Predefined_Real_To_String_Format => + null; when Iir_Predefined_Record_Equality | Iir_Predefined_Record_Inequality => @@ -18614,6 +18857,12 @@ package body Translation is Set_Info (Subprg, Infos.Arr_Concat_Info); end if; + when Iir_Predefined_Array_Minimum + | Iir_Predefined_Array_Maximum + | Iir_Predefined_Vector_Minimum + | Iir_Predefined_Vector_Maximum => + null; + when Iir_Predefined_TF_Array_And | Iir_Predefined_TF_Array_Or | Iir_Predefined_TF_Array_Nand @@ -18623,6 +18872,29 @@ package body Translation is | Iir_Predefined_TF_Array_Not => Translate_Predefined_Array_Logical (Subprg); + when Iir_Predefined_TF_Reduction_And + | Iir_Predefined_TF_Reduction_Or + | Iir_Predefined_TF_Reduction_Nand + | Iir_Predefined_TF_Reduction_Nor + | Iir_Predefined_TF_Reduction_Xor + | Iir_Predefined_TF_Reduction_Xnor + | Iir_Predefined_TF_Reduction_Not + | Iir_Predefined_TF_Array_Element_And + | Iir_Predefined_TF_Element_Array_And + | Iir_Predefined_TF_Array_Element_Or + | Iir_Predefined_TF_Element_Array_Or + | Iir_Predefined_TF_Array_Element_Nand + | Iir_Predefined_TF_Element_Array_Nand + | Iir_Predefined_TF_Array_Element_Nor + | Iir_Predefined_TF_Element_Array_Nor + | Iir_Predefined_TF_Array_Element_Xor + | Iir_Predefined_TF_Element_Array_Xor + | Iir_Predefined_TF_Array_Element_Xnor + | Iir_Predefined_TF_Element_Array_Xnor + | Iir_Predefined_Bit_Array_Match_Equality + | Iir_Predefined_Bit_Array_Match_Inequality => + null; + when Iir_Predefined_Array_Sll | Iir_Predefined_Array_Srl => if Infos.Arr_Shl_Info = null then @@ -18650,25 +18922,18 @@ package body Translation is Set_Info (Subprg, Infos.Arr_Rot_Info); end if; - when Iir_Predefined_Physical_Identity => - null; - - when Iir_Predefined_Physical_Integer_Mul - | Iir_Predefined_Physical_Integer_Div - | Iir_Predefined_Integer_Physical_Mul - | Iir_Predefined_Physical_Real_Mul - | Iir_Predefined_Physical_Real_Div - | Iir_Predefined_Real_Physical_Mul - | Iir_Predefined_Physical_Physical_Div => + when Iir_Predefined_Access_Equality + | Iir_Predefined_Access_Inequality => + -- Intrinsic. null; - - when Iir_Predefined_Floating_Exp - | Iir_Predefined_Floating_Identity => + when Iir_Predefined_Deallocate => + -- Intrinsic. null; when Iir_Predefined_File_Open | Iir_Predefined_File_Open_Status | Iir_Predefined_File_Close + | Iir_Predefined_Flush | Iir_Predefined_Endfile => -- All of them have predefined definitions. null; @@ -18687,13 +18952,45 @@ package body Translation is end if; end; + when Iir_Predefined_Attribute_Image + | Iir_Predefined_Attribute_Value + | Iir_Predefined_Attribute_Pos + | Iir_Predefined_Attribute_Val + | Iir_Predefined_Attribute_Succ + | Iir_Predefined_Attribute_Pred + | Iir_Predefined_Attribute_Leftof + | Iir_Predefined_Attribute_Rightof + | Iir_Predefined_Attribute_Left + | Iir_Predefined_Attribute_Right + | Iir_Predefined_Attribute_Event + | Iir_Predefined_Attribute_Active + | Iir_Predefined_Attribute_Last_Event + | Iir_Predefined_Attribute_Last_Active + | Iir_Predefined_Attribute_Last_Value + | Iir_Predefined_Attribute_Driving + | Iir_Predefined_Attribute_Driving_Value => + raise Internal_Error; + + when Iir_Predefined_Array_Char_To_String + | Iir_Predefined_Bit_Vector_To_Ostring + | Iir_Predefined_Bit_Vector_To_Hstring + | Iir_Predefined_Std_Ulogic_Match_Equality + | Iir_Predefined_Std_Ulogic_Match_Inequality + | Iir_Predefined_Std_Ulogic_Match_Less + | Iir_Predefined_Std_Ulogic_Match_Less_Equal + | Iir_Predefined_Std_Ulogic_Match_Greater + | Iir_Predefined_Std_Ulogic_Match_Greater_Equal + | Iir_Predefined_Std_Ulogic_Array_Match_Equality + | Iir_Predefined_Std_Ulogic_Array_Match_Inequality => + null; + when Iir_Predefined_Now_Function => null; - when others => - Error_Kind ("translate_implicit_subprogram (" - & Iir_Predefined_Functions'Image (Kind) & ")", - Subprg); + -- when others => + -- Error_Kind ("translate_implicit_subprogram (" + -- & Iir_Predefined_Functions'Image (Kind) & ")", + -- Subprg); end case; end Translate_Implicit_Subprogram; end Chap7; @@ -20180,15 +20477,17 @@ package body Translation is when Iir_Predefined_File_Open_Status => declare + Std_File_Open_Status_Otype : constant O_Tnode := + Get_Ortho_Type (File_Open_Status_Type_Definition, + Mode_Value); N_Param : Iir; - Status_Param : Iir; + Status_Param : constant Iir := Get_Actual (Param_Chain); File_Param : Iir; Name_Param : Iir; Kind_Param : Iir; Constr : O_Assoc_List; Status : Mnode; begin - Status_Param := Get_Actual (Param_Chain); Status := Chap6.Translate_Name (Status_Param); N_Param := Get_Chain (Param_Chain); File_Param := Get_Actual (N_Param); @@ -20213,7 +20512,7 @@ package body Translation is New_Assign_Stmt (M2Lv (Status), New_Convert_Ov (New_Function_Call (Constr), - Std_File_Open_Status_Type)); + Std_File_Open_Status_Otype)); end; when Iir_Predefined_File_Close => @@ -20739,8 +21038,8 @@ package body Translation is begin Type_Info := Get_Info (Targ_Type); case Type_Info.Type_Mode is - when Type_Mode_B2 => - Subprg := Ghdl_Signal_Simple_Assign_B2; + when Type_Mode_B1 => + Subprg := Ghdl_Signal_Simple_Assign_B1; Conv := Ghdl_Bool_Type; when Type_Mode_E8 => Subprg := Ghdl_Signal_Simple_Assign_E8; @@ -20837,8 +21136,8 @@ package body Translation is Type_Info := Get_Info (Targ_Type); case Type_Info.Type_Mode is - when Type_Mode_B2 => - Subprg := Ghdl_Signal_Start_Assign_B2; + when Type_Mode_B1 => + Subprg := Ghdl_Signal_Start_Assign_B1; Conv := Ghdl_Bool_Type; when Type_Mode_E8 => Subprg := Ghdl_Signal_Start_Assign_E8; @@ -21007,8 +21306,8 @@ package body Translation is Type_Info := Get_Info (Targ_Type); case Type_Info.Type_Mode is - when Type_Mode_B2 => - Subprg := Ghdl_Signal_Next_Assign_B2; + when Type_Mode_B1 => + Subprg := Ghdl_Signal_Next_Assign_B1; Conv := Ghdl_Bool_Type; when Type_Mode_E8 => Subprg := Ghdl_Signal_Next_Assign_E8; @@ -21424,13 +21723,13 @@ package body Translation is Data : Signal_Assign_Data; begin Open_Temp; - Reject_Time := Create_Temp (Std_Time_Type); - After_Time := Create_Temp (Std_Time_Type); + Reject_Time := Create_Temp (Std_Time_Otype); + After_Time := Create_Temp (Std_Time_Otype); Del := Get_Time (We); if Del = Null_Iir then New_Assign_Stmt (New_Obj (After_Time), - New_Lit (New_Signed_Literal (Std_Time_Type, 0))); + New_Lit (New_Signed_Literal (Std_Time_Otype, 0))); else New_Assign_Stmt (New_Obj (After_Time), @@ -21440,7 +21739,7 @@ package body Translation is when Iir_Transport_Delay => New_Assign_Stmt (New_Obj (Reject_Time), - New_Lit (New_Signed_Literal (Std_Time_Type, 0))); + New_Lit (New_Signed_Literal (Std_Time_Otype, 0))); when Iir_Inertial_Delay => Rej := Get_Reject_Time_Expression (Stmt); if Rej = Null_Iir then @@ -21475,7 +21774,7 @@ package body Translation is Data : Signal_Assign_Data; begin Open_Temp; - After_Time := Create_Temp (Std_Time_Type); + After_Time := Create_Temp (Std_Time_Otype); New_Assign_Stmt (New_Obj (After_Time), Chap7.Translate_Expression (Get_Time (We), @@ -23325,8 +23624,8 @@ package body Translation is if Data.Set_Init then case Type_Info.Type_Mode is - when Type_Mode_B2 => - Init_Subprg := Ghdl_Signal_Init_B2; + when Type_Mode_B1 => + Init_Subprg := Ghdl_Signal_Init_B1; Conv := Ghdl_Bool_Type; when Type_Mode_E8 => Init_Subprg := Ghdl_Signal_Init_E8; @@ -24704,7 +25003,7 @@ package body Translation is Op := ON_Sub_Ov; end if; case Tinfo.Type_Mode is - when Type_Mode_B2 + when Type_Mode_B1 | Type_Mode_E8 | Type_Mode_E32 => -- Should check it is not the last. @@ -24919,7 +25218,7 @@ package body Translation is begin Open_Temp; Val := Create_Temp_Init - (Std_Time_Type, + (Std_Time_Otype, Read_Last_Time (New_Value (M2Lv (Targ)), Data.Field)); Start_If_Stmt (If_Blk, New_Compare_Op (ON_Gt, @@ -24993,15 +25292,16 @@ package body Translation is Prefix_Type := Get_Type (Prefix); Name := Chap6.Translate_Name (Prefix); Info := Get_Info (Prefix_Type); - Var := Create_Temp (Std_Time_Type); + Var := Create_Temp (Std_Time_Otype); if Info.Type_Mode in Type_Mode_Scalar then New_Assign_Stmt (New_Obj (Var), Read_Last_Time (M2E (Name), Field)); else -- Init with a negative value. - New_Assign_Stmt (New_Obj (Var), - New_Lit (New_Signed_Literal (Std_Time_Type, -1))); + New_Assign_Stmt + (New_Obj (Var), + New_Lit (New_Signed_Literal (Std_Time_Otype, -1))); Data := Last_Time_Data'(Var => Var, Field => Field); Translate_Last_Time (Name, Prefix_Type, Data); end if; @@ -25014,13 +25314,14 @@ package body Translation is (If_Blk, New_Compare_Op (ON_Lt, New_Obj_Value (Var), - New_Lit (New_Signed_Literal (Std_Time_Type, 0)), + New_Lit (New_Signed_Literal (Std_Time_Otype, 0)), Ghdl_Bool_Type)); -- LRM 14.1 Predefined attributes -- [...]; otherwise, it returns TIME'HIGH. - New_Assign_Stmt (New_Obj (Var), - New_Lit (New_Signed_Literal - (Std_Time_Type, Integer_64 (Right_Bound)))); + New_Assign_Stmt + (New_Obj (Var), + New_Lit (New_Signed_Literal + (Std_Time_Otype, Integer_64 (Right_Bound)))); New_Else_Stmt (If_Blk); -- Returns NOW - Var. New_Assign_Stmt (New_Obj (Var), @@ -25139,8 +25440,8 @@ package body Translation is begin Tinfo := Get_Info (Sig_Type); case Tinfo.Type_Mode is - when Type_Mode_B2 => - Subprg := Ghdl_Signal_Driving_Value_B2; + when Type_Mode_B1 => + Subprg := Ghdl_Signal_Driving_Value_B1; when Type_Mode_E8 => Subprg := Ghdl_Signal_Driving_Value_E8; when Type_Mode_E32 => @@ -25194,8 +25495,8 @@ package body Translation is Res := Create_Temp (Std_String_Node); Create_Temp_Stack2_Mark; case Pinfo.Type_Mode is - when Type_Mode_B2 => - Subprg := Ghdl_Image_B2; + when Type_Mode_B1 => + Subprg := Ghdl_Image_B1; Conv := Ghdl_Bool_Type; when Type_Mode_E8 => Subprg := Ghdl_Image_E8; @@ -25227,7 +25528,7 @@ package body Translation is (Chap7.Translate_Expression (Get_Parameter (Attr), Prefix_Type), Conv)); case Pinfo.Type_Mode is - when Type_Mode_B2 + when Type_Mode_B1 | Type_Mode_E8 | Type_Mode_E32 | Type_Mode_P32 @@ -25253,8 +25554,8 @@ package body Translation is Assoc : O_Assoc_List; begin case Pinfo.Type_Mode is - when Type_Mode_B2 => - Subprg := Ghdl_Value_B2; + when Type_Mode_B1 => + Subprg := Ghdl_Value_B1; when Type_Mode_E8 => Subprg := Ghdl_Value_E8; when Type_Mode_E32 => @@ -25276,7 +25577,7 @@ package body Translation is Chap7.Translate_Expression (Get_Parameter (Attr), String_Type_Definition)); case Pinfo.Type_Mode is - when Type_Mode_B2 + when Type_Mode_B1 | Type_Mode_E8 | Type_Mode_E32 | Type_Mode_P32 @@ -25522,8 +25823,8 @@ package body Translation is Ghdl_Rtik_Attribute); New_Enum_Literal - (Constr, Get_Identifier ("__ghdl_rtik_type_b2"), - Ghdl_Rtik_Type_B2); + (Constr, Get_Identifier ("__ghdl_rtik_type_b1"), + Ghdl_Rtik_Type_B1); New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_type_e8"), Ghdl_Rtik_Type_E8); @@ -26283,8 +26584,8 @@ package body Translation is Start_Const_Value (Info.Type_Rti); case Info.Type_Mode is - when Type_Mode_B2 => - Kind := Ghdl_Rtik_Type_B2; + when Type_Mode_B1 => + Kind := Ghdl_Rtik_Type_B1; when Type_Mode_E8 => Kind := Ghdl_Rtik_Type_E8; when Type_Mode_E32 => @@ -28483,11 +28784,11 @@ package body Translation is O_Storage_External); New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"), - Std_Time_Type); + Std_Time_Otype); New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), - Std_Time_Type); + Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Start_Assign); -- procedure __ghdl_signal_next_assign_XXX (sign : __ghdl_signal_ptr; @@ -28500,7 +28801,7 @@ package body Translation is New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), - Std_Time_Type); + Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Next_Assign); -- procedure __ghdl_signal_associate_XXX (sign : __ghdl_signal_ptr; @@ -28563,29 +28864,75 @@ package body Translation is Finish_Subprogram_Decl (Interfaces, Value_Subprg); end Create_Image_Value_Subprograms; + -- function __ghdl_std_ulogic_match_NAME (l : __ghdl_e8; r : __ghdl_e8) + -- return __ghdl_e8; + procedure Create_Std_Ulogic_Match_Subprogram (Name : String; + Subprg : out O_Dnode) + is + Interfaces : O_Inter_List; + Param : O_Dnode; + begin + Start_Function_Decl + (Interfaces, Get_Identifier ("__ghdl_std_ulogic_match_" & Name), + O_Storage_External, Ghdl_I32_Type); + New_Interface_Decl + (Interfaces, Param, Wki_Left, Ghdl_I32_Type); + New_Interface_Decl + (Interfaces, Param, Wki_Right, Ghdl_I32_Type); + Finish_Subprogram_Decl (Interfaces, Subprg); + end Create_Std_Ulogic_Match_Subprogram; + + -- procedure __ghdl_to_string_NAME (res : std_string_ptr_node; + -- val : VAL_TYPE; + -- ARG2_NAME : ARG2_TYPE); + procedure Create_To_String_Subprogram (Name : String; + Subprg : out O_Dnode; + Val_Type : O_Tnode; + Arg2_Type : O_Tnode; + Arg2_Name : String) + is + Interfaces : O_Inter_List; + Param : O_Dnode; + begin + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_to_string_" & Name), + O_Storage_External); + New_Interface_Decl + (Interfaces, Param, Get_Identifier ("res"), Std_String_Ptr_Node); + New_Interface_Decl + (Interfaces, Param, Get_Identifier ("val"), Val_Type); + if Arg2_Type /= O_Tnode_Null then + New_Interface_Decl + (Interfaces, Param, Get_Identifier (Arg2_Name), Arg2_Type); + end if; + Finish_Subprogram_Decl (Interfaces, Subprg); + end Create_To_String_Subprogram; + -- Do internal declarations that need std.standard declarations. procedure Post_Initialize is Interfaces : O_Inter_List; Rec : O_Element_List; Param : O_Dnode; - Integer_Otype : O_Tnode; - Real_Otype : O_Tnode; - Time_Otype : O_Tnode; Info : Type_Info_Acc; begin New_Debug_Comment_Decl ("internal declarations, part 2"); + + -- Remember some pervasive types. Info := Get_Info (String_Type_Definition); Std_String_Node := Info.Ortho_Type (Mode_Value); Std_String_Ptr_Node := Info.Ortho_Ptr_Type (Mode_Value); - Integer_Otype := Get_Ortho_Type (Integer_Type_Definition, Mode_Value); - Real_Otype := Get_Ortho_Type (Real_Type_Definition, Mode_Value); - Time_Otype := Get_Ortho_Type (Time_Type_Definition, Mode_Value); + + Std_Integer_Otype := + Get_Ortho_Type (Integer_Type_Definition, Mode_Value); + Std_Real_Otype := + Get_Ortho_Type (Real_Type_Definition, Mode_Value); + Std_Time_Otype := Get_Ortho_Type (Time_Type_Definition, Mode_Value); -- __ghdl_now : time; -- ??? maybe this should be a function ? New_Var_Decl (Ghdl_Now, Get_Identifier ("__ghdl_now"), - O_Storage_External, Time_Otype); + O_Storage_External, Std_Time_Otype); -- procedure __ghdl_assert_failed (str : __ghdl_array_template; -- severity : ghdl_int); @@ -28638,7 +28985,7 @@ package body Translation is -- return std__standard_integer; Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_text_read_length"), - O_Storage_External, Integer_Otype); + O_Storage_External, Std_Integer_Otype); New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"), Ghdl_File_Index_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"), @@ -28676,11 +29023,11 @@ package body Translation is -- return std__standard__real; Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_real_exp"), O_Storage_External, - Real_Otype); + Std_Real_Otype); New_Interface_Decl (Interfaces, Param, Get_Identifier ("left"), - Real_Otype); + Std_Real_Otype); New_Interface_Decl (Interfaces, Param, Get_Identifier ("right"), - Integer_Otype); + Std_Integer_Otype); Finish_Subprogram_Decl (Interfaces, Ghdl_Real_Exp); -- function __ghdl_integer_exp (left : std__standard__integer; @@ -28688,17 +29035,17 @@ package body Translation is -- return std__standard__integer; Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_integer_exp"), O_Storage_External, - Integer_Otype); - New_Interface_Decl (Interfaces, Param, Wki_Left, Integer_Otype); - New_Interface_Decl (Interfaces, Param, Wki_Right, Integer_Otype); + Std_Integer_Otype); + New_Interface_Decl (Interfaces, Param, Wki_Left, Std_Integer_Otype); + New_Interface_Decl (Interfaces, Param, Wki_Right, Std_Integer_Otype); Finish_Subprogram_Decl (Interfaces, Ghdl_Integer_Exp); - -- procedure __ghdl_image_b2 (res : std_string_ptr_node; + -- procedure __ghdl_image_b1 (res : std_string_ptr_node; -- val : ghdl_bool_type; -- rti : ghdl_rti_access); Create_Image_Value_Subprograms - ("b2", Ghdl_Bool_Type, True, Ghdl_Image_B2, Ghdl_Value_B2); + ("b1", Ghdl_Bool_Type, True, Ghdl_Image_B1, Ghdl_Value_B1); -- procedure __ghdl_image_e8 (res : std_string_ptr_node; -- val : ghdl_i32_type; @@ -28869,10 +29216,10 @@ package body Translation is Ghdl_Scalar_Bytes); New_Record_Field (Rec, Ghdl_Signal_Last_Event_Field, Get_Identifier ("last_event"), - Time_Otype); + Std_Time_Otype); New_Record_Field (Rec, Ghdl_Signal_Last_Active_Field, Get_Identifier ("last_active"), - Time_Otype); + Std_Time_Otype); New_Record_Field (Rec, Ghdl_Signal_Event_Field, Get_Identifier ("event"), Std_Boolean_Type_Node); @@ -28926,7 +29273,7 @@ package body Translation is O_Storage_External); New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl - (Interfaces, Param, Get_Identifier ("time"), Std_Time_Type); + (Interfaces, Param, Get_Identifier ("time"), Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Set_Disconnect); -- procedure __ghdl_signal_disconnect (sig : __ghdl_signal_ptr); @@ -29003,9 +29350,9 @@ package body Translation is O_Storage_External); New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"), - Std_Time_Type); + Std_Time_Otype); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), - Std_Time_Type); + Std_Time_Otype); New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Start_Assign_Error); @@ -29019,7 +29366,7 @@ package body Translation is O_Storage_External); New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), - Std_Time_Type); + Std_Time_Otype); New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Error); @@ -29032,9 +29379,9 @@ package body Translation is O_Storage_External); New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"), - Std_Time_Type); + Std_Time_Otype); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), - Std_Time_Type); + Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Start_Assign_Null); -- procedure __ghdl_signal_next_assign_null (sig : __ghdl_signal_ptr; @@ -29044,11 +29391,11 @@ package body Translation is O_Storage_External); New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"), - Std_Time_Type); + Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Null); - -- function __ghdl_create_signal_enum8 (init_val : ghdl_i32_type) - -- return __ghdl_signal_ptr; + -- function __ghdl_create_signal_e8 (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 ("e8", Ghdl_I32_Type, @@ -29060,10 +29407,10 @@ 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); + -- function __ghdl_create_signal_e32 (init_val : ghdl_i32_type) + -- return __ghdl_signal_ptr; + -- procedure __ghdl_signal_simple_assign_e32 (sign : __ghdl_signal_ptr; + -- val : __ghdl_integer); Create_Signal_Subprograms ("e32", Ghdl_I32_Type, Ghdl_Create_Signal_E32, Ghdl_Signal_Init_E32, @@ -29073,18 +29420,18 @@ package body Translation is Ghdl_Signal_Associate_E32, Ghdl_Signal_Driving_Value_E32); - -- function __ghdl_create_signal_b2 (init_val : ghdl_bool_type) + -- function __ghdl_create_signal_b1 (init_val : ghdl_bool_type) -- return __ghdl_signal_ptr; - -- procedure __ghdl_signal_simple_assign_b2 (sign : __ghdl_signal_ptr; + -- procedure __ghdl_signal_simple_assign_b1 (sign : __ghdl_signal_ptr; -- val : ghdl_bool_type); - Create_Signal_Subprograms ("b2", Ghdl_Bool_Type, - Ghdl_Create_Signal_B2, - Ghdl_Signal_Init_B2, - Ghdl_Signal_Simple_Assign_B2, - Ghdl_Signal_Start_Assign_B2, - Ghdl_Signal_Next_Assign_B2, - Ghdl_Signal_Associate_B2, - Ghdl_Signal_Driving_Value_B2); + Create_Signal_Subprograms ("b1", Ghdl_Bool_Type, + Ghdl_Create_Signal_B1, + Ghdl_Signal_Init_B1, + Ghdl_Signal_Simple_Assign_B1, + Ghdl_Signal_Start_Assign_B1, + Ghdl_Signal_Next_Assign_B1, + Ghdl_Signal_Associate_B1, + Ghdl_Signal_Driving_Value_B1); Create_Signal_Subprograms ("i32", Ghdl_I32_Type, Ghdl_Create_Signal_I32, @@ -29190,7 +29537,7 @@ package body Translation is Start_Function_Decl (Interfaces, Get_Identifier (Name), O_Storage_External, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), - Std_Time_Type); + Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Res); end Create_Signal_Attribute; begin @@ -29231,7 +29578,7 @@ package body Translation is New_Interface_Decl (Interfaces, Param, Get_Identifier ("sig"), Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), - Std_Time_Type); + Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Ghdl_Create_Delayed_Signal); -- function __ghdl_signal_create_guard @@ -29268,7 +29615,7 @@ package body Translation is (Interfaces, Get_Identifier ("__ghdl_process_wait_timeout"), O_Storage_External); New_Interface_Decl (Interfaces, Param, Get_Identifier ("time"), - Std_Time_Type); + Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Timeout); -- void __ghdl_process_wait_set_timeout (time : std_time); @@ -29276,7 +29623,7 @@ package body Translation is (Interfaces, Get_Identifier ("__ghdl_process_wait_set_timeout"), O_Storage_External); New_Interface_Decl (Interfaces, Param, Get_Identifier ("time"), - Std_Time_Type); + Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Set_Timeout); -- void __ghdl_process_wait_add_sensitivity (sig : __ghdl_signal_ptr); @@ -29348,42 +29695,54 @@ package body Translation is New_Interface_Decl (Interfaces, Param, Wki_Instance, Ghdl_Ptr_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Rti_Add_Top); + + -- Create match subprograms for std_ulogic type. + Create_Std_Ulogic_Match_Subprogram ("eq", Ghdl_Std_Ulogic_Match_Eq); + Create_Std_Ulogic_Match_Subprogram ("ne", Ghdl_Std_Ulogic_Match_Ne); + Create_Std_Ulogic_Match_Subprogram ("lt", Ghdl_Std_Ulogic_Match_Lt); + Create_Std_Ulogic_Match_Subprogram ("le", Ghdl_Std_Ulogic_Match_Le); + + -- Create To_String subprograms. + Create_To_String_Subprogram + ("i32", Ghdl_To_String_I32, Ghdl_I32_Type, + O_Tnode_Null, ""); + Create_To_String_Subprogram + ("f64", Ghdl_To_String_F64, Ghdl_Real_Type, + O_Tnode_Null, ""); + Create_To_String_Subprogram + ("f64_digits", Ghdl_To_String_F64_Digits, Ghdl_Real_Type, + Ghdl_I32_Type, "nbr_digits"); end Post_Initialize; - procedure Translate_Std_Type_Declaration (Decl : Iir) + procedure Translate_Type_Implicit_Subprograms (Decl : in out Iir) is - Chain : Iir; Infos : Chap7.Implicit_Subprogram_Infos; begin - case Get_Kind (Decl) is - when Iir_Kind_Type_Declaration => - Chap4.Translate_Type_Declaration (Decl); - when Iir_Kind_Anonymous_Type_Declaration => - Chap4.Translate_Anonymous_Type_Declaration (Decl); - when others => - Error_Kind ("translate_std_type_declaration", Decl); - end case; + -- Skip type declaration. + pragma Assert (Get_Kind (Decl) in Iir_Kinds_Type_Declaration); + Decl := Get_Chain (Decl); - -- Also declares the subprograms. - Chain := Get_Chain (Decl); Chap7.Init_Implicit_Subprogram_Infos (Infos); - while Chain /= Null_Iir loop - case Get_Kind (Chain) is + while Decl /= Null_Iir loop + case Get_Kind (Decl) is when Iir_Kind_Implicit_Function_Declaration | Iir_Kind_Implicit_Procedure_Declaration => - Chap7.Translate_Implicit_Subprogram (Chain, Infos); - Chain := Get_Chain (Chain); + Chap7.Translate_Implicit_Subprogram (Decl, Infos); + Decl := Get_Chain (Decl); when others => exit; end case; end loop; - end Translate_Std_Type_Declaration; + end Translate_Type_Implicit_Subprograms; procedure Translate_Standard (Main : Boolean) is Lib_Mark, Unit_Mark : Id_Mark_Type; Info : Ortho_Info_Acc; pragma Unreferenced (Info); + Decl : Iir; + Time_Type_Staticness : Iir_Staticness; + Time_Subtype_Staticness : Iir_Staticness; begin Update_Node_Infos; @@ -29403,6 +29762,27 @@ package body Translation is Push_Identifier_Prefix (Unit_Mark, Get_Identifier (Standard_Package)); + -- With VHDL93 and later, time type is globally static. As a result, + -- it will be elaborated at run-time (and not statically). + -- However, there is no elaboration of std.standard. Furthermore, + -- time type can be pre-elaborated without any difficulties. + -- There is a kludge here: set type staticess of time type locally + -- and then revert it just after its translation. + Time_Type_Staticness := Get_Type_Staticness (Time_Type_Definition); + Time_Subtype_Staticness := Get_Type_Staticness (Time_Subtype_Definition); + if Flags.Flag_Time_64 then + Set_Type_Staticness (Time_Type_Definition, Locally); + end if; + Set_Type_Staticness (Time_Subtype_Definition, Locally); + if Flags.Vhdl_Std > Vhdl_87 then + Set_Type_Staticness (Delay_Length_Subtype_Definition, Locally); + end if; + + Decl := Get_Declaration_Chain (Standard_Package); + + -- The first (and one of the most important) declaration is the + -- boolean type declaration. + pragma Assert (Decl = Boolean_Type_Declaration); Chap4.Translate_Bool_Type_Declaration (Boolean_Type_Declaration); -- We need this type very early, for predefined functions. Std_Boolean_Type_Node := @@ -29414,81 +29794,69 @@ package body Translation is New_Array_Type (Std_Boolean_Type_Node, Ghdl_Index_Type); New_Type_Decl (Create_Identifier ("BOOLEAN_ARRAY"), Std_Boolean_Array_Type); - Chap4.Translate_Bool_Type_Declaration (Bit_Type_Declaration); - - Chap4.Translate_Type_Declaration (Character_Type_Declaration); - - Chap4.Translate_Type_Declaration (Severity_Level_Type_Declaration); + Translate_Type_Implicit_Subprograms (Decl); - Chap4.Translate_Anonymous_Type_Declaration - (Universal_Integer_Type_Declaration); - Chap4.Translate_Subtype_Declaration - (Universal_Integer_Subtype_Declaration); + -- Second declaration: bit. + pragma Assert (Decl = Bit_Type_Declaration); + Chap4.Translate_Bool_Type_Declaration (Bit_Type_Declaration); + Translate_Type_Implicit_Subprograms (Decl); - Chap4.Translate_Anonymous_Type_Declaration - (Universal_Real_Type_Declaration); - Chap4.Translate_Subtype_Declaration - (Universal_Real_Subtype_Declaration); + -- Nothing special for other declarations. + while Decl /= Null_Iir loop + case Get_Kind (Decl) is + when Iir_Kind_Type_Declaration => + Chap4.Translate_Type_Declaration (Decl); + Translate_Type_Implicit_Subprograms (Decl); + when Iir_Kind_Anonymous_Type_Declaration => + Chap4.Translate_Anonymous_Type_Declaration (Decl); + Translate_Type_Implicit_Subprograms (Decl); + when Iir_Kind_Subtype_Declaration => + Chap4.Translate_Subtype_Declaration (Decl); + Decl := Get_Chain (Decl); + when Iir_Kind_Attribute_Declaration => + Decl := Get_Chain (Decl); + when Iir_Kind_Implicit_Function_Declaration => + case Get_Implicit_Definition (Decl) is + when Iir_Predefined_Now_Function => + null; + when Iir_Predefined_Enum_To_String + | Iir_Predefined_Integer_To_String + | Iir_Predefined_Floating_To_String + | Iir_Predefined_Real_To_String_Digits + | Iir_Predefined_Real_To_String_Format + | Iir_Predefined_Physical_To_String + | Iir_Predefined_Time_To_String_Unit => + -- These are defined after the types. + null; + when others => + Error_Kind + ("translate_standard (" + & Iir_Predefined_Functions'Image + (Get_Implicit_Definition (Decl)) & ")", + Decl); + end case; + Decl := Get_Chain (Decl); + when others => + Error_Kind ("translate_standard", Decl); + end case; + -- DECL was updated by Translate_Type_Implicit_Subprograms or + -- explicitly in other branches. + end loop; + -- These types don't appear in std.standard. Chap4.Translate_Anonymous_Type_Declaration (Convertible_Integer_Type_Declaration); Chap4.Translate_Anonymous_Type_Declaration (Convertible_Real_Type_Declaration); - Translate_Std_Type_Declaration (Real_Type_Declaration); - Std_Real_Type_Node := Get_Ortho_Type (Real_Type_Definition, Mode_Value); - Chap4.Translate_Subtype_Declaration (Real_Subtype_Declaration); - - Translate_Std_Type_Declaration (Integer_Type_Declaration); - Std_Integer_Type_Node := Get_Ortho_Type - (Integer_Type_Definition, Mode_Value); - Chap4.Translate_Subtype_Declaration (Integer_Subtype_Declaration); - Chap4.Translate_Subtype_Declaration (Natural_Subtype_Declaration); - Chap4.Translate_Subtype_Declaration (Positive_Subtype_Declaration); - - Translate_Std_Type_Declaration (String_Type_Declaration); - - Translate_Std_Type_Declaration (Bit_Vector_Type_Declaration); - - declare - Type_Staticness : Iir_Staticness; - Subtype_Staticness : Iir_Staticness; - begin - -- With VHDL93 and later, time type is globally static. As a result, - -- it will be elaborated at run-time (and not statically). - -- However, there is no elaboration of std.standard. Furthermore, - -- time type can be pre-elaborated without any difficulties. - -- There is a kludge here: set type staticess of time type locally - -- and then revert it just after its translation. - Type_Staticness := Get_Type_Staticness (Time_Type_Definition); - Subtype_Staticness := Get_Type_Staticness (Time_Subtype_Definition); - if Flags.Flag_Time_64 then - Set_Type_Staticness (Time_Type_Definition, Locally); - end if; - Set_Type_Staticness (Time_Subtype_Definition, Locally); - - Translate_Std_Type_Declaration (Time_Type_Declaration); - Chap4.Translate_Subtype_Declaration (Time_Subtype_Declaration); - - if Flags.Vhdl_Std > Vhdl_87 then - Set_Type_Staticness (Delay_Length_Subtype_Definition, Locally); - Chap4.Translate_Subtype_Declaration - (Delay_Length_Subtype_Declaration); - Set_Type_Staticness (Delay_Length_Subtype_Definition, - Subtype_Staticness); - end if; - - Set_Type_Staticness (Time_Type_Definition, Type_Staticness); - Set_Type_Staticness (Time_Subtype_Definition, Subtype_Staticness); - end; - Std_Time_Type := Get_Ortho_Type (Time_Type_Definition, Mode_Value); + -- Restore time type staticness. if Flags.Vhdl_Std > Vhdl_87 then - Translate_Std_Type_Declaration (File_Open_Kind_Type_Declaration); - Translate_Std_Type_Declaration (File_Open_Status_Type_Declaration); - Std_File_Open_Status_Type := - Get_Ortho_Type (File_Open_Status_Type_Definition, Mode_Value); + Set_Type_Staticness (Delay_Length_Subtype_Definition, + Time_Subtype_Staticness); end if; + Set_Type_Staticness (Time_Type_Definition, Time_Type_Staticness); + Set_Type_Staticness (Time_Subtype_Definition, Time_Subtype_Staticness); if Flag_Rti then Rtis.Generate_Unit (Standard_Package); |