vhdl: supports VHPIDIRECT in mcode backend.

src: add hash.ad[sb], interning.ad[sb]
Automatically link with vhpidirect libraries.

14 files changed, 473 insertions, 99 deletions

diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb
index e77bfb8f4..cdec0eca6 100644
--- a/src/ghdldrv/ghdldrv.adb
+++ b/src/ghdldrv/ghdldrv.adb
@@ -315,6 +315,7 @@ package body Ghdldrv is
       Free (Obj_File);
    end Do_Compile;
 
+   --  Table of files to be linked.
    package Filelist is new Tables
      (Table_Component_Type => String_Access,
       Table_Index_Type => Natural,
@@ -383,6 +384,9 @@ package body Ghdldrv is
             if Line (1) = '>' then
                Dir_Len := L - 1;
                Dir (1 .. Dir_Len) := Line (2 .. L);
+            elsif Line (1) = '+' then
+               File := new String'(Line (2 .. L));
+               Filelist.Append (File);
             else
                if To_Obj then
                   File := new String'(Dir (1 .. Dir_Len)
@@ -392,8 +396,7 @@ package body Ghdldrv is
                   File := new String'(Substitute (Line (1 .. L)));
                end if;
 
-               Filelist.Increment_Last;
-               Filelist.Table (Filelist.Last) := File;
+               Filelist.Append (File);
 
                Dir_Len := 0;
             end if;
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index 3501bb692..fbe10c5d3 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -44,12 +44,15 @@ with Ieee.Std_Logic_1164;
 
 with Lists;
 with Str_Table;
+with Hash;
+with Interning;
 with Nodes;
 with Files_Map;
 with Name_Table;
 
 with Grt.Main;
 with Grt.Modules;
+with Grt.Dynload; use Grt.Dynload;
 with Grt.Lib;
 with Grt.Processes;
 with Grt.Rtis;
@@ -80,6 +83,36 @@ package body Ghdlrun is
    --  Default elaboration mode is dynamic.
    Elab_Mode : constant Elab_Mode_Type := Elab_Dynamic;
 
+   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 : Translation.Foreign_Info_Type;
                            Ortho : O_Dnode);
@@ -103,6 +136,7 @@ package body Ghdlrun is
       end if;
 
       Translation.Foreign_Hook := Foreign_Hook'Access;
+      Shlib_Interning.Init;
 
       --  FIXME: add a flag to force unnesting.
       --  Translation.Flag_Unnest_Subprograms := True;
@@ -174,7 +208,7 @@ package body Ghdlrun is
          when Elab_Static =>
             raise Program_Error;
          when Elab_Dynamic =>
-            Translation.Elaborate (Config, "", True);
+            Translation.Elaborate (Config, True);
       end case;
 
       if Errorout.Nbr_Errors > 0 then
@@ -241,14 +275,43 @@ package body Ghdlrun is
             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
-               Res := Foreigns.Find_Foreign (Name);
-               if Res /= Null_Address then
-                  Def (Ortho, Res);
+               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
-                  Error_Msg_Sem
-                    (+Decl, "unknown foreign VHPIDIRECT '" & Name & "'");
+                  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 =>
 
diff --git a/src/hash.adb b/src/hash.adb
new file mode 100644
index 000000000..194a378dd
--- /dev/null
+++ b/src/hash.adb
@@ -0,0 +1,30 @@
+--  Hash.
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  GHDL 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, or (at your option) any later
+--  version.
+--
+--  GHDL 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package body Hash is
+   function String_Hash (Key : String) return Hash_Value_Type
+   is
+      Res : Hash_Value_Type;
+   begin
+      Res := 0;
+      for I in Key'Range loop
+         Res := Res * 5 + Character'Pos (Key (I));
+      end loop;
+      return Res;
+   end String_Hash;
+end Hash;
diff --git a/src/hash.ads b/src/hash.ads
new file mode 100644
index 000000000..839099dd2
--- /dev/null
+++ b/src/hash.ads
@@ -0,0 +1,26 @@
+--  Hash.
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  GHDL 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, or (at your option) any later
+--  version.
+--
+--  GHDL 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Types; use Types;
+
+package Hash is
+   type Hash_Value_Type is new Uns32;
+
+   --  A simple hash function for strings.
+   function String_Hash (Key : String) return Hash_Value_Type;
+end Hash;
diff --git a/src/interning.adb b/src/interning.adb
new file mode 100644
index 000000000..66aedf903
--- /dev/null
+++ b/src/interning.adb
@@ -0,0 +1,140 @@
+--  Type interning - set of unique objects.
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  GHDL 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, or (at your option) any later
+--  version.
+--
+--  GHDL 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Ada.Unchecked_Deallocation;
+with Dyn_Tables;
+
+package body Interning is
+   type Element_Wrapper is record
+      Hash : Hash_Value_Type;
+      Next : Index_Type;
+      Obj  : Object_Type;
+   end record;
+
+   package Wrapper_Tables is new Dyn_Tables
+     (Table_Index_Type => Index_Type,
+      Table_Component_Type => Element_Wrapper,
+      Table_Low_Bound => No_Index + 1,
+      Table_Initial => 128);
+
+   type Hash_Array is array (Hash_Value_Type range <>) of Index_Type;
+   type Hash_Array_Acc is access Hash_Array;
+
+   Initial_Size : constant Hash_Value_Type := 1024;
+
+   Size : Hash_Value_Type;
+   Hash_Table : Hash_Array_Acc;
+   Els : Wrapper_Tables.Instance;
+
+   procedure Deallocate is new Ada.Unchecked_Deallocation
+     (Hash_Array, Hash_Array_Acc);
+
+   procedure Init is
+   begin
+      Size := Initial_Size;
+      Hash_Table := new Hash_Array'(0 .. Initial_Size - 1 => No_Index);
+      Wrapper_Tables.Init (Els);
+      pragma Assert (Wrapper_Tables.Last (Els) = No_Index);
+   end Init;
+
+   --  Expand the hash table (double the size).
+   procedure Expand
+   is
+      Old_Hash_Table : Hash_Array_Acc;
+      Idx : Index_Type;
+   begin
+      Old_Hash_Table := Hash_Table;
+      Size := Size * 2;
+      Hash_Table := new Hash_Array'(0 .. Size - 1 => No_Index);
+
+      --  Rehash.
+      for I in Old_Hash_Table'Range loop
+         Idx := Old_Hash_Table (I);
+         while Idx /= No_Index loop
+            --  Note: collisions are put in reverse order.
+            declare
+               Ent : Element_Wrapper renames Els.Table (Idx);
+               Hash_Index : constant Hash_Value_Type :=
+                 Ent.Hash and (Size - 1);
+               Next_Idx : constant Index_Type := Ent.Next;
+            begin
+               Ent.Next := Hash_Table (Hash_Index);
+               Hash_Table (Hash_Index) := Idx;
+               Idx := Next_Idx;
+            end;
+         end loop;
+      end loop;
+
+      Deallocate (Old_Hash_Table);
+   end Expand;
+
+   function Get (Params : Params_Type) return Object_Type
+   is
+      Hash_Value : Hash_Value_Type;
+      Hash_Index : Hash_Value_Type;
+      Idx : Index_Type;
+      Res : Object_Type;
+   begin
+      --  Check if the package was initialized.
+      pragma Assert (Hash_Table /= null);
+
+      Hash_Value := Hash (Params);
+      Hash_Index := Hash_Value and (Size - 1);
+
+      Idx := Hash_Table (Hash_Index);
+      while Idx /= No_Index loop
+         declare
+            E : Element_Wrapper renames Els.Table (Idx);
+         begin
+            if E.Hash = Hash_Value and then Equal (E.Obj, Params) then
+               return E.Obj;
+            end if;
+            Idx := E.Next;
+         end;
+      end loop;
+
+      --  Maybe expand the table.
+      if Hash_Value_Type (Wrapper_Tables.Last (Els)) > 2 * Size then
+         Expand;
+
+         --  Recompute hash index.
+         Hash_Index := Hash_Value and (Size - 1);
+      end if;
+
+      Res := Build (Params);
+
+      --  Insert.
+      Wrapper_Tables.Append (Els,
+                             (Hash => Hash_Value,
+                              Next => Hash_Table (Hash_Index),
+                              Obj => Res));
+      Hash_Table (Hash_Index) := Wrapper_Tables.Last (Els);
+      return Res;
+   end Get;
+
+   function Last_Index return Index_Type is
+   begin
+      return Wrapper_Tables.Last (Els);
+   end Last_Index;
+
+   function Get_By_Index (Index : Index_Type) return Object_Type is
+   begin
+      pragma Assert (Index <= Wrapper_Tables.Last (Els));
+      return Els.Table (Index).Obj;
+   end Get_By_Index;
+end Interning;
diff --git a/src/interning.ads b/src/interning.ads
new file mode 100644
index 000000000..70573022e
--- /dev/null
+++ b/src/interning.ads
@@ -0,0 +1,59 @@
+--  Type interning - set of unique objects.
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  GHDL 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, or (at your option) any later
+--  version.
+--
+--  GHDL 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+with Types; use Types;
+with Hash; use Hash;
+
+--  This generic package provides a factory to build unique objects.
+--  Get will return an existing object or create a new one.
+generic
+   --  Parameters of the object to be created.
+   type Params_Type (<>) is private;
+
+   --  Object to be built and stored.
+   type Object_Type is private;
+
+   --  Reduce PARAMS to a small value.
+   --  The required property is: Hash(P1) /= Hash(P2) => P1 /= P2.
+   with function Hash (Params : Params_Type) return Hash_Value_Type;
+
+   --  Create an object from PARAMS.
+   with function Build (Params : Params_Type) return Object_Type;
+
+   --  Return True iff OBJ is the object corresponding to PARAMS.
+   with function Equal (Obj : Object_Type; Params : Params_Type)
+                       return Boolean;
+package Interning is
+   --  Initialize.  Required before any other operation.
+   procedure Init;
+
+   --  If there is already an existing object for PARAMS, return it.
+   --  Otherwise create it.
+   function Get (Params : Params_Type) return Object_Type;
+
+   type Index_Type is new Uns32;
+   No_Index : constant Index_Type := 0;
+   First_Index : constant Index_Type := 1;
+
+   --  Get the number of elements in the table.
+   function Last_Index return Index_Type;
+
+   --  Get an element by index.  The index has no real meaning, but the
+   --  current implementation allocates index incrementally.
+   function Get_By_Index (Index : Index_Type) return Object_Type;
+end Interning;
diff --git a/src/types.ads b/src/types.ads
index 3cf273bd8..2c59f583b 100644
--- a/src/types.ads
+++ b/src/types.ads
@@ -177,6 +177,4 @@ package Types is
 
    --  Result of a comparaison of two numeric values.
    type Order_Type is (Less, Equal, Greater);
-
-   subtype Hash_Value_Type is Uns32;
 end Types;
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;