From 86af8ab7aa5f56ce5636eb6b8d48b03d52b415eb Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sat, 14 Jun 2014 17:34:15 +0200
Subject: configuration: add Check_Entity_Declaration_Top from translation.
 evaluation: add Get_Path_Instance_Name_Suffix from translation. grt-signals:
 rename ghdl_signal_direct_driver to ghdl_signal_add_direct_driver.  add
 ghdl_signal_direct_assign; make active_chain private.

---
 translate/ghdldrv/ghdlrun.adb   | 10 ++++----
 translate/ghdldrv/ghdlsimul.adb | 55 +++++++++++++++++++++++++++--------------
 2 files changed, 41 insertions(+), 24 deletions(-)

(limited to 'translate/ghdldrv')

diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb
index fb05df789..7dbce3ded 100644
--- a/translate/ghdldrv/ghdlrun.adb
+++ b/translate/ghdldrv/ghdlrun.adb
@@ -304,13 +304,10 @@ package body Ghdlrun is
       Def (Trans_Decls.Ghdl_Now,
            Grt.Types.Current_Time'Address);
 
-      Def (Trans_Decls.Ghdl_Signal_Active_Chain,
-           Grt.Signals.Ghdl_Signal_Active_Chain'Address);
-
       Def (Trans_Decls.Ghdl_Process_Add_Driver,
            Grt.Signals.Ghdl_Process_Add_Driver'Address);
-      Def (Trans_Decls.Ghdl_Signal_Direct_Driver,
-           Grt.Signals.Ghdl_Signal_Direct_Driver'Address);
+      Def (Trans_Decls.Ghdl_Signal_Add_Direct_Driver,
+           Grt.Signals.Ghdl_Signal_Add_Direct_Driver'Address);
 
       Def (Trans_Decls.Ghdl_Signal_Add_Source,
            Grt.Signals.Ghdl_Signal_Add_Source'Address);
@@ -366,6 +363,9 @@ package body Ghdlrun is
       Def (Trans_Decls.Ghdl_Signal_Start_Assign_Null,
            Grt.Signals.Ghdl_Signal_Start_Assign_Null'Address);
 
+      Def (Trans_Decls.Ghdl_Signal_Direct_Assign,
+           Grt.Signals.Ghdl_Signal_Direct_Assign'Address);
+
       Def (Trans_Decls.Ghdl_Create_Signal_B2,
            Grt.Signals.Ghdl_Create_Signal_B2'Address);
       Def (Trans_Decls.Ghdl_Signal_Init_B2,
diff --git a/translate/ghdldrv/ghdlsimul.adb b/translate/ghdldrv/ghdlsimul.adb
index d2a7772c9..a3f20ae69 100644
--- a/translate/ghdldrv/ghdlsimul.adb
+++ b/translate/ghdldrv/ghdlsimul.adb
@@ -48,6 +48,9 @@ with Grtlink;
 
 package body Ghdlsimul is
 
+   --  FIXME: reuse simulation.top_config
+   Top_Conf : Iir;
+
    procedure Compile_Init (Analyze_Only : Boolean) is
    begin
       if Analyze_Only then
@@ -72,6 +75,11 @@ package body Ghdlsimul is
    procedure Compile_Elab
      (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural)
    is
+      use Name_Table;
+      use Types;
+
+      First_Id : Name_Id;
+      Sec_Id : Name_Id;
    begin
       Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg);
 
@@ -82,6 +90,31 @@ package body Ghdlsimul is
          --  This may happen (bad entity for example).
          raise Compilation_Error;
       end if;
+
+      First_Id := Get_Identifier (Prim_Name.all);
+      if Sec_Name = null then
+         Sec_Id := Null_Identifier;
+      else
+         Sec_Id := Get_Identifier (Sec_Name.all);
+      end if;
+      Top_Conf := Configuration.Configure (First_Id, Sec_Id);
+      if Top_Conf = Null_Iir then
+         raise Compilation_Error;
+      end if;
+
+      --  Check (and possibly abandon) if entity can be at the top of the
+      --  hierarchy.
+      declare
+         Conf_Unit : constant Iir := Get_Library_Unit (Top_Conf);
+         Arch : constant Iir :=
+           Get_Block_Specification (Get_Block_Configuration (Conf_Unit));
+         Entity : constant Iir := Get_Entity (Arch);
+      begin
+         Configuration.Check_Entity_Declaration_Top (Entity);
+         if Nbr_Errors > 0 then
+            raise Compilation_Error;
+         end if;
+      end;
    end Compile_Elab;
 
    --  Set options.
@@ -114,6 +147,8 @@ package body Ghdlsimul is
             Simulation.Trace_Simulation := True;
          elsif Arg.all = "--trace-stmt" then
             Execution.Trace_Statements := True;
+         elsif Arg.all = "--stats" then
+            Simulation.Disp_Stats := True;
          elsif Arg.all = "-i" then
             Simulation.Flag_Interractive := True;
          else
@@ -133,26 +168,8 @@ package body Ghdlsimul is
       end loop;
    end Set_Run_Options;
 
-   procedure Run
-   is
-      use Name_Table;
-      use Types;
-
-      First_Id : Name_Id;
-      Sec_Id : Name_Id;
-      Top_Conf : Iir;
+   procedure Run is
    begin
-      First_Id := Get_Identifier (Prim_Name.all);
-      if Sec_Name = null then
-         Sec_Id := Null_Identifier;
-      else
-         Sec_Id := Get_Identifier (Sec_Name.all);
-      end if;
-      Top_Conf := Configuration.Configure (First_Id, Sec_Id);
-      if Top_Conf = Null_Iir then
-         raise Compilation_Error;
-      end if;
-
       Grtlink.Flag_String := Flags.Flag_String;
 
       Simulation.Simulation_Entity (Top_Conf);
-- 
cgit v1.2.3