diff options
author | Tristan Gingold <tgingold@free.fr> | 2023-01-27 08:13:42 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2023-01-27 08:13:42 +0100 |
commit | 2a1fe0e8ab996a9aa2e2f2b32513e23345b50c2d (patch) | |
tree | e86daef35977376183289e5687e029dbb770e183 /src/ghdldrv/ghdlrun.adb | |
parent | 756b1fd183ab96edd0f330fcc2b411f6e71577f1 (diff) | |
download | ghdl-2a1fe0e8ab996a9aa2e2f2b32513e23345b50c2d.tar.gz ghdl-2a1fe0e8ab996a9aa2e2f2b32513e23345b50c2d.tar.bz2 ghdl-2a1fe0e8ab996a9aa2e2f2b32513e23345b50c2d.zip |
ghdlrun: extract trans_foreign
Diffstat (limited to 'src/ghdldrv/ghdlrun.adb')
-rw-r--r-- | src/ghdldrv/ghdlrun.adb | 114 |
1 files changed, 6 insertions, 108 deletions
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index b0b0da347..e72f3d18d 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -26,16 +26,12 @@ with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; with Simple_IO; use Simple_IO; -with Hash; -with Interning; -with Name_Table; with Flags; with Options; with Errorout; use Errorout; with Vhdl.Nodes; use Vhdl.Nodes; with Vhdl.Std_Package; -with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Canon; with Vhdl.Ieee.Std_Logic_1164; with Vhdl.Back_End; @@ -44,12 +40,10 @@ with Ortho_Nodes; use Ortho_Nodes; with Trans_Decls; with Translation; with Trans_Link; +with Trans_Foreign; with Grt.Main; with Grt.Modules; -with Grt.Dynload; use Grt.Dynload; -with Grt.Lib; -with Grt.Files; with Grt.Options; with Grt.Types; with Grt.Errors; @@ -57,41 +51,9 @@ with Grt.Backtraces.Jit; with Grt.Analog_Solver; with Ghdlcomp; use Ghdlcomp; -with Foreigns; with Grtlink; package body Ghdlrun is - -- Elaboration mode. - type Shlib_Object_Type is record - Name : String_Access; - Handler : Address; - end record; - - function Shlib_Build (Name : String) return Shlib_Object_Type - is - Name_Acc : constant String_Access := new String'(Name); - C_Name : constant String := Name & Nul; - Handler : Address; - begin - Handler := - Grt_Dynload_Open (Grt.Types.To_Ghdl_C_String (C_Name'Address)); - return (Name => Name_Acc, - Handler => Handler); - end Shlib_Build; - - function Shlib_Equal (Obj : Shlib_Object_Type; Param : String) - return Boolean is - begin - return Obj.Name.all = Param; - end Shlib_Equal; - - package Shlib_Interning is new Interning - (Params_Type => String, - Object_Type => Shlib_Object_Type, - Hash => Hash.String_Hash, - Build => Shlib_Build, - Equal => Shlib_Equal); - procedure Foreign_Hook (Decl : Iir; Info : Vhdl.Back_End.Foreign_Info_Type; Ortho : O_Dnode); @@ -128,7 +90,7 @@ package body Ghdlrun is end if; Translation.Foreign_Hook := Foreign_Hook'Access; - Shlib_Interning.Init; + Trans_Foreign.Init; -- FIXME: add a flag to force unnesting. -- Translation.Flag_Unnest_Subprograms := True; @@ -231,76 +193,12 @@ package body Ghdlrun is Info : Vhdl.Back_End.Foreign_Info_Type; Ortho : O_Dnode) is - use Vhdl.Back_End; Res : Address; begin - case Info.Kind is - when Foreign_Vhpidirect => - declare - Name : constant String := - Info.Subprg_Name (1 .. Info.Subprg_Len); - Lib : constant String := - Info.Lib_Name (1 .. Info.Lib_Len); - Shlib : Shlib_Object_Type; - begin - if Info.Lib_Len = 0 - or else Lib = "null" - then - Res := Foreigns.Find_Foreign (Name); - if Res = Null_Address then - Error_Msg_Sem - (+Decl, "unknown foreign VHPIDIRECT '" & Name & "'"); - return; - end if; - else - Shlib := Shlib_Interning.Get (Lib); - if Shlib.Handler = Null_Address then - Error_Msg_Sem - (+Decl, "cannot load VHPIDIRECT shared library '" & - Lib & "'"); - return; - end if; - - declare - C_Name : constant String := Name & Nul; - begin - Res := Grt_Dynload_Symbol - (Shlib.Handler, - Grt.Types.To_Ghdl_C_String (C_Name'Address)); - end; - if Res = Null_Address then - Error_Msg_Sem - (+Decl, "cannot resolve VHPIDIRECT symbol '" - & Name & "'"); - return; - end if; - end if; - Def (Ortho, Res); - end; - when Foreign_Intrinsic => - - declare - Name : constant String := - Name_Table.Image (Get_Identifier (Decl)); - begin - if Name = "untruncated_text_read" then - Def (Ortho, Grt.Files.Ghdl_Untruncated_Text_Read'Address); - elsif Name = "textio_read_real" then - Def (Ortho, Grt.Lib.Textio_Read_Real'Address); - elsif Name = "textio_write_real" then - Def (Ortho, Grt.Lib.Textio_Write_Real'Address); - elsif Name = "control_simulation" then - Def (Ortho, Grt.Lib.Ghdl_Control_Simulation'Address); - elsif Name = "get_resolution_limit" then - Def (Ortho, Grt.Lib.Ghdl_Get_Resolution_Limit'Address); - else - Error_Msg_Sem - (+Decl, "unknown foreign intrinsic %i", +Decl); - end if; - end; - when Foreign_Unknown => - null; - end case; + Res := Trans_Foreign.Get_Foreign_Address (Decl, Info); + if Res /= Null_Address then + Def (Ortho, Res); + end if; end Foreign_Hook; procedure Run |