-- GHDL Run Time (GRT) - command line options. -- 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 Interfaces; use Interfaces; with Grt.Errors; use Grt.Errors; with Grt.Astdio; with Grt.Hooks; package body Grt.Options is Std_Standard_Time_Fs : Std_Time; Std_Standard_Time_Ps : Std_Time; Std_Standard_Time_Ns : Std_Time; Std_Standard_Time_Us : Std_Time; Std_Standard_Time_Ms : Std_Time; Std_Standard_Time_Sec : Std_Time; Std_Standard_Time_Min : Std_Time; Std_Standard_Time_Hr : Std_Time; pragma Export (C, Std_Standard_Time_Fs, "std__standard__time__BT__fs"); pragma Weak_External (Std_Standard_Time_Fs); pragma Export (C, Std_Standard_Time_Ps, "std__standard__time__BT__ps"); pragma Weak_External (Std_Standard_Time_Ps); pragma Export (C, Std_Standard_Time_Ns, "std__standard__time__BT__ns"); pragma Weak_External (Std_Standard_Time_Ns); pragma Export (C, Std_Standard_Time_Us, "std__standard__time__BT__us"); pragma Weak_External (Std_Standard_Time_Us); pragma Export (C, Std_Standard_Time_Ms, "std__standard__time__BT__ms"); pragma Weak_External (Std_Standard_Time_Ms); pragma Export (C, Std_Standard_Time_Sec, "std__standard__time__BT__sec"); pragma Weak_External (Std_Standard_Time_Sec); pragma Export (C, Std_Standard_Time_Min, "std__standard__time__BT__min"); pragma Weak_External (Std_Standard_Time_Min); pragma Export (C, Std_Standard_Time_Hr, "std__standard__time__BT__hr"); pragma Weak_External (Std_Standard_Time_Hr); procedure Set_Time_Resolution (Res : Character) is begin Std_Standard_Time_Hr := 0; case Res is when 'f' => Std_Standard_Time_Fs := 1; Std_Standard_Time_Ps := 1000; Std_Standard_Time_Ns := 1000_000; Std_Standard_Time_Us := 1000_000_000; Std_Standard_Time_Ms := Std_Time'Last; Std_Standard_Time_Sec := Std_Time'Last; Std_Standard_Time_Min := Std_Time'Last; Std_Standard_Time_Hr := Std_Time'Last; when 'p' => Std_Standard_Time_Fs := 0; Std_Standard_Time_Ps := 1; Std_Standard_Time_Ns := 1000; Std_Standard_Time_Us := 1000_000; Std_Standard_Time_Ms := 1000_000_000; Std_Standard_Time_Sec := Std_Time'Last; Std_Standard_Time_Min := Std_Time'Last; Std_Standard_Time_Hr := Std_Time'Last; when 'n' => Std_Standard_Time_Fs := 0; Std_Standard_Time_Ps := 0; Std_Standard_Time_Ns := 1; Std_Standard_Time_Us := 1000; Std_Standard_Time_Ms := 1000_000; Std_Standard_Time_Sec := 1000_000_000; Std_Standard_Time_Min := Std_Time'Last; Std_Standard_Time_Hr := Std_Time'Last; when 'u' => Std_Standard_Time_Fs := 0; Std_Standard_Time_Ps := 0; Std_Standard_Time_Ns := 0; Std_Standard_Time_Us := 1; Std_Standard_Time_Ms := 1000; Std_Standard_Time_Sec := 1000_000; Std_Standard_Time_Min := 60_000_000; Std_Standard_Time_Hr := Std_Time'Last; when 'm' => Std_Standard_Time_Fs := 0; Std_Standard_Time_Ps := 0; Std_Standard_Time_Ns := 0; Std_Standard_Time_Us := 0; Std_Standard_Time_Ms := 1; Std_Standard_Time_Sec := 1000; Std_Standard_Time_Min := 60_000; Std_Standard_Time_Hr := 3600_000; when 's' => Std_Standard_Time_Fs := 0; Std_Standard_Time_Ps := 0; Std_Standard_Time_Ns := 0; Std_Standard_Time_Us := 0; Std_Standard_Time_Ms := 0; Std_Standard_Time_Sec := 1; Std_Standard_Time_Min := 60; Std_Standard_Time_Hr := 3600; when 'M' => Std_Standard_Time_Fs := 0; Std_Standard_Time_Ps := 0; Std_Standard_Time_Ns := 0; Std_Standard_Time_Us := 0; Std_Standard_Time_Ms := 0; Std_Standard_Time_Sec := 0; Std_Standard_Time_Min := 1; Std_Standard_Time_Hr := 60; when 'h' => Std_Standard_Time_Fs := 0; Std_Standard_Time_Ps := 0; Std_Standard_Time_Ns := 0; Std_Standard_Time_Us := 0; Std_Standard_Time_Ms := 0; Std_Standard_Time_Sec := 0; Std_Standard_Time_Min := 0; Std_Standard_Time_Hr := 1; when others => Error ("bad time resolution"); end case; end Set_Time_Resolution; procedure Help is use Grt.Astdio; procedure P (Str : String) renames Put_Line; Prog_Name : Ghdl_C_String; begin if Argc > 0 then Prog_Name := Argv (0); Put ("Usage: "); Put (Prog_Name (1 .. strlen (Prog_Name))); Put (" [OPTIONS]"); New_Line; end if; P ("Options are:"); P (" --help, -h disp this help"); P (" --assert-level=LEVEL stop simulation if assert at LEVEL"); P (" LEVEL is note,warning,error,failure,none"); P (" --stop-time=X stop the simulation at time X"); P (" X is expressed as a time value, without spaces: 1ns, ps..."); P (" --stop-delta=X stop the simulation cycle after X delta"); P (" --disp-tree[=KIND] disp the design hierarchy after elaboration"); P (" KIND is inst, proc, port (default)"); P (" --expect-failure invert exit status"); P (" --stack-size=X set the stack size of non-sensitized processes"); P (" --stack-max-size=X set the maximum stack size"); P (" --no-run do not simulate, only elaborate"); -- P (" --threads=N use N threads for simulation"); Grt.Hooks.Call_Help_Hooks; P ("trace options:"); P (" --disp-time disp time as simulation advances"); P (" --trace-signals disp signals after each cycle"); P (" --trace-processes disp process name before each cycle"); P (" --stats display run-time statistics"); P ("debug options:"); P (" --disp-order disp signals order"); P (" --disp-sources disp sources while displaying signals"); P (" --disp-sig-types disp signal types"); P (" --disp-signals-map disp map bw declared sigs and internal sigs"); P (" --disp-signals-table disp internal signals"); P (" --dump-rti dump Run Time Information"); P (" --checks do internal checks after each process run"); P (" --activity=LEVEL watch activity of LEVEL signals"); P (" LEVEL is all, min (default) or none (unsafe)"); end Help; -- Extract from STR a number. -- First, all leading blanks are skipped. -- Then, all next digits are eaten. -- The position of the first non digit or one past the upper bound is -- returned into POS. -- If there is no digits, OK is set to false, else to true. procedure Extract_Integer (Str : String; Ok : out Boolean; Result : out Integer_64; Pos : out Natural) is begin Pos := Str'First; -- Skip blanks. while Pos <= Str'Last and then Str (Pos) = ' ' loop Pos := Pos + 1; end loop; Ok := False; Result := 0; loop exit when Pos > Str'Last or else Str (Pos) not in '0' .. '9'; Ok := True; Result := Result * 10 + (Character'Pos (Str (Pos)) - Character'Pos ('0')); Pos := Pos + 1; end loop; end Extract_Integer; function Extract_Size (Str : String; Option_Name : String) return Natural is Ok : Boolean; Val : Integer_64; Pos : Natural; begin Extract_Integer (Str, Ok, Val, Pos); if not Ok then Val := 1; end if; if Pos > Str'Last then -- No suffix. return Natural (Val); end if; if Pos = Str'Last or else (Pos + 1 = Str'Last and then (Str (Pos + 1) = 'b' or Str (Pos + 1) = 'o')) then if Str (Pos) = 'k' or Str (Pos) = 'K' then return Natural (Val) * 1024; elsif Str (Pos) = 'm' or Str (Pos) = 'M' then return Natural (Val) * 1024 * 1024; end if; end if; Error_C ("bad memory unit for option "); Error_E (Option_Name); end Extract_Size; function To_Lower (C : Character) return Character is begin if C in 'A' .. 'Z' then return Character'Val (Character'Pos (C) + 32); else return C; end if; end To_Lower; procedure Decode (Stop : out Boolean) is Arg : Ghdl_C_String; Len : Natural; begin Stop := False; Last_Opt := Argc - 1; for I in 1 .. Argc - 1 loop Arg := Argv (I); Len := strlen (Arg); declare Argument : String := Arg (1 .. Len); begin if Argument = "--" then Last_Opt := I; exit; elsif Argument = "--help" or else Argument = "-h" then Help; Stop := True; elsif Len >= 11 and then Argument (1 .. 11) = "--disp-tree" then if Len = 11 then Disp_Tree := Disp_Tree_Port; elsif Argument (12 .. Len) = "=port" then Disp_Tree := Disp_Tree_Port; elsif Argument (12 .. Len) = "=proc" then Disp_Tree := Disp_Tree_Proc; elsif Argument (12 .. Len) = "=inst" then Disp_Tree := Disp_Tree_Inst; elsif Argument (12 .. Len) = "=none" then Disp_Tree := Disp_Tree_None; else Error ("bad argument for --disp-tree option, try --help"); end if; elsif Argument = "--disp-time" then Disp_Time := True; elsif Argument = "--trace-signals" then Trace_Signals := True; Disp_Time := True; elsif Argument = "--trace-processes" then Trace_Processes := True; Disp_Time := True; elsif Argument = "--disp-order" then Disp_Signals_Order := True; elsif Argument = "--checks" then Checks := True; elsif Argument = "--disp-sources" then Disp_Sources := True; elsif Argument = "--disp-sig-types" then Disp_Sig_Types := True; elsif Argument = "--disp-signals-map" then Disp_Signals_Map := True; elsif Argument = "--disp-signals-table" then Disp_Signals_Table := True; elsif Argument = "--dump-rti" then Flag_Dump_Rti := True; elsif Argument = "--stats" then Flag_Stats := True; elsif Argument = "--no-run" then Flag_No_Run := True; elsif Len > 18 and then Argument (1 .. 18) = "--time-resolution=" then declare Res : Character; Unit : String (1 .. 3); begin Res := '?'; if Len >= 20 then Unit (1) := To_Lower (Argument (19)); Unit (2) := To_Lower (Argument (20)); if Len = 20 then if Unit (1 .. 2) = "fs" then Res := 'f'; elsif Unit (1 .. 2) = "ps" then Res := 'p'; elsif Unit (1 .. 2) = "ns" then Res := 'n'; elsif Unit (1 .. 2) = "us" then Res := 'u'; elsif Unit (1 .. 2) = "ms" then Res := 'm'; elsif Unit (1 .. 2) = "hr" then Res := 'h'; end if; elsif Len = 21 then Unit (3) := To_Lower (Argument (21)); if Unit = "min" then Res := 'M'; elsif Unit = "sec" then Res := 's'; end if; end if; end if; if Res = '?' then Error_C ("bad unit for '"); Error_C (Argument); Error_E ("'"); else if Flag_String (5) = '-' then Error ("time resolution is ignored"); elsif Flag_String (5) = '?' then if Stop_Time /= Std_Time'Last then Error ("time resolution must be set " & "before --stop-time"); else Set_Time_Resolution (Res); end if; elsif Flag_String (5) /= Res then Error ("time resolution is fixed during analysis"); end if; end if; end; elsif Len > 12 and then Argument (1 .. 12) = "--stop-time=" then declare Ok : Boolean; Pos : Natural; Time : Integer_64; Unit : String (1 .. 3); begin Extract_Integer (Argument (13 .. Len), Ok, Time, Pos); if not Ok then Time := 1; end if; if (Len - Pos + 1) not in 2 .. 3 then Error_C ("bad unit for '"); Error_C (Argument); Error_E ("'"); return; end if; Unit (1) := To_Lower (Argument (Pos)); Unit (2) := To_Lower (Argument (Pos + 1)); if Len = Pos + 2 then Unit (3) := To_Lower (Argument (Pos + 2)); else Unit (3) := ' '; end if; if Unit = "fs " then null; elsif Unit = "ps " then Time := Time * (10 ** 3); elsif Unit = "ns " then Time := Time * (10 ** 6); elsif Unit = "us " then Time := Time * (10 ** 9); elsif Unit = "ms " then Time := Time * (10 ** 12); elsif Unit = "sec" then Time := Time * (10 ** 15); elsif Unit = "min" then Time := Time * (10 ** 15) * 60; elsif Unit = "hr " then Time := Time * (10 ** 15) * 3600; else Error_C ("bad unit name for '"); Error_C (Argument); Error_E ("'"); end if; Stop_Time := Std_Time (Time); end; elsif Len > 13 and then Argument (1 .. 13) = "--stop-delta=" then declare Ok : Boolean; Pos : Natural; Time : Integer_64; begin Extract_Integer (Argument (14 .. Len), Ok, Time, Pos); if not Ok or else Pos <= Len then Error_C ("bad value in '"); Error_C (Argument); Error_E ("'"); else if Time > Integer_64 (Integer'Last) then Stop_Delta := Integer'Last; else Stop_Delta := Integer (Time); end if; end if; end; elsif Len > 15 and then Argument (1 .. 15) = "--assert-level=" then if Argument (16 .. Len) = "note" then Severity_Level := Note_Severity; elsif Argument (16 .. Len) = "warning" then Severity_Level := Warning_Severity; elsif Argument (16 .. Len) = "error" then Severity_Level := Error_Severity; elsif Argument (16 .. Len) = "failure" then Severity_Level := Failure_Severity; elsif Argument (16 .. Len) = "none" then Severity_Level := 4; else Error ("bad argument for --assert-level option, try --help"); end if; elsif Argument = "--expect-failure" then Expect_Failure := True; elsif Len >= 13 and then Argument (1 .. 13) = "--stack-size=" then Stack_Size := Extract_Size (Argument (14 .. Len), "--stack-size"); if Stack_Size > Stack_Max_Size then Stack_Max_Size := Stack_Size; end if; elsif Len >= 17 and then Argument (1 .. 17) = "--stack-max-size=" then Stack_Max_Size := Extract_Size (Argument (18 .. Len), "--stack-size"); if Stack_Size > Stack_Max_Size then Stack_Size := Stack_Max_Size; end if; elsif Len >= 11 and then Argument (1 .. 11) = "--activity=" then if Argument (12 .. Len) = "none" then Flag_Activity := Activity_None; elsif Argument (12 .. Len) = "min" then Flag_Activity := Activity_Minimal; elsif Argument (12 .. Len) = "all" then Flag_Activity := Activity_All; else Error ("bad argument for --activity, try --help"); end if; elsif Len > 10 and then Argument (1 .. 10) = "--threads=" then declare Ok : Boolean; Pos : Natural; Val : Integer_64; begin Extract_Integer (Argument (11 .. Len), Ok, Val, Pos); if not Ok or else Pos <= Len then Error_C ("bad value in '"); Error_C (Argument); Error_E ("'"); else Nbr_Threads := Integer (Val); end if; end; elsif not Grt.Hooks.Call_Option_Hooks (Argument) then Error_C ("unknown option '"); Error_C (Argument); Error_E ("', try --help"); end if; end; end loop; end Decode; end Grt.Options;