libghdlsynth: decode options.

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;