diff options
Diffstat (limited to 'translate/ghdldrv')
| -rw-r--r-- | translate/ghdldrv/foreigns.adb | 64 | ||||
| -rw-r--r-- | translate/ghdldrv/foreigns.ads | 5 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 64 |
3 files changed, 119 insertions, 14 deletions
diff --git a/translate/ghdldrv/foreigns.adb b/translate/ghdldrv/foreigns.adb new file mode 100644 index 0000000..15e3dd0 --- /dev/null +++ b/translate/ghdldrv/foreigns.adb @@ -0,0 +1,64 @@ +with Interfaces.C; use Interfaces.C; + +package body Foreigns is + function Sin (Arg : double) return double; + pragma Import (C, Sin); + + function Log (Arg : double) return double; + pragma Import (C, Log); + + function Exp (Arg : double) return double; + pragma Import (C, Exp); + + function Sqrt (Arg : double) return double; + pragma Import (C, Sqrt); + + function Asin (Arg : double) return double; + pragma Import (C, Asin); + + function Acos (Arg : double) return double; + pragma Import (C, Acos); + + function Asinh (Arg : double) return double; + pragma Import (C, Asinh); + + function Acosh (Arg : double) return double; + pragma Import (C, Acosh); + + function Atanh (X : double) return double; + pragma Import (C, Atanh); + + function Atan2 (X, Y : double) return double; + pragma Import (C, Atan2); + + type String_Cacc is access constant String; + type Foreign_Record is record + Name : String_Cacc; + Addr : Address; + end record; + + + Foreign_Arr : constant array (Natural range <>) of Foreign_Record := + ( + (new String'("sin"), Sin'Address), + (new String'("log"), Log'Address), + (new String'("exp"), Exp'Address), + (new String'("sqrt"), Sqrt'Address), + (new String'("asin"), Asin'Address), + (new String'("acos"), Acos'Address), + (new String'("asinh"), Asinh'Address), + (new String'("acosh"), Acosh'Address), + (new String'("atanh"), Atanh'Address), + (new String'("atan2"), Atan2'Address) + ); + + function Find_Foreign (Name : String) return Address is + begin + for I in Foreign_Arr'Range loop + if Foreign_Arr(I).Name.all = Name then + return Foreign_Arr(I).Addr; + end if; + end loop; + return Null_Address; + end Find_Foreign; +end Foreigns; diff --git a/translate/ghdldrv/foreigns.ads b/translate/ghdldrv/foreigns.ads new file mode 100644 index 0000000..5759ae4 --- /dev/null +++ b/translate/ghdldrv/foreigns.ads @@ -0,0 +1,5 @@ +with System; use System; + +package Foreigns is + function Find_Foreign (Name : String) return Address; +end Foreigns; diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index 1d70c14..b08ac82 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -47,6 +47,7 @@ with Trans_Be; with Translation; with Std_Names; with Ieee.Std_Logic_1164; +with Interfaces.C; with Binary_File.Elf; @@ -70,9 +71,14 @@ with Grt.Values; with Grt.Names; with Ghdlcomp; +with Foreigns; package body Ghdlrun is - Snap_Filename : String_Access := null; + Snap_Filename : GNAT.OS_Lib.String_Access := null; + + procedure Foreign_Hook (Decl : Iir; + Info : Translation.Foreign_Info_Type; + Ortho : O_Dnode); procedure Compile_Init (Analyze_Only : Boolean) is begin @@ -82,6 +88,8 @@ package body Ghdlrun is return; end if; + Translation.Foreign_Hook := Foreign_Hook'Access; + -- Initialize. Back_End.Finish_Compilation := Trans_Be.Finish_Compilation'Access; @@ -92,6 +100,7 @@ package body Ghdlrun is Libraries.Load_Std_Library; Ortho_Mcode.Init; + Binary_File.Memory.Write_Memory_Init; Translation.Initialize; Canon.Canon_Flag_Add_Labels := True; @@ -237,6 +246,34 @@ package body Ghdlrun is return Conv (Get_Symbol_Vaddr (Get_Decl_Symbol (Decl))); end Get_Address; + procedure Foreign_Hook (Decl : Iir; + Info : Translation.Foreign_Info_Type; + Ortho : O_Dnode) + is + use Translation; + Res : Address; + begin + case Info.Kind is + when Foreign_Vhpidirect => + declare + Name : String := Name_Table.Name_Buffer (Info.Subprg_First + .. Info.Subprg_Last); + begin + Res := Foreigns.Find_Foreign (Name); + if Res /= Null_Address then + Def (Ortho, Res); + else + Error_Msg_Sem ("unknown foreign VHPIDIRECT '" & Name & "'", + Decl); + end if; + end; + when Foreign_Intrinsic => + null; + when Foreign_Unknown => + null; + end case; + end Foreign_Hook; + procedure Run is use Binary_File; @@ -257,8 +294,6 @@ package body Ghdlrun is raise Compile_Error; end if; - Binary_File.Memory.Write_Memory_Init; - Ortho_Code.Abi.Link_Intrinsics; Def (Trans_Decls.Ghdl_Memcpy, @@ -467,17 +502,6 @@ package body Ghdlrun is Grt.Rtis.Ghdl_Rti_Top_Instance'Address); Def (Trans_Decls.Ghdl_Rti_Top_Ptr, Grt.Rtis.Ghdl_Rti_Top_Ptr'Address); - Std_Standard_Boolean_RTI_Ptr := - Get_Address (Trans_Decls.Std_Standard_Boolean_Rti); - Std_Standard_Bit_RTI_Ptr := - Get_Address (Trans_Decls.Std_Standard_Bit_Rti); - if Ieee.Std_Logic_1164.Resolved /= Null_Iir then - Decl := Translation.Get_Resolv_Ortho_Decl - (Ieee.Std_Logic_1164.Resolved); - if Decl /= O_Dnode_Null then - Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address (Decl); - end if; - end if; Def (Trans_Decls.Ghdl_Protected_Enter, Grt.Processes.Ghdl_Protected_Enter'Address); @@ -555,6 +579,18 @@ package body Ghdlrun is raise Compile_Error; end if; + Std_Standard_Boolean_RTI_Ptr := + Get_Address (Trans_Decls.Std_Standard_Boolean_Rti); + Std_Standard_Bit_RTI_Ptr := + Get_Address (Trans_Decls.Std_Standard_Bit_Rti); + if Ieee.Std_Logic_1164.Resolved /= Null_Iir then + Decl := Translation.Get_Resolv_Ortho_Decl + (Ieee.Std_Logic_1164.Resolved); + if Decl /= O_Dnode_Null then + Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address (Decl); + end if; + end if; + Flag_String := Flags.Flag_String; Elaborate_Proc := Conv (Get_Address (Trans_Decls.Ghdl_Elaborate)); |