aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ghdldrv/ghdlrun.adb114
-rw-r--r--src/vhdl/translate/trans_foreign.adb127
-rw-r--r--src/vhdl/translate/trans_foreign.ads11
3 files changed, 144 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
diff --git a/src/vhdl/translate/trans_foreign.adb b/src/vhdl/translate/trans_foreign.adb
new file mode 100644
index 000000000..2fe6ea72f
--- /dev/null
+++ b/src/vhdl/translate/trans_foreign.adb
@@ -0,0 +1,127 @@
+with Hash;
+with Interning;
+with Name_Table;
+
+with Foreigns;
+
+with Vhdl.Errors; use Vhdl.Errors;
+
+with Grt.Types; use Grt.Types;
+with Grt.Dynload; use Grt.Dynload;
+with Grt.Lib;
+with Grt.Files;
+
+package body Trans_Foreign 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);
+
+ function Get_Foreign_Address
+ (Decl : Iir; Info : Vhdl.Back_End.Foreign_Info_Type) return Address
+ 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 Null_Address;
+ 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 Null_Address;
+ 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 Null_Address;
+ end if;
+ end if;
+ return Res;
+ end;
+ when Foreign_Intrinsic =>
+
+ declare
+ Name : constant String :=
+ Name_Table.Image (Get_Identifier (Decl));
+ begin
+ if Name = "untruncated_text_read" then
+ Res := Grt.Files.Ghdl_Untruncated_Text_Read'Address;
+ elsif Name = "textio_read_real" then
+ Res := Grt.Lib.Textio_Read_Real'Address;
+ elsif Name = "textio_write_real" then
+ Res := Grt.Lib.Textio_Write_Real'Address;
+ elsif Name = "control_simulation" then
+ Res := Grt.Lib.Ghdl_Control_Simulation'Address;
+ elsif Name = "get_resolution_limit" then
+ Res := Grt.Lib.Ghdl_Get_Resolution_Limit'Address;
+ else
+ Error_Msg_Sem
+ (+Decl, "unknown foreign intrinsic %i", +Decl);
+ Res := Null_Address;
+ end if;
+ end;
+ when Foreign_Unknown =>
+ null;
+ end case;
+ return Res;
+ end Get_Foreign_Address;
+
+ procedure Init is
+ begin
+ Shlib_Interning.Init;
+ end Init;
+end Trans_Foreign;
diff --git a/src/vhdl/translate/trans_foreign.ads b/src/vhdl/translate/trans_foreign.ads
new file mode 100644
index 000000000..dd66b5132
--- /dev/null
+++ b/src/vhdl/translate/trans_foreign.ads
@@ -0,0 +1,11 @@
+with System; use System;
+
+with Vhdl.Nodes; use Vhdl.Nodes;
+with Vhdl.Back_End;
+
+package Trans_Foreign is
+ procedure Init;
+
+ function Get_Foreign_Address
+ (Decl : Iir; Info : Vhdl.Back_End.Foreign_Info_Type) return Address;
+end Trans_Foreign;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 03:52:01 +0000