aboutsummaryrefslogtreecommitdiffstats
path: root/src/ghdldrv
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2023-01-27 08:13:42 +0100
committerTristan Gingold <tgingold@free.fr>2023-01-27 08:13:42 +0100
commit2a1fe0e8ab996a9aa2e2f2b32513e23345b50c2d (patch)
treee86daef35977376183289e5687e029dbb770e183 /src/ghdldrv
parent756b1fd183ab96edd0f330fcc2b411f6e71577f1 (diff)
downloadghdl-2a1fe0e8ab996a9aa2e2f2b32513e23345b50c2d.tar.gz
ghdl-2a1fe0e8ab996a9aa2e2f2b32513e23345b50c2d.tar.bz2
ghdl-2a1fe0e8ab996a9aa2e2f2b32513e23345b50c2d.zip
ghdlrun: extract trans_foreign
Diffstat (limited to 'src/ghdldrv')
-rw-r--r--src/ghdldrv/ghdlrun.adb114
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