diff options
Diffstat (limited to 'translate')
| -rw-r--r-- | translate/gcc/INSTALL | 2 | ||||
| -rwxr-xr-x | translate/gcc/dist.sh | 2 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 28 | ||||
| -rw-r--r-- | translate/grt/grt-avhpi.adb | 7 | ||||
| -rw-r--r-- | translate/grt/grt-disp_rti.adb | 8 | ||||
| -rw-r--r-- | translate/grt/grt-files.adb | 4 | ||||
| -rw-r--r-- | translate/grt/grt-images.adb | 7 | ||||
| -rw-r--r-- | translate/grt/grt-images.ads | 3 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_addr.adb | 5 | ||||
| -rw-r--r-- | translate/grt/grt-rtis_utils.adb | 16 | ||||
| -rw-r--r-- | translate/grt/grt-signals.adb | 84 | ||||
| -rw-r--r-- | translate/grt/grt-signals.ads | 34 | ||||
| -rw-r--r-- | translate/trans_decls.ads | 10 | ||||
| -rw-r--r-- | translate/translation.adb | 156 |
14 files changed, 312 insertions, 54 deletions
diff --git a/translate/gcc/INSTALL b/translate/gcc/INSTALL index 2f5c5e1..26b0ee3 100644 --- a/translate/gcc/INSTALL +++ b/translate/gcc/INSTALL @@ -13,7 +13,7 @@ You must be root to install this distribution. To install ghdl: $ su -# tar -C / -zxvf @TARFILE@ +# tar -C / -jxvf @TARFILE@.tar.bz2 Note: you must also have a C compiler and zlib installed. diff --git a/translate/gcc/dist.sh b/translate/gcc/dist.sh index 65aa920..e03e686 100755 --- a/translate/gcc/dist.sh +++ b/translate/gcc/dist.sh @@ -230,7 +230,7 @@ do_tar_dist () { rm -rf $bindirname mkdir $bindirname - sed -e "s/@TARFILE@/$dir.tar/" < INSTALL > $bindirname/INSTALL + sed -e "s/@TARFILE@/$bindirname/" < INSTALL > $bindirname/INSTALL ln ../../COPYING $bindirname ln $TARINSTALL $bindirname tar cvf $bindirname.tar $bindirname diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index 0dc31f4..1d70c14 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -352,6 +352,8 @@ package body Ghdlrun is Grt.Signals.Ghdl_Signal_Driving_Value_B2'Address); Def (Trans_Decls.Ghdl_Signal_Driving_Value_E8, Grt.Signals.Ghdl_Signal_Driving_Value_E8'Address); + Def (Trans_Decls.Ghdl_Signal_Driving_Value_E32, + Grt.Signals.Ghdl_Signal_Driving_Value_E32'Address); Def (Trans_Decls.Ghdl_Signal_Driving_Value_I32, Grt.Signals.Ghdl_Signal_Driving_Value_I32'Address); Def (Trans_Decls.Ghdl_Signal_Driving_Value_I64, @@ -398,6 +400,19 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Signal_Associate_E8, Grt.Signals.Ghdl_Signal_Associate_E8'Address); + Def (Trans_Decls.Ghdl_Create_Signal_E32, + Grt.Signals.Ghdl_Create_Signal_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Init_E32, + Grt.Signals.Ghdl_Signal_Init_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Simple_Assign_E32, + Grt.Signals.Ghdl_Signal_Simple_Assign_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Start_Assign_E32, + Grt.Signals.Ghdl_Signal_Start_Assign_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Next_Assign_E32, + Grt.Signals.Ghdl_Signal_Next_Assign_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Associate_E32, + Grt.Signals.Ghdl_Signal_Associate_E32'Address); + Def (Trans_Decls.Ghdl_Create_Signal_I32, Grt.Signals.Ghdl_Create_Signal_I32'Address); Def (Trans_Decls.Ghdl_Signal_Init_I32, @@ -479,18 +494,25 @@ package body Ghdlrun is Grt.Files.Ghdl_Text_File_Finalize'Address); Def (Trans_Decls.Ghdl_Text_File_Open, Grt.Files.Ghdl_Text_File_Open'Address); + Def (Trans_Decls.Ghdl_Text_File_Open_Status, + Grt.Files.Ghdl_Text_File_Open_Status'Address); Def (Trans_Decls.Ghdl_Text_Write, Grt.Files.Ghdl_Text_Write'Address); Def (Trans_Decls.Ghdl_Text_Read_Length, Grt.Files.Ghdl_Text_Read_Length'Address); Def (Trans_Decls.Ghdl_Text_File_Close, Grt.Files.Ghdl_Text_File_Close'Address); - Def (Trans_Decls.Ghdl_File_Close, - Grt.Files.Ghdl_File_Close'Address); + Def (Trans_Decls.Ghdl_File_Elaborate, Grt.Files.Ghdl_File_Elaborate'Address); + Def (Trans_Decls.Ghdl_File_Finalize, + Grt.Files.Ghdl_File_Finalize'Address); Def (Trans_Decls.Ghdl_File_Open, Grt.Files.Ghdl_File_Open'Address); + Def (Trans_Decls.Ghdl_File_Open_Status, + Grt.Files.Ghdl_File_Open_Status'Address); + Def (Trans_Decls.Ghdl_File_Close, + Grt.Files.Ghdl_File_Close'Address); Def (Trans_Decls.Ghdl_Write_Scalar, Grt.Files.Ghdl_Write_Scalar'Address); Def (Trans_Decls.Ghdl_Read_Scalar, @@ -503,6 +525,8 @@ package body Ghdlrun is Grt.Images.Ghdl_Image_B2'Address); Def (Trans_Decls.Ghdl_Image_E8, Grt.Images.Ghdl_Image_E8'Address); + Def (Trans_Decls.Ghdl_Image_E32, + Grt.Images.Ghdl_Image_E32'Address); Def (Trans_Decls.Ghdl_Image_I32, Grt.Images.Ghdl_Image_I32'Address); Def (Trans_Decls.Ghdl_Image_F64, diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb index fc38f87..7c8b10f 100644 --- a/translate/grt/grt-avhpi.adb +++ b/translate/grt/grt-avhpi.adb @@ -329,7 +329,8 @@ package body Grt.Avhpi is end if; end; when Ghdl_Rtik_Type_B2 - | Ghdl_Rtik_Type_E8 => + | Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 => Res := (Kind => VhpiEnumTypeDeclK, Ctxt => Ctxt, Atype => Rti); @@ -387,6 +388,7 @@ package body Grt.Avhpi is | Ghdl_Rtik_Subtype_Array | Ghdl_Rtik_Subtype_Array_Ptr | Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 | Ghdl_Rtik_Type_B2 => Rti_To_Handle (Ch, Iterator.Ctxt, Res); if Res.Kind /= VhpiUndefined then @@ -581,6 +583,9 @@ package body Grt.Avhpi is -- when Ghdl_Rtik_Type_E8 => -- Disp_Enum_Value -- (Stream, Rti, Ghdl_Index_Type (Vptr.E8)); +-- when Ghdl_Rtik_Type_E32 => +-- Disp_Enum_Value +-- (Stream, Rti, Ghdl_Index_Type (Vptr.E32)); -- when Ghdl_Rtik_Type_B2 => -- Disp_Enum_Value -- (Stream, Rti, diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb index e9ac3e6..dded644 100644 --- a/translate/grt/grt-disp_rti.adb +++ b/translate/grt/grt-disp_rti.adb @@ -73,6 +73,11 @@ package body Grt.Disp_Rti is if not Is_Sig then Update (8); end if; + when Ghdl_Rtik_Type_E32 => + Disp_Enum_Value (Stream, Rti, Ghdl_Index_Type (Vptr.E32)); + if not Is_Sig then + Update (32); + end if; when Ghdl_Rtik_Type_B2 => Disp_Enum_Value (Stream, Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Vptr.B2))); @@ -201,6 +206,7 @@ package body Grt.Disp_Rti is Obj, Is_Sig); when Ghdl_Rtik_Type_I32 | Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 | Ghdl_Rtik_Type_B2 => Disp_Scalar_Value (Stream, Rti, Obj, Is_Sig); when Ghdl_Rtik_Type_Array => @@ -310,6 +316,8 @@ package body Grt.Disp_Rti is Put ("ghdl_rtik_type_b2"); when Ghdl_Rtik_Type_E8 => Put ("ghdl_rtik_type_e8"); + when Ghdl_Rtik_Type_E32 => + Put ("ghdl_rtik_type_e32"); when Ghdl_Rtik_Type_P64 => Put ("ghdl_rtik_type_p64"); when Ghdl_Rtik_Type_I32 => diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb index 974d557..9037fce 100644 --- a/translate/grt/grt-files.adb +++ b/translate/grt/grt-files.adb @@ -153,8 +153,8 @@ package body Grt.Files is end if; -- Copy file name and convert it to a C string (NUL terminated). - for I in 0 .. Str.Bounds.Dim_1.Length - 1 loop - Name (1 + Natural (I)) := Str.Base (I); + for I in 1 .. Str.Bounds.Dim_1.Length loop + Name (Natural (I)) := Str.Base (I - 1); end loop; Name (Name'Last) := NUL; diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb index 396a0ea..5f8a081 100644 --- a/translate/grt/grt-images.adb +++ b/translate/grt/grt-images.adb @@ -68,6 +68,13 @@ package body Grt.Images is Return_Enum (Res, Rti, Ghdl_E8'Pos (Val)); end Ghdl_Image_E8; + procedure Ghdl_Image_E32 + (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access) + is + begin + Return_Enum (Res, Rti, Ghdl_E32'Pos (Val)); + end Ghdl_Image_E32; + procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32) is Str : String (1 .. 11); diff --git a/translate/grt/grt-images.ads b/translate/grt/grt-images.ads index fb33b63..74a7bd7 100644 --- a/translate/grt/grt-images.ads +++ b/translate/grt/grt-images.ads @@ -23,6 +23,8 @@ package Grt.Images is (Res : Std_String_Ptr; Val : Ghdl_B2; Rti : Ghdl_Rti_Access); procedure Ghdl_Image_E8 (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access); + procedure Ghdl_Image_E32 + (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access); procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32); procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64); procedure Ghdl_Image_P64 @@ -32,6 +34,7 @@ package Grt.Images is private pragma Export (C, Ghdl_Image_B2, "__ghdl_image_b2"); pragma Export (C, Ghdl_Image_E8, "__ghdl_image_e8"); + pragma Export (C, Ghdl_Image_E32, "__ghdl_image_e32"); pragma Export (C, Ghdl_Image_I32, "__ghdl_image_i32"); pragma Export (C, Ghdl_Image_F64, "__ghdl_image_f64"); pragma Export (C, Ghdl_Image_P64, "__ghdl_image_p64"); diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb index 4f24fe7..64273b3 100644 --- a/translate/grt/grt-rtis_addr.adb +++ b/translate/grt/grt-rtis_addr.adb @@ -231,6 +231,10 @@ package body Grt.Rtis_Addr is Align (Ghdl_Range_E8'Alignment); Res (I) := To_Ghdl_Range_Ptr (Bounds); Update (Ghdl_Range_E8'Size); + when Ghdl_Rtik_Type_E32 => + Align (Ghdl_Range_E32'Alignment); + Res (I) := To_Ghdl_Range_Ptr (Bounds); + Update (Ghdl_Range_E32'Size); when others => -- Bounds are not known anymore. Bounds := Null_Address; @@ -249,6 +253,7 @@ package body Grt.Rtis_Addr is return To_Ghdl_Rti_Access (To_Ghdl_Rtin_Subtype_Array_Acc (Atype).Basetype); when Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 | Ghdl_Rtik_Type_B2 => return Atype; when others => diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb index 9754ada..4fd558e 100644 --- a/translate/grt/grt-rtis_utils.adb +++ b/translate/grt/grt-rtis_utils.adb @@ -198,6 +198,8 @@ package body Grt.Rtis_Utils is Update (32); when Ghdl_Rtik_Type_E8 => Update (8); + when Ghdl_Rtik_Type_E32 => + Update (32); when Ghdl_Rtik_Type_B2 => Update (8); when Ghdl_Rtik_Type_F64 => @@ -231,6 +233,13 @@ package body Grt.Rtis_Utils is when Dir_Downto => Val.E8 := Rng.E8.Left - Ghdl_E8 (Pos); end case; + when Ghdl_Rtik_Type_E32 => + case Rng.E32.Dir is + when Dir_To => + Val.E32 := Rng.E32.Left + Ghdl_E32 (Pos); + when Dir_Downto => + Val.E32 := Rng.E32.Left - Ghdl_E32 (Pos); + end case; when Ghdl_Rtik_Type_B2 => case Pos is when 0 => @@ -265,6 +274,8 @@ package body Grt.Rtis_Utils is end; when Ghdl_Rtik_Type_E8 => Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E8)); + when Ghdl_Rtik_Type_E32 => + Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E32)); when Ghdl_Rtik_Type_B2 => Get_Enum_Value (Vstr, Rti, Ghdl_B2'Pos (V.B2)); when others => @@ -348,6 +359,7 @@ package body Grt.Rtis_Utils is Handle_Scalar (To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype); when Ghdl_Rtik_Type_I32 | Ghdl_Rtik_Type_E8 + | Ghdl_Rtik_Type_E32 | Ghdl_Rtik_Type_B2 => Handle_Scalar (Rti); when Ghdl_Rtik_Type_Array => @@ -430,6 +442,8 @@ package body Grt.Rtis_Utils is end; when Ghdl_Rtik_Type_E8 => Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E8)); + when Ghdl_Rtik_Type_E32 => + Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E32)); when Ghdl_Rtik_Type_B2 => Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2))); @@ -520,6 +534,8 @@ package body Grt.Rtis_Utils is end; when Ghdl_Rtik_Type_E8 => Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E8)); + when Ghdl_Rtik_Type_E32 => + Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E32)); when Ghdl_Rtik_Type_B2 => Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2))); diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb index 5b3a12f..a165144 100644 --- a/translate/grt/grt-signals.adb +++ b/translate/grt/grt-signals.adb @@ -802,6 +802,77 @@ package body Grt.Signals is (Sign, Value_Union'(Mode => Mode_E8, E8 => Val), After); end Ghdl_Signal_Next_Assign_E8; + function Ghdl_Create_Signal_E32 + (Init_Val : Ghdl_E32; + Resolv_Func : System.Address; + Resolv_Inst : System.Address) + return Ghdl_Signal_Ptr + is + begin + return Create_Signal + (Mode_E32, Value_Union'(Mode => Mode_E32, E32 => Init_Val), + Get_Current_Mode_Signal, + Resolv_Func, Resolv_Inst); + end Ghdl_Create_Signal_E32; + + procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32) + is + begin + Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_E32, E32 => Init_Val)); + end Ghdl_Signal_Init_E32; + + procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32) + is + begin + Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E32, E32 => Val)); + end Ghdl_Signal_Associate_E32; + + procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_E32) + is + Trans : Transaction_Acc; + begin + if not Sign.Flags.Has_Active + and then Sign.Net = Net_One_Driver + and then Val = Sign.Value.E32 + and then Sign.S.Drivers (0).First_Trans.Next = null + then + return; + end if; + + Trans := new Transaction' + (Kind => Trans_Value, + Time => 0, + Next => null, + Val => Value_Union'(Mode => Mode_E32, E32 => Val)); + + Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); + end Ghdl_Signal_Simple_Assign_E32; + + procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Rej : Std_Time; + Val : Ghdl_E32; + After : Std_Time) + is + Trans : Transaction_Acc; + begin + Trans := new Transaction' + (Kind => Trans_Value, + Time => 0, + Next => null, + Val => Value_Union'(Mode => Mode_E32, E32 => Val)); + Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); + end Ghdl_Signal_Start_Assign_E32; + + procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_E32; + After : Std_Time) + is + begin + Ghdl_Signal_Next_Assign + (Sign, Value_Union'(Mode => Mode_E32, E32 => Val), After); + end Ghdl_Signal_Next_Assign_E32; + function Ghdl_Create_Signal_I32 (Init_Val : Ghdl_I32; Resolv_Func : System.Address; @@ -1358,6 +1429,19 @@ package body Grt.Signals is end if; end Ghdl_Signal_Driving_Value_E8; + function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr) + return Ghdl_E32 + is + Drv : Driver_Acc; + begin + Drv := Get_Driver (Sig); + if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then + Error ("'driving_value: no active driver in process for signal"); + else + return Drv.First_Trans.Val.E32; + end if; + end Ghdl_Signal_Driving_Value_E32; + function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr) return Ghdl_I32 is diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads index c78bf52..500cd55 100644 --- a/translate/grt/grt-signals.ads +++ b/translate/grt/grt-signals.ads @@ -453,6 +453,25 @@ package Grt.Signals is function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr) return Ghdl_E8; + function Ghdl_Create_Signal_E32 + (Init_Val : Ghdl_E32; + Resolv_Func : System.Address; + Resolv_Inst : System.Address) + return Ghdl_Signal_Ptr; + procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32); + procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32); + procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_E32); + procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Rej : Std_Time; + Val : Ghdl_E32; + After : Std_Time); + procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr; + Val : Ghdl_E32; + After : Std_Time); + function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr) + return Ghdl_E32; + function Ghdl_Create_Signal_I32 (Init_Val : Ghdl_I32; Resolv_Func : System.Address; @@ -634,6 +653,21 @@ private pragma Export (C, Ghdl_Signal_Driving_Value_E8, "__ghdl_signal_driving_value_e8"); + pragma Export (C, Ghdl_Create_Signal_E32, + "__ghdl_create_signal_e32"); + pragma Export (C, Ghdl_Signal_Init_E32, + "__ghdl_signal_init_e32"); + pragma Export (C, Ghdl_Signal_Associate_E32, + "__ghdl_signal_associate_e32"); + pragma Export (C, Ghdl_Signal_Simple_Assign_E32, + "__ghdl_signal_simple_assign_e32"); + pragma Export (C, Ghdl_Signal_Start_Assign_E32, + "__ghdl_signal_start_assign_e32"); + pragma Export (C, Ghdl_Signal_Next_Assign_E32, + "__ghdl_signal_next_assign_e32"); + pragma Export (C, Ghdl_Signal_Driving_Value_E32, + "__ghdl_signal_driving_value_e32"); + pragma Export (C, Ghdl_Create_Signal_I32, "__ghdl_create_signal_i32"); pragma Export (C, Ghdl_Signal_Init_I32, diff --git a/translate/trans_decls.ads b/translate/trans_decls.ads index 20498e4..6141fcd 100644 --- a/translate/trans_decls.ads +++ b/translate/trans_decls.ads @@ -77,6 +77,14 @@ package Trans_Decls is Ghdl_Signal_Associate_E8 : O_Dnode; Ghdl_Signal_Driving_Value_E8 : O_Dnode; + Ghdl_Create_Signal_E32 : O_Dnode; + Ghdl_Signal_Init_E32 : O_Dnode; + Ghdl_Signal_Simple_Assign_E32 : O_Dnode; + Ghdl_Signal_Start_Assign_E32 : O_Dnode; + Ghdl_Signal_Next_Assign_E32 : O_Dnode; + Ghdl_Signal_Associate_E32 : O_Dnode; + Ghdl_Signal_Driving_Value_E32 : O_Dnode; + Ghdl_Create_Signal_B2 : O_Dnode; Ghdl_Signal_Init_B2 : O_Dnode; Ghdl_Signal_Simple_Assign_B2 : O_Dnode; @@ -190,6 +198,7 @@ package Trans_Decls is -- 'Image attributes. Ghdl_Image_B2 : O_Dnode; Ghdl_Image_E8 : O_Dnode; + Ghdl_Image_E32 : O_Dnode; Ghdl_Image_I32 : O_Dnode; Ghdl_Image_P32 : O_Dnode; Ghdl_Image_P64 : O_Dnode; @@ -198,6 +207,7 @@ package Trans_Decls is -- 'Value attributes Ghdl_Value_B2 : O_Dnode; Ghdl_Value_E8 : O_Dnode; + Ghdl_Value_E32 : O_Dnode; Ghdl_Value_I32 : O_Dnode; Ghdl_Value_P32 : O_Dnode; Ghdl_Value_P64 : O_Dnode; diff --git a/translate/translation.adb b/translate/translation.adb index dfbe23a..9241f36 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -978,8 +978,12 @@ package body Translation is Resolv_Block : Iir; -- Parameter nodes. Var_Instance : O_Dnode; + + -- Signals Var_Vals : O_Dnode; + -- Driving vector. Var_Vec : O_Dnode; + -- Length of Vector. Var_Vlen : O_Dnode; Var_Nbr_Drv : O_Dnode; Var_Nbr_Ports : O_Dnode; @@ -6659,7 +6663,10 @@ package body Translation is case Get_Kind (El) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => - Chap2.Translate_Subprogram_Declaration (El); + -- Translate only if used. + if Get_Info (El) /= null then + Chap2.Translate_Subprogram_Declaration (El); + end if; when others => Error_Kind ("translate_protected_type_subprograms", El); end case; @@ -8128,10 +8135,11 @@ package body Translation is end; when Type_Mode_Fat_Array => -- a fat array. + D := Stabilize (Dest); Gen_Memcpy - (M2Addr (Get_Array_Base (Dest)), + (M2Addr (Get_Array_Base (D)), M2Addr (Get_Array_Base (E2M (Src, Info, Kind))), - Get_Object_Size (Dest, Obj_Type)); + Get_Object_Size (D, Obj_Type)); when Type_Mode_Record | Type_Mode_Ptr_Array => Gen_Memcpy @@ -9427,6 +9435,9 @@ package body Translation is when Type_Mode_E8 => Create_Subprg := Ghdl_Create_Signal_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Create_Subprg := Ghdl_Create_Signal_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Create_Subprg := Ghdl_Create_Signal_I32; @@ -10254,7 +10265,8 @@ package body Translation is (Interface_List, Rinfo.Var_Instance, Wki_Instance, Itype); -- The signal. - El_Type := Get_Return_Type (Func); + El_Type := Get_Type (Get_Interface_Declaration_Chain (Func)); + El_Type := Get_Element_Subtype (El_Type); El_Info := Get_Info (El_Type); case El_Info.Type_Mode is when Type_Mode_Thin => @@ -10383,10 +10395,17 @@ package body Translation is is -- Type of the resolution function parameter. Arr_Type : Iir; - Base_Type, El_Type : Iir; - El_Info : Type_Info_Acc; + Base_Type : Iir; Base_Info : Type_Info_Acc; + -- Type of parameter element. + El_Type : Iir; + El_Info : Type_Info_Acc; + + -- Type of the function return value. + Ret_Type : Iir; + Ret_Info : Type_Info_Acc; + -- Type and info of the array index. Index_Type : Iir; Index_Tinfo : Type_Info_Acc; @@ -10421,13 +10440,16 @@ package body Translation is return; end if; - El_Type := Get_Return_Type (Func); - El_Info := Get_Info (El_Type); + Ret_Type := Get_Return_Type (Func); + Ret_Info := Get_Info (Ret_Type); Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Func)); Base_Type := Get_Base_Type (Arr_Type); Base_Info := Get_Info (Base_Type); + El_Type := Get_Element_Subtype (Arr_Type); + El_Info := Get_Info (El_Type); + Index_Type := Get_First_Element (Get_Index_Subtype_List (Arr_Type)); Index_Tinfo := Get_Info (Index_Type); @@ -10441,7 +10463,7 @@ package body Translation is -- A signal. New_Var_Decl (Var_Res, Get_Identifier ("res"), - O_Storage_Local, El_Info.Ortho_Type (Mode_Value)); + O_Storage_Local, Ret_Info.Ortho_Type (Mode_Value)); -- I, J. New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type); @@ -10559,8 +10581,10 @@ package body Translation is Finish_Loop_Stmt (Label); if Finfo.Res_Interface /= O_Dnode_Null then - Res := Lo2M (Var_Res, El_Info, Mode_Value); - Allocate_Complex_Object (El_Type, Alloc_Stack, Res); + Res := Lo2M (Var_Res, Ret_Info, Mode_Value); + if Ret_Info.Type_Mode /= Type_Mode_Fat_Array then + Allocate_Complex_Object (Ret_Type, Alloc_Stack, Res); + end if; end if; -- Call the resolution function. @@ -10574,11 +10598,17 @@ package body Translation is Base_Info.Ortho_Ptr_Type (Mode_Value))); if Finfo.Res_Interface = O_Dnode_Null then - Res := E2M (New_Function_Call (Assoc), El_Info, Mode_Value); + Res := E2M (New_Function_Call (Assoc), Ret_Info, Mode_Value); else New_Procedure_Call (Assoc); end if; + if El_Type /= Ret_Type then + Res := E2M + (Chap7.Translate_Implicit_Conv (M2E (Res), Ret_Type, El_Type, + Mode_Value, Func), + El_Info, Mode_Value); + end if; Chap7.Set_Driving_Value (Vals, El_Type, Res); Close_Temp; @@ -10600,11 +10630,7 @@ package body Translation is when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration => -- Translate interfaces. - if Flag_Discard_Unused - and then not Get_Use_Flag (El) - then - null; - else + if not Flag_Discard_Unused or else Get_Use_Flag (El) then Info := Add_Info (El, Kind_Subprg); Chap2.Translate_Subprogram_Interfaces (El); if Get_Kind (El) = Iir_Kind_Function_Declaration @@ -10637,18 +10663,16 @@ package body Translation is case Get_Kind (El) is when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration => + -- Translate only if used. if Get_Info (El) /= null then Chap2.Translate_Subprogram_Declaration (El); Translate_Resolution_Function (El, Block); end if; when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => - if Flag_Discard_Unused - and then - not Get_Use_Flag (Get_Subprogram_Specification (El)) + if not Flag_Discard_Unused + or else Get_Use_Flag (Get_Subprogram_Specification (El)) then - null; - else Chap2.Translate_Subprogram_Body (El); Translate_Resolution_Function_Body (Get_Subprogram_Specification (El), Block); @@ -11455,6 +11479,9 @@ package body Translation is when Type_Mode_E8 => Subprg := Ghdl_Signal_Associate_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Subprg := Ghdl_Signal_Associate_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 => Subprg := Ghdl_Signal_Associate_I32; Conv := Ghdl_I32_Type; @@ -14918,8 +14945,6 @@ package body Translation is begin Tinfo := Get_Info (Target_Type); Open_Temp; - -- FIXME: to be removed ? - --Chap3.Translate_Type_Definition (Aggr_Type); Targ := Stabilize (Target); Base := Stabilize (Chap3.Get_Array_Base (Targ)); Bounds := Stabilize (Chap3.Get_Array_Bounds (Targ)); @@ -15053,6 +15078,10 @@ package body Translation is Translate_Array_Aggregate_Gen (Base, Bounds, Aggr, Aggr_Type, 1, Var_Index); Close_Temp; + + -- FIXME: creating aggregate subtype is expensive and rarely used. + -- (one of the current use - only ? - is check_array_match). + Chap3.Translate_Type_Definition (Aggr_Type, False); end Translate_Array_Aggregate; procedure Translate_Aggregate @@ -15174,7 +15203,8 @@ package body Translation is Res_Info := Get_Info (Res_Type); Expr_Info := Get_Info (Expr_Type); case Res_Info.Type_Mode is - when Type_Mode_Array => + when Type_Mode_Array + | Type_Mode_Ptr_Array => declare E : O_Dnode; begin @@ -15612,9 +15642,6 @@ package body Translation is | Iir_Kind_Simple_Aggregate | Iir_Kind_Simple_Name_Attribute => Res := Translate_String_Literal (Expr); - Res := Translate_Implicit_Conv - (Res, Expr_Type, Res_Type, Mode_Value, Expr); - return Res; when Iir_Kind_Aggregate => declare @@ -15700,8 +15727,6 @@ package body Translation is when Iir_Kind_Qualified_Expression => -- FIXME: check type. Res := Translate_Expression (Get_Expression (Expr), Expr_Type); - return Translate_Implicit_Conv - (Res, Expr_Type, Rtype, Mode_Value, Expr); when Iir_Kind_Constant_Declaration | Iir_Kind_Variable_Declaration @@ -15735,11 +15760,6 @@ package body Translation is Res := Translate_Signal (Res, Expr_Type); end if; end; - if Rtype /= Null_Iir then - Res := Translate_Implicit_Conv - (Res, Expr_Type, Rtype, Mode_Value, Expr); - end if; - return Res; when Iir_Kind_Iterator_Declaration => declare @@ -15802,9 +15822,7 @@ package body Translation is Assoc_Chain := Canon.Canon_Subprogram_Call (Expr); Res := Translate_Function_Call (Imp, Assoc_Chain, Get_Method_Object (Expr)); - return Translate_Implicit_Conv - (Res, Get_Return_Type (Imp), - Res_Type, Mode_Value, Expr); + Expr_Type := Get_Return_Type (Imp); end if; end; @@ -15816,8 +15834,6 @@ package body Translation is Res := Translate_Type_Conversion (Translate_Expression (Conv_Expr), Get_Type (Conv_Expr), Expr_Type, Expr); - return Translate_Implicit_Conv - (Res, Expr_Type, Res_Type, Mode_Value, Expr); end; when Iir_Kind_Length_Array_Attribute => @@ -15844,9 +15860,8 @@ package body Translation is return Chap14.Translate_Succ_Pred_Attribute (Expr); when Iir_Kind_Image_Attribute => - return Translate_Implicit_Conv - (Chap14.Translate_Image_Attribute (Expr), - String_Type_Definition, Res_Type, Mode_Value, Expr); + Res := Chap14.Translate_Image_Attribute (Expr); + when Iir_Kind_Value_Attribute => return Chap14.Translate_Value_Attribute (Expr); @@ -15855,7 +15870,7 @@ package body Translation is when Iir_Kind_Active_Attribute => return Chap14.Translate_Active_Attribute (Expr); when Iir_Kind_Last_Value_Attribute => - return Chap14.Translate_Last_Value_Attribute (Expr); + Res := Chap14.Translate_Last_Value_Attribute (Expr); when Iir_Kind_High_Type_Attribute => return Chap14.Translate_High_Type_Attribute (Get_Type (Expr)); @@ -15874,13 +15889,13 @@ package body Translation is (Get_Prefix (Expr), Ghdl_Signal_Last_Active_Node); when Iir_Kind_Driving_Value_Attribute => - return Chap14.Translate_Driving_Value_Attribute (Expr); + Res := Chap14.Translate_Driving_Value_Attribute (Expr); when Iir_Kind_Driving_Attribute => - return Chap14.Translate_Driving_Attribute (Expr); + Res := Chap14.Translate_Driving_Attribute (Expr); when Iir_Kind_Path_Name_Attribute | Iir_Kind_Instance_Name_Attribute => - return Chap14.Translate_Path_Instance_Name_Attribute (Expr); + Res := Chap14.Translate_Path_Instance_Name_Attribute (Expr); when Iir_Kind_Simple_Name | Iir_Kind_Selected_Name => @@ -15889,6 +15904,14 @@ package body Translation is when others => Error_Kind ("translate_expression", Expr); end case; + + -- Quick test to avoid useless calls. + if Expr_Type /= Res_Type then + Res := Translate_Implicit_Conv + (Res, Expr_Type, Res_Type, Mode_Value, Expr); + end if; + + return Res; end Translate_Expression; -- Check if RNG is of the form: @@ -19411,6 +19434,9 @@ package body Translation is when Type_Mode_E8 => Subprg := Ghdl_Signal_Simple_Assign_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Subprg := Ghdl_Signal_Simple_Assign_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Subprg := Ghdl_Signal_Simple_Assign_I32; @@ -19533,6 +19559,9 @@ package body Translation is when Type_Mode_E8 => Subprg := Ghdl_Signal_Start_Assign_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Subprg := Ghdl_Signal_Start_Assign_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Subprg := Ghdl_Signal_Start_Assign_I32; @@ -19699,6 +19728,9 @@ package body Translation is when Type_Mode_E8 => Subprg := Ghdl_Signal_Next_Assign_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Subprg := Ghdl_Signal_Next_Assign_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Subprg := Ghdl_Signal_Next_Assign_I32; @@ -21014,6 +21046,9 @@ package body Translation is when Type_Mode_E8 => Init_Subprg := Ghdl_Signal_Init_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Init_Subprg := Ghdl_Signal_Init_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Init_Subprg := Ghdl_Signal_Init_I32; @@ -22832,6 +22867,8 @@ package body Translation is Subprg := Ghdl_Signal_Driving_Value_B2; when Type_Mode_E8 => Subprg := Ghdl_Signal_Driving_Value_E8; + when Type_Mode_E32 => + Subprg := Ghdl_Signal_Driving_Value_E32; when Type_Mode_I32 | Type_Mode_P32 => Subprg := Ghdl_Signal_Driving_Value_I32; @@ -22888,6 +22925,9 @@ package body Translation is when Type_Mode_E8 => Subprg := Ghdl_Image_E8; Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + Subprg := Ghdl_Image_E32; + Conv := Ghdl_I32_Type; when Type_Mode_I32 => Subprg := Ghdl_Image_I32; Conv := Ghdl_I32_Type; @@ -22942,6 +22982,8 @@ package body Translation is Subprg := Ghdl_Value_B2; when Type_Mode_E8 => Subprg := Ghdl_Value_E8; + when Type_Mode_E32 => + Subprg := Ghdl_Value_E32; when Type_Mode_I32 => Subprg := Ghdl_Value_I32; when Type_Mode_P64 => @@ -26569,6 +26611,12 @@ package body Translation is Create_Image_Value_Subprograms ("e8", Ghdl_I32_Type, True, Ghdl_Image_E8, Ghdl_Value_E8); + -- procedure __ghdl_image_e32 (res : std_string_ptr_node; + -- val : ghdl_i32_type; + -- rti : ghdl_rti_access); + Create_Image_Value_Subprograms + ("e32", Ghdl_I32_Type, True, Ghdl_Image_E32, Ghdl_Value_E32); + -- procedure __ghdl_image_i32 (res : std_string_ptr_node; -- val : ghdl_i32_type); Create_Image_Value_Subprograms @@ -26903,6 +26951,19 @@ package body Translation is Ghdl_Signal_Associate_E8, Ghdl_Signal_Driving_Value_E8); + -- function __ghdl_create_signal_enum8 (init_val : ghdl_i32_type) + -- return __ghdl_signal_ptr; + -- procedure __ghdl_signal_simple_assign_e8 (sign : __ghdl_signal_ptr; + -- val : __ghdl_integer); + Create_Signal_Subprograms ("e32", Ghdl_I32_Type, + Ghdl_Create_Signal_E32, + Ghdl_Signal_Init_E32, + Ghdl_Signal_Simple_Assign_E32, + Ghdl_Signal_Start_Assign_E32, + Ghdl_Signal_Next_Assign_E32, + Ghdl_Signal_Associate_E32, + Ghdl_Signal_Driving_Value_E32); + -- function __ghdl_create_signal_b2 (init_val : ghdl_bool_type) -- return __ghdl_signal_ptr; -- procedure __ghdl_signal_simple_assign_b2 (sign : __ghdl_signal_ptr; @@ -27683,6 +27744,7 @@ package body Translation is begin -- Load the unit in memory to compute the dependence list. Libraries.Load_Design_Unit (Unit, Null_Iir); + Update_Node_Infos; Set_Elab_Flag (Unit, True); Design_Units.Append (Unit); |