grt-options.adb

vhdl集成电路设计软件.需要用gcc-4.0.2版本编译.

--  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