From c53f12b1de543dc1fe9c6adf62655068c37e405d Mon Sep 17 00:00:00 2001 From: Joel Sherrill Date: Wed, 2 Feb 2011 19:08:06 +0000 Subject: 2011-02-02 Joel Sherrill * 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. --- shell/ChangeLog | 7 ++ shell/command_line_arguments.adb | 19 ++++ shell/command_line_arguments.ads | 25 +++++ shell/commands.adb | 52 ++++++++++ shell/commands.ads | 13 ++- shell/getopt_r.adb | 205 +++++++++++++++++++++++++++++++++++++++ shell/getopt_r.ads | 96 ++++++++++++++++++ shell/rtems_shell.ads | 76 +++++++-------- shell/shell.adb | 49 ++++++---- 9 files changed, 475 insertions(+), 67 deletions(-) create mode 100644 shell/command_line_arguments.adb create mode 100644 shell/command_line_arguments.ads create mode 100644 shell/getopt_r.adb create mode 100644 shell/getopt_r.ads 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 + + * 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 * .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 +-- Copyright (C) 2011 Joel Sherrill +-- +-- 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 +-- Copyright (C) 2011 Joel Sherrill +-- +-- 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; -- cgit v1.2.3