First import from sources

1 files changed, 468 insertions, 0 deletions

diff --git a/translate/grt/grt-options.adb b/translate/grt/grt-options.adb
new file mode 100644
index 0000000..9aa6f64
--- /dev/null
+++ b/translate/grt/grt-options.adb
@@ -0,0 +1,468 @@
+--  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");
+      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 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;