From 490a0195485d547f1ac07e2d7fbb15eed6dbfc68 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 4 Jul 2019 18:20:41 +0200 Subject: libghdlsynth: decode options. --- src/ghdldrv/ghdlmain.adb | 164 ++++++++++++++++++++++++--------------------- src/ghdldrv/ghdlmain.ads | 7 ++ src/synth/libghdlsynth.adb | 9 ++- 3 files changed, 104 insertions(+), 76 deletions(-) diff --git a/src/ghdldrv/ghdlmain.adb b/src/ghdldrv/ghdlmain.adb index 12d30bba8..4c8a3c956 100644 --- a/src/ghdldrv/ghdlmain.adb +++ b/src/ghdldrv/ghdlmain.adb @@ -269,14 +269,86 @@ package body Ghdlmain is return 0; end Index; + -- Decode command CMD_NAME and options from ARGS. + -- Return the index of the first non-option argument. + procedure Decode_Command_Options (Cmd_Name : String; + Cmd : out Command_Acc; + Args : Argument_List; + First_Arg : out Natural) + is + Arg_Index : Natural; + begin + -- Decode command. + Cmd := Find_Command (Cmd_Name); + if Cmd = null then + Error ("unknown command '" & Cmd_Name & "', try --help"); + raise Option_Error; + end if; + + Init (Cmd.all); + + -- Decode options. + + First_Arg := 0; + Arg_Index := Args'First; + while Arg_Index <= Args'Last loop + declare + Arg : constant String_Access := Args (Arg_Index); + Res : Option_State; + begin + if Arg (1) = '-' then + -- Argument is an option. + + if First_Arg > 0 then + Error ("options after file"); + raise Option_Error; + end if; + + Decode_Option (Cmd.all, Arg.all, "", Res); + case Res is + when Option_Unknown => + Error ("unknown option '" & Arg.all & "' for command '" + & Cmd_Name & "'"); + raise Option_Error; + when Option_Err => + raise Option_Error; + when Option_Ok => + Arg_Index := Arg_Index + 1; + when Option_Arg_Req => + if Arg_Index + 1 > Args'Last then + Error + ("option '" & Arg.all & "' requires an argument"); + raise Option_Error; + end if; + Decode_Option + (Cmd.all, Arg.all, Args (Arg_Index + 1).all, Res); + if Res /= Option_Arg then + raise Program_Error; + end if; + Arg_Index := Arg_Index + 2; + when Option_Arg => + raise Program_Error; + when Option_End => + First_Arg := Arg_Index; + exit; + end case; + else + First_Arg := Arg_Index; + exit; + end if; + end; + end loop; + + if First_Arg = 0 then + First_Arg := Args'Last + 1; + end if; + end Decode_Command_Options; + procedure Main is use Ada.Command_Line; - Cmd : Command_Acc; - Cmd_Name : String_Access; Args : String_List_Access; Arg_Index : Natural; - First_Arg : Natural; begin -- Set program name for error message. Errorout.Console.Set_Program_Name (Command_Name); @@ -334,85 +406,27 @@ package body Ghdlmain is end if; end loop; - -- Decode command. - - Cmd_Name := Args (1); - Cmd := Find_Command (Cmd_Name.all); - if Cmd = null then - Error ("unknown command '" & Cmd_Name.all & "', try --help"); - raise Option_Error; - end if; - - Init (Cmd.all); + declare + Cmd : Command_Acc; + First_Arg : Natural; + begin + Decode_Command_Options (Args (1).all, Cmd, + Args (2 .. Args'Last), First_Arg); - -- Decode options. + -- Set before running the action, so that it can be changed. + Set_Exit_Status (Success); - First_Arg := 0; - Arg_Index := 2; - while Arg_Index <= Args'Last loop declare - Arg : constant String_Access := Args (Arg_Index); - Res : Option_State; + Cmd_Args : Argument_List (1 .. Args'Last - First_Arg + 1); begin - if Arg (1) = '-' then - -- Argument is an option. - - if First_Arg > 0 then - Error ("options after file"); - raise Option_Error; - end if; - - Decode_Option (Cmd.all, Arg.all, "", Res); - case Res is - when Option_Unknown => - Error ("unknown option '" & Arg.all & "' for command '" - & Cmd_Name.all & "'"); - raise Option_Error; - when Option_Err => - raise Option_Error; - when Option_Ok => - Arg_Index := Arg_Index + 1; - when Option_Arg_Req => - if Arg_Index + 1 > Argument_Count then - Error - ("option '" & Arg.all & "' requires an argument"); - raise Option_Error; - end if; - Decode_Option - (Cmd.all, Arg.all, Args (Arg_Index + 1).all, Res); - if Res /= Option_Arg then - raise Program_Error; - end if; - Arg_Index := Arg_Index + 2; - when Option_Arg => - raise Program_Error; - when Option_End => - First_Arg := Arg_Index; - exit; - end case; - else - First_Arg := Arg_Index; - exit; - end if; + for I in Cmd_Args'Range loop + Cmd_Args (I) := Args (First_Arg + I - 1); + end loop; + Perform_Action (Cmd.all, Cmd_Args); end; - end loop; - - if First_Arg = 0 then - First_Arg := Argument_Count + 1; - end if; - - -- Set before running the action, so that it can be changed. - Set_Exit_Status (Success); - - declare - Cmd_Args : Argument_List (1 .. Args'Last - First_Arg + 1); - begin - for I in Cmd_Args'Range loop - Cmd_Args (I) := Args (First_Arg + I - 1); - end loop; - Perform_Action (Cmd.all, Cmd_Args); end; + -- Free args. for I in Args'Range loop Free (Args (I)); end loop; diff --git a/src/ghdldrv/ghdlmain.ads b/src/ghdldrv/ghdlmain.ads index b9958ec61..54c9ebfef 100644 --- a/src/ghdldrv/ghdlmain.ads +++ b/src/ghdldrv/ghdlmain.ads @@ -68,6 +68,13 @@ package Ghdlmain is -- Exec failed: either the program was not found, or failed. Exec_Error : exception; + -- Decode command CMD_NAME and options from ARGS. + -- Return the index of the first non-option argument. + procedure Decode_Command_Options (Cmd_Name : String; + Cmd : out Command_Acc; + Args : Argument_List; + First_Arg : out Natural); + procedure Main; -- Additionnal one-line message displayed by the --version command, diff --git a/src/synth/libghdlsynth.adb b/src/synth/libghdlsynth.adb index 37f5a8e30..d9d844de1 100644 --- a/src/synth/libghdlsynth.adb +++ b/src/synth/libghdlsynth.adb @@ -20,6 +20,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; +with Ghdlmain; use Ghdlmain; with Ghdlsynth; with Options; use Options; with Errorout.Console; @@ -29,6 +30,8 @@ package body Libghdlsynth is is Args : Argument_List (1 .. Argc); Res : Module; + Cmd : Command_Acc; + First_Arg : Natural; begin -- Create arguments list. for I in 0 .. Argc - 1 loop @@ -39,8 +42,11 @@ package body Libghdlsynth is end; end loop; + -- Find the command. This is a little bit convoluted... + Decode_Command_Options ("--synth", Cmd, Args, First_Arg); + -- Do the real work! - Res := Ghdlsynth.Ghdl_Synth (Args); + Res := Ghdlsynth.Ghdl_Synth (Args (First_Arg .. Args'Last)); return Res; exception @@ -51,6 +57,7 @@ package body Libghdlsynth is Gnat_Version : constant String := "unknown compiler version" & ASCII.NUL; pragma Export (C, Gnat_Version, "__gnat_version"); begin + Ghdlsynth.Register_Commands; Options.Initialize; Errorout.Console.Install_Handler; end Libghdlsynth; -- cgit v1.2.3