summaryrefslogtreecommitdiff
path: root/src/translate/grt/grt-options.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/translate/grt/grt-options.adb')
-rw-r--r--src/translate/grt/grt-options.adb507
1 files changed, 0 insertions, 507 deletions
diff --git a/src/translate/grt/grt-options.adb b/src/translate/grt/grt-options.adb
deleted file mode 100644
index df1eb4e..0000000
--- a/src/translate/grt/grt-options.adb
+++ /dev/null
@@ -1,507 +0,0 @@
--- GHDL Run Time (GRT) - command line options.
--- Copyright (C) 2002 - 2014 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.
---
--- As a special exception, if other files instantiate generics from this
--- unit, or you link this unit with other files to produce an executable,
--- this unit does not by itself cause the resulting executable to be
--- covered by the GNU General Public License. This exception does not
--- however invalidate any other reasons why the executable file might be
--- covered by the GNU Public License.
-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 (" --ieee-asserts=POLICY enable or disable asserts from IEEE");
- P (" POLICY is enable,disable,disable-at-0");
- 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 (" --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 (" --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.
- if Val > Integer_64(Natural'Last) then
- Error_C ("Size exceeds limit for option ");
- Error_E (Option_Name);
- else
- return Natural (Val);
- end if;
- 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_Option
- (Option : String; Status : out Decode_Option_Status)
- is
- pragma Assert (Option'First = 1);
- Len : constant Natural := Option'Last;
- begin
- Status := Decode_Option_Ok;
- if Option = "--" then
- Status := Decode_Option_Last;
- elsif Option = "--help" or else Option = "-h" then
- Help;
- Status := Decode_Option_Help;
- elsif Option = "--disp-time" then
- Disp_Time := True;
- elsif Option = "--trace-signals" then
- Trace_Signals := True;
- Disp_Time := True;
- elsif Option = "--trace-processes" then
- Trace_Processes := True;
- Disp_Time := True;
- elsif Option = "--disp-order" then
- Disp_Signals_Order := True;
- elsif Option = "--checks" then
- Checks := True;
- elsif Option = "--disp-sources" then
- Disp_Sources := True;
- elsif Option = "--disp-sig-types" then
- Disp_Sig_Types := True;
- elsif Option = "--disp-signals-map" then
- Disp_Signals_Map := True;
- elsif Option = "--disp-signals-table" then
- Disp_Signals_Table := True;
- elsif Option = "--disp-sensitivity" then
- Disp_Sensitivity := True;
- elsif Option = "--stats" then
- Flag_Stats := True;
- elsif Option = "--no-run" then
- Flag_No_Run := True;
- elsif Len > 18 and then Option (1 .. 18) = "--time-resolution=" then
- declare
- Res : Character;
- Unit : String (1 .. 3);
- begin
- Res := '?';
- if Len >= 20 then
- Unit (1) := To_Lower (Option (19));
- Unit (2) := To_Lower (Option (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 (Option (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 (Option);
- 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 Option (1 .. 12) = "--stop-time=" then
- declare
- Ok : Boolean;
- Pos : Natural;
- Time : Integer_64;
- Unit : String (1 .. 3);
- begin
- Extract_Integer (Option (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 (Option);
- Error_E ("'");
- return;
- end if;
- Unit (1) := To_Lower (Option (Pos));
- Unit (2) := To_Lower (Option (Pos + 1));
- if Len = Pos + 2 then
- Unit (3) := To_Lower (Option (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 (Option);
- Error_E ("'");
- end if;
- Stop_Time := Std_Time (Time);
- end;
- elsif Len > 13 and then Option (1 .. 13) = "--stop-delta=" then
- declare
- Ok : Boolean;
- Pos : Natural;
- Time : Integer_64;
- begin
- Extract_Integer (Option (14 .. Len), Ok, Time, Pos);
- if not Ok or else Pos <= Len then
- Error_C ("bad value in '");
- Error_C (Option);
- 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 Option (1 .. 15) = "--assert-level=" then
- if Option (16 .. Len) = "note" then
- Severity_Level := Note_Severity;
- elsif Option (16 .. Len) = "warning" then
- Severity_Level := Warning_Severity;
- elsif Option (16 .. Len) = "error" then
- Severity_Level := Error_Severity;
- elsif Option (16 .. Len) = "failure" then
- Severity_Level := Failure_Severity;
- elsif Option (16 .. Len) = "none" then
- Severity_Level := 4;
- else
- Error ("bad argument for --assert-level option, try --help");
- end if;
- elsif Len > 15 and then Option (1 .. 15) = "--ieee-asserts=" then
- if Option (16 .. Len) = "disable" then
- Ieee_Asserts := Disable_Asserts;
- elsif Option (16 .. Len) = "enable" then
- Ieee_Asserts := Enable_Asserts;
- elsif Option (16 .. Len) = "disable-at-0" then
- Ieee_Asserts := Disable_Asserts_At_Time_0;
- else
- Error ("bad argument for --ieee-asserts option, try --help");
- end if;
- elsif Option = "--expect-failure" then
- Expect_Failure := True;
- elsif Len >= 13 and then Option (1 .. 13) = "--stack-size=" then
- Stack_Size := Extract_Size
- (Option (14 .. Len), "--stack-size");
- if Stack_Size > Stack_Max_Size then
- Stack_Max_Size := Stack_Size;
- end if;
- elsif Len >= 17 and then Option (1 .. 17) = "--stack-max-size=" then
- Stack_Max_Size := Extract_Size
- (Option (18 .. Len), "--stack-size");
- if Stack_Size > Stack_Max_Size then
- Stack_Size := Stack_Max_Size;
- end if;
- elsif Len >= 11 and then Option (1 .. 11) = "--activity=" then
- if Option (12 .. Len) = "none" then
- Flag_Activity := Activity_None;
- elsif Option (12 .. Len) = "min" then
- Flag_Activity := Activity_Minimal;
- elsif Option (12 .. Len) = "all" then
- Flag_Activity := Activity_All;
- else
- Error ("bad argument for --activity, try --help");
- end if;
- elsif Len > 10 and then Option (1 .. 10) = "--threads=" then
- declare
- Ok : Boolean;
- Pos : Natural;
- Val : Integer_64;
- begin
- Extract_Integer (Option (11 .. Len), Ok, Val, Pos);
- if not Ok or else Pos <= Len then
- Error_C ("bad value in '");
- Error_C (Option);
- Error_E ("'");
- else
- Nbr_Threads := Integer (Val);
- end if;
- end;
- elsif not Grt.Hooks.Call_Option_Hooks (Option) then
- Error_C ("unknown option '");
- Error_C (Option);
- Error_E ("', try --help");
- end if;
- end Decode_Option;
-
- procedure Decode (Stop : out Boolean)
- is
- Arg : Ghdl_C_String;
- Len : Natural;
- Status : Decode_Option_Status;
- begin
- Stop := False;
- Last_Opt := Argc - 1;
- for I in 1 .. Argc - 1 loop
- Arg := Argv (I);
- Len := strlen (Arg);
- declare
- Argument : constant String := Arg (1 .. Len);
- begin
- Decode_Option (Argument, Status);
- case Status is
- when Decode_Option_Last =>
- Last_Opt := I;
- exit;
- when Decode_Option_Help =>
- Stop := True;
- when Decode_Option_Ok =>
- null;
- end case;
- end;
- end loop;
- end Decode;
-end Grt.Options;
generated by cgit (git 2.34.1) at 2024-12-21 07:04:22 +0000