aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl')
-rw-r--r--src/vhdl/translate/ortho_front.adb128
-rw-r--r--src/vhdl/translate/trans-chap12.adb72
-rw-r--r--src/vhdl/translate/trans-chap12.ads7
-rw-r--r--src/vhdl/translate/trans_be.adb7
-rw-r--r--src/vhdl/translate/trans_be.ads10
-rw-r--r--src/vhdl/translate/translation.adb5
-rw-r--r--src/vhdl/translate/translation.ads4
7 files changed, 144 insertions, 89 deletions
diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb
index 041eae45e..208348ef4 100644
--- a/src/vhdl/translate/ortho_front.adb
+++ b/src/vhdl/translate/ortho_front.adb
@@ -15,8 +15,13 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
+with System;
+with Interfaces.C_Streams;
+
with Types; use Types;
with Name_Table;
+with Hash;
+with Interning;
with Iirs; use Iirs;
with Libraries;
with Iirs_Utils; use Iirs_Utils;
@@ -397,6 +402,117 @@ package body Ortho_Front is
Libraries.Save_Work_Library;
end Do_Compile;
+ -- Table of libraries gathered from vhpidirect.
+ function Shlib_Build (Name : String) return String_Acc is
+ begin
+ return new String'(Name);
+ end Shlib_Build;
+
+ function Shlib_Equal (Obj : String_Acc; Param : String) return Boolean is
+ begin
+ return Obj.all = Param;
+ end Shlib_Equal;
+
+ package Shlib_Interning is new Interning
+ (Params_Type => String,
+ Object_Type => String_Acc,
+ Hash => Hash.String_Hash,
+ Build => Shlib_Build,
+ Equal => Shlib_Equal);
+
+ procedure Sem_Foreign_Hook
+ (Decl : Iir; Info : Translation.Foreign_Info_Type)
+ is
+ pragma Unreferenced (Decl);
+ use Translation;
+ begin
+ case Info.Kind is
+ when Foreign_Vhpidirect =>
+ declare
+ Lib : constant String :=
+ Info.Lib_Name (1 .. Info.Lib_Len);
+ Shlib : String_Acc;
+ pragma Unreferenced (Shlib);
+ begin
+ if Info.Lib_Len /= 0 and then Lib /= "null" then
+ Shlib := Shlib_Interning.Get (Lib);
+ end if;
+ end;
+ when Foreign_Intrinsic =>
+ null;
+ when Foreign_Unknown =>
+ null;
+ end case;
+ end Sem_Foreign_Hook;
+
+ -- Write to file FILELIST all the files that are needed to link the design.
+ procedure Write_File_List (Filelist : String)
+ is
+ use Interfaces.C_Streams;
+ use System;
+ use Configuration;
+ use Name_Table;
+
+ Nul : constant Character := Character'Val (0);
+ Fname : String := Filelist & Nul;
+ Mode : constant String := "wt" & Nul;
+ F : FILEs;
+ R : int;
+ S : size_t;
+ pragma Unreferenced (R, S); -- FIXME
+ Id : Name_Id;
+ Lib : Iir_Library_Declaration;
+ File : Iir_Design_File;
+ Unit : Iir_Design_Unit;
+ begin
+ F := fopen (Fname'Address, Mode'Address);
+ if F = NULL_Stream then
+ Error_Msg_Elab ("cannot open " & Filelist);
+ return;
+ end if;
+
+ -- Clear elab flags on design files.
+ for I in Design_Units.First .. Design_Units.Last loop
+ Unit := Design_Units.Table (I);
+ File := Get_Design_File (Unit);
+ Set_Elab_Flag (File, False);
+ end loop;
+
+ for J in Design_Units.First .. Design_Units.Last loop
+ Unit := Design_Units.Table (J);
+ File := Get_Design_File (Unit);
+ if not Get_Elab_Flag (File) then
+ Set_Elab_Flag (File, True);
+
+ -- Write '>LIBRARY_DIRECTORY'.
+ Lib := Get_Library (File);
+ R := fputc (Character'Pos ('>'), F);
+ Id := Get_Library_Directory (Lib);
+ S := fwrite (Get_Address (Id),
+ size_t (Get_Name_Length (Id)), 1, F);
+ R := fputc (10, F);
+
+ -- Write 'FILENAME'.
+ Id := Get_Design_File_Filename (File);
+ S := fwrite (Get_Address (Id),
+ size_t (Get_Name_Length (Id)), 1, F);
+ R := fputc (10, F);
+ end if;
+ end loop;
+
+ for I in Shlib_Interning.First_Index .. Shlib_Interning.Last_Index loop
+ declare
+ Str : constant String_Acc := Shlib_Interning.Get_By_Index (I);
+ begin
+ R := fputc (Character'Pos ('+'), F);
+ S := fwrite (Str.all'Address, size_t (Str'Length), 1, F);
+ R := fputc (10, F);
+ end;
+ end loop;
+
+ R := fclose (F);
+ end Write_File_List;
+
Nbr_Parse : Natural := 0;
function Parse (Filename : String_Acc) return Boolean
@@ -429,13 +545,21 @@ package body Ortho_Front is
Error_Msg_Option ("missing -l for --elab");
raise Option_Error;
end if;
+
+ -- Be sure to collect libraries used for vhpidirect.
+ Trans_Be.Sem_Foreign_Hook := Sem_Foreign_Hook'Access;
+ Shlib_Interning.Init;
+
Config := Configuration.Configure
(Elab_Entity.all, Elab_Architecture.all);
if Errorout.Nbr_Errors > 0 then
-- This may happen (bad entity for example).
raise Compilation_Error;
end if;
- Translation.Elaborate (Config, Elab_Filelist.all, False);
+
+ Translation.Elaborate (Config, False);
+
+ Write_File_List (Elab_Filelist.all);
if Errorout.Nbr_Errors > 0 then
-- This may happen (bad entity for example).
@@ -482,7 +606,7 @@ package body Ortho_Front is
Flags.Flag_Only_Elab_Warnings := False;
Config := Configuration.Configure
(Elab_Entity.all, Elab_Architecture.all);
- Translation.Elaborate (Config, "", True);
+ Translation.Elaborate (Config, True);
if Errorout.Nbr_Errors > 0 then
-- This may happen (bad entity for example).
diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb
index 387c80863..1e39d3456 100644
--- a/src/vhdl/translate/trans-chap12.adb
+++ b/src/vhdl/translate/trans-chap12.adb
@@ -16,13 +16,10 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with System;
with Configuration;
-with Interfaces.C_Streams;
with Errorout; use Errorout;
with Std_Package; use Std_Package;
with Iirs_Utils; use Iirs_Utils;
-with Name_Table;
with Libraries;
with Flags;
with Sem;
@@ -528,72 +525,10 @@ package body Trans.Chap12 is
end loop;
end Gen_Stubs;
- -- Write to file FILELIST all the files that are needed to link the design.
- procedure Write_File_List (Filelist : String)
- is
- use Interfaces.C_Streams;
- use System;
- use Configuration;
- use Name_Table;
-
- Nul : constant Character := Character'Val (0);
- Fname : String := Filelist & Nul;
- Mode : constant String := "wt" & Nul;
- F : FILEs;
- R : int;
- S : size_t;
- pragma Unreferenced (R, S); -- FIXME
- Id : Name_Id;
- Lib : Iir_Library_Declaration;
- File : Iir_Design_File;
- Unit : Iir_Design_Unit;
- begin
- F := fopen (Fname'Address, Mode'Address);
- if F = NULL_Stream then
- Error_Msg_Elab ("cannot open " & Filelist);
- return;
- end if;
-
- -- Clear elab flags on design files.
- for I in Design_Units.First .. Design_Units.Last loop
- Unit := Design_Units.Table (I);
- File := Get_Design_File (Unit);
- Set_Elab_Flag (File, False);
- end loop;
-
- for J in Design_Units.First .. Design_Units.Last loop
- Unit := Design_Units.Table (J);
- File := Get_Design_File (Unit);
- if not Get_Elab_Flag (File) then
- Set_Elab_Flag (File, True);
-
- -- Write '>LIBRARY_DIRECTORY'.
- Lib := Get_Library (File);
- R := fputc (Character'Pos ('>'), F);
- Id := Get_Library_Directory (Lib);
- S := fwrite (Get_Address (Id),
- size_t (Get_Name_Length (Id)), 1, F);
- R := fputc (10, F);
-
- -- Write 'FILENAME'.
- Id := Get_Design_File_Filename (File);
- S := fwrite (Get_Address (Id),
- size_t (Get_Name_Length (Id)), 1, F);
- R := fputc (10, F);
- end if;
- end loop;
-
- R := fclose (F);
- end Write_File_List;
-
- procedure Elaborate (Config : Iir_Design_Unit;
- Filelist : String;
- Whole : Boolean)
+ procedure Elaborate (Config : Iir_Design_Unit; Whole : Boolean)
is
use Configuration;
- Has_Filelist : constant Boolean := Filelist /= "";
-
Unit : Iir_Design_Unit;
Lib_Unit : Iir;
Config_Lib : Iir_Configuration_Declaration;
@@ -751,11 +686,6 @@ package body Trans.Chap12 is
Gen_Stubs;
end if;
- -- Write the file containing the list of object files.
- if Has_Filelist then
- Write_File_List (Filelist);
- end if;
-
-- Disp list of files needed.
if Flags.Verbose then
Report_Msg (Msgid_Note, Elaboration, No_Location,
diff --git a/src/vhdl/translate/trans-chap12.ads b/src/vhdl/translate/trans-chap12.ads
index a0db62399..248b7851d 100644
--- a/src/vhdl/translate/trans-chap12.ads
+++ b/src/vhdl/translate/trans-chap12.ads
@@ -23,11 +23,6 @@ package Trans.Chap12 is
-- Generate ortho code to elaborate declaration of the top unit.
procedure Call_Elab_Decls (Arch : Iir; Arch_Instance : O_Enode);
- -- Write to file FILELIST all the files that are needed to link the design.
- procedure Write_File_List (Filelist : String);
-
-- Generate elaboration code for CONFIG.
- procedure Elaborate (Config : Iir_Design_Unit;
- Filelist : String;
- Whole : Boolean);
+ procedure Elaborate (Config : Iir_Design_Unit; Whole : Boolean);
end Trans.Chap12;
diff --git a/src/vhdl/translate/trans_be.adb b/src/vhdl/translate/trans_be.adb
index 699c1e55e..e3f8e20da 100644
--- a/src/vhdl/translate/trans_be.adb
+++ b/src/vhdl/translate/trans_be.adb
@@ -15,8 +15,6 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Iirs; use Iirs;
-with Translation;
with Errorout; use Errorout;
with Ada.Text_IO;
with Back_End;
@@ -26,7 +24,6 @@ package body Trans_Be is
is
use Translation;
Fi : Foreign_Info_Type;
- pragma Unreferenced (Fi);
begin
case Get_Kind (Decl) is
when Iir_Kind_Architecture_Body =>
@@ -39,6 +36,10 @@ package body Trans_Be is
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
diff --git a/src/vhdl/translate/trans_be.ads b/src/vhdl/translate/trans_be.ads
index 9ff06031b..95cf04c1a 100644
--- a/src/vhdl/translate/trans_be.ads
+++ b/src/vhdl/translate/trans_be.ads
@@ -15,7 +15,15 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
+with Iirs; use Iirs;
+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 fd68e2f84..9dab1243b 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -2130,8 +2130,7 @@ package body Translation is
Free_Old_Temp;
end Finalize;
- procedure Elaborate (Config : Iir;
- Filelist : String;
- Whole : Boolean) renames Trans.Chap12.Elaborate;
+ procedure Elaborate (Config : Iir; Whole : Boolean)
+ renames Trans.Chap12.Elaborate;
end Translation;
diff --git a/src/vhdl/translate/translation.ads b/src/vhdl/translate/translation.ads
index ffaabd3bf..ca8877ad7 100644
--- a/src/vhdl/translate/translation.ads
+++ b/src/vhdl/translate/translation.ads
@@ -42,9 +42,7 @@ package Translation is
-- Generate elaboration code for CONFIG. Also use units from Configure
-- package.
- procedure Elaborate (Config : Iir;
- Filelist : String;
- Whole : Boolean);
+ procedure Elaborate (Config : Iir; Whole : Boolean);
-- If set, generate Run-Time Information nodes.
Flag_Rti : Boolean := True;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 11:51:04 +0000