-- GHDL driver - simulator commands.
-- Copyright (C) 2002, 2003, 2004, 2005 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 GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ada.Command_Line;
with Ghdllocal; use Ghdllocal;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Simple_IO;
with Types;
with Flags;
with Vhdl.Std_Package;
with Vhdl.Canon;
with Vhdl.Configuration;
with Vhdl.Annotations;
with Simul.Elaboration;
with Simul.Simulation.Main;
with Simul.Debugger;
with Simul.Execution;
with Ghdlcomp; use Ghdlcomp;
with Grt.Types;
with Grt.Options;
with Grt.Errors;
with Grt.Stdio;
with Grtlink;
package body Ghdlsimul is
-- FIXME: reuse simulation.top_config
Top_Conf : Iir;
procedure Compile_Init (Analyze_Only : Boolean) is
begin
Common_Compile_Init (Analyze_Only);
if Analyze_Only then
return;
end if;
Vhdl.Canon.Canon_Flag_Add_Labels := True;
Vhdl.Canon.Canon_Flag_Sequentials_Stmts := True;
Vhdl.Canon.Canon_Flag_Expressions := True;
Vhdl.Canon.Canon_Flag_All_Sensitivity := True;
end Compile_Init;
procedure Compile_Elab
(Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural)
is
use Vhdl.Configuration;
begin
Common_Compile_Elab (Cmd_Name, Args, Opt_Arg, Top_Conf);
-- Annotate all units.
Vhdl.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit);
for I in Design_Units.First .. Design_Units.Last loop
Vhdl.Annotations.Annotate (Design_Units.Table (I));
end loop;
end Compile_Elab;
-- Set options.
procedure Set_Run_Options (Args : Argument_List)
is
use Grt.Options;
use Types;
Arg : String_Access;
Status : Decode_Option_Status;
Argv0 : String_Acc;
begin
-- Set progname (used for grt error messages)
Argv0 := new String'(Ada.Command_Line.Command_Name & ASCII.Nul);
Grt.Options.Progname := Grt.Types.To_Ghdl_C_String (Argv0.all'Address);
Grt.Errors.Set_Error_Stream (Grt.Stdio.stdout);
Grtlink.Flag_String := Flags.Flag_String;
Grt.Options.Set_Time_Resolution;
for I in Args'Range loop
Arg := Args (I);
if Arg.all = "--disp-tree" then
Simul.Simulation.Disp_Tree := True;
elsif Arg.all = "--expect-failure" then
Decode_Option (Arg.all, Status);
pragma Assert (Status = Decode_Option_Ok);
elsif Arg.all = "--trace-elab" then
Simul.Elaboration.Trace_Elaboration := True;
elsif Arg.all = "--trace-drivers" then
Simul.Elaboration.Trace_Drivers := True;
elsif Arg.all = "--trace-simu" then
Simul.Simulation.Trace_Simulation := True;
elsif Arg.all = "--trace-stmt" then
Simul.Execution.Trace_Statements := True;
elsif Arg.all = "--stats" then
Simul.Simulation.Disp_Stats := True;
elsif Arg.all = "-i" then
Simul.Debugger.Flag_Debugger := True;
Simul.Debugger.Flag_Interractive := True;
else
Decode_Option (Arg.all, Status);
case Status is
when Decode_Option_Last =>
exit;
when Decode_Option_Stop =>
Grt.Options.Flag_No_Run := True;
when Decode_Option_Ok =>
null;
end case;
-- Ghdlmain.Error ("unknown run options '" & Arg.all & "'");
-- raise Option_Error;
end if;
end loop;
end Set_Run_Options;
procedure Run
is
use Ada.Command_Line;
begin
if Grt.Options.Flag_No_Run then
-- Some options like --has-feature set the exit status.
Set_Exit_Status (Exit_Status (Grt.Errors.Exit_Status));
return;
end if;
Simul.Simulation.Main.Simulation_Entity (Top_Conf);
Set_Exit_Status (Exit_Status (Grt.Errors.Exit_Status));
end Run;
function Decode_Option (Option : String) return Boolean
is
begin
if Option = "--debug" or Option = "-g" then
Simul.Debugger.Flag_Debugger := True;
else
return False;
end if;
return True;
end Decode_Option;
procedure Disp_Long_Help is
begin
Simple_IO.Put_Line (" --debug Run with debugger");
end Disp_Long_Help;
function Get_Top_Config return Iir is
begin
return Top_Conf;
end Get_Top_Config;
procedure Set_Hooks is
begin
Ghdlcomp.Hooks := (Compile_Init'Access,
Compile_Elab'Access,
Set_Run_Options'Access,
Run'Access,
Decode_Option'Access,
Disp_Long_Help'Access);
end Set_Hooks;
procedure Register_Commands is
begin
Set_Hooks;
Ghdlcomp.Register_Commands;
end Register_Commands;
procedure Compile_Init is
begin
Ghdllocal.Compile_Init;
Set_Hooks;
end Compile_Init;
end Ghdlsimul;
