diff options
Diffstat (limited to 'src/ghdldrv')
| -rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 22 | ||||
| -rw-r--r-- | src/ghdldrv/ghdldrv.adb | 89 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 35 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.ads | 5 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlmain.adb | 22 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlmain.ads | 17 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlprint.adb | 14 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlsynth.adb | 5 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlvpi.adb | 7 |
9 files changed, 102 insertions, 114 deletions
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index 619d1afb0..0282736d5 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -17,6 +17,7 @@ -- 02111-1307, USA. with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; +with Options; use Options; with Ada.Command_Line; @@ -42,13 +43,13 @@ package body Ghdlcomp is procedure Decode_Option (Cmd : in out Command_Comp; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); procedure Disp_Long_Help (Cmd : Command_Comp); procedure Decode_Option (Cmd : in out Command_Comp; Option : String; Arg : String; - Res : out Option_Res) + Res : out Option_State) is pragma Assert (Option'First = 1); begin @@ -159,7 +160,7 @@ package body Ghdlcomp is procedure Decode_Option (Cmd : in out Command_Compile; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); procedure Perform_Action (Cmd : Command_Compile; Args : Argument_List); @@ -182,7 +183,7 @@ package body Ghdlcomp is procedure Decode_Option (Cmd : in out Command_Compile; Option : String; Arg : String; - Res : out Option_Res) + Res : out Option_State) is begin if Option = "-r" or else Option = "-e" then @@ -348,6 +349,7 @@ package body Ghdlcomp is else if Run_Arg <= Args'Last then Error_Msg_Option ("options after unit are ignored"); + raise Option_Error; end if; end if; end Perform_Action; @@ -492,7 +494,7 @@ package body Ghdlcomp is procedure Decode_Option (Cmd : in out Command_Elab; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); procedure Perform_Action (Cmd : Command_Elab; Args : Argument_List); @@ -515,7 +517,7 @@ package body Ghdlcomp is procedure Decode_Option (Cmd : in out Command_Elab; Option : String; Arg : String; - Res : out Option_Res) + Res : out Option_State) is pragma Assert (Option'First = 1); begin @@ -529,10 +531,11 @@ package body Ghdlcomp is -- Silently accepted. Res := Option_Arg; end if; - elsif Option'Length >= 4 - and then Option (1 .. 4) = "-Wl," then + elsif Option'Length >= 4 and then Option (1 .. 4) = "-Wl," + then Error_Msg_Option ("option -Wl is not available when ghdl " & "is not configured with gcc or llvm"); + Res := Option_Err; else Decode_Option (Command_Lib (Cmd), Option, Arg, Res); end if; @@ -553,6 +556,7 @@ package body Ghdlcomp is Hooks.Compile_Elab.all ("-e", Args, Run_Arg); if Run_Arg <= Args'Last then Error_Msg_Option ("options after unit are ignored"); + raise Option_Error; end if; if Flag_Expect_Failure then raise Compilation_Error; @@ -611,7 +615,7 @@ package body Ghdlcomp is begin if Args'Length /= 0 then Error ("--disp-config does not accept any argument"); - raise Errorout.Option_Error; + raise Option_Error; end if; Put_Line ("command_name: " & Ada.Command_Line.Command_Name); diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index 5817b974d..463b3e9c6 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -15,27 +15,27 @@ -- 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 System; with Ada.Command_Line; use Ada.Command_Line; +with Interfaces.C_Streams; with GNAT.OS_Lib; use GNAT.OS_Lib; +with Types; use Types; with Tables; with Dyn_Tables; -with Simple_IO; use Simple_IO; +with Files_Map; with Libraries; +with Default_Paths; +with Simple_IO; use Simple_IO; with Name_Table; use Name_Table; with Vhdl.Std_Package; -with Types; use Types; with Vhdl.Nodes; use Vhdl.Nodes; -with Files_Map; with Vhdl.Configuration; -with Default_Paths; -with Interfaces.C_Streams; -with System; +with Options; use Options; with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; with Errorout; with Version; -with Options; package body Ghdldrv is -- Name of the tools used. @@ -577,7 +577,7 @@ package body Ghdldrv is procedure Decode_Option (Cmd : in out Command_Comp; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); procedure Disp_Long_Help (Cmd : Command_Comp); @@ -602,12 +602,12 @@ package body Ghdldrv is procedure Decode_Option (Cmd : in out Command_Comp; Option : String; Arg : String; - Res : out Option_Res) + Res : out Option_State) is Opt : constant String (1 .. Option'Length) := Option; Str : String_Access; begin - Res := Option_Bad; + Res := Option_Unknown; if Opt = "-v" and then Flag_Verbose = False then -- Note: this is also decoded for command_lib, but we set -- Flag_Disp_Commands too. @@ -655,7 +655,8 @@ package body Ghdldrv is Add_Arguments (Linker_Args, Opt); else Error ("unknown tool name in '-W" & Opt (3) & ",' option"); - raise Option_Error; + Res := Option_Err; + return; end if; Res := Option_Ok; elsif Opt'Length >= 2 and then Opt (2) = 'g' then @@ -682,37 +683,42 @@ package body Ghdldrv is elsif Opt = "--dyn-elab" then Elab_Mode := Elab_Dynamic; Res := Option_Ok; - elsif Options.Parse_Option (Opt) then - if Opt'Length > 2 and then Opt (1 .. 2) = "-P" then - -- Discard -Pxxx switches, as they are already added to - -- compiler_args. - null; - else - if Backend = Backend_Gcc then - -- Prefix options for gcc so that lang.opt does need to be - -- updated when a new option is added. - Str := new String'("--ghdl" & Opt); - else - Str := new String'(Opt); - end if; - Add_Argument (Compiler_Args, Str); - end if; - Res := Option_Ok; elsif Opt'Length > 18 and then Opt (1 .. 18) = "--time-resolution=" then Error ("option --time-resolution not supported by back-end"); - raise Option_Error; - elsif Opt'Length >= 2 - and then (Opt (2) = 'O' or Opt (2) = 'f') - then - -- Optimization option. - -- This is put after Flags.Parse_Option, since it may catch -fxxx - -- options. - Add_Argument (Compiler_Args, new String'(Opt)); - Res := Option_Ok; + Res := Option_Err; + return; else - Decode_Option (Command_Lib (Cmd), Opt, Arg, Res); + Res := Options.Parse_Option (Opt); + if Res = Option_Ok then + if Opt'Length > 2 and then Opt (1 .. 2) = "-P" then + -- Discard -Pxxx switches, as they are already added to + -- compiler_args. + null; + else + if Backend = Backend_Gcc then + -- Prefix options for gcc so that lang.opt does need to be + -- updated when a new option is added. + Str := new String'("--ghdl" & Opt); + else + Str := new String'(Opt); + end if; + Add_Argument (Compiler_Args, Str); + end if; + elsif Res = Option_Unknown then + if Opt'Length >= 2 + and then (Opt (2) = 'O' or Opt (2) = 'f') + then + -- Optimization option supported by gcc/llvm. + -- This is put after Flags.Parse_Option, since it may catch + -- -fxxx options. + Add_Argument (Compiler_Args, new String'(Opt)); + Res := Option_Ok; + else + Decode_Option (Command_Lib (Cmd), Opt, Arg, Res); + end if; + end if; end if; end Decode_Option; @@ -1316,7 +1322,7 @@ package body Ghdldrv is procedure Decode_Option (Cmd : in out Command_Anaelab; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); procedure Perform_Action (Cmd : Command_Anaelab; Args : Argument_List); @@ -1340,8 +1346,7 @@ package body Ghdldrv is procedure Decode_Option (Cmd : in out Command_Anaelab; Option : String; Arg : String; - Res : out Option_Res) - is + Res : out Option_State) is begin if Option = "-e" then Res := Option_End; @@ -1397,7 +1402,7 @@ package body Ghdldrv is procedure Decode_Option (Cmd : in out Command_Make; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); function Get_Short_Help (Cmd : Command_Make) return String; procedure Disp_Long_Help (Cmd : Command_Make); @@ -1440,7 +1445,7 @@ package body Ghdldrv is procedure Decode_Option (Cmd : in out Command_Make; Option : String; Arg : String; - Res : out Option_Res) is + Res : out Option_State) is begin if Option = "-b" then Cmd.Flag_Bind_Only := True; diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index d7db3965f..fa2525112 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -33,7 +33,6 @@ with Vhdl.Scanner; with Errorout; with Vhdl.Configuration; with Files_Map; -with Options; with Vhdl.Utils; use Vhdl.Utils; package body Ghdllocal is @@ -58,54 +57,44 @@ package body Ghdllocal is Compile_Init; end Init; - function Decode_Driver_Option (Opt : String) return Boolean + function Decode_Driver_Option (Opt : String) return Option_State is pragma Assert (Opt'First = 1); begin if Opt = "-v" and then Flag_Verbose = False then Flag_Verbose := True; - return True; elsif Opt'Length > 9 and then Opt (1 .. 9) = "--PREFIX=" then Switch_Prefix_Path := new String'(Opt (10 .. Opt'Last)); - return True; elsif Opt = "--ieee=synopsys" then Flag_Ieee := Lib_Synopsys; - return True; elsif Opt = "--ieee=mentor" then Flag_Ieee := Lib_Mentor; - return True; elsif Opt = "--ieee=none" then Flag_Ieee := Lib_None; - return True; elsif Opt = "--ieee=standard" then Flag_Ieee := Lib_Standard; - return True; elsif Opt = "-m32" then Flag_32bit := True; - return True; elsif Opt'Length >= 2 and then (Opt (2) = 'g' or Opt (2) = 'O') then -- Silently accept -g and -O. - return True; + null; else return Options.Parse_Option (Opt); end if; + return Option_Ok; end Decode_Driver_Option; procedure Decode_Option (Cmd : in out Command_Lib; Option : String; Arg : String; - Res : out Option_Res) + Res : out Option_State) is pragma Unreferenced (Cmd); pragma Unreferenced (Arg); begin - if Decode_Driver_Option (Option) then - Res := Option_Ok; - else - Res := Option_Bad; - end if; + Res := Decode_Driver_Option (Option); end Decode_Option; procedure Disp_Long_Help (Cmd : Command_Lib) @@ -761,7 +750,7 @@ package body Ghdllocal is procedure Decode_Option (Cmd : in out Command_Check_Syntax; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); function Get_Short_Help (Cmd : Command_Check_Syntax) return String; procedure Perform_Action (Cmd : Command_Check_Syntax; Args : Argument_List); @@ -784,7 +773,7 @@ package body Ghdllocal is procedure Decode_Option (Cmd : in out Command_Check_Syntax; Option : String; Arg : String; - Res : out Option_Res) + Res : out Option_State) is pragma Assert (Option'First = 1); begin @@ -1610,19 +1599,23 @@ package body Ghdllocal is end Is_A_File_Name; Res : String_Access; + Err : Boolean; begin -- Try to identifier bad names (such as file names), so that -- friendly message can be displayed. if Is_Bad_Unit_Name then - Errorout.Error_Msg_Option_NR ("bad unit name '" & Name.all & "'"); + Errorout.Error_Msg_Option ("bad unit name '" & Name.all & "'"); if Is_A_File_Name then - Errorout.Error_Msg_Option_NR + Errorout.Error_Msg_Option ("(a unit name is required instead of a filename)"); end if; raise Option_Error; end if; Res := new String'(Name.all); - Vhdl.Scanner.Convert_Identifier (Res.all); + Vhdl.Scanner.Convert_Identifier (Res.all, Err); + if Err then + raise Option_Error; + end if; return Res; end Convert_Name; diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads index 0a903a129..553ebfda0 100644 --- a/src/ghdldrv/ghdllocal.ads +++ b/src/ghdldrv/ghdllocal.ads @@ -18,6 +18,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; with Ghdlmain; use Ghdlmain; with Vhdl.Nodes; use Vhdl.Nodes; +with Options; use Options; package Ghdllocal is -- Init procedure for the functionnal interface. @@ -25,7 +26,7 @@ package Ghdllocal is -- Handle: -- --std=xx, --work=xx, -Pxxx, --workdir=x, --ieee=x, -Px, and -v - function Decode_Driver_Option (Opt : String) return Boolean; + function Decode_Driver_Option (Opt : String) return Option_State; type Command_Lib is abstract new Command_Type with null record; @@ -36,7 +37,7 @@ package Ghdllocal is procedure Decode_Option (Cmd : in out Command_Lib; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); -- Disp detailled help. procedure Disp_Long_Help (Cmd : Command_Lib); diff --git a/src/ghdldrv/ghdlmain.adb b/src/ghdldrv/ghdlmain.adb index 402565b9e..12d30bba8 100644 --- a/src/ghdldrv/ghdlmain.adb +++ b/src/ghdldrv/ghdlmain.adb @@ -21,8 +21,8 @@ with Ada.Command_Line.Response_File; with Simple_IO; with Version; with Bug; -with Options; with Types; use Types; +with Errorout; use Errorout; with Errorout.Console; package body Ghdlmain is @@ -36,13 +36,13 @@ package body Ghdlmain is procedure Decode_Option (Cmd : in out Command_Type; Option : String; Arg : String; - Res : out Option_Res) + Res : out Option_State) is pragma Unreferenced (Cmd); pragma Unreferenced (Option); pragma Unreferenced (Arg); begin - Res := Option_Bad; + Res := Option_Unknown; end Decode_Option; procedure Disp_Long_Help (Cmd : Command_Type) @@ -87,7 +87,7 @@ package body Ghdlmain is procedure Decode_Option (Cmd : in out Command_Help; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); function Get_Short_Help (Cmd : Command_Help) return String; procedure Perform_Action (Cmd : Command_Help; Args : Argument_List); @@ -102,7 +102,7 @@ package body Ghdlmain is procedure Decode_Option (Cmd : in out Command_Help; Option : String; Arg : String; - Res : out Option_Res) + Res : out Option_State) is pragma Unreferenced (Cmd); pragma Unreferenced (Option); @@ -249,16 +249,12 @@ package body Ghdlmain is end Perform_Action; -- Disp MSG on the standard output with the command name. - procedure Error (Msg : String) - is - use Errorout; + procedure Error (Msg : String)is begin Report_Msg (Msgid_Error, Option, No_Source_Coord, Msg); end Error; - procedure Warning (Msg : String) - is - use Errorout; + procedure Warning (Msg : String) is begin Report_Msg (Msgid_Warning, Option, No_Source_Coord, Msg); end Warning; @@ -356,7 +352,7 @@ package body Ghdlmain is while Arg_Index <= Args'Last loop declare Arg : constant String_Access := Args (Arg_Index); - Res : Option_Res; + Res : Option_State; begin if Arg (1) = '-' then -- Argument is an option. @@ -368,7 +364,7 @@ package body Ghdlmain is Decode_Option (Cmd.all, Arg.all, "", Res); case Res is - when Option_Bad => + when Option_Unknown => Error ("unknown option '" & Arg.all & "' for command '" & Cmd_Name.all & "'"); raise Option_Error; diff --git a/src/ghdldrv/ghdlmain.ads b/src/ghdldrv/ghdlmain.ads index 226dc9f94..b9958ec61 100644 --- a/src/ghdldrv/ghdlmain.ads +++ b/src/ghdldrv/ghdlmain.ads @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with GNAT.OS_Lib; use GNAT.OS_Lib; -with Errorout; +with Options; use Options; package Ghdlmain is type Command_Type; @@ -34,20 +34,10 @@ package Ghdlmain is -- Initialize the command, before decoding actions. procedure Init (Cmd : in out Command_Type); - -- Option_OK: OPTION is handled. - -- Option_Bad: OPTION is unknown. - -- Option_Err: OPTION has an error (message was displayed). - -- Option_Arg_Req: OPTION requires an argument. Must be set only when - -- ARG = "", the manager will recall Decode_Option. - -- Option_Arg: OPTION used the argument. - type Option_Res is - (Option_Bad, Option_Err, - Option_Ok, Option_Arg, Option_Arg_Req, - Option_End); procedure Decode_Option (Cmd : in out Command_Type; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); -- Get a one-line help for the command. -- If the first character is '!', the string is not displayed by --help @@ -72,9 +62,6 @@ package Ghdlmain is -- Return the index of C in STR, or 0 if not found. function Index (Str : String; C : Character) return Natural; - -- May be raise by perform_action if the arguments are bad. - Option_Error : exception renames Errorout.Option_Error; - -- Action failed. Compile_Error : exception; diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index b93cd147b..8cd8de53f 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -25,6 +25,7 @@ with Flags; with Name_Table; use Name_Table; with Files_Map; with Libraries; +with Options; use Options; with Errorout; use Errorout; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; @@ -971,7 +972,7 @@ package body Ghdlprint is procedure Decode_Option (Cmd : in out Command_Reprint; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); procedure Perform_Action (Cmd : Command_Reprint; Args : Argument_List); @@ -993,7 +994,7 @@ package body Ghdlprint is procedure Decode_Option (Cmd : in out Command_Reprint; Option : String; Arg : String; - Res : out Option_Res) + Res : out Option_State) is pragma Assert (Option'First = 1); begin @@ -1207,14 +1208,14 @@ package body Ghdlprint is procedure Decode_Option (Cmd : in out Command_Html; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); procedure Disp_Long_Help (Cmd : Command_Html); procedure Decode_Option (Cmd : in out Command_Html; Option : String; Arg : String; - Res : out Option_Res) is + Res : out Option_State) is begin if Option = "--format=css" then Html_Format := Html_Css; @@ -1307,7 +1308,7 @@ package body Ghdlprint is procedure Decode_Option (Cmd : in out Command_Xref_Html; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); procedure Disp_Long_Help (Cmd : Command_Xref_Html); procedure Perform_Action (Cmd : Command_Xref_Html; @@ -1331,8 +1332,7 @@ package body Ghdlprint is procedure Decode_Option (Cmd : in out Command_Xref_Html; Option : String; Arg : String; - Res : out Option_Res) - is + Res : out Option_State) is begin if Option = "-o" then if Arg = "" then diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index f887279a7..4e296dc76 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -20,6 +20,7 @@ with Ghdllocal; use Ghdllocal; with Ghdlcomp; with Ghdlmain; use Ghdlmain; with Ghdlsimul; +with Options; use Options; with Simul.Annotations; @@ -44,7 +45,7 @@ package body Ghdlsynth is procedure Decode_Option (Cmd : in out Command_Synth; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); procedure Perform_Action (Cmd : Command_Synth; Args : Argument_List); @@ -66,7 +67,7 @@ package body Ghdlsynth is procedure Decode_Option (Cmd : in out Command_Synth; Option : String; Arg : String; - Res : out Option_Res) is + Res : out Option_State) is begin if Option = "--disp-noinline" then Cmd.Disp_Inline := False; diff --git a/src/ghdldrv/ghdlvpi.adb b/src/ghdldrv/ghdlvpi.adb index e2e142d6a..8b79b98c6 100644 --- a/src/ghdldrv/ghdlvpi.adb +++ b/src/ghdldrv/ghdlvpi.adb @@ -19,6 +19,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; with Ada.Command_Line; use Ada.Command_Line; with Simple_IO; use Simple_IO; +with Options; use Options; with Ghdlmain; use Ghdlmain; with Ghdllocal; @@ -211,13 +212,13 @@ package body Ghdlvpi is procedure Decode_Option (Cmd : in out Command_Spawn_Type; Option : String; Arg : String; - Res : out Option_Res); + Res : out Option_State); procedure Decode_Option (Cmd : in out Command_Spawn_Type; Option : String; Arg : String; - Res : out Option_Res) + Res : out Option_State) is pragma Unreferenced (Arg); begin @@ -225,7 +226,7 @@ package body Ghdlvpi is Cmd.Flag_Verbose := True; Res := Option_Ok; else - Res := Option_Bad; + Res := Option_Unknown; end if; end Decode_Option; |