2011-02-02 Joel Sherrill <joel.sherrill@gmail.com>

	* commands.adb, commands.ads, rtems_shell.ads, shell.adb: Add getopt_r
	Package and example command.
	* command_line_arguments.adb, command_line_arguments.ads, getopt_r.adb,
	getopt_r.ads: New files.

9 files changed, 475 insertions, 67 deletions

diff --git a/shell/ChangeLog b/shell/ChangeLog
index 9db5c7d..35470e8 100644
--- a/shell/ChangeLog
+++ b/shell/ChangeLog
@@ -1,3 +1,10 @@
+2011-02-02	Joel Sherrill <joel.sherrill@gmail.com>
+
+	* commands.adb, commands.ads, rtems_shell.ads, shell.adb: Add getopt_r
+	Package and example command.
+	* command_line_arguments.adb, command_line_arguments.ads, getopt_r.adb,
+	getopt_r.ads: New files.
+
 2009-09-17	Joel Sherrill <joel.sherrill@oarcorp.com>
 
 	* .cvsignore: Update or add .cvsignore.
diff --git a/shell/command_line_arguments.adb b/shell/command_line_arguments.adb
new file mode 100644
index 0000000..0610d67
--- /dev/null
+++ b/shell/command_line_arguments.adb
@@ -0,0 +1,19 @@
+with Interfaces.C;          use Interfaces.C;
+with Interfaces.C.Strings;  use Interfaces.C.Strings;
+with Interfaces.C.Pointers;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+package body Command_Line_Arguments is
+
+   function Get_Argument(
+      Argv   : Argument_Vector_Type;
+      Index  : Argument_Count_Type)
+   return String is
+      Arguments : Argument_Array(1 .. Index);
+   begin
+      Arguments := Argument_Vector_Package.Value (ArgV, Index);
+
+      return To_String (To_Unbounded_String (Value(Arguments (Index))));
+   end Get_Argument;
+
+end Command_Line_Arguments;
diff --git a/shell/command_line_arguments.ads b/shell/command_line_arguments.ads
new file mode 100644
index 0000000..4c54bab
--- /dev/null
+++ b/shell/command_line_arguments.ads
@@ -0,0 +1,25 @@
+with Interfaces.C;          use Interfaces.C;
+with Interfaces.C.Strings;  use Interfaces.C.Strings;
+with Interfaces.C.Pointers;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+package Command_Line_Arguments is
+
+   type Argument_Array is array (ptrdiff_t range <>) of aliased chars_ptr;
+
+   package Argument_Vector_Package is new Pointers (
+      Index => ptrdiff_t,
+      Element => chars_ptr,
+      Element_Array => Argument_Array,
+      Default_Terminator => Null_Ptr
+   );
+
+   subtype Argument_Count_Type is ptrdiff_t;
+   subtype Argument_Vector_Type is Argument_Vector_Package.Pointer;
+
+   function Get_Argument(
+      Argv   : in Argument_Vector_Type;
+      Index  : Argument_Count_Type
+   ) return String;
+
+end Command_Line_Arguments;
diff --git a/shell/commands.adb b/shell/commands.adb
index d7971ce..da8548d 100644
--- a/shell/commands.adb
+++ b/shell/commands.adb
@@ -3,6 +3,10 @@
 --
 
 with Ada.Text_IO; use Ada.Text_IO;
+with Command_Line_Arguments; use Command_Line_Arguments;
+with Getopt_R;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
 
 package body Commands is
 
@@ -32,4 +36,52 @@ package body Commands is
       return 0;
    end Command_Test_Arguments;
 
+   function Command_Getopt_R
+     (ArgC : Argument_Count_Type;
+      ArgV : Argument_Vector_Type)
+   return int is
+      Test_String : String := "c:di:n:p:u:V";
+      Optchar : character;
+      V       : Integer;
+      Reent   : aliased Getopt_R.Reentrant;
+   begin
+     Getopt_R.Initialize( Reent'Unrestricted_Access, Argc, Argv );
+     loop
+	V := Getopt_R.Getopt( Reent'Unrestricted_Access, Test_String );
+	exit when V = -1;
+
+	optchar :=  Character'Val( V );
+	case optchar is
+	   when 'c' =>
+	      Put_Line("command is "& To_String(Reent.Optarg));
+	   when 'd' =>
+	       Put_Line("debug on");
+	   when 'i' =>
+	      Put_line("got -i, its argument is:" & To_String(Reent.Optarg) );
+	   when 'n' =>
+	      Put_line("got -n, its argument is:" & To_String(Reent.Optarg));
+	   when 'p' =>
+	      Put_line("got -p, its argument is:" & To_String(Reent.Optarg));
+	   when 'u' =>
+	      Put_line("got -u, its argument is:" & To_String(Reent.Optarg));
+	   when 'V' =>
+	      Put_line("got -V");
+
+	   when '?' =>
+	      Put_Line("got ?, optopt is " & Reent.Optopt);
+
+	   when ':' =>
+	      Put_Line("get :, optopt is "& Reent.optopt);
+
+	   when others => null;
+	end case;
+     end loop;
+
+     for Count in Reent.Optind .. Reent.ArgC
+     loop
+        Put_Line (ptrdiff_t'Image(Count) & ": " & Get_Argument(Argv, Count));
+     end loop;
+
+     return 0;
+   end Command_Getopt_R;
 end Commands;
diff --git a/shell/commands.ads b/shell/commands.ads
index ce47730..de023c7 100644
--- a/shell/commands.ads
+++ b/shell/commands.ads
@@ -2,9 +2,10 @@
 --  $Id$
 --
 
-with Interfaces.C;         use Interfaces.C;
-with Interfaces.C.Strings; use Interfaces.C.Strings;
-with RTEMS_Shell;          use RTEMS_Shell;
+with RTEMS_Shell;            use RTEMS_Shell;
+with Command_Line_Arguments; use Command_Line_Arguments;
+with Interfaces.C;           use Interfaces.C;
+with Interfaces.C.Strings;   use Interfaces.C.Strings;
 
 package Commands is
 
@@ -18,4 +19,10 @@ package Commands is
       return int;
    pragma Convention (C, Command_Test_Arguments);
 
+   function Command_Getopt_R
+     (ArgC : Argument_Count_Type;
+      ArgV : Argument_Vector_Type)
+      return int;
+   pragma Convention (C, Command_Getopt_R);
+
 end Commands;
diff --git a/shell/getopt_r.adb b/shell/getopt_r.adb
new file mode 100644
index 0000000..22bbdc6
--- /dev/null
+++ b/shell/getopt_r.adb
@@ -0,0 +1,205 @@
+--
+--                            REENTRANT GETOPT
+--                                 BODY
+-- $Id$
+--
+--  Based upon getopt by Nasser Abbasi.
+--  modifications to support reentrancy by Joel Sherrill.
+--
+--  Copyright (C) 1998 Nasser Abbasi <nabbasi@pacbell.net>
+--  Copyright (C) 2011 Joel Sherrill <joe.sherrill@oarcorp.com>
+--
+-- This is free software;  you can  redistribute it  and/or modify it under
+-- terms of the  GNU General Public License as published  by the Free Soft-
+-- ware  Foundation;  either version 2,  or (at your option) any later ver-
+-- sion. GETOPT is distributed in the hope that it will be useful, but WITH
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+-- for  more details. 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.
+--
+------------------------------------------------------------------------------
+--
+-- change history:
+--
+-- name         changes
+-- ----------   --------------------------------------------------------------
+-- NMA021899    created
+-- NMA030299    Changed header to make it modified GPL
+--
+-- description:
+--
+-- This package is an Ada implementation of getopt() as specified by the
+-- document "The Single UNIX Specification, Version 2", Copyright 1997 The
+-- Open Group
+--
+-- This describes the items involveed using example
+--
+--
+--         curopt
+--           |
+--           V
+-- "-f foo -dbc -k"
+--  ^
+--  |
+-- optind
+--
+-- optind is position (index) that tells which command line argument is
+-- being processed now.
+-- curopt tells which optchar is being processed within one command line
+-- argument. This is needed only if more that one optchar are stuck
+-- togother in one argument with no space, as in -df where both d and f
+-- are valid optchar and d takes no optarg.
+--
+-- Compiler used: GCC 4.5.2 targeting i386-rtems4.10
+-- Platform:      Fedora 14/x86_64
+--
+
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Ada.Text_Io; use Ada.Text_Io;
+with Interfaces.C;          use Interfaces.C;
+with Interfaces.C.Pointers;
+with Interfaces.C.Strings;  use Interfaces.C.Strings;
+
+package body Getopt_R is
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize (
+     R     : Reentrant_Ptr;
+     Argc  : Argument_Count_Type;
+     Argv  : Argument_Vector_Type
+   ) is
+   begin
+      R.Optind := 2;
+      R.Optopt := ' ';
+      R.Opterr := 1;
+      R.Curopt := 2;
+      R.Argc := Argc;
+      R.ArgV := Argv;
+   end Initialize;
+
+   ------------
+   -- Getopt --
+   ------------
+
+   function Getopt (
+     R : Reentrant_Ptr;
+     Optstring : String
+   ) return Integer is
+     Arg       : Unbounded_String;
+     Arguments : Argument_Array(1 .. R.Argc);
+   begin
+
+
+      if (R.Argc = 0  or else
+          R.optind > R.Argc) then
+         return -1;
+      end if;
+
+      Arguments := Argument_Vector_Package.Value (R.ArgV, R.ArgC);
+
+      Arg := To_Unbounded_String (Value(Arguments (R.optind)));
+      if Element (Arg, 1) /= '-' then
+         return -1;
+      end if;
+      
+      if (Length(Arg) = 1) then
+         return -1;
+      end if;
+
+      --  according to The Single UNIX  Specification, Version 2, if "--"
+      --  is found, return -1 after  ++optind.
+      if Element (Arg, 2) = '-' then
+         R.Optind := R.Optind + 1;
+         return -1;
+      end if;
+
+      --  if we get here, the command argument has "-X"
+      for I in Optstring'Range loop
+         Arg := To_Unbounded_String (Value(Arguments (R.optind)));
+         if (Optstring (I) = Element (Arg, R.Curopt)) then
+            if (I < Optstring'Length) then
+               if (Optstring (I + 1) = ':') then
+
+                  --  see if optarg stuck to optchar
+                  if ( Length (Arg) -  R.Curopt > 0) then
+                     R.Optarg  := To_Unbounded_String 
+                        (Slice (Arg, R.Curopt + 1, Length (Arg)));
+                     R.Curopt := R.Curopt + 1;
+                     R.Optind := R.Optind + 1;
+                     return character'Pos (Optstring (I));
+                  end if;
+
+                  --  see if optarg on separate argument
+                  if (R.Optind < R.Argc) then
+                     R.Curopt := 2;
+                     R.Optind  := R.Optind + 1;
+                     R.Optarg  := To_Unbounded_String
+                                  (Value (Arguments (R.Optind)));
+                     R.Optind  := R.optind + 1;
+                     return character'Pos (Optstring (I));
+                  else
+                     R.Optind := R.Optind + 1;
+                     R.Optopt := Optstring (I);
+
+                     if (R.Opterr = 1  and
+                         Optstring (Optstring'First) /= ':') then
+                        Put_Line (Standard_Error,
+                                 "Argument expected for the -"&
+                                 Optstring (I .. I) & " option");
+                     end if;
+
+                     if (Optstring (Optstring'First) = ':') then
+                        return Character'Pos (':');
+                     else
+                        return  Character'Pos ('?');
+                     end if;
+                  end if;
+               else  -- current optchar matches and has no arg option
+                  if (R.Curopt < Length (Arg)) then
+                     R.Curopt := R.Curopt + 1;
+                  else
+                     R.Curopt := 2;
+                     R.Optind := R.Optind + 1;
+                  end if;
+                  return character'Pos (Optstring (I));
+               end if;
+            else -- last char in optstring, can't have argument
+               if (R.Curopt < Length (Arg)) then
+                  R.Curopt := R.Curopt + 1;
+               else
+                  R.Curopt := 2;
+                  R.Optind := R.Optind + 1;
+               end if;
+               return character'Pos (Optstring (I));
+            end if;
+         end if;
+      end loop;
+
+      Arg := To_Unbounded_String (Value(Arguments (R.optind)));
+      R.Optopt := Element (Arg, R.Curopt);
+      if (R.Curopt < Length (Arg)) then
+         R.Curopt := R.Curopt + 1;
+      else
+         R.Curopt := 2;
+         R.Optind := R.Optind + 1;
+      end if;
+
+      --  we get here if current command argument not found in optstring
+      return character'Pos ('?');
+
+   end Getopt;
+
+begin
+  Null;
+end Getopt_R;
diff --git a/shell/getopt_r.ads b/shell/getopt_r.ads
new file mode 100644
index 0000000..d802054
--- /dev/null
+++ b/shell/getopt_r.ads
@@ -0,0 +1,96 @@
+--
+--                            REENTRANT GETOPT
+--                             SPECIFICATION
+-- $Id$
+--
+--  Based upon getopt by Nasser Abbasi.
+--  modifications to support reentrancy by Joel Sherrill.
+--
+--  Copyright (C) 1998 Nasser Abbasi <nabbasi@pacbell.net>
+--  Copyright (C) 2011 Joel Sherrill <joe.sherrill@oarcorp.com>
+--
+-- This is free software;  you can  redistribute it  and/or modify it under
+-- terms of the  GNU General Public License as published  by the Free Soft-
+-- ware  Foundation;  either version 2,  or (at your option) any later ver-
+-- sion. GETOPT is distributed in the hope that it will be useful, but WITH
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+-- for  more details. 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.
+--
+------------------------------------------------------------------------------
+--
+-- change history:
+--
+-- name         changes
+-- ----------   --------------------------------------------------------------
+-- NMA021899    created
+-- NMA030299    Changed header to make it modified GPL
+--
+-- description:
+--
+-- This package is an Ada implementation of getopt() as specified by the
+-- document "The Single UNIX Specification, Version 2", Copyright 1997 The
+-- Open Group
+--
+-- This describes the items involveed using example
+--
+--
+--         curopt
+--           |
+--           V
+-- "-f foo -dbc -k"
+--  ^
+--  |
+-- optind
+--
+-- optind is position (index) that tells which command line argument is
+-- being processed now.
+-- curopt tells which optchar is being processed within one command line
+-- argument. This is needed only if more that one optchar are stuck
+-- togother in one argument with no space, as in -df where both d and f
+-- are valid optchar and d takes no optarg.
+--
+-- Compiler used: GCC 4.5.2 targeting i386-rtems4.10
+-- Platform:      Fedora 14/x86_64
+--
+
+
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Command_Line_Arguments; use Command_Line_Arguments;
+
+package Getopt_R is
+
+   pragma Elaborate_Body;
+
+   type Reentrant is
+   record 
+     Optind : Argument_Count_type;
+     Optarg : Unbounded_String;
+     Optopt : Character := ' ';
+     Opterr : Integer := 1;
+     Curopt : Natural := 2;
+     Argc   : Argument_Count_Type;
+     Argv   : Argument_Vector_Type;
+   end record; 
+
+   type Reentrant_Ptr is access all Reentrant;
+
+   procedure Initialize (
+     R     : Reentrant_Ptr;
+     Argc  : Argument_Count_Type;
+     Argv  : Argument_Vector_Type);
+
+   function Getopt (
+     R : Reentrant_Ptr;
+     Optstring : String
+   ) return Integer;
+
+end Getopt_R;
diff --git a/shell/rtems_shell.ads b/shell/rtems_shell.ads
index 8f7b5d6..90040fb 100644
--- a/shell/rtems_shell.ads
+++ b/shell/rtems_shell.ads
@@ -1,43 +1,33 @@
---

---  $Id$

---

-

-with Interfaces.C;          use Interfaces.C;

-with Interfaces.C.Strings;  use Interfaces.C.Strings;

-with Interfaces.C.Pointers;

-

-package RTEMS_Shell is

-

-   type Argument_Array is array (ptrdiff_t range <>) of aliased chars_ptr;

-

-   package Argument_Vector_Package is

-      new Pointers (Index              => ptrdiff_t,

-                    Element            => chars_ptr,

-                    Element_Array      => Argument_Array,

-                    Default_Terminator => Null_Ptr);

-

-   subtype Argument_Count_Type is ptrdiff_t;

-   subtype Argument_Vector_Type is Argument_Vector_Package.Pointer;

-

-   type Command_Function_Type is access function (ArgC : Argument_Count_Type;

-      ArgV : Argument_Vector_Type) return int;

-   pragma Convention (C, Command_Function_Type);

-

-   procedure RTEMS_Shell_Add_Command(Name : chars_ptr; Category : chars_ptr;

-      Help : chars_ptr; Command_Function : Command_Function_Type);

-   pragma Import (C, RTEMS_Shell_Add_Command, "rtems_shell_add_cmd");

-

-   type Prompt_Function_Type is access function return chars_ptr;

-   pragma Convention (C, Prompt_Function_Type);

-

-   procedure Set_RTEMS_Shell_Prompt_Function(

-      Prompt_Function : Prompt_Function_Type);

-   pragma Import (C, Set_RTEMS_Shell_Prompt_Function, "set_prompt_function");

-

-   procedure Invoke_RTEMS_Shell;

-   pragma Import (C, Invoke_RTEMS_Shell, "invoke_rtems_shell");

-

-   procedure Initialize_Telnet_Daemon;

-   pragma Import (C, Initialize_Telnet_Daemon, "init_telnet_daemon");

-

-end RTEMS_Shell;

+--
+--  $Id$
+--
+
+with Command_Line_Arguments; use Command_Line_Arguments;
+with Interfaces.C;           use Interfaces.C;
+with Interfaces.C.Strings;   use Interfaces.C.Strings;
+with Interfaces.C.Pointers;
+
+package RTEMS_Shell is
+
+   type Command_Function_Type is access function (ArgC : Argument_Count_Type;
+      ArgV : Argument_Vector_Type) return int;
+   pragma Convention (C, Command_Function_Type);
+
+   procedure RTEMS_Shell_Add_Command(Name : chars_ptr; Category : chars_ptr;
+      Help : chars_ptr; Command_Function : Command_Function_Type);
+   pragma Import (C, RTEMS_Shell_Add_Command, "rtems_shell_add_cmd");
+
+   type Prompt_Function_Type is access function return chars_ptr;
+   pragma Convention (C, Prompt_Function_Type);
+
+   procedure Set_RTEMS_Shell_Prompt_Function(
+      Prompt_Function : Prompt_Function_Type);
+   pragma Import (C, Set_RTEMS_Shell_Prompt_Function, "set_prompt_function");
+
+   procedure Invoke_RTEMS_Shell;
+   pragma Import (C, Invoke_RTEMS_Shell, "invoke_rtems_shell");
+
+   procedure Initialize_Telnet_Daemon;
+   pragma Import (C, Initialize_Telnet_Daemon, "init_telnet_daemon");
+
+end RTEMS_Shell;
diff --git a/shell/shell.adb b/shell/shell.adb
index a4ae014..1bd5096 100644
--- a/shell/shell.adb
+++ b/shell/shell.adb
@@ -1,21 +1,28 @@
---

---  $Id$

---

-

-with Interfaces.C.Strings; use Interfaces.C.Strings;

-with Commands;             use Commands;

-with RTEMS_Shell;          use RTEMS_Shell;

-

-procedure Main is

-begin

-   RTEMS_Shell_Add_Command

-     (New_String ("args"),

-      New_String ("test"),

-      New_String ("Test passing arguments"),

-      Command_Test_Arguments'Access);

-   Set_RTEMS_Shell_Prompt_Function (C_Prompt'Access);

-   Initialize_Telnet_Daemon;

-   loop

-      Invoke_RTEMS_Shell;

-   end loop;

-end Main;

+--
+--  $Id$
+--
+
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Commands;             use Commands;
+with RTEMS_Shell;          use RTEMS_Shell;
+
+procedure Shell is
+begin
+   RTEMS_Shell_Add_Command
+     (New_String ("getopt"),
+      New_String ("test"),
+      New_String ("Example of getopt with pattern c:di:n:p:u:V"),
+      Command_Getopt_R'Access);
+
+   RTEMS_Shell_Add_Command
+     (New_String ("args"),
+      New_String ("test"),
+      New_String ("Test passing arguments"),
+      Command_Test_Arguments'Access);
+
+   Set_RTEMS_Shell_Prompt_Function (C_Prompt'Access);
+   --  Initialize_Telnet_Daemon;
+   loop
+      Invoke_RTEMS_Shell;
+   end loop;
+end Shell;