bugs fixed

3 files changed, 119 insertions, 14 deletions

diff --git a/translate/ghdldrv/foreigns.adb b/translate/ghdldrv/foreigns.adb
new file mode 100644
index 000000000..15e3dd009
--- /dev/null
+++ b/translate/ghdldrv/foreigns.adb
@@ -0,0 +1,64 @@
+with Interfaces.C; use Interfaces.C;
+
+package body Foreigns is
+   function Sin (Arg : double) return double;
+   pragma Import (C, Sin);
+
+   function Log (Arg : double) return double;
+   pragma Import (C, Log);
+
+   function Exp (Arg : double) return double;
+   pragma Import (C, Exp);
+
+   function Sqrt (Arg : double) return double;
+   pragma Import (C, Sqrt);
+
+   function Asin (Arg : double) return double;
+   pragma Import (C, Asin);
+
+   function Acos (Arg : double) return double;
+   pragma Import (C, Acos);
+
+   function Asinh (Arg : double) return double;
+   pragma Import (C, Asinh);
+
+   function Acosh (Arg : double) return double;
+   pragma Import (C, Acosh);
+
+   function Atanh (X : double) return double;
+   pragma Import (C, Atanh);
+
+   function Atan2 (X, Y : double) return double;
+   pragma Import (C, Atan2);
+
+   type String_Cacc is access constant String;
+   type Foreign_Record is record
+      Name : String_Cacc;
+      Addr : Address;
+   end record;
+
+
+   Foreign_Arr : constant array (Natural range <>) of Foreign_Record :=
+     (
+      (new String'("sin"), Sin'Address),
+      (new String'("log"), Log'Address),
+      (new String'("exp"), Exp'Address),
+      (new String'("sqrt"), Sqrt'Address),
+      (new String'("asin"), Asin'Address),
+      (new String'("acos"), Acos'Address),
+      (new String'("asinh"), Asinh'Address),
+      (new String'("acosh"), Acosh'Address),
+      (new String'("atanh"), Atanh'Address),
+      (new String'("atan2"), Atan2'Address)
+     );
+
+   function Find_Foreign (Name : String) return Address is
+   begin
+      for I in Foreign_Arr'Range loop
+         if Foreign_Arr(I).Name.all = Name then
+            return Foreign_Arr(I).Addr;
+         end if;
+      end loop;
+      return Null_Address;
+   end Find_Foreign;
+end Foreigns;
diff --git a/translate/ghdldrv/foreigns.ads b/translate/ghdldrv/foreigns.ads
new file mode 100644
index 000000000..5759ae4f5
--- /dev/null
+++ b/translate/ghdldrv/foreigns.ads
@@ -0,0 +1,5 @@
+with System; use System;
+
+package Foreigns is
+   function Find_Foreign (Name : String) return Address;
+end Foreigns;
diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb
index 1d70c141b..b08ac82c7 100644
--- a/translate/ghdldrv/ghdlrun.adb
+++ b/translate/ghdldrv/ghdlrun.adb
@@ -47,6 +47,7 @@ with Trans_Be;
 with Translation;
 with Std_Names;
 with Ieee.Std_Logic_1164;
+with Interfaces.C;
 
 with Binary_File.Elf;
 
@@ -70,9 +71,14 @@ with Grt.Values;
 with Grt.Names;
 
 with Ghdlcomp;
+with Foreigns;
 
 package body Ghdlrun is
-   Snap_Filename : String_Access := null;
+   Snap_Filename : GNAT.OS_Lib.String_Access := null;
+
+   procedure Foreign_Hook (Decl : Iir;
+                           Info : Translation.Foreign_Info_Type;
+                           Ortho : O_Dnode);
 
    procedure Compile_Init (Analyze_Only : Boolean) is
    begin
@@ -82,6 +88,8 @@ package body Ghdlrun is
          return;
       end if;
 
+      Translation.Foreign_Hook := Foreign_Hook'Access;
+
       -- Initialize.
       Back_End.Finish_Compilation := Trans_Be.Finish_Compilation'Access;
 
@@ -92,6 +100,7 @@ package body Ghdlrun is
       Libraries.Load_Std_Library;
 
       Ortho_Mcode.Init;
+      Binary_File.Memory.Write_Memory_Init;
 
       Translation.Initialize;
       Canon.Canon_Flag_Add_Labels := True;
@@ -237,6 +246,34 @@ package body Ghdlrun is
       return Conv (Get_Symbol_Vaddr (Get_Decl_Symbol (Decl)));
    end Get_Address;
 
+   procedure Foreign_Hook (Decl : Iir;
+                           Info : Translation.Foreign_Info_Type;
+                           Ortho : O_Dnode)
+   is
+      use Translation;
+      Res : Address;
+   begin
+      case Info.Kind is
+         when Foreign_Vhpidirect =>
+            declare
+               Name : String := Name_Table.Name_Buffer (Info.Subprg_First
+                                                        .. Info.Subprg_Last);
+            begin
+               Res := Foreigns.Find_Foreign (Name);
+               if Res /= Null_Address then
+                  Def (Ortho, Res);
+               else
+                  Error_Msg_Sem ("unknown foreign VHPIDIRECT '" & Name & "'",
+                                 Decl);
+               end if;
+            end;
+         when Foreign_Intrinsic =>
+            null;
+         when Foreign_Unknown =>
+            null;
+      end case;
+   end Foreign_Hook;
+
    procedure Run
    is
       use Binary_File;
@@ -257,8 +294,6 @@ package body Ghdlrun is
          raise Compile_Error;
       end if;
 
-      Binary_File.Memory.Write_Memory_Init;
-
       Ortho_Code.Abi.Link_Intrinsics;
 
       Def (Trans_Decls.Ghdl_Memcpy,
@@ -467,17 +502,6 @@ package body Ghdlrun is
            Grt.Rtis.Ghdl_Rti_Top_Instance'Address);
       Def (Trans_Decls.Ghdl_Rti_Top_Ptr,
            Grt.Rtis.Ghdl_Rti_Top_Ptr'Address);
-      Std_Standard_Boolean_RTI_Ptr :=
-        Get_Address (Trans_Decls.Std_Standard_Boolean_Rti);
-      Std_Standard_Bit_RTI_Ptr :=
-        Get_Address (Trans_Decls.Std_Standard_Bit_Rti);
-      if Ieee.Std_Logic_1164.Resolved /= Null_Iir then
-         Decl := Translation.Get_Resolv_Ortho_Decl
-           (Ieee.Std_Logic_1164.Resolved);
-         if Decl /= O_Dnode_Null then
-            Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address (Decl);
-         end if;
-      end if;
 
       Def (Trans_Decls.Ghdl_Protected_Enter,
            Grt.Processes.Ghdl_Protected_Enter'Address);
@@ -555,6 +579,18 @@ package body Ghdlrun is
          raise Compile_Error;
       end if;
 
+      Std_Standard_Boolean_RTI_Ptr :=
+        Get_Address (Trans_Decls.Std_Standard_Boolean_Rti);
+      Std_Standard_Bit_RTI_Ptr :=
+        Get_Address (Trans_Decls.Std_Standard_Bit_Rti);
+      if Ieee.Std_Logic_1164.Resolved /= Null_Iir then
+         Decl := Translation.Get_Resolv_Ortho_Decl
+           (Ieee.Std_Logic_1164.Resolved);
+         if Decl /= O_Dnode_Null then
+            Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address (Decl);
+         end if;
+      end if;
+
       Flag_String := Flags.Flag_String;
 
       Elaborate_Proc := Conv (Get_Address (Trans_Decls.Ghdl_Elaborate));