aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ghdldrv/ghdlrun.adb10
-rw-r--r--src/vhdl/translate/ortho_front.adb12
-rw-r--r--src/vhdl/translate/trans-chap2.adb2
-rw-r--r--src/vhdl/translate/trans_be.adb75
-rw-r--r--src/vhdl/translate/trans_be.ads27
-rw-r--r--src/vhdl/translate/translation.adb172
-rw-r--r--src/vhdl/translate/translation.ads37
-rw-r--r--src/vhdl/vhdl-back_end.adb169
-rw-r--r--src/vhdl/vhdl-back_end.ads36
9 files changed, 266 insertions, 274 deletions
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index 758966231..0c8ba1ccb 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -38,10 +38,10 @@ with Vhdl.Std_Package;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Canon;
with Vhdl.Ieee.Std_Logic_1164;
+with Vhdl.Back_End;
with Ortho_Jit;
with Ortho_Nodes; use Ortho_Nodes;
with Trans_Decls;
-with Trans_Be;
with Translation;
with Grt.Main;
@@ -110,7 +110,7 @@ package body Ghdlrun is
Equal => Shlib_Equal);
procedure Foreign_Hook (Decl : Iir;
- Info : Translation.Foreign_Info_Type;
+ Info : Vhdl.Back_End.Foreign_Info_Type;
Ortho : O_Dnode);
subtype F64_C_Arr_Ptr is Grt.Analog_Solver.F64_C_Arr_Ptr;
@@ -258,10 +258,10 @@ package body Ghdlrun is
renames Ortho_Jit.Set_Address;
procedure Foreign_Hook (Decl : Iir;
- Info : Translation.Foreign_Info_Type;
+ Info : Vhdl.Back_End.Foreign_Info_Type;
Ortho : O_Dnode)
is
- use Translation;
+ use Vhdl.Back_End;
Res : Address;
begin
case Info.Kind is
@@ -867,6 +867,6 @@ package body Ghdlrun is
Ortho_Jit.Disp_Help'Access);
Ghdlcomp.Register_Commands;
Register_Command (new Command_Run_Help);
- Trans_Be.Register_Translation_Back_End;
+ Translation.Register_Translation_Back_End;
end Register_Commands;
end Ghdlrun;
diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb
index 88effc3c1..469fc7327 100644
--- a/src/vhdl/translate/ortho_front.adb
+++ b/src/vhdl/translate/ortho_front.adb
@@ -23,10 +23,13 @@ with Hash;
with Interning;
with Flags;
with Libraries;
+
with Vhdl.Nodes; use Vhdl.Nodes;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Std_Package;
with Vhdl.Configuration;
+with Vhdl.Back_End;
+
with Translation;
with Vhdl.Sem;
with Vhdl.Sem_Lib; use Vhdl.Sem_Lib;
@@ -34,7 +37,6 @@ with Errorout; use Errorout;
with Errorout.Console;
with Vhdl.Errors; use Vhdl.Errors;
with Bug;
-with Trans_Be;
with Options; use Options;
package body Ortho_Front is
@@ -85,7 +87,7 @@ package body Ortho_Front is
Errorout.Console.Install_Handler;
-- Initialize.
- Trans_Be.Register_Translation_Back_End;
+ Translation.Register_Translation_Back_End;
Options.Initialize;
@@ -451,10 +453,10 @@ package body Ortho_Front is
Equal => Shlib_Equal);
procedure Sem_Foreign_Hook
- (Decl : Iir; Info : Translation.Foreign_Info_Type)
+ (Decl : Iir; Info : Vhdl.Back_End.Foreign_Info_Type)
is
pragma Unreferenced (Decl);
- use Translation;
+ use Vhdl.Back_End;
begin
case Info.Kind is
when Foreign_Vhpidirect =>
@@ -579,7 +581,7 @@ package body Ortho_Front is
end if;
-- Be sure to collect libraries used for vhpidirect.
- Trans_Be.Sem_Foreign_Hook := Sem_Foreign_Hook'Access;
+ Vhdl.Back_End.Sem_Foreign_Hook := Sem_Foreign_Hook'Access;
Shlib_Interning.Init;
Config := Vhdl.Configuration.Configure
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index e105dc6ab..27e556609 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -20,6 +20,7 @@ with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Sem_Inst;
with Vhdl.Nodes_Meta;
with Vhdl.Utils; use Vhdl.Utils;
+with Vhdl.Back_End;
with Trans.Chap3;
with Trans.Chap4;
with Trans.Chap5;
@@ -216,6 +217,7 @@ package body Trans.Chap2 is
procedure Translate_Subprogram_Declaration (Spec : Iir)
is
+ use Vhdl.Back_End;
Info : constant Subprg_Info_Acc := Get_Info (Spec);
Is_Func : constant Boolean :=
Get_Kind (Spec) = Iir_Kind_Function_Declaration;
diff --git a/src/vhdl/translate/trans_be.adb b/src/vhdl/translate/trans_be.adb
deleted file mode 100644
index 1c7bd9f0b..000000000
--- a/src/vhdl/translate/trans_be.adb
+++ /dev/null
@@ -1,75 +0,0 @@
--- Back-end for translation.
--- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of the GNU General Public License as published by
--- the Free Software Foundation, either version 2 of the License, or
--- (at your option) any later version.
---
--- This program is distributed in the hope that it will be useful,
--- but WITHOUT ANY WARRANTY; without even the implied warranty of
--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
--- GNU General Public License for more details.
---
--- You should have received a copy of the GNU General Public License
--- along with this program. If not, see <gnu.org/licenses>.
-
-with Simple_IO;
-with Vhdl.Errors; use Vhdl.Errors;
-with Vhdl.Back_End;
-
-package body Trans_Be is
- procedure Sem_Foreign (Decl : Iir)
- is
- use Translation;
- Fi : Foreign_Info_Type;
- begin
- case Get_Kind (Decl) is
- when Iir_Kind_Architecture_Body =>
- Error_Msg_Sem (+Decl, "FOREIGN architectures are not yet handled");
- when Iir_Kind_Procedure_Declaration
- | Iir_Kind_Function_Declaration =>
- null;
- when others =>
- Error_Kind ("sem_foreign", Decl);
- end case;
- -- Let it generate error messages.
- Fi := Translate_Foreign_Id (Decl);
-
- if Sem_Foreign_Hook /= null then
- Sem_Foreign_Hook.all (Decl, Fi);
- end if;
- end Sem_Foreign;
-
- function Parse_Option (Opt : String) return Boolean is
- begin
- if Opt = "--dump-drivers" then
- Translation.Flag_Dump_Drivers := True;
- elsif Opt = "--no-direct-drivers" then
- Translation.Flag_Direct_Drivers := False;
- elsif Opt = "--no-range-checks" then
- Translation.Flag_Range_Checks := False;
- elsif Opt = "--no-index-checks" then
- Translation.Flag_Index_Checks := False;
- elsif Opt = "--no-identifiers" then
- Translation.Flag_Discard_Identifiers := True;
- else
- return False;
- end if;
- return True;
- end Parse_Option;
-
- procedure Disp_Option
- is
- procedure P (Str : String) renames Simple_IO.Put_Line;
- begin
- P (" --dump-drivers dump processes drivers");
- end Disp_Option;
-
- procedure Register_Translation_Back_End is
- begin
- Vhdl.Back_End.Sem_Foreign := Sem_Foreign'Access;
- Vhdl.Back_End.Parse_Option := Parse_Option'Access;
- Vhdl.Back_End.Disp_Option := Disp_Option'Access;
- end Register_Translation_Back_End;
-end Trans_Be;
diff --git a/src/vhdl/translate/trans_be.ads b/src/vhdl/translate/trans_be.ads
deleted file mode 100644
index fea171067..000000000
--- a/src/vhdl/translate/trans_be.ads
+++ /dev/null
@@ -1,27 +0,0 @@
--- Back-end for translation.
--- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of the GNU General Public License as published by
--- the Free Software Foundation, either version 2 of the License, or
--- (at your option) any later version.
---
--- This program is distributed in the hope that it will be useful,
--- but WITHOUT ANY WARRANTY; without even the implied warranty of
--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
--- GNU General Public License for more details.
---
--- You should have received a copy of the GNU General Public License
--- along with this program. If not, see <gnu.org/licenses>.
-with Vhdl.Nodes; use Vhdl.Nodes;
-with Translation;
-
-package Trans_Be is
- type Sem_Foreign_Hook_Type is access
- procedure (Decl : Iir; Info : Translation.Foreign_Info_Type);
-
- -- Hook called by Sem_Foreign.
- Sem_Foreign_Hook : Sem_Foreign_Hook_Type := null;
-
- procedure Register_Translation_Back_End;
-end Trans_Be;
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index cbca05a6a..52bdc9df9 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -14,21 +14,23 @@
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
with Interfaces; use Interfaces;
-with Ortho_Nodes; use Ortho_Nodes;
-with Ortho_Ident; use Ortho_Ident;
+
with Flags; use Flags;
with Types; use Types;
with Errorout; use Errorout;
-with Vhdl.Errors; use Vhdl.Errors;
with Name_Table; -- use Name_Table;
-with Str_Table;
with Files_Map;
+with Libraries;
+with Simple_IO;
+
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Std_Package; use Vhdl.Std_Package;
-with Vhdl.Sem_Specs;
-with Libraries;
-with Std_Names;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Canon;
+
+with Ortho_Nodes; use Ortho_Nodes;
+with Ortho_Ident; use Ortho_Ident;
+
with Trans;
with Trans_Decls; use Trans_Decls;
with Trans.Chap1;
@@ -64,130 +66,6 @@ package body Translation is
end if;
end Get_Resolv_Ortho_Decl;
- function Get_String_As_String (Expr : Iir) return String is
- begin
- case Get_Kind (Expr) is
- when Iir_Kind_String_Literal8 =>
- declare
- Len : constant Natural := Natural (Get_String_Length (Expr));
- Id : constant String8_Id := Get_String8_Id (Expr);
- Res : String (1 .. Len);
- begin
- for I in 1 .. Len loop
- Res (I) := Str_Table.Char_String8 (Id, Pos32 (I));
- end loop;
- return Res;
- end;
- when Iir_Kind_Simple_Aggregate =>
- declare
- List : constant Iir_Flist := Get_Simple_Aggregate_List (Expr);
- Len : constant Natural := Get_Nbr_Elements (List);
- Res : String (1 .. Len);
- El : Iir;
- begin
- for I in Flist_First .. Flist_Last (List) loop
- El := Get_Nth_Element (List, I);
- pragma Assert (Get_Kind (El) = Iir_Kind_Enumeration_Literal);
- Res (I - Flist_First + 1) :=
- Character'Val (Get_Enum_Pos (El));
- end loop;
- return Res;
- end;
- when others =>
- if Get_Expr_Staticness (Expr) /= Locally then
- Error_Msg_Sem
- (+Expr, "value of FOREIGN attribute must be locally static");
- return "";
- else
- raise Internal_Error;
- end if;
- end case;
- end Get_String_As_String;
-
- function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type
- is
- -- Look for 'FOREIGN.
- Attr : constant Iir_Attribute_Value :=
- Vhdl.Sem_Specs.Find_Attribute_Value (Decl, Std_Names.Name_Foreign);
- pragma Assert (Attr /= Null_Iir);
- Spec : constant Iir_Attribute_Specification :=
- Get_Attribute_Specification (Attr);
- Name : constant String := Get_String_As_String (Get_Expression (Spec));
- Length : constant Natural := Name'Length;
- begin
- if Length = 0 then
- return Foreign_Bad;
- end if;
-
- pragma Assert (Name'First = 1);
-
- -- Only 'VHPIDIRECT' is recognized.
- if Length >= 10 and then Name (1 .. 10) = "VHPIDIRECT" then
- declare
- Info : Foreign_Info_Type (Foreign_Vhpidirect);
- P : Natural;
- Sf, Sl : Natural;
- Lf, Ll : Natural;
- begin
- P := 11;
-
- -- Skip spaces.
- while P <= Length and then Name (P) = ' ' loop
- P := P + 1;
- end loop;
- if P > Length then
- Error_Msg_Sem
- (+Spec, "missing subprogram/library name after VHPIDIRECT");
- Info.Lib_Len := 0;
- Info.Subprg_Len := 0;
- return Info;
- end if;
- -- Extract library.
- Lf := P;
- while P <= Length and then Name (P) /= ' ' loop
- P := P + 1;
- end loop;
- Ll := P - 1;
- -- Extract subprogram.
- while P <= Length and then Name (P) = ' ' loop
- P := P + 1;
- end loop;
- Sf := P;
- while P <= Length and then Name (P) /= ' ' loop
- P := P + 1;
- end loop;
- Sl := P - 1;
- if P <= Length then
- Error_Msg_Sem (+Spec, "garbage at end of VHPIDIRECT");
- end if;
-
- -- Accept empty library.
- if Sf > Length then
- Sf := Lf;
- Sl := Ll;
- Lf := 1;
- Ll := 0;
- end if;
-
- Info.Lib_Len := Ll - Lf + 1;
- Info.Lib_Name (1 .. Info.Lib_Len) := Name (Lf .. Ll);
-
- Info.Subprg_Len := Sl - Sf + 1;
- Info.Subprg_Name (1 .. Info.Subprg_Len) := Name (Sf .. Sl);
- return Info;
- end;
- elsif Length = 14
- and then Name (1 .. 14) = "GHDL intrinsic"
- then
- return Foreign_Info_Type'(Kind => Foreign_Intrinsic);
- else
- Error_Msg_Sem
- (+Spec,
- "value of 'FOREIGN attribute does not begin with VHPIDIRECT");
- return Foreign_Bad;
- end if;
- end Translate_Foreign_Id;
-
procedure Gen_Filename (Design_File : Iir)
is
Info : Design_File_Info_Acc;
@@ -2222,6 +2100,38 @@ package body Translation is
--Pop_Global_Factory;
end Translate_Standard;
+ function Parse_Option (Opt : String) return Boolean is
+ begin
+ if Opt = "--dump-drivers" then
+ Translation.Flag_Dump_Drivers := True;
+ elsif Opt = "--no-direct-drivers" then
+ Translation.Flag_Direct_Drivers := False;
+ elsif Opt = "--no-range-checks" then
+ Translation.Flag_Range_Checks := False;
+ elsif Opt = "--no-index-checks" then
+ Translation.Flag_Index_Checks := False;
+ elsif Opt = "--no-identifiers" then
+ Translation.Flag_Discard_Identifiers := True;
+ else
+ return False;
+ end if;
+ return True;
+ end Parse_Option;
+
+ procedure Disp_Option
+ is
+ procedure P (Str : String) renames Simple_IO.Put_Line;
+ begin
+ P (" --dump-drivers dump processes drivers");
+ end Disp_Option;
+
+ procedure Register_Translation_Back_End is
+ begin
+ Vhdl.Back_End.Sem_Foreign := Vhdl.Back_End.Sem_Foreign_Wrapper'Access;
+ Vhdl.Back_End.Parse_Option := Parse_Option'Access;
+ Vhdl.Back_End.Disp_Option := Disp_Option'Access;
+ end Register_Translation_Back_End;
+
procedure Finalize is
begin
Free_Node_Infos;
diff --git a/src/vhdl/translate/translation.ads b/src/vhdl/translate/translation.ads
index a91b74d91..376060dfd 100644
--- a/src/vhdl/translate/translation.ads
+++ b/src/vhdl/translate/translation.ads
@@ -14,6 +14,7 @@
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
with Vhdl.Nodes; use Vhdl.Nodes;
+with Vhdl.Back_End;
with Ortho_Nodes;
package Translation is
@@ -77,39 +78,13 @@ package Translation is
-- defined by the value.
Flag_Check_Stack_Allocation : Natural := 32 * 1024;
- type Foreign_Kind_Type is (Foreign_Unknown,
- Foreign_Vhpidirect,
- Foreign_Intrinsic);
-
- type Foreign_Info_Type (Kind : Foreign_Kind_Type := Foreign_Unknown)
- is record
- case Kind is
- when Foreign_Unknown =>
- null;
- when Foreign_Vhpidirect =>
- Lib_Name : String (1 .. 32);
- Lib_Len : Natural;
- Subprg_Name : String (1 .. 64);
- Subprg_Len : Natural;
- when Foreign_Intrinsic =>
- null;
- end case;
- end record;
-
- Foreign_Bad : constant Foreign_Info_Type := (Kind => Foreign_Unknown);
-
- -- Return a foreign_info for DECL.
- -- Can generate error messages, if the attribute expression is ill-formed.
- -- If EXTRACT_NAME is set, internal fields of foreign_info are set.
- -- Otherwise, only KIND discriminent is set.
- -- EXTRACT_NAME should be set only inside translation itself, since the
- -- name can be based on the prefix.
- function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type;
+ procedure Register_Translation_Back_End;
-- If not null, this procedure is called when a foreign subprogram is
-- created.
- type Foreign_Hook_Access is access procedure (Decl : Iir;
- Info : Foreign_Info_Type;
- Ortho : Ortho_Nodes.O_Dnode);
+ type Foreign_Hook_Access is access
+ procedure (Decl : Iir;
+ Info : Vhdl.Back_End.Foreign_Info_Type;
+ Ortho : Ortho_Nodes.O_Dnode);
Foreign_Hook : Foreign_Hook_Access := null;
end Translation;
diff --git a/src/vhdl/vhdl-back_end.adb b/src/vhdl/vhdl-back_end.adb
new file mode 100644
index 000000000..1a0449ec0
--- /dev/null
+++ b/src/vhdl/vhdl-back_end.adb
@@ -0,0 +1,169 @@
+-- Back-end specialization
+-- Copyright (C) 2023 Tristan Gingold
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <gnu.org/licenses>.
+
+with Types; use Types;
+with Str_Table;
+with Std_Names;
+
+with Vhdl.Errors; use Vhdl.Errors;
+with Vhdl.Sem_Specs;
+
+package body Vhdl.Back_End is
+ function Get_String_As_String (Expr : Iir) return String is
+ begin
+ case Get_Kind (Expr) is
+ when Iir_Kind_String_Literal8 =>
+ declare
+ Len : constant Natural := Natural (Get_String_Length (Expr));
+ Id : constant String8_Id := Get_String8_Id (Expr);
+ Res : String (1 .. Len);
+ begin
+ for I in 1 .. Len loop
+ Res (I) := Str_Table.Char_String8 (Id, Pos32 (I));
+ end loop;
+ return Res;
+ end;
+ when Iir_Kind_Simple_Aggregate =>
+ declare
+ List : constant Iir_Flist := Get_Simple_Aggregate_List (Expr);
+ Len : constant Natural := Get_Nbr_Elements (List);
+ Res : String (1 .. Len);
+ El : Iir;
+ begin
+ for I in Flist_First .. Flist_Last (List) loop
+ El := Get_Nth_Element (List, I);
+ pragma Assert (Get_Kind (El) = Iir_Kind_Enumeration_Literal);
+ Res (I - Flist_First + 1) :=
+ Character'Val (Get_Enum_Pos (El));
+ end loop;
+ return Res;
+ end;
+ when others =>
+ if Get_Expr_Staticness (Expr) /= Locally then
+ Error_Msg_Sem
+ (+Expr, "value of FOREIGN attribute must be locally static");
+ return "";
+ else
+ raise Internal_Error;
+ end if;
+ end case;
+ end Get_String_As_String;
+
+ function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type
+ is
+ -- Look for 'FOREIGN.
+ Attr : constant Iir_Attribute_Value :=
+ Vhdl.Sem_Specs.Find_Attribute_Value (Decl, Std_Names.Name_Foreign);
+ pragma Assert (Attr /= Null_Iir);
+ Spec : constant Iir_Attribute_Specification :=
+ Get_Attribute_Specification (Attr);
+ Name : constant String := Get_String_As_String (Get_Expression (Spec));
+ Length : constant Natural := Name'Length;
+ begin
+ if Length = 0 then
+ return Foreign_Bad;
+ end if;
+
+ pragma Assert (Name'First = 1);
+
+ -- Only 'VHPIDIRECT' is recognized.
+ if Length >= 10 and then Name (1 .. 10) = "VHPIDIRECT" then
+ declare
+ Info : Foreign_Info_Type (Foreign_Vhpidirect);
+ P : Natural;
+ Sf, Sl : Natural;
+ Lf, Ll : Natural;
+ begin
+ P := 11;
+
+ -- Skip spaces.
+ while P <= Length and then Name (P) = ' ' loop
+ P := P + 1;
+ end loop;
+ if P > Length then
+ Error_Msg_Sem
+ (+Spec, "missing subprogram/library name after VHPIDIRECT");
+ Info.Lib_Len := 0;
+ Info.Subprg_Len := 0;
+ return Info;
+ end if;
+ -- Extract library.
+ Lf := P;
+ while P <= Length and then Name (P) /= ' ' loop
+ P := P + 1;
+ end loop;
+ Ll := P - 1;
+ -- Extract subprogram.
+ while P <= Length and then Name (P) = ' ' loop
+ P := P + 1;
+ end loop;
+ Sf := P;
+ while P <= Length and then Name (P) /= ' ' loop
+ P := P + 1;
+ end loop;
+ Sl := P - 1;
+ if P <= Length then
+ Error_Msg_Sem (+Spec, "garbage at end of VHPIDIRECT");
+ end if;
+
+ -- Accept empty library.
+ if Sf > Length then
+ Sf := Lf;
+ Sl := Ll;
+ Lf := 1;
+ Ll := 0;
+ end if;
+
+ Info.Lib_Len := Ll - Lf + 1;
+ Info.Lib_Name (1 .. Info.Lib_Len) := Name (Lf .. Ll);
+
+ Info.Subprg_Len := Sl - Sf + 1;
+ Info.Subprg_Name (1 .. Info.Subprg_Len) := Name (Sf .. Sl);
+ return Info;
+ end;
+ elsif Length = 14
+ and then Name (1 .. 14) = "GHDL intrinsic"
+ then
+ return Foreign_Info_Type'(Kind => Foreign_Intrinsic);
+ else
+ Error_Msg_Sem
+ (+Spec,
+ "value of 'FOREIGN attribute does not begin with VHPIDIRECT");
+ return Foreign_Bad;
+ end if;
+ end Translate_Foreign_Id;
+
+ procedure Sem_Foreign_Wrapper (Decl : Iir)
+ is
+ Fi : Foreign_Info_Type;
+ begin
+ case Get_Kind (Decl) is
+ when Iir_Kind_Architecture_Body =>
+ Error_Msg_Sem (+Decl, "FOREIGN architectures are not yet handled");
+ when Iir_Kind_Procedure_Declaration
+ | Iir_Kind_Function_Declaration =>
+ null;
+ when others =>
+ Error_Kind ("sem_foreign", Decl);
+ end case;
+ -- Let it generate error messages.
+ Fi := Translate_Foreign_Id (Decl);
+
+ if Sem_Foreign_Hook /= null then
+ Sem_Foreign_Hook.all (Decl, Fi);
+ end if;
+ end Sem_Foreign_Wrapper;
+end Vhdl.Back_End;
diff --git a/src/vhdl/vhdl-back_end.ads b/src/vhdl/vhdl-back_end.ads
index d190d6347..275166a9f 100644
--- a/src/vhdl/vhdl-back_end.ads
+++ b/src/vhdl/vhdl-back_end.ads
@@ -29,4 +29,40 @@ package Vhdl.Back_End is
-- May be NULL for no additionnal checks.
type Sem_Foreign_Acc is access procedure (Decl : Iir);
Sem_Foreign : Sem_Foreign_Acc := null;
+
+ -- Utils for foreign analysis.
+
+ type Foreign_Kind_Type is (Foreign_Unknown,
+ Foreign_Vhpidirect,
+ Foreign_Intrinsic);
+
+ type Foreign_Info_Type (Kind : Foreign_Kind_Type := Foreign_Unknown)
+ is record
+ case Kind is
+ when Foreign_Unknown =>
+ null;
+ when Foreign_Vhpidirect =>
+ Lib_Name : String (1 .. 32);
+ Lib_Len : Natural;
+ Subprg_Name : String (1 .. 64);
+ Subprg_Len : Natural;
+ when Foreign_Intrinsic =>
+ null;
+ end case;
+ end record;
+
+ Foreign_Bad : constant Foreign_Info_Type := (Kind => Foreign_Unknown);
+
+ -- Return a foreign_info for DECL.
+ -- Can generate error messages, if the attribute expression is ill-formed.
+ function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type;
+
+ -- Wrapper for Sem_Foreign: call the hook.
+ procedure Sem_Foreign_Wrapper (Decl : Iir);
+
+ type Sem_Foreign_Hook_Type is access
+ procedure (Decl : Iir; Info : Vhdl.Back_End.Foreign_Info_Type);
+
+ -- Hook called by Sem_Foreign.
+ Sem_Foreign_Hook : Sem_Foreign_Hook_Type := null;
end Vhdl.Back_End;
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-25 17:46:03 +0000