Move files and dirs from translate/

1 files changed, 507 insertions, 0 deletions

diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb
new file mode 100644
index 000000000..df1eb4ec8
--- /dev/null
+++ b/src/grt/grt-options.adb
@@ -0,0 +1,507 @@
+--  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;