------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              G N A T C M D                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.8.10.1 $
--                                                                          --
--          Copyright (C) 1996-2001 Free Software Foundation, Inc.          --
--                                                                          --
-- GNAT 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.  GNAT 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.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Command_Line;        use Ada.Command_Line;
with Ada.Text_IO;             use Ada.Text_IO;

with Osint;    use Osint;
with Sdefault; use Sdefault;
with Hostparm; use Hostparm;
--  Used to determine if we are in VMS or not for error message purposes

with Gnatvsn;
with GNAT.OS_Lib;             use GNAT.OS_Lib;

with Table;

procedure GNATCmd is
   pragma Ident (Gnatvsn.Gnat_Version_String);

   ------------------
   -- SWITCH TABLE --
   ------------------

   --  The switch tables contain an entry for each switch recognized by the
   --  command processor. The syntax of entries is as follows:

   --    SWITCH_STRING ::= "/ command-qualifier-name TRANSLATION"

   --    TRANSLATION ::=
   --      DIRECT_TRANSLATION
   --    | DIRECTORIES_TRANSLATION
   --    | FILE_TRANSLATION
   --    | NUMERIC_TRANSLATION
   --    | STRING_TRANSLATION
   --    | OPTIONS_TRANSLATION
   --    | COMMANDS_TRANSLATION
   --    | ALPHANUMPLUS_TRANSLATION
   --    | OTHER_TRANSLATION

   --    DIRECT_TRANSLATION       ::= space UNIX_SWITCHES
   --    DIRECTORIES_TRANSLATION  ::= =* UNIX_SWITCH *
   --    DIRECTORY_TRANSLATION    ::= =% UNIX_SWITCH %
   --    FILE_TRANSLATION         ::= =@ UNIX_SWITCH @
   --    NUMERIC_TRANSLATION      ::= =# UNIX_SWITCH # | # number #
   --    STRING_TRANSLATION       ::= =" UNIX_SWITCH "
   --    OPTIONS_TRANSLATION      ::= =OPTION {space OPTION}
   --    COMMANDS_TRANSLATION     ::= =? ARGS space command-name
   --    ALPHANUMPLUS_TRANSLATION ::= =| UNIX_SWITCH |

   --    UNIX_SWITCHES ::= UNIX_SWITCH {, UNIX_SWITCH}

   --    UNIX_SWITCH ::= unix-switch-string | !unix-switch-string | `string'

   --    OPTION ::= option-name space UNIX_SWITCHES

   --    ARGS ::= -cargs | -bargs | -largs

   --  Here command-qual is the name of the switch recognized by the GNATCmd.
   --  This is always given in upper case in the templates, although in the
   --  actual commands, either upper or lower case is allowed.

   --  The unix-switch-string always starts with a minus, and has no commas
   --  or spaces in it. Case is significant in the unix switch string. If a
   --  unix switch string is preceded by the not sign (!) it means that the
   --  effect of the corresponding command qualifer is to remove any previous
   --  occurrence of the given switch in the command line.

   --  The DIRECTORIES_TRANSLATION format is used where a list of directories
   --  is given. This possible corresponding formats recognized by GNATCmd are
   --  as shown by the following example for the case of PATH

   --    PATH=direc
   --    PATH=(direc,direc,direc,direc)

   --  When more than one directory is present for the DIRECTORIES case, then
   --  multiple instances of the corresponding unix switch are generated,
   --  with the file name being substituted for the occurrence of *.

   --  The FILE_TRANSLATION format is similar except that only a single
   --  file is allowed, not a list of files, and only one unix switch is
   --  generated as a result.

   --  The NUMERIC_TRANSLATION format is similar to the FILE_TRANSLATION case
   --  except that the parameter is a decimal integer in the range 0 to 999.

   --  For the OPTIONS_TRANSLATION case, GNATCmd similarly permits one or
   --  more options to appear (although only in some cases does the use of
   --  multiple options make logical sense). For example, taking the
   --  case of ERRORS for GCC, the following are all allowed:

   --    /ERRORS=BRIEF
   --    /ERRORS=(FULL,VERBOSE)
   --    /ERRORS=(BRIEF IMMEDIATE)

   --  If no option is provided (e.g. just /ERRORS is written), then the
   --  first option in the list is the default option. For /ERRORS this
   --  is NORMAL, so /ERRORS with no option is equivalent to /ERRORS=NORMAL.

   --  The COMMANDS_TRANSLATION case is only used for gnatmake, to correspond
   --  to the use of -cargs, -bargs and -largs (the ARGS string as indicated
   --  is one of these three possibilities). The name given by COMMAND is the
   --  corresponding command name to be used to interprete the switches to be
   --  passed on. Switches of this type set modes, e.g. /COMPILER_QUALIFIERS
   --  sets the mode so that all subsequent switches, up to another switch
   --  with COMMANDS_TRANSLATION apply to the corresponding commands issued
   --  by the make utility. For example

   --    /COMPILER_QUALIFIERS /LIST /BINDER_QUALIFIERS /MAIN
   --    /COMPILER_QUALIFIERS /NOLIST /COMPILE_CHECKS=SYNTAX

   --  Clearly these switches must come at the end of the list of switches
   --  since all subsequent switches apply to an issued command.

   --  For the DIRECT_TRANSLATION case, an implicit additional entry is
   --  created by prepending NO to the name of the qualifer, and then
   --  inverting the sense of the UNIX_SWITCHES string. For example,
   --  given the entry:

   --     "/LIST -gnatl"

   --  An implicit entry is created:

   --     "/NOLIST !-gnatl"

   --  In the case where, a ! is already present, inverting the sense of the
   --  switch means removing it.

   subtype S is String;
   --  A synonym to shorten the table

   type String_Ptr is access constant String;
   --  String pointer type used throughout

   type Switches is array (Natural range <>) of String_Ptr;
   --  Type used for array of swtiches

   type Switches_Ptr is access constant Switches;

   --------------------------------
   -- Switches for project files --
   --------------------------------

   S_Ext_Ref      : aliased constant S := "/EXTERNAL_REFERENCE=" & '"'    &
                                            "-X" & '"';

   S_Project_File : aliased constant S := "/PROJECT_FILE=*"               &
                                            "-P*";
   S_Project_Verb : aliased constant S := "/PROJECT_FILE_VERBOSITY="      &
                                            "DEFAULT "                    &
                                               "-vP0 "                    &
                                            "MEDIUM "                     &
                                               "-vP1 "                    &
                                            "HIGH "                       &
                                               "-vP2";

   ----------------------------
   -- Switches for GNAT BIND --
   ----------------------------

   S_Bind_Bind    : aliased constant S := "/BIND_FILE="                    &
                                            "ADA "                         &
                                               "-A "                       &
                                            "C "                           &
                                               "-C";

   S_Bind_Build   : aliased constant S := "/BUILD_LIBRARY=|"               &
                                            "-L|";

   S_Bind_Current : aliased constant S := "/CURRENT_DIRECTORY "            &
                                            "!-I-";

   S_Bind_Debug   : aliased constant S := "/DEBUG="                        &
                                            "TRACEBACK "                   &
                                               "-g2 "                      &
                                            "ALL "                         &
                                               "-g3 "                      &
                                            "NONE "                        &
                                               "-g0 "                      &
                                            "SYMBOLS "                     &
                                               "-g1 "                      &
                                            "NOSYMBOLS "                   &
                                               "!-g1 "                     &
                                            "LINK "                        &
                                               "-g3 "                      &
                                            "NOTRACEBACK "                 &
                                               "!-g2";

   S_Bind_DebugX  : aliased constant S := "/NODEBUG "                      &
                                            "!-g";

   S_Bind_Elab    : aliased constant S := "/ELABORATION_DEPENDENCIES "     &
                                            "-e";

   S_Bind_Error   : aliased constant S := "/ERROR_LIMIT=#"                 &
                                            "-m#";

   S_Bind_Library : aliased constant S := "/LIBRARY_SEARCH=*"              &
                                            "-aO*";

   S_Bind_Linker  : aliased constant S := "/LINKER_OPTION_LIST "           &
                                            "-K";

   S_Bind_Main    : aliased constant S := "/MAIN "                         &
                                            "!-n";

   S_Bind_Nostinc : aliased constant S := "/NOSTD_INCLUDES "               &
                                            "-nostdinc";

   S_Bind_Nostlib : aliased constant S := "/NOSTD_LIBRARIES "              &
                                            "-nostdlib";

   S_Bind_Object  : aliased constant S := "/OBJECT_LIST "                  &
                                            "-O";

   S_Bind_Order   : aliased constant S := "/ORDER_OF_ELABORATION "         &
                                            "-l";

   S_Bind_Output  : aliased constant S := "/OUTPUT=@"                      &
                                            "-o@";

   S_Bind_OutputX : aliased constant S := "/NOOUTPUT "                     &
                                            "-c";

   S_Bind_Pess    : aliased constant S := "/PESSIMISTIC_ELABORATION "      &
                                            "-p";

   S_Bind_Read    : aliased constant S := "/READ_SOURCES="                 &
                                            "ALL "                         &
                                               "-s "                       &
                                            "NONE "                        &
                                               "-x "                       &
                                            "AVAILABLE "                   &
                                               "!-x,!-s";

   S_Bind_ReadX   : aliased constant S := "/NOREAD_SOURCES "               &
                                            "-x";

   S_Bind_Rename  : aliased constant S := "/RENAME_MAIN "                  &
                                           "-r";

   S_Bind_Report  : aliased constant S := "/REPORT_ERRORS="                &
                                            "VERBOSE "                     &
                                               "-v "                       &
                                            "BRIEF "                       &
                                               "-b "                       &
                                            "DEFAULT "                     &
                                               "!-b,!-v";

   S_Bind_ReportX : aliased constant S := "/NOREPORT_ERRORS "              &
                                            "!-b,!-v";

   S_Bind_Search  : aliased constant S := "/SEARCH=*"                      &
                                            "-I*";

   S_Bind_Shared  : aliased constant S := "/SHARED "                       &
                                           "-shared";

   S_Bind_Source  : aliased constant S := "/SOURCE_SEARCH=*"               &
                                            "-aI*";

   S_Bind_Time    : aliased constant S := "/TIME_STAMP_CHECK "             &
                                            "!-t";

   S_Bind_Verbose : aliased constant S := "/VERBOSE "                      &
                                            "-v";

   S_Bind_Warn    : aliased constant S := "/WARNINGS="                     &
                                            "NORMAL "                      &
                                               "!-ws,!-we "                &
                                            "SUPPRESS "                    &
                                               "-ws "                      &
                                            "ERROR "                       &
                                               "-we";

   S_Bind_WarnX   : aliased constant S := "/NOWARNINGS "                   &
                                            "-ws";

   Bind_Switches : aliased constant Switches := (
     S_Bind_Bind    'Access,
     S_Bind_Build   'Access,
     S_Bind_Current 'Access,
     S_Bind_Debug   'Access,
     S_Bind_DebugX  'Access,
     S_Bind_Elab    'Access,
     S_Bind_Error   'Access,
     S_Ext_Ref      'Access,
     S_Bind_Library 'Access,
     S_Bind_Linker  'Access,
     S_Bind_Main    'Access,
     S_Bind_Nostinc 'Access,
     S_Bind_Nostlib 'Access,
     S_Bind_Object  'Access,
     S_Bind_Order   'Access,
     S_Bind_Output  'Access,
     S_Bind_OutputX 'Access,
     S_Bind_Pess    'Access,
     S_Project_File 'Access,
     S_Project_Verb 'Access,
     S_Bind_Read    'Access,
     S_Bind_ReadX   'Access,
     S_Bind_Rename  'Access,
     S_Bind_Report  'Access,
     S_Bind_ReportX 'Access,
     S_Bind_Search  'Access,
     S_Bind_Shared  'Access,
     S_Bind_Source  'Access,
     S_Bind_Time    'Access,
     S_Bind_Verbose 'Access,
     S_Bind_Warn    'Access,
     S_Bind_WarnX   'Access);

   ----------------------------
   -- Switches for GNAT CHOP --
   ----------------------------

   S_Chop_Comp   : aliased constant S := "/COMPILATION "                   &
                                            "-c";

   S_Chop_File   : aliased constant S := "/FILE_NAME_MAX_LENGTH=#"         &
                                            "-k#";

   S_Chop_Help   : aliased constant S := "/HELP "                          &
                                            "-h";

   S_Chop_Over   : aliased constant S := "/OVERWRITE "                     &
                                            "-w";

   S_Chop_Pres   : aliased constant S := "/PRESERVE "                      &
                                            "-p";

   S_Chop_Quiet  : aliased constant S := "/QUIET "                         &
                                            "-q";

   S_Chop_Ref    : aliased constant S := "/REFERENCE "                     &
                                            "-r";

   S_Chop_Verb   : aliased constant S := "/VERBOSE "                       &
                                            "-v";

   Chop_Switches : aliased constant Switches := (
     S_Chop_Comp   'Access,
     S_Chop_File   'Access,
     S_Chop_Help   'Access,
     S_Chop_Over   'Access,
     S_Chop_Pres   'Access,
     S_Chop_Quiet  'Access,
     S_Chop_Ref    'Access,
     S_Chop_Verb   'Access);

   -------------------------------
   -- Switches for GNAT COMPILE --
   -------------------------------

   S_GCC_Ada_83  : aliased constant S := "/83 "                            &
                                            "-gnat83";

   S_GCC_Ada_95  : aliased constant S := "/95 "                            &
                                            "!-gnat83";

   S_GCC_Asm     : aliased constant S := "/ASM "                           &
                                            "-S,!-c";

   S_GCC_Checks  : aliased constant S := "/CHECKS="                        &
                                             "FULL "                       &
                                                "-gnato,!-gnatE,!-gnatp "  &
                                             "OVERFLOW "                   &
                                                "-gnato "                  &
                                             "ELABORATION "                &
                                                "-gnatE "                  &
                                             "ASSERTIONS "                 &
                                                "-gnata "                  &
                                             "DEFAULT "                    &
                                                "!-gnato,!-gnatp "         &
                                             "SUPPRESS_ALL "               &
                                                "-gnatp";

   S_GCC_ChecksX : aliased constant S := "/NOCHECKS "                      &
                                             "-gnatp,!-gnato,!-gnatE";

   S_GCC_Compres : aliased constant S := "/COMPRESS_NAMES "                &
                                            "-gnatC";

   S_GCC_Current : aliased constant S := "/CURRENT_DIRECTORY "             &
                                            "!-I-";

   S_GCC_Debug   : aliased constant S := "/DEBUG="                         &
                                            "SYMBOLS "                     &
                                               "-g2 "                      &
                                            "NOSYMBOLS "                   &
                                               "!-g2 "                     &
                                            "TRACEBACK "                   &
                                               "-g1 "                      &
                                            "ALL "                         &
                                               "-g3 "                      &
                                            "NONE "                        &
                                               "-g0 "                      &
                                            "NOTRACEBACK "                 &
                                               "-g0";

   S_GCC_DebugX  : aliased constant S := "/NODEBUG "                       &
                                            "!-g";

   S_GCC_Dist    : aliased constant S := "/DISTRIBUTION_STUBS="            &
                                            "RECEIVER "                    &
                                               "-gnatzr "                  &
                                            "CALLER "                      &
                                               "-gnatzc";

   S_GCC_DistX   : aliased constant S := "/NODISTRIBUTION_STUBS "          &
                                            "!-gnatzr,!-gnatzc";

   S_GCC_Error   : aliased constant S := "/ERROR_LIMIT=#"                  &
                                            "-gnatm#";

   S_GCC_ErrorX  : aliased constant S := "/NOERROR_LIMIT "                 &
                                            "-gnatm999";

   S_GCC_Expand  : aliased constant S := "/EXPAND_SOURCE "                 &
                                            "-gnatG";

   S_GCC_Extend  : aliased constant S := "/EXTENSIONS_ALLOWED "            &
                                            "-gnatX";

   S_GCC_File    : aliased constant S := "/FILE_NAME_MAX_LENGTH=#"         &
                                            "-gnatk#";

   S_GCC_Force   : aliased constant S := "/FORCE_ALI "                     &
                                            "-gnatQ";

   S_GCC_Ident   : aliased constant S := "/IDENTIFIER_CHARACTER_SET="      &
                                             "DEFAULT "                    &
                                                "-gnati1 "                 &
                                             "1 "                          &
                                                "-gnati1 "                 &
                                             "2 "                          &
                                                "-gnati2 "                 &
                                             "3 "                          &
                                                "-gnati3 "                 &
                                             "4 "                          &
                                                "-gnati4 "                 &
                                             "5 "                          &
                                                "-gnati5 "                 &
                                             "PC "                         &
                                                "-gnatip "                 &
                                             "PC850 "                      &
                                                "-gnati8 "                 &
                                             "FULL_UPPER "                 &
                                                "-gnatif "                 &
                                             "NO_UPPER "                   &
                                                "-gnatin "                 &
                                             "WIDE "                       &
                                                "-gnatiw";

   S_GCC_IdentX  : aliased constant S := "/NOIDENTIFIER_CHARACTER_SET "    &
                                             "-gnati1";

   S_GCC_Inline  : aliased constant S := "/INLINE="                        &
                                            "PRAGMA "                      &
                                              "-gnatn "                    &
                                            "SUPPRESS "                    &
                                            "-fno-inline";

   S_GCC_InlineX : aliased constant S := "/NOINLINE "                      &
                                            "!-gnatn";

   S_GCC_List    : aliased constant S := "/LIST "                          &
                                            "-gnatl";

   S_GCC_Noload  : aliased constant S := "/NOLOAD "                        &
                                            "-gnatc";

   S_GCC_Nostinc : aliased constant S := "/NOSTD_INCLUDES "                &
                                            "-nostdinc";

   S_GCC_Opt     : aliased constant S := "/OPTIMIZE="                      &
                                            "ALL "                         &
                                               "-O2,!-O0,!-O1,!-O3 "       &
                                            "NONE "                        &
                                               "-O0,!-O1,!-O2,!-O3 "       &
                                            "SOME "                        &
                                               "-O1,!-O0,!-O2,!-O3 "       &
                                            "DEVELOPMENT "                 &
                                               "-O1,!-O0,!-O2,!-O3 "       &
                                            "UNROLL_LOOPS "                &
                                               "-funroll-loops "           &
                                            "INLINING "                    &
                                               "-O3,!-O0,!-O1,!-O2";

   S_GCC_OptX    : aliased constant S := "/NOOPTIMIZE "                    &
                                            "-O0,!-O1,!-O2,!-O3";

   S_GCC_Report  : aliased constant S := "/REPORT_ERRORS="                 &
                                            "VERBOSE "                     &
                                               "-gnatv "                   &
                                            "BRIEF "                       &
                                               "-gnatb "                   &
                                            "FULL "                        &
                                               "-gnatf "                   &
                                            "IMMEDIATE "                   &
                                               "-gnate "                   &
                                            "DEFAULT "                     &
                                               "!-gnatb,!-gnatv";

   S_GCC_ReportX : aliased constant S := "/NOREPORT_ERRORS "               &
                                            "!-gnatb,!-gnatv";

   S_GCC_Repinfo : aliased constant S := "/REPRESENTATION_INFO="           &
                                            "ARRAYS "                      &
                                            "-gnatR1 "                     &
                                            "NONE "                        &
                                            "-gnatR0 "                     &
                                            "OBJECTS "                     &
                                            "-gnatR2 "                     &
                                            "SYMBOLIC "                    &
                                            "-gnatR3 "                     &
                                            "DEFAULT "                     &
                                            "-gnatR";

   S_GCC_RepinfX : aliased constant S := "/NOREPRESENTATION_INFO "         &
                                            "!-gnatR";

   S_GCC_Search  : aliased constant S := "/SEARCH=*"                       &
                                            "-I*";

   S_GCC_Style   : aliased constant S := "/STYLE_CHECKS="                  &
                                            "ALL_BUILTIN "                 &
                                               "-gnaty "                   &
                                            "1 "                           &
                                               "-gnaty1 "                  &
                                            "2 "                           &
                                               "-gnaty2 "                  &
                                            "3 "                           &
                                               "-gnaty3 "                  &
                                            "4 "                           &
                                               "-gnaty4 "                  &
                                            "5 "                           &
                                               "-gnaty5 "                  &
                                            "6 "                           &
                                               "-gnaty6 "                  &
                                            "7 "                           &
                                               "-gnaty7 "                  &
                                            "8 "                           &
                                               "-gnaty8 "                  &
                                            "9 "                           &
                                               "-gnaty9 "                  &
                                            "ATTRIBUTE "                   &
                                               "-gnatya "                  &
                                            "BLANKS "                      &
                                               "-gnatyb "                  &
                                            "COMMENTS "                    &
                                               "-gnatyc "                  &
                                            "END "                         &
                                               "-gnatye "                  &
                                            "VTABS "                       &
                                               "-gnatyf "                  &
                                            "GNAT "                        &
                                               "-gnatg "                   &
                                            "HTABS "                       &
                                               "-gnatyh "                  &
                                            "IF_THEN "                     &
                                               "-gnatyi "                  &
                                            "KEYWORD "                     &
                                               "-gnatyk "                  &
                                            "LAYOUT "                      &
                                               "-gnatyl "                  &
                                            "LINE_LENGTH "                 &
                                               "-gnatym "                  &
                                            "STANDARD_CASING "             &
                                               "-gnatyn "                  &
                                            "ORDERED_SUBPROGRAMS "         &
                                               "-gnatyo "                  &
                                            "NONE "                        &
                                               "!-gnatg,!-gnatr "          &
                                            "PRAGMA "                      &
                                               "-gnatyp "                  &
                                            "REFERENCES "                  &
                                               "-gnatr "                   &
                                            "SPECS "                       &
                                               "-gnatys "                  &
                                            "TOKEN "                       &
                                               "-gnatyt ";

   S_GCC_StyleX  : aliased constant S := "/NOSTYLE_CHECKS "                &
                                            "!-gnatg,!-gnatr";

   S_GCC_Syntax  : aliased constant S := "/SYNTAX_ONLY "                   &
                                            "-gnats";

   S_GCC_Trace   : aliased constant S := "/TRACE_UNITS "                   &
                                            "-gnatdc";

   S_GCC_Tree    : aliased constant S := "/TREE_OUTPUT "                   &
                                            "-gnatt";

   S_GCC_Trys    : aliased constant S := "/TRY_SEMANTICS "                 &
                                            "-gnatq";

   S_GCC_Units   : aliased constant S := "/UNITS_LIST "                    &
                                            "-gnatu";

   S_GCC_Unique  : aliased constant S := "/UNIQUE_ERROR_TAG "              &
                                            "-gnatU";

   S_GCC_Upcase  : aliased constant S := "/UPPERCASE_EXTERNALS "           &
                                            "-gnatF";

   S_GCC_Valid   : aliased constant S := "/VALIDITY_CHECKING="             &
                                            "DEFAULT "                     &
                                            "-gnatVd "                     &
                                            "NODEFAULT "                   &
                                            "-gnatVD "                     &
                                            "COPIES "                      &
                                            "-gnatVc "                     &
                                            "NOCOPIES "                    &
                                            "-gnatVC "                     &
                                            "FLOATS "                      &
                                            "-gnatVf "                     &
                                            "NOFLOATS "                    &
                                            "-gnatVF "                     &
                                            "IN_PARAMS "                   &
                                            "-gnatVi "                     &
                                            "NOIN_PARAMS "                 &
                                            "-gnatVI "                     &
                                            "MOD_PARAMS "                  &
                                            "-gnatVm "                     &
                                            "NOMOD_PARAMS "                &
                                            "-gnatVM "                     &
                                            "OPERANDS "                    &
                                            "-gnatVo "                     &
                                            "NOOPERANDS "                  &
                                            "-gnatVO "                     &
                                            "RETURNS "                     &
                                            "-gnatVr "                     &
                                            "NORETURNS "                   &
                                            "-gnatVR "                     &
                                            "SUBSCRIPTS "                  &
                                            "-gnatVs "                     &
                                            "NOSUBSCRIPTS "                &
                                            "-gnatVS "                     &
                                            "TESTS "                       &
                                            "-gnatVt "                     &
                                            "NOTESTS "                     &
                                            "-gnatVT "                     &
                                            "ALL "                         &
                                            "-gnatVa "                     &
                                            "NONE "                        &
                                            "-gnatVn";

   S_GCC_Verbose : aliased constant S := "/VERBOSE "                       &
                                            "-v";

   S_GCC_Warn    : aliased constant S := "/WARNINGS="                      &
                                            "DEFAULT "                     &
                                               "!-gnatws,!-gnatwe "        &
                                            "ALL_GCC "                     &
                                               "-Wall "                    &
                                            "CONDITIONALS "                &
                                               "-gnatwc "                  &
                                            "NOCONDITIONALS "              &
                                               "-gnatwC "                  &
                                            "ELABORATION "                 &
                                               "-gnatwl "                  &
                                            "NOELABORATION "               &
                                               "-gnatwL "                  &
                                            "ERRORS "                      &
                                               "-gnatwe "                  &
                                            "HIDING "                      &
                                               "-gnatwh "                  &
                                            "NOHIDING "                    &
                                               "-gnatwH "                  &
                                            "IMPLEMENTATION "              &
                                               "-gnatwi "                  &
                                            "NOIMPLEMENTATION "            &
                                               "-gnatwI "                  &
                                            "OPTIONAL "                    &
                                               "-gnatwa "                  &
                                            "NOOPTIONAL "                  &
                                               "-gnatwA "                  &
                                            "OVERLAYS "                    &
                                               "-gnatwo "                  &
                                            "NOOVERLAYS "                  &
                                               "-gnatwO "                  &
                                            "REDUNDANT "                   &
                                               "-gnatwr "                  &
                                            "NOREDUNDANT "                 &
                                               "-gnatwR "                  &
                                            "SUPPRESS "                    &
                                               "-gnatws "                  &
                                            "UNINITIALIZED "               &
                                               "-Wuninitialized "          &
                                            "UNUSED "                      &
                                               "-gnatwu "                  &
                                            "NOUNUSED "                    &
                                               "-gnatwU";

   S_GCC_WarnX   : aliased constant S := "/NOWARNINGS "                    &
                                            "-gnatws";

   S_GCC_Wide    : aliased constant S := "/WIDE_CHARACTER_ENCODING="       &
                                             "BRACKETS "                   &
                                                "-gnatWb "                 &
                                             "NONE "                       &
                                                "-gnatWn "                 &
                                             "HEX "                        &
                                                "-gnatWh "                 &
                                             "UPPER "                      &
                                                "-gnatWu "                 &
                                             "SHIFT_JIS "                  &
                                                "-gnatWs "                 &
                                             "UTF8 "                       &
                                                "-gnatW8 "                 &
                                             "EUC "                        &
                                                "-gnatWe";

   S_GCC_WideX   : aliased constant S := "/NOWIDE_CHARACTER_ENCODING "     &
                                            "-gnatWn";

   S_GCC_Xdebug  : aliased constant S := "/XDEBUG "                        &
                                            "-gnatD";

   S_GCC_Xref    : aliased constant S := "/XREF="                          &
                                            "GENERATE "                    &
                                              "!-gnatx "                   &
                                            "SUPPRESS "                    &
                                              "-gnatx";

   GCC_Switches : aliased constant Switches := (
     S_GCC_Ada_83  'Access,
     S_GCC_Ada_95  'Access,
     S_GCC_Asm     'Access,
     S_GCC_Checks  'Access,
     S_GCC_ChecksX 'Access,
     S_GCC_Compres 'Access,
     S_GCC_Current 'Access,
     S_GCC_Debug   'Access,
     S_GCC_DebugX  'Access,
     S_GCC_Dist    'Access,
     S_GCC_DistX   'Access,
     S_GCC_Error   'Access,
     S_GCC_ErrorX  'Access,
     S_GCC_Expand  'Access,
     S_GCC_Extend  'Access,
     S_GCC_File    'Access,
     S_GCC_Force   'Access,
     S_GCC_Ident   'Access,
     S_GCC_IdentX  'Access,
     S_GCC_Inline  'Access,
     S_GCC_InlineX 'Access,
     S_GCC_List    'Access,
     S_GCC_Noload  'Access,
     S_GCC_Nostinc 'Access,
     S_GCC_Opt     'Access,
     S_GCC_OptX    'Access,
     S_GCC_Report  'Access,
     S_GCC_ReportX 'Access,
     S_GCC_Repinfo 'Access,
     S_GCC_RepinfX 'Access,
     S_GCC_Search  'Access,
     S_GCC_Style   'Access,
     S_GCC_StyleX  'Access,
     S_GCC_Syntax  'Access,
     S_GCC_Trace   'Access,
     S_GCC_Tree    'Access,
     S_GCC_Trys    'Access,
     S_GCC_Units   'Access,
     S_GCC_Unique  'Access,
     S_GCC_Upcase  'Access,
     S_GCC_Valid   'Access,
     S_GCC_Verbose 'Access,
     S_GCC_Warn    'Access,
     S_GCC_WarnX   'Access,
     S_GCC_Wide    'Access,
     S_GCC_WideX   'Access,
     S_GCC_Xdebug  'Access,
     S_GCC_Xref    'Access);

   ----------------------------
   -- Switches for GNAT ELIM --
   ----------------------------

   S_Elim_All    : aliased constant S := "/ALL "                           &
                                            "-a";

   S_Elim_Miss   : aliased constant S := "/MISSED "                        &
                                            "-m";

   S_Elim_Verb   : aliased constant S := "/VERBOSE "                       &
                                            "-v";

   Elim_Switches : aliased constant Switches := (
     S_Elim_All    'Access,
     S_Elim_Miss   'Access,
     S_Elim_Verb   'Access);

   ----------------------------
   -- Switches for GNAT FIND --
   ----------------------------

   S_Find_All     : aliased constant S := "/ALL_FILES "                    &
                                            "-a";

   S_Find_Expr    : aliased constant S := "/EXPRESSIONS "                  &
                                            "-e";

   S_Find_Full    : aliased constant S := "/FULL_PATHNAME "                &
                                            "-f";

   S_Find_Ignore  : aliased constant S := "/IGNORE_LOCALS "                &
                                            "-g";

   S_Find_Object  : aliased constant S := "/OBJECT_SEARCH=*"               &
                                            "-aO*";

   S_Find_Print   : aliased constant S := "/PRINT_LINES "                  &
                                            "-s";

   S_Find_Project : aliased constant S := "/PROJECT=@"                     &
                                            "-p@";

   S_Find_Ref     : aliased constant S := "/REFERENCES "                   &
                                            "-r";

   S_Find_Search  : aliased constant S := "/SEARCH=*"                      &
                                            "-I*";

   S_Find_Source  : aliased constant S := "/SOURCE_SEARCH=*"               &
                                            "-aI*";

   Find_Switches : aliased constant Switches := (
      S_Find_All     'Access,
      S_Find_Expr    'Access,
      S_Ext_Ref      'Access,
      S_Find_Full    'Access,
      S_Find_Ignore  'Access,
      S_Find_Object  'Access,
      S_Find_Print   'Access,
      S_Find_Project 'Access,
      S_Project_File 'Access,
      S_Project_Verb 'Access,
      S_Find_Ref     'Access,
      S_Find_Search  'Access,
      S_Find_Source  'Access);

   ------------------------------
   -- Switches for GNAT KRUNCH --
   ------------------------------

   S_Krunch_Count  : aliased constant S := "/COUNT=#"                      &
                                            "`#";

   Krunch_Switches : aliased constant Switches  := (1 .. 1 =>
     S_Krunch_Count  'Access);

   -------------------------------
   -- Switches for GNAT LIBRARY --
   -------------------------------

   S_Lbr_Config    : aliased constant S := "/CONFIG=@"                     &
                                            "--config=@";

   S_Lbr_Create    : aliased constant S := "/CREATE=%"                     &
                                               "--create=%";

   S_Lbr_Delete    : aliased constant S := "/DELETE=%"                     &
                                               "--delete=%";

   S_Lbr_Set       : aliased constant S := "/SET=%"                        &
                                               "--set=%";

   Lbr_Switches : aliased constant Switches  := (
     S_Lbr_Config 'Access,
     S_Lbr_Create 'Access,
     S_Lbr_Delete 'Access,
     S_Lbr_Set    'Access);

   ----------------------------
   -- Switches for GNAT LINK --
   ----------------------------

   S_Link_Bind    : aliased constant S := "/BIND_FILE="                    &
                                            "ADA "                         &
                                               "-A "                       &
                                            "C "                           &
                                               "-C";

   S_Link_Debug   : aliased constant S := "/DEBUG="                        &
                                            "ALL "                         &
                                               "-g3 "                      &
                                            "NONE "                        &
                                               "-g0 "                      &
                                            "TRACEBACK "                   &
                                               "-g1 "                      &
                                            "NOTRACEBACK "                 &
                                               "-g0";

   S_Link_Execut  : aliased constant S := "/EXECUTABLE=@"                  &
                                            "-o@";

   S_Link_Ident   : aliased constant S := "/IDENTIFICATION=" & '"'         &
                                            "--for-linker=IDENT="          &
                                            '"';

   S_Link_Nocomp  : aliased constant S := "/NOCOMPILE "                    &
                                            "-n";

   S_Link_Nofiles : aliased constant S := "/NOSTART_FILES "                &
                                            "-nostartfiles";

   S_Link_Noinhib : aliased constant S := "/NOINHIBIT-EXEC "               &
                                            "--for-linker=--noinhibit-exec";

   S_Link_Static  : aliased constant S := "/STATIC "                       &
                                            "--for-linker=-static";

   S_Link_Verb    : aliased constant S := "/VERBOSE "                      &
                                            "-v";

   S_Link_ZZZZZ   : aliased constant S := "/<other> "                      &
                                            "--for-linker=";

   Link_Switches : aliased constant Switches := (
      S_Link_Bind    'Access,
      S_Link_Debug   'Access,
      S_Link_Execut  'Access,
      S_Ext_Ref      'Access,
      S_Link_Ident   'Access,
      S_Link_Nocomp  'Access,
      S_Link_Nofiles 'Access,
      S_Link_Noinhib 'Access,
      S_Project_File 'Access,
      S_Project_Verb 'Access,
      S_Link_Static  'Access,
      S_Link_Verb    'Access,
      S_Link_ZZZZZ   'Access);

   ----------------------------
   -- Switches for GNAT LIST --
   ----------------------------

   S_List_All     : aliased constant S := "/ALL_UNITS "                    &
                                            "-a";

   S_List_Current : aliased constant S := "/CURRENT_DIRECTORY "            &
                                            "!-I-";

   S_List_Depend  : aliased constant S := "/DEPENDENCIES "                 &
                                            "-d";

   S_List_Nostinc : aliased constant S := "/NOSTD_INCLUDES "               &
                                            "-nostdinc";

   S_List_Object  : aliased constant S := "/OBJECT_SEARCH=*"               &
                                            "-aO*";

   S_List_Output  : aliased constant S := "/OUTPUT="                       &
                                            "SOURCES "                     &
                                               "-s "                       &
                                            "OBJECTS "                     &
                                               "-o "                       &
                                            "UNITS "                       &
                                               "-u "                       &
                                            "OPTIONS "                     &
                                               "-h "                       &
                                            "VERBOSE "                     &
                                               "-v ";

   S_List_Search  : aliased constant S := "/SEARCH=*"                      &
                                            "-I*";

   S_List_Source  : aliased constant S := "/SOURCE_SEARCH=*"               &
                                            "-aI*";

   List_Switches : aliased constant Switches := (
     S_List_All     'Access,
     S_List_Current 'Access,
     S_List_Depend  'Access,
     S_Ext_Ref      'Access,
     S_List_Nostinc 'Access,
     S_List_Object  'Access,
     S_List_Output  'Access,
     S_Project_File 'Access,
     S_Project_Verb 'Access,
     S_List_Search  'Access,
     S_List_Source  'Access);

   ----------------------------
   -- Switches for GNAT MAKE --
   ----------------------------

   S_Make_Actions : aliased constant S := "/ACTIONS="                      &
                                            "COMPILE "                     &
                                              "-c "                        &
                                            "BIND "                        &
                                              "-b "                        &
                                            "LINK "                        &
                                              "-l ";

   S_Make_All     : aliased constant S := "/ALL_FILES "                    &
                                            "-a";

   S_Make_Bind    : aliased constant S := "/BINDER_QUALIFIERS=?"           &
                                            "-bargs BIND";

   S_Make_Comp    : aliased constant S := "/COMPILER_QUALIFIERS=?"         &
                                            "-cargs COMPILE";

   S_Make_Cond    : aliased constant S := "/CONDITIONAL_SOURCE_SEARCH=*"   &
                                            "-A*";

   S_Make_Cont    : aliased constant S := "/CONTINUE_ON_ERROR "            &
                                            "-k";

   S_Make_Current : aliased constant S := "/CURRENT_DIRECTORY "            &
                                            "!-I-";

   S_Make_Dep     : aliased constant S := "/DEPENDENCIES_LIST "            &
                                            "-M";

   S_Make_Doobj   : aliased constant S := "/DO_OBJECT_CHECK "              &
                                            "-n";

   S_Make_Execut  : aliased constant S := "/EXECUTABLE=@"                  &
                                            "-o@";

   S_Make_Force   : aliased constant S := "/FORCE_COMPILE "                &
                                            "-f";

   S_Make_Inplace : aliased constant S := "/IN_PLACE "                     &
                                           "-i";

   S_Make_Library : aliased constant S := "/LIBRARY_SEARCH=*"              &
                                            "-L*";

   S_Make_Link    : aliased constant S := "/LINKER_QUALIFIERS=?"           &
                                            "-largs LINK";

   S_Make_Minimal : aliased constant S := "/MINIMAL_RECOMPILATION "        &
                                           "-m";

   S_Make_Nolink  : aliased constant S := "/NOLINK "                       &
                                            "-c";

   S_Make_Nostinc : aliased constant S := "/NOSTD_INCLUDES "               &
                                            "-nostdinc";

   S_Make_Nostlib : aliased constant S := "/NOSTD_LIBRARIES "              &
                                            "-nostdlib";

   S_Make_Object  : aliased constant S := "/OBJECT_SEARCH=*"               &
                                            "-aO*";

   S_Make_Proc    : aliased constant S := "/PROCESSES=#"                   &
                                            "-j#";

   S_Make_Nojobs  : aliased constant S := "/NOPROCESSES "                  &
                                            "-j1";

   S_Make_Quiet   : aliased constant S := "/QUIET "                        &
                                            "-q";

   S_Make_Reason  : aliased constant S := "/REASONS "                      &
                                            "-v";

   S_Make_Search  : aliased constant S := "/SEARCH=*"                      &
                                            "-I*";

   S_Make_Skip    : aliased constant S := "/SKIP_MISSING=*"                &
                                            "-aL*";

   S_Make_Source  : aliased constant S := "/SOURCE_SEARCH=*"               &
                                            "-aI*";

   S_Make_Verbose : aliased constant S := "/VERBOSE "                      &
                                            "-v";

   Make_Switches : aliased constant Switches := (
     S_Make_Actions 'Access,
     S_Make_All     'Access,
     S_Make_Bind    'Access,
     S_Make_Comp    'Access,
     S_Make_Cond    'Access,
     S_Make_Cont    'Access,
     S_Make_Current 'Access,
     S_Make_Dep     'Access,
     S_Make_Doobj   'Access,
     S_Make_Execut  'Access,
     S_Ext_Ref      'Access,
     S_Make_Force   'Access,
     S_Make_Inplace 'Access,
     S_Make_Library 'Access,
     S_Make_Link    'Access,
     S_Make_Minimal 'Access,
     S_Make_Nolink  'Access,
     S_Make_Nostinc 'Access,
     S_Make_Nostlib 'Access,
     S_Make_Object  'Access,
     S_Make_Proc    'Access,
     S_Project_File 'Access,
     S_Project_Verb 'Access,
     S_Make_Nojobs  'Access,
     S_Make_Quiet   'Access,
     S_Make_Reason  'Access,
     S_Make_Search  'Access,
     S_Make_Skip    'Access,
     S_Make_Source  'Access,
     S_Make_Verbose 'Access);

   ----------------------------------
   -- Switches for GNAT PREPROCESS --
   ----------------------------------

   S_Prep_Blank   : aliased constant S := "/BLANK_LINES "                   &
                                            "-b";

   S_Prep_Com     : aliased constant S := "/COMMENTS "                      &
                                            "-c";

   S_Prep_Ref     : aliased constant S := "/REFERENCE "                     &
                                            "-r";

   S_Prep_Remove  : aliased constant S := "/REMOVE "                        &
                                            "!-b,!-c";

   S_Prep_Symbols : aliased constant S := "/SYMBOLS "                       &
                                            "-s";

   S_Prep_Undef   : aliased constant S := "/UNDEFINED "                     &
                                            "-u";

   S_Prep_Verbose : aliased constant S := "/VERBOSE "                       &
                                            "-v";

   S_Prep_Version : aliased constant S := "/VERSION "                       &
                                            "-v";

   Prep_Switches : aliased constant Switches := (
     S_Prep_Blank   'Access,
     S_Prep_Com     'Access,
     S_Prep_Ref     'Access,
     S_Prep_Remove  'Access,
     S_Prep_Symbols 'Access,
     S_Prep_Undef   'Access,
     S_Prep_Verbose 'Access,
     S_Prep_Version 'Access);

   ------------------------------
   -- Switches for GNAT SHARED --
   ------------------------------

   S_Shared_Debug   : aliased constant S := "/DEBUG="                      &
                                            "ALL "                         &
                                               "-g3 "                      &
                                            "NONE "                        &
                                               "-g0 "                      &
                                            "TRACEBACK "                   &
                                               "-g1 "                      &
                                            "NOTRACEBACK "                 &
                                               "-g0";

   S_Shared_Image  : aliased constant S := "/IMAGE=@"                      &
                                            "-o@";

   S_Shared_Ident   : aliased constant S := "/IDENTIFICATION=" & '"'       &
                                            "--for-linker=IDENT="          &
                                            '"';

   S_Shared_Nofiles : aliased constant S := "/NOSTART_FILES "              &
                                            "-nostartfiles";

   S_Shared_Noinhib : aliased constant S := "/NOINHIBIT-IMAGE "            &
                                            "--for-linker=--noinhibit-exec";

   S_Shared_Verb    : aliased constant S := "/VERBOSE "                    &
                                            "-v";

   S_Shared_ZZZZZ   : aliased constant S := "/<other> "                    &
                                            "--for-linker=";

   Shared_Switches : aliased constant Switches := (
      S_Shared_Debug   'Access,
      S_Shared_Image   'Access,
      S_Shared_Ident   'Access,
      S_Shared_Nofiles 'Access,
      S_Shared_Noinhib 'Access,
      S_Shared_Verb    'Access,
      S_Shared_ZZZZZ   'Access);

   --------------------------------
   -- Switches for GNAT STANDARD --
   --------------------------------

   Standard_Switches : aliased constant Switches := (1 .. 0 => null);

   ----------------------------
   -- Switches for GNAT STUB --
   ----------------------------

   S_Stub_Current : aliased constant S := "/CURRENT_DIRECTORY "            &
                                            "!-I-";

   S_Stub_Full    : aliased constant S := "/FULL "                         &
                                            "-f";

   S_Stub_Header  : aliased constant S := "/HEADER="                       &
                                            "GENERAL "                     &
                                               "-hg "                      &
                                            "SPEC "                        &
                                               "-hs";

   S_Stub_Indent  : aliased constant S := "/INDENTATION=#"                 &
                                            "-i#";

   S_Stub_Length  : aliased constant S := "/LINE_LENGTH=#"                 &
                                            "-l#";

   S_Stub_Quiet   : aliased constant S := "/QUIET "                        &
                                            "-q";

   S_Stub_Search  : aliased constant S := "/SEARCH=*"                      &
                                            "-I*";

   S_Stub_Tree    : aliased constant S := "/TREE_FILE="                    &
                                            "OVERWRITE "                   &
                                               "-t "                       &
                                            "SAVE "                        &
                                               "-k "                       &
                                            "REUSE "                       &
                                               "-r";

   S_Stub_Verbose : aliased constant S := "/VERBOSE "                      &
                                            "-v";

   Stub_Switches : aliased constant Switches := (
     S_Stub_Current 'Access,
     S_Stub_Full    'Access,
     S_Stub_Header  'Access,
     S_Stub_Indent  'Access,
     S_Stub_Length  'Access,
     S_Stub_Quiet   'Access,
     S_Stub_Search  'Access,
     S_Stub_Tree    'Access,
     S_Stub_Verbose 'Access);

   ------------------------------
   -- Switches for GNAT SYSTEM --
   ------------------------------

   System_Switches : aliased constant Switches  := (1 .. 0 => null);

   ----------------------------
   -- Switches for GNAT XREF --
   ----------------------------

   S_Xref_All     : aliased constant S := "/ALL_FILES "                    &
                                            "-a";

   S_Xref_Full    : aliased constant S := "/FULL_PATHNAME "                &
                                            "-f";

   S_Xref_Global  : aliased constant S := "/IGNORE_LOCALS "                &
                                            "-g";

   S_Xref_Object  : aliased constant S := "/OBJECT_SEARCH=*"               &
                                            "-aO*";

   S_Xref_Project : aliased constant S := "/PROJECT=@"                     &
                                            "-p@";

   S_Xref_Search  : aliased constant S := "/SEARCH=*"                      &
                                            "-I*";

   S_Xref_Source  : aliased constant S := "/SOURCE_SEARCH=*"               &
                                            "-aI*";

   S_Xref_Output  : aliased constant S := "/UNUSED "                       &
                                            "-u";

   Xref_Switches : aliased constant Switches := (
      S_Xref_All     'Access,
      S_Ext_Ref      'Access,
      S_Xref_Full    'Access,
      S_Xref_Global  'Access,
      S_Xref_Object  'Access,
      S_Xref_Project 'Access,
      S_Project_File 'Access,
      S_Project_Verb 'Access,
      S_Xref_Search  'Access,
      S_Xref_Source  'Access,
      S_Xref_Output  'Access);

   -------------------
   -- COMMAND TABLE --
   -------------------

   --  The command table contains an entry for each command recognized by
   --  GNATCmd. The entries are represented by an array of records.

   type Parameter_Type is
   --  A parameter is defined as a whitespace bounded string, not begining
   --   with a slash. (But see note under FILES_OR_WILDCARD).
     (File,
      --  A required file or directory parameter.

      Optional_File,
      --  An optional file or directory parameter.

      Other_As_Is,
      --  A parameter that's passed through as is (not canonicalized)

      Unlimited_Files,
      --  An unlimited number of writespace separate file or directory
      --  parameters including wildcard specifications.

      Files_Or_Wildcard);
      --  A comma separated list of files and/or wildcard file specifications.
      --  A comma preceded by or followed by whitespace is considered as a
      --  single comma character w/o whitespace.

   type Parameter_Array is array (Natural range <>) of Parameter_Type;
   type Parameter_Ref is access all Parameter_Array;

   type Command_Entry is record
      Cname : String_Ptr;
      --  Command name for GNAT xxx command

      Usage : String_Ptr;
      --  A usage string, used for error messages

      Unixcmd  : String_Ptr;
      --  Corresponding Unix command

      Switches : Switches_Ptr;
      --  Pointer to array of switch strings

      Params : Parameter_Ref;
      --  Describes the allowable types of parameters.
      --  Params (1) is the type of the first parameter, etc.
      --  An empty parameter array means this command takes no parameters.

      Defext : String (1 .. 3);
      --  Default extension. If non-blank, then this extension is supplied by
      --  default as the extension for any file parameter which does not have
      --  an extension already.
   end record;

   -------------------------
   -- INTERNAL STRUCTURES --
   -------------------------

   --  The switches and commands are defined by strings in the previous
   --  section so that they are easy to modify, but internally, they are
   --  kept in a more conveniently accessible form described in this
   --  section.

   --  Commands, command qualifers and options have a similar common format
   --  so that searching for matching names can be done in a common manner.

   type Item_Id is (Id_Command, Id_Switch, Id_Option);

   type Translation_Type is
     (
      T_Direct,
      --  A qualifier with no options.
      --  Example: GNAT MAKE /VERBOSE

      T_Directories,
      --  A qualifier followed by a list of directories
      --  Example: GNAT COMPILE /SEARCH=([], [.FOO], [.BAR])

      T_Directory,
      --  A qualifier followed by one directory
      --  Example: GNAT LIBRARY /SET=[.VAXFLOATLIB]

      T_File,
      --  A quailifier followed by a filename
      --  Example: GNAT LINK /EXECUTABLE=FOO.EXE

      T_Numeric,
      --  A qualifier followed by a numeric value.
      --  Example: GNAT CHOP /FILE_NAME_MAX_LENGTH=39

      T_String,
      --  A qualifier followed by a quoted string. Only used by
      --  /IDENTIFICATION qualfier.
      --  Example: GNAT LINK /IDENTIFICATION="3.14a1 version"

      T_Options,
      --  A qualifier followed by a list of options.
      --  Example: GNAT COMPILE /REPRESENTATION_INFO=(ARRAYS,OBJECTS)

      T_Commands,
      --  A qualifier followed by a list. Only used for
      --  MAKE /COMPILER_QUALIFIERS /BINDER_QUALIFIERS /LINKER_QUALIFIERS
      --  (gnatmake -cargs -bargs -largs )
      --  Example: GNAT MAKE ... /LINKER_QUALIFIERS /VERBOSE FOOBAR.OBJ

      T_Other,
      --  A qualifier passed directly to the linker. Only used
      --  for LINK and SHARED if no other match is found.
      --  Example: GNAT LINK FOO.ALI /SYSSHR

      T_Alphanumplus
      --  A qualifier followed by a legal linker symbol prefix. Only used
      --  for BIND /BUILD_LIBRARY (gnatbind -Lxyz).
      --  Example: GNAT BIND /BUILD_LIBRARY=foobar
     );

   type Item (Id : Item_Id);
   type Item_Ptr is access all Item;

   type Item (Id : Item_Id) is record
      Name : String_Ptr;
      --  Name of the command, switch (with slash) or option

      Next : Item_Ptr;
      --  Pointer to next item on list, always has the same Id value

      Unix_String : String_Ptr;
      --  Corresponding Unix string. For a command, this is the unix command
      --  name and possible default switches. For a switch or option it is
      --  the unix switch string.

      case Id is

         when Id_Command =>

            Switches : Item_Ptr;
            --  Pointer to list of switch items for the command, linked
            --  through the Next fields with null terminating the list.

            Usage : String_Ptr;
            --  Usage information, used only for errors and the default
            --  list of commands output.

            Params : Parameter_Ref;
            --  Array of parameters

            Defext : String (1 .. 3);
            --  Default extension. If non-blank, then this extension is
            --  supplied by default as the extension for any file parameter
            --  which does not have an extension already.

         when Id_Switch =>

            Translation : Translation_Type;
            --  Type of switch translation. For all cases, except Options,
            --  this is the only field needed, since the Unix translation
            --  is found in Unix_String.

            Options : Item_Ptr;
            --  For the Options case, this field is set to point to a list
            --  of options item (for this case Unix_String is null in the
            --  main switch item). The end of the list is marked by null.

         when Id_Option =>

            null;
            --  No special fields needed, since Name and Unix_String are
            --  sufficient to completely described an option.

      end case;
   end record;

   subtype Command_Item is Item (Id_Command);
   subtype Switch_Item  is Item (Id_Switch);
   subtype Option_Item  is Item (Id_Option);

   ----------------------------------
   -- Declarations for GNATCMD use --
   ----------------------------------

   Commands : Item_Ptr;
   --  Pointer to head of list of command items, one for each command, with
   --  the end of the list marked by a null pointer.

   Last_Command : Item_Ptr;
   --  Pointer to last item in Commands list

   Normal_Exit : exception;
   --  Raise this exception for normal program termination

   Error_Exit : exception;
   --  Raise this exception if error detected

   Errors : Natural := 0;
   --  Count errors detected

   Command : Item_Ptr;
   --  Pointer to command item for current command

   Make_Commands_Active : Item_Ptr := null;
   --  Set to point to Command entry for COMPILE, BIND, or LINK as appropriate
   --  if a COMMANDS_TRANSLATION switch has been encountered while processing
   --  a MAKE Command.

   My_Exit_Status : Exit_Status := Success;

   package Buffer is new Table.Table (
     Table_Component_Type => Character,
     Table_Index_Type     => Integer,
     Table_Low_Bound      => 1,
     Table_Initial        => 4096,
     Table_Increment      => 2,
     Table_Name           => "Buffer");

   Param_Count : Natural := 0;
   --  Number of parameter arguments so far

   Arg_Num : Natural;
   --  Argument number

   Display_Command : Boolean := False;
   --  Set true if /? switch causes display of generated command

   -----------------------
   -- Local Subprograms --
   -----------------------

   function Init_Object_Dirs return String_Ptr;

   function Invert_Sense (S : String) return String_Ptr;
   --  Given a unix switch string S, computes the inverse (adding or
   --  removing ! characters as required), and returns a pointer to
   --  the allocated result on the heap.

   function Is_Extensionless (F : String) return Boolean;
   --  Returns true if the filename has no extension.

   function Match (S1, S2 : String) return Boolean;
   --  Determines whether S1 and S2 match. This is a case insensitive match.

   function Match_Prefix (S1, S2 : String) return Boolean;
   --  Determines whether S1 matches a prefix of S2. This is also a case
   --  insensitive match (for example Match ("AB","abc") is True).

   function Matching_Name
     (S     : String;
      Itm   : Item_Ptr;
      Quiet : Boolean := False)
      return  Item_Ptr;
   --  Determines if the item list headed by Itm and threaded through the
   --  Next fields (with null marking the end of the list), contains an
   --  entry that uniquely matches the given string. The match is case
   --  insensitive and permits unique abbreviation. If the match succeeds,
   --  then a pointer to the matching item is returned. Otherwise, an
   --  appropriate error message is written. Note that the discriminant
   --  of Itm is used to determine the appropriate form of this message.
   --  Quiet is normally False as shown, if it is set to True, then no
   --  error message is generated in a not found situation (null is still
   --  returned to indicate the not-found situation).

   function OK_Alphanumerplus (S : String) return Boolean;
   --  Checks that S is a string of alphanumeric characters,
   --  returning True if all alphanumeric characters,
   --  False if empty or a non-alphanumeric character is present.

   function OK_Integer (S : String) return Boolean;
   --  Checks that S is a string of digits, returning True if all digits,
   --  False if empty or a non-digit is present.

   procedure Place (C : Character);
   --  Place a single character in the buffer, updating Ptr

   procedure Place (S : String);
   --  Place a string character in the buffer, updating Ptr

   procedure Place_Lower (S : String);
   --  Place string in buffer, forcing letters to lower case, updating Ptr

   procedure Place_Unix_Switches (S : String_Ptr);
   --  Given a unix switch string, place corresponding switches in Buffer,
   --  updating Ptr appropriatelly. Note that in the case of use of ! the
   --  result may be to remove a previously placed switch.

   procedure Validate_Command_Or_Option (N : String_Ptr);
   --  Check that N is a valid command or option name, i.e. that it is of the
   --  form of an Ada identifier with upper case letters and underscores.

   procedure Validate_Unix_Switch (S : String_Ptr);
   --  Check that S is a valid switch string as described in the syntax for
   --  the switch table item UNIX_SWITCH or else begins with a backquote.

   ----------------------
   -- Init_Object_Dirs --
   ----------------------

   function Init_Object_Dirs return String_Ptr is
      Object_Dirs     : Integer;
      Object_Dir      : array (Integer range 1 .. 256) of String_Access;
      Object_Dir_Name : String_Access;

   begin
      Object_Dirs := 0;
      Object_Dir_Name := String_Access (Object_Dir_Default_Name);
      Get_Next_Dir_In_Path_Init (Object_Dir_Name);

      loop
         declare
            Dir : String_Access := String_Access
              (Get_Next_Dir_In_Path (Object_Dir_Name));
         begin
            exit when Dir = null;
            Object_Dirs := Object_Dirs + 1;
            Object_Dir (Object_Dirs)
              := String_Access (Normalize_Directory_Name (Dir.all));
         end;
      end loop;

      for Dirs in 1 .. Object_Dirs loop
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := '-';
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := 'L';
         Object_Dir_Name := new String'(
           To_Canonical_Dir_Spec
             (To_Host_Dir_Spec (Object_Dir (Dirs).all, True).all, True).all);

         for J in Object_Dir_Name'Range loop
            Buffer.Increment_Last;
            Buffer.Table (Buffer.Last) := Object_Dir_Name (J);
         end loop;

         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := ' ';
      end loop;

      Buffer.Increment_Last;
      Buffer.Table (Buffer.Last) := '-';
      Buffer.Increment_Last;
      Buffer.Table (Buffer.Last) := 'l';
      Buffer.Increment_Last;
      Buffer.Table (Buffer.Last) := 'g';
      Buffer.Increment_Last;
      Buffer.Table (Buffer.Last) := 'n';
      Buffer.Increment_Last;
      Buffer.Table (Buffer.Last) := 'a';
      Buffer.Increment_Last;
      Buffer.Table (Buffer.Last) := 't';

      if Hostparm.OpenVMS then
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := ' ';
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := '-';
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := 'l';
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := 'd';
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := 'e';
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := 'c';
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := 'g';
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := 'n';
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := 'a';
         Buffer.Increment_Last;
         Buffer.Table (Buffer.Last) := 't';
      end if;

      return new String'(String (Buffer.Table (1 .. Buffer.Last)));
   end Init_Object_Dirs;

   ------------------
   -- Invert_Sense --
   ------------------

   function Invert_Sense (S : String) return String_Ptr is
      Sinv : String (1 .. S'Length * 2);
      --  Result (for sure long enough)

      Sinvp : Natural := 0;
      --  Pointer to output string

   begin
      for Sp in S'Range loop
         if Sp = S'First or else S (Sp - 1) = ',' then
            if S (Sp) = '!' then
               null;
            else
               Sinv (Sinvp + 1) := '!';
               Sinv (Sinvp + 2) := S (Sp);
               Sinvp := Sinvp + 2;
            end if;

         else
            Sinv (Sinvp + 1) := S (Sp);
            Sinvp := Sinvp + 1;
         end if;
      end loop;

      return new String'(Sinv (1 .. Sinvp));
   end Invert_Sense;

   ----------------------
   -- Is_Extensionless --
   ----------------------

   function Is_Extensionless (F : String) return Boolean is
   begin
      for J in reverse F'Range loop
         if F (J) = '.' then
            return False;
         elsif F (J) = '/' or else F (J) = ']' or else F (J) = ':' then
            return True;
         end if;
      end loop;

      return True;
   end Is_Extensionless;

   -----------
   -- Match --
   -----------

   function Match (S1, S2 : String) return Boolean is
      Dif : constant Integer := S2'First - S1'First;

   begin

      if S1'Length /= S2'Length then
         return False;

      else
         for J in S1'Range loop
            if To_Lower (S1 (J)) /= To_Lower (S2 (J + Dif)) then
               return False;
            end if;
         end loop;

         return True;
      end if;
   end Match;

   ------------------
   -- Match_Prefix --
   ------------------

   function Match_Prefix (S1, S2 : String) return Boolean is
   begin
      if S1'Length > S2'Length then
         return False;
      else
         return Match (S1, S2 (S2'First .. S2'First + S1'Length - 1));
      end if;
   end Match_Prefix;

   -------------------
   -- Matching_Name --
   -------------------

   function Matching_Name
     (S     : String;
      Itm   : Item_Ptr;
      Quiet : Boolean := False)
      return  Item_Ptr
   is
      P1, P2 : Item_Ptr;

      procedure Err;
      --  Little procedure to output command/qualifier/option as appropriate
      --  and bump error count.

      procedure Err is
      begin
         if Quiet then
            return;
         end if;

         Errors := Errors + 1;

         if Itm /= null then
            case Itm.Id is
               when Id_Command =>
                  Put (Standard_Error, "command");

               when Id_Switch =>
                  if OpenVMS then
                     Put (Standard_Error, "qualifier");
                  else
                     Put (Standard_Error, "switch");
                  end if;

               when Id_Option =>
                  Put (Standard_Error, "option");

            end case;
         else
            Put (Standard_Error, "input");

         end if;

         Put (Standard_Error, ": ");
         Put (Standard_Error, S);

      end Err;

   --  Start of processing for Matching_Name

   begin
      --  If exact match, that's the one we want

      P1 := Itm;
      while P1 /= null loop
         if Match (S, P1.Name.all) then
            return P1;
         else
            P1 := P1.Next;
         end if;
      end loop;

      --  Now check for prefix matches

      P1 := Itm;
      while P1 /= null loop
         if P1.Name.all = "/<other>" then
            return P1;

         elsif not Match_Prefix (S, P1.Name.all) then
            P1 := P1.Next;

         else
            --  Here we have found one matching prefix, so see if there is
            --  another one (which is an ambiguity)

            P2 := P1.Next;
            while P2 /= null loop
               if Match_Prefix (S, P2.Name.all) then
                  if not Quiet then
                     Put (Standard_Error, "ambiguous ");
                     Err;
                     Put (Standard_Error, " (matches ");
                     Put (Standard_Error, P1.Name.all);

                     while P2 /= null loop
                        if Match_Prefix (S, P2.Name.all) then
                           Put (Standard_Error, ',');
                           Put (Standard_Error, P2.Name.all);
                        end if;

                        P2 := P2.Next;
                     end loop;

                     Put_Line (Standard_Error, ")");
                  end if;

                  return null;
               end if;

               P2 := P2.Next;
            end loop;

            --  If we fall through that loop, then there was only one match

            return P1;
         end if;
      end loop;

      --  If we fall through outer loop, there was no match

      if not Quiet then
         Put (Standard_Error, "unrecognized ");
         Err;
         New_Line (Standard_Error);
      end if;

      return null;
   end Matching_Name;

   -----------------------
   -- OK_Alphanumerplus --
   -----------------------

   function OK_Alphanumerplus (S : String) return Boolean is
   begin
      if S'Length = 0 then
         return False;

      else
         for J in S'Range loop
            if not (Is_Alphanumeric (S (J)) or else
                    S (J) = '_' or else S (J) = '$')
            then
               return False;
            end if;
         end loop;

         return True;
      end if;
   end OK_Alphanumerplus;

   ----------------
   -- OK_Integer --
   ----------------

   function OK_Integer (S : String) return Boolean is
   begin
      if S'Length = 0 then
         return False;

      else
         for J in S'Range loop
            if not Is_Digit (S (J)) then
               return False;
            end if;
         end loop;

         return True;
      end if;
   end OK_Integer;

   -----------
   -- Place --
   -----------

   procedure Place (C : Character) is
   begin
      Buffer.Increment_Last;
      Buffer.Table (Buffer.Last) := C;
   end Place;

   procedure Place (S : String) is
   begin
      for J in S'Range loop
         Place (S (J));
      end loop;
   end Place;

   -----------------
   -- Place_Lower --
   -----------------

   procedure Place_Lower (S : String) is
   begin
      for J in S'Range loop
         Place (To_Lower (S (J)));
      end loop;
   end Place_Lower;

   -------------------------
   -- Place_Unix_Switches --
   -------------------------

   procedure Place_Unix_Switches (S : String_Ptr) is
      P1, P2, P3 : Natural;
      Remove     : Boolean;
      Slen       : Natural;

   begin
      P1 := S'First;
      while P1 <= S'Last loop
         if S (P1) = '!' then
            P1 := P1 + 1;
            Remove := True;
         else
            Remove := False;
         end if;

         P2 := P1;
         pragma Assert (S (P1) = '-' or else S (P1) = '`');

         while P2 < S'Last and then S (P2 + 1) /= ',' loop
            P2 := P2 + 1;
         end loop;

         --  Switch is now in S (P1 .. P2)

         Slen := P2 - P1 + 1;

         if Remove then
            P3 := 2;
            while P3 <= Buffer.Last - Slen loop
               if Buffer.Table (P3) = ' '
                 and then String (Buffer.Table (P3 + 1 .. P3 + Slen))
                          = S (P1 .. P2)
                 and then (P3 + Slen = Buffer.Last
                             or else
                           Buffer.Table (P3 + Slen + 1) = ' ')
               then
                  Buffer.Table (P3 .. Buffer.Last - Slen - 1) :=
                    Buffer.Table (P3 + Slen + 1 .. Buffer.Last);
                  Buffer.Set_Last (Buffer.Last - Slen - 1);

               else
                  P3 := P3 + 1;
               end if;
            end loop;

         else
            Place (' ');

            if S (P1) = '`' then
               P1 := P1 + 1;
            end if;

            Place (S (P1 .. P2));
         end if;

         P1 := P2 + 2;
      end loop;
   end Place_Unix_Switches;

   --------------------------------
   -- Validate_Command_Or_Option --
   --------------------------------

   procedure Validate_Command_Or_Option (N : String_Ptr) is
   begin
      pragma Assert (N'Length > 0);

      for J in N'Range loop
         if N (J) = '_' then
            pragma Assert (N (J - 1) /= '_');
            null;
         else
            pragma Assert (Is_Upper (N (J)) or else Is_Digit (N (J)));
            null;
         end if;
      end loop;
   end Validate_Command_Or_Option;

   --------------------------
   -- Validate_Unix_Switch --
   --------------------------

   procedure Validate_Unix_Switch (S : String_Ptr) is
   begin
      if S (S'First) = '`' then
         return;
      end if;

      pragma Assert (S (S'First) = '-' or else S (S'First) = '!');

      for J in S'First + 1 .. S'Last loop
         pragma Assert (S (J) /= ' ');

         if S (J) = '!' then
            pragma Assert (S (J - 1) = ',' and then S (J + 1) = '-');
            null;
         end if;
      end loop;
   end Validate_Unix_Switch;

   ----------------------
   -- List of Commands --
   ----------------------

   --  Note that we put this after all the local bodies to avoid
   --  some access before elaboration problems.

   Command_List : array (Natural range <>) of Command_Entry := (

      (Cname    => new S'("BIND"),
       Usage    => new S'("GNAT BIND file[.ali] /qualifiers"),
       Unixcmd  => new S'("gnatbind"),
       Switches => Bind_Switches'Access,
       Params   => new Parameter_Array'(1 => File),
       Defext   => "ali"),

      (Cname    => new S'("CHOP"),
       Usage    => new S'("GNAT CHOP file [directory] /qualifiers"),
       Unixcmd  => new S'("gnatchop"),
       Switches => Chop_Switches'Access,
       Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
       Defext   => "   "),

      (Cname    => new S'("COMPILE"),
       Usage    => new S'("GNAT COMPILE filespec[,...] /qualifiers"),
       Unixcmd  => new S'("gcc -c -x ada"),
       Switches => GCC_Switches'Access,
       Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
       Defext   => "   "),

      (Cname    => new S'("ELIM"),
       Usage    => new S'("GNAT ELIM name /qualifiers"),
       Unixcmd  => new S'("gnatelim"),
       Switches => Elim_Switches'Access,
       Params   => new Parameter_Array'(1 => Other_As_Is),
       Defext   => "ali"),

      (Cname    => new S'("FIND"),
       Usage    => new S'("GNAT FIND pattern[:sourcefile[:line[:column]]]" &
                          " filespec[,...] /qualifiers"),
       Unixcmd  => new S'("gnatfind"),
       Switches => Find_Switches'Access,
       Params   => new Parameter_Array'(1 => Other_As_Is,
                                        2 => Files_Or_Wildcard),
       Defext   => "ali"),

      (Cname    => new S'("KRUNCH"),
       Usage    => new S'("GNAT KRUNCH file [/COUNT=nnn]"),
       Unixcmd  => new S'("gnatkr"),
       Switches => Krunch_Switches'Access,
       Params   => new Parameter_Array'(1 => File),
       Defext   => "   "),

      (Cname    => new S'("LIBRARY"),
       Usage    => new S'("GNAT LIBRARY /[CREATE | SET | DELETE]=directory"
                          & " [/CONFIG=file]"),
       Unixcmd  => new S'("gnatlbr"),
       Switches => Lbr_Switches'Access,
       Params   => new Parameter_Array'(1 .. 0 => File),
       Defext   => "   "),

      (Cname    => new S'("LINK"),
       Usage    => new S'("GNAT LINK file[.ali]"
                   & " [extra obj_&_lib_&_exe_&_opt files]"
                   & " /qualifiers"),
       Unixcmd  => new S'("gnatlink"),
       Switches => Link_Switches'Access,
       Params   => new Parameter_Array'(1 => Unlimited_Files),
       Defext   => "ali"),

      (Cname    => new S'("LIST"),
       Usage    => new S'("GNAT LIST /qualifiers object_or_ali_file"),
       Unixcmd  => new S'("gnatls"),
       Switches => List_Switches'Access,
       Params   => new Parameter_Array'(1 => File),
       Defext   => "ali"),

      (Cname    => new S'("MAKE"),
       Usage    =>
         new S'("GNAT MAKE file /qualifiers (includes COMPILE /qualifiers)"),
       Unixcmd  => new S'("gnatmake"),
       Switches => Make_Switches'Access,
       Params   => new Parameter_Array'(1 => File),
       Defext   => "   "),

      (Cname    => new S'("PREPROCESS"),
       Usage    => new S'("GNAT PREPROCESS ifile ofile dfile /qualifiers"),
       Unixcmd  => new S'("gnatprep"),
       Switches => Prep_Switches'Access,
       Params   => new Parameter_Array'(1 .. 3 => File),
       Defext   => "   "),

      (Cname    => new S'("SHARED"),
       Usage    => new S'("GNAT SHARED [obj_&_lib_&_exe_&_opt files]"
                   & " /qualifiers"),
       Unixcmd  => new S'("gcc -shared " & Init_Object_Dirs.all),
       Switches => Shared_Switches'Access,
       Params   => new Parameter_Array'(1 => Unlimited_Files),
       Defext   => "   "),

      (Cname    => new S'("STANDARD"),
       Usage    => new S'("GNAT STANDARD"),
       Unixcmd  => new S'("gnatpsta"),
       Switches => Standard_Switches'Access,
       Params   => new Parameter_Array'(1 .. 0 => File),
       Defext   => "   "),

      (Cname    => new S'("STUB"),
       Usage    => new S'("GNAT STUB file [directory] /qualifiers"),
       Unixcmd  => new S'("gnatstub"),
       Switches => Stub_Switches'Access,
       Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
       Defext   => "   "),

      (Cname    => new S'("SYSTEM"),
       Usage    => new S'("GNAT SYSTEM"),
       Unixcmd  => new S'("gnatpsys"),
       Switches => System_Switches'Access,
       Params   => new Parameter_Array'(1 .. 0 => File),
       Defext   => "   "),

      (Cname    => new S'("XREF"),
       Usage    => new S'("GNAT XREF filespec[,...] /qualifiers"),
       Unixcmd  => new S'("gnatxref"),
       Switches => Xref_Switches'Access,
       Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
       Defext   => "ali")
   );

-------------------------------------
-- Start of processing for GNATCmd --
-------------------------------------

begin
   Buffer.Init;

   --  First we must preprocess the string form of the command and options
   --  list into the internal form that we use.

   for C in Command_List'Range loop

      declare
         Command : Item_Ptr := new Command_Item;

         Last_Switch : Item_Ptr;
         --  Last switch in list

      begin
         --  Link new command item into list of commands

         if Last_Command = null then
            Commands := Command;
         else
            Last_Command.Next := Command;
         end if;

         Last_Command := Command;

         --  Fill in fields of new command item

         Command.Name        := Command_List (C).Cname;
         Command.Usage       := Command_List (C).Usage;
         Command.Unix_String := Command_List (C).Unixcmd;
         Command.Params      := Command_List (C).Params;
         Command.Defext      := Command_List (C).Defext;

         Validate_Command_Or_Option (Command.Name);

         --  Process the switch list

         for S in Command_List (C).Switches'Range loop
            declare
               SS : constant String_Ptr := Command_List (C).Switches (S);

               P  : Natural := SS'First;
               Sw : Item_Ptr := new Switch_Item;

               Last_Opt : Item_Ptr;
               --  Pointer to last option

            begin
               --  Link new switch item into list of switches

               if Last_Switch = null then
                  Command.Switches := Sw;
               else
                  Last_Switch.Next := Sw;
               end if;

               Last_Switch := Sw;

               --  Process switch string, first get name

               while SS (P) /= ' ' and SS (P) /= '=' loop
                  P := P + 1;
               end loop;

               Sw.Name := new String'(SS (SS'First .. P - 1));

               --  Direct translation case

               if SS (P) = ' ' then
                  Sw.Translation := T_Direct;
                  Sw.Unix_String := new String'(SS (P + 1 .. SS'Last));
                  Validate_Unix_Switch (Sw.Unix_String);

                  if SS (P - 1) = '>' then
                     Sw.Translation := T_Other;

                  elsif SS (P + 1) = '`' then
                     null;

                  --  Create the inverted case (/NO ..)

                  elsif SS (SS'First + 1 .. SS'First + 2) /= "NO" then
                     Sw := new Switch_Item;
                     Last_Switch.Next := Sw;
                     Last_Switch := Sw;

                     Sw.Name :=
                       new String'("/NO" & SS (SS'First + 1 .. P - 1));
                     Sw.Translation := T_Direct;
                     Sw.Unix_String := Invert_Sense (SS (P + 1 .. SS'Last));
                     Validate_Unix_Switch (Sw.Unix_String);
                  end if;

               --  Directories translation case

               elsif SS (P + 1) = '*' then
                  pragma Assert (SS (SS'Last) = '*');
                  Sw.Translation := T_Directories;
                  Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                  Validate_Unix_Switch (Sw.Unix_String);

               --  Directory translation case

               elsif SS (P + 1) = '%' then
                  pragma Assert (SS (SS'Last) = '%');
                  Sw.Translation := T_Directory;
                  Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                  Validate_Unix_Switch (Sw.Unix_String);

               --  File translation case

               elsif SS (P + 1) = '@' then
                  pragma Assert (SS (SS'Last) = '@');
                  Sw.Translation := T_File;
                  Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                  Validate_Unix_Switch (Sw.Unix_String);

               --  Numeric translation case

               elsif SS (P + 1) = '#' then
                  pragma Assert (SS (SS'Last) = '#');
                  Sw.Translation := T_Numeric;
                  Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                  Validate_Unix_Switch (Sw.Unix_String);

               --  Alphanumerplus translation case

               elsif SS (P + 1) = '|' then
                  pragma Assert (SS (SS'Last) = '|');
                  Sw.Translation := T_Alphanumplus;
                  Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                  Validate_Unix_Switch (Sw.Unix_String);

               --  String translation case

               elsif SS (P + 1) = '"' then
                  pragma Assert (SS (SS'Last) = '"');
                  Sw.Translation := T_String;
                  Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                  Validate_Unix_Switch (Sw.Unix_String);

               --  Commands translation case

               elsif SS (P + 1) = '?' then
                  Sw.Translation := T_Commands;
                  Sw.Unix_String := new String'(SS (P + 2 .. SS'Last));

               --  Options translation case

               else
                  Sw.Translation := T_Options;
                  Sw.Unix_String := new String'("");

                  P := P + 1; -- bump past =
                  while P <= SS'Last loop
                     declare
                        Opt : Item_Ptr := new Option_Item;
                        Q   : Natural;

                     begin
                        --  Link new option item into options list

                        if Last_Opt = null then
                           Sw.Options := Opt;
                        else
                           Last_Opt.Next := Opt;
                        end if;

                        Last_Opt := Opt;

                        --  Fill in fields of new option item

                        Q := P;
                        while SS (Q) /= ' ' loop
                           Q := Q + 1;
                        end loop;

                        Opt.Name := new String'(SS (P .. Q - 1));
                        Validate_Command_Or_Option (Opt.Name);

                        P := Q + 1;
                        Q := P;

                        while Q <= SS'Last and then SS (Q) /= ' ' loop
                           Q := Q + 1;
                        end loop;

                        Opt.Unix_String := new String'(SS (P .. Q - 1));
                        Validate_Unix_Switch (Opt.Unix_String);
                        P := Q + 1;
                     end;
                  end loop;
               end if;
            end;
         end loop;
      end;
   end loop;

   --  If no parameters, give complete list of commands

   if Argument_Count = 0 then
      Put_Line ("List of available commands");
      New_Line;

      while Commands /= null loop
         Put (Commands.Usage.all);
         Set_Col (53);
         Put_Line (Commands.Unix_String.all);
         Commands := Commands.Next;
      end loop;

      raise Normal_Exit;
   end if;

   Arg_Num := 1;

   loop
      exit when Arg_Num > Argument_Count;

      declare
         Argv    : String_Access;
         Arg_Idx : Integer;

         function Get_Arg_End
           (Argv    : String;
            Arg_Idx : Integer)
            return    Integer;
         --  Begins looking at Arg_Idx + 1 and returns the index of the
         --  last character before a slash or else the index of the last
         --  character in the string Argv.

         function Get_Arg_End
           (Argv    : String;
            Arg_Idx : Integer)
            return    Integer
         is
         begin
            for J in Arg_Idx + 1 .. Argv'Last loop
               if Argv (J) = '/' then
                  return J - 1;
               end if;
            end loop;

            return Argv'Last;
         end Get_Arg_End;

      begin
         Argv := new String'(Argument (Arg_Num));
         Arg_Idx := Argv'First;

      <<Tryagain_After_Coalesce>>
         loop
            declare
               Next_Arg_Idx : Integer;
               Arg          : String_Access;

            begin
               Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
               Arg          := new String'(Argv (Arg_Idx .. Next_Arg_Idx));

               --  The first one must be a command name

               if Arg_Num = 1 and then Arg_Idx = Argv'First then

                  Command := Matching_Name (Arg.all, Commands);

                  if Command = null then
                     raise Error_Exit;
                  end if;

                  --  Give usage information if only command given

                  if Argument_Count = 1 and then Next_Arg_Idx = Argv'Last
                    and then
                     not (Command.Name.all = "SYSTEM"
                          or else Command.Name.all = "STANDARD")
                  then
                     Put_Line ("List of available qualifiers and options");
                     New_Line;

                     Put (Command.Usage.all);
                     Set_Col (53);
                     Put_Line (Command.Unix_String.all);

                     declare
                        Sw : Item_Ptr := Command.Switches;

                     begin
                        while Sw /= null loop
                           Put ("   ");
                           Put (Sw.Name.all);

                           case Sw.Translation is

                              when T_Other =>
                                 Set_Col (53);
                                 Put_Line (Sw.Unix_String.all & "/<other>");

                              when T_Direct =>
                                 Set_Col (53);
                                 Put_Line (Sw.Unix_String.all);

                              when T_Directories =>
                                 Put ("=(direc,direc,..direc)");
                                 Set_Col (53);
                                 Put (Sw.Unix_String.all);
                                 Put (" direc ");
                                 Put (Sw.Unix_String.all);
                                 Put_Line (" direc ...");

                              when T_Directory =>
                                 Put ("=directory");
                                 Set_Col (53);
                                 Put (Sw.Unix_String.all);

                                 if Sw.Unix_String (Sw.Unix_String'Last)
                                   /= '='
                                 then
                                    Put (' ');
                                 end if;

                                 Put_Line ("directory ");

                              when T_File =>
                                 Put ("=file");
                                 Set_Col (53);
                                 Put (Sw.Unix_String.all);

                                 if Sw.Unix_String (Sw.Unix_String'Last)
                                   /= '='
                                 then
                                    Put (' ');
                                 end if;

                                 Put_Line ("file ");

                              when T_Numeric =>
                                 Put ("=nnn");
                                 Set_Col (53);

                                 if Sw.Unix_String (Sw.Unix_String'First)
                                   = '`'
                                 then
                                    Put (Sw.Unix_String
                                      (Sw.Unix_String'First + 1
                                       .. Sw.Unix_String'Last));
                                 else
                                    Put (Sw.Unix_String.all);
                                 end if;

                                 Put_Line ("nnn");

                              when T_Alphanumplus =>
                                 Put ("=xyz");
                                 Set_Col (53);

                                 if Sw.Unix_String (Sw.Unix_String'First)
                                   = '`'
                                 then
                                    Put (Sw.Unix_String
                                      (Sw.Unix_String'First + 1
                                       .. Sw.Unix_String'Last));
                                 else
                                    Put (Sw.Unix_String.all);
                                 end if;

                                 Put_Line ("xyz");

                              when T_String =>
                                 Put ("=");
                                 Put ('"');
                                 Put ("<string>");
                                 Put ('"');
                                 Set_Col (53);

                                 Put (Sw.Unix_String.all);

                                 if Sw.Unix_String (Sw.Unix_String'Last)
                                   /= '='
                                 then
                                    Put (' ');
                                 end if;

                                 Put ("<string>");
                                 New_Line;

                              when T_Commands =>
                                 Put (" (switches for ");
                                 Put (Sw.Unix_String (
                                      Sw.Unix_String'First + 7
                                       .. Sw.Unix_String'Last));
                                 Put (')');
                                 Set_Col (53);
                                 Put (Sw.Unix_String (
                                      Sw.Unix_String'First
                                       .. Sw.Unix_String'First + 5));
                                 Put_Line (" switches");

                              when T_Options =>
                                 declare
                                    Opt : Item_Ptr := Sw.Options;

                                 begin
                                    Put_Line ("=(option,option..)");

                                    while Opt /= null loop
                                       Put ("      ");
                                       Put (Opt.Name.all);

                                       if Opt = Sw.Options then
                                          Put (" (D)");
                                       end if;

                                       Set_Col (53);
                                       Put_Line (Opt.Unix_String.all);
                                       Opt := Opt.Next;
                                    end loop;
                                 end;

                           end case;

                           Sw := Sw.Next;
                        end loop;
                     end;

                     raise Normal_Exit;
                  end if;

                  Place (Command.Unix_String.all);

               --  Special handling for internal debugging switch /?

               elsif Arg.all = "/?" then
                  Display_Command := True;

               --  Copy -switch unchanged

               elsif Arg (Arg'First) = '-' then
                  Place (' ');
                  Place (Arg.all);

               --  Copy quoted switch with quotes stripped

               elsif Arg (Arg'First) = '"' then
                  if Arg (Arg'Last) /= '"' then
                     Put (Standard_Error, "misquoted argument: ");
                     Put_Line (Standard_Error, Arg.all);
                     Errors := Errors + 1;

                  else
                     Put (Arg (Arg'First + 1 .. Arg'Last - 1));
                  end if;

               --  Parameter Argument

               elsif Arg (Arg'First) /= '/'
                 and then Make_Commands_Active = null
               then
                  Param_Count := Param_Count + 1;

                  if Param_Count <= Command.Params'Length then

                     case Command.Params (Param_Count) is

                        when File | Optional_File =>
                           declare
                              Normal_File : String_Access
                                := To_Canonical_File_Spec (Arg.all);
                           begin
                              Place (' ');
                              Place_Lower (Normal_File.all);

                              if Is_Extensionless (Normal_File.all)
                                and then Command.Defext /= "   "
                              then
                                 Place ('.');
                                 Place (Command.Defext);
                              end if;
                           end;

                        when Unlimited_Files =>
                           declare
                              Normal_File : String_Access
                                := To_Canonical_File_Spec (Arg.all);

                              File_Is_Wild  : Boolean := False;
                              File_List     : String_Access_List_Access;
                           begin
                              for I in Arg'Range loop
                                 if Arg (I) = '*'
                                   or else Arg (I) = '%'
                                 then
                                    File_Is_Wild := True;
                                 end if;
                              end loop;

                              if File_Is_Wild then
                                 File_List := To_Canonical_File_List
                                                (Arg.all, False);

                                 for I in File_List.all'Range loop
                                    Place (' ');
                                    Place_Lower (File_List.all (I).all);
                                 end loop;
                              else
                                 Place (' ');
                                 Place_Lower (Normal_File.all);

                                 if Is_Extensionless (Normal_File.all)
                                   and then Command.Defext /= "   "
                                 then
                                    Place ('.');
                                    Place (Command.Defext);
                                 end if;
                              end if;

                              Param_Count := Param_Count - 1;
                           end;

                        when Other_As_Is =>
                           Place (' ');
                           Place (Arg.all);

                        when Files_Or_Wildcard =>

                           --  Remove spaces from a comma separated list
                           --  of file names and adjust control variables
                           --  accordingly.

                           while Arg_Num < Argument_Count and then
                             (Argv (Argv'Last) = ',' xor
                              Argument (Arg_Num + 1)
                               (Argument (Arg_Num + 1)'First) = ',')
                           loop
                              Argv := new String'(Argv.all
                                                  & Argument (Arg_Num + 1));
                              Arg_Num := Arg_Num + 1;
                              Arg_Idx := Argv'First;
                              Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
                              Arg :=
                                new String'(Argv (Arg_Idx .. Next_Arg_Idx));
                           end loop;

                           --  Parse the comma separated list of VMS filenames
                           --  and place them on the command line as space
                           --  separated Unix style filenames. Lower case and
                           --  add default extension as appropriate.

                           declare
                              Arg1_Idx : Integer := Arg'First;

                              function Get_Arg1_End
                                (Arg : String; Arg_Idx : Integer)
                                return Integer;
                              --  Begins looking at Arg_Idx + 1 and
                              --  returns the index of the last character
                              --  before a comma or else the index of the
                              --  last character in the string Arg.

                              function Get_Arg1_End
                                (Arg : String; Arg_Idx : Integer)
                                return Integer
                              is
                              begin
                                 for I in Arg_Idx + 1 .. Arg'Last loop
                                    if Arg (I) = ',' then
                                       return I - 1;
                                    end if;
                                 end loop;

                                 return Arg'Last;
                              end Get_Arg1_End;

                           begin
                              loop
                                 declare
                                    Next_Arg1_Idx : Integer
                                      := Get_Arg1_End (Arg.all, Arg1_Idx);

                                    Arg1          : String
                                      := Arg (Arg1_Idx .. Next_Arg1_Idx);

                                    Normal_File   : String_Access
                                      := To_Canonical_File_Spec (Arg1);

                                 begin
                                    Place (' ');
                                    Place_Lower (Normal_File.all);

                                    if Is_Extensionless (Normal_File.all)
                                      and then Command.Defext /= "   "
                                    then
                                       Place ('.');
                                       Place (Command.Defext);
                                    end if;

                                    Arg1_Idx := Next_Arg1_Idx + 1;
                                 end;

                                 exit when Arg1_Idx > Arg'Last;

                                 --  Don't allow two or more commas in a row

                                 if Arg (Arg1_Idx) = ',' then
                                    Arg1_Idx := Arg1_Idx + 1;
                                    if Arg1_Idx > Arg'Last or else
                                       Arg (Arg1_Idx) = ','
                                    then
                                       Put_Line (Standard_Error,
                                         "Malformed Parameter: " & Arg.all);
                                       Put (Standard_Error, "usage: ");
                                       Put_Line (Standard_Error,
                                         Command.Usage.all);
                                       raise Error_Exit;
                                    end if;
                                 end if;

                              end loop;
                           end;
                     end case;
                  end if;

               --  Qualifier argument

               else
                  declare
                     Sw   : Item_Ptr;
                     SwP  : Natural;
                     P2   : Natural;
                     Endp : Natural := 0; -- avoid warning!
                     Opt  : Item_Ptr;

                  begin
                     SwP := Arg'First;
                     while SwP < Arg'Last and then Arg (SwP + 1) /= '=' loop
                        SwP := SwP + 1;
                     end loop;

                     --  At this point, the switch name is in
                     --  Arg (Arg'First..SwP) and if that is not the whole
                     --  switch, then there is an equal sign at
                     --  Arg (SwP + 1) and the rest of Arg is what comes
                     --  after the equal sign.

                     --  If make commands are active, see if we have another
                     --  COMMANDS_TRANSLATION switch belonging to gnatmake.

                     if Make_Commands_Active /= null then
                        Sw :=
                          Matching_Name
                            (Arg (Arg'First .. SwP),
                             Command.Switches,
                             Quiet => True);

                        if Sw /= null and then Sw.Translation = T_Commands then
                           null;

                        else
                           Sw :=
                             Matching_Name
                               (Arg (Arg'First .. SwP),
                                Make_Commands_Active.Switches,
                                Quiet => False);
                        end if;

                     --  For case of GNAT MAKE or CHOP, if we cannot find the
                     --  switch, then see if it is a recognized compiler switch
                     --  instead, and if so process the compiler switch.

                     elsif Command.Name.all = "MAKE"
                       or else Command.Name.all = "CHOP" then
                        Sw :=
                          Matching_Name
                            (Arg (Arg'First .. SwP),
                             Command.Switches,
                             Quiet => True);

                        if Sw = null then
                           Sw :=
                             Matching_Name
                               (Arg (Arg'First .. SwP),
                                Matching_Name ("COMPILE", Commands).Switches,
                                Quiet => False);
                        end if;

                     --  For all other cases, just search the relevant command

                     else
                        Sw :=
                          Matching_Name
                            (Arg (Arg'First .. SwP),
                             Command.Switches,
                             Quiet => False);
                     end if;

                     if Sw /= null then
                        case Sw.Translation is

                           when T_Direct =>
                              Place_Unix_Switches (Sw.Unix_String);
                              if Arg (SwP + 1) = '=' then
                                 Put (Standard_Error,
                                      "qualifier options ignored: ");
                                 Put_Line (Standard_Error, Arg.all);
                              end if;

                           when T_Directories =>
                              if SwP + 1 > Arg'Last then
                                 Put (Standard_Error,
                                      "missing directories for: ");
                                 Put_Line (Standard_Error, Arg.all);
                                 Errors := Errors + 1;

                              elsif Arg (SwP + 2) /= '(' then
                                 SwP := SwP + 2;
                                 Endp := Arg'Last;

                              elsif Arg (Arg'Last) /= ')' then

                                 --  Remove spaces from a comma separated list
                                 --  of file names and adjust control
                                 --  variables accordingly.

                                 if Arg_Num < Argument_Count and then
                                   (Argv (Argv'Last) = ',' xor
                                    Argument (Arg_Num + 1)
                                     (Argument (Arg_Num + 1)'First) = ',')
                                 then
                                    Argv := new String'(Argv.all
                                                & Argument (Arg_Num + 1));
                                    Arg_Num := Arg_Num + 1;
                                    Arg_Idx := Argv'First;
                                    Next_Arg_Idx
                                      := Get_Arg_End (Argv.all, Arg_Idx);
                                    Arg := new String'
                                      (Argv (Arg_Idx .. Next_Arg_Idx));
                                    goto Tryagain_After_Coalesce;
                                 end if;

                                 Put (Standard_Error,
                                      "incorrectly parenthesized " &
                                      "or malformed argument: ");
                                 Put_Line (Standard_Error, Arg.all);
                                 Errors := Errors + 1;

                              else
                                 SwP := SwP + 3;
                                 Endp := Arg'Last - 1;
                              end if;

                              while SwP <= Endp loop
                                 declare
                                    Dir_Is_Wild       : Boolean := False;
                                    Dir_Maybe_Is_Wild : Boolean := False;
                                    Dir_List : String_Access_List_Access;
                                 begin
                                    P2 := SwP;

                                    while P2 < Endp
                                          and then Arg (P2 + 1) /= ','
                                    loop

                                       --  A wildcard directory spec on VMS
                                       --  will contain either * or % or ...

                                       if Arg (P2) = '*' then
                                          Dir_Is_Wild := True;

                                       elsif Arg (P2) = '%' then
                                          Dir_Is_Wild := True;

                                       elsif Dir_Maybe_Is_Wild
                                         and then Arg (P2) = '.'
                                         and then Arg (P2 + 1) = '.'
                                       then
                                          Dir_Is_Wild := True;
                                          Dir_Maybe_Is_Wild := False;

                                       elsif Dir_Maybe_Is_Wild then
                                          Dir_Maybe_Is_Wild := False;

                                       elsif Arg (P2) = '.'
                                         and then Arg (P2 + 1) = '.'
                                       then
                                          Dir_Maybe_Is_Wild := True;

                                       end if;

                                       P2 := P2 + 1;
                                    end loop;

                                    if (Dir_Is_Wild) then
                                       Dir_List := To_Canonical_File_List
                                                      (Arg (SwP .. P2), True);

                                       for I in Dir_List.all'Range loop
                                          Place_Unix_Switches (Sw.Unix_String);
                                          Place_Lower (Dir_List.all (I).all);
                                       end loop;
                                    else
                                       Place_Unix_Switches (Sw.Unix_String);
                                       Place_Lower (To_Canonical_Dir_Spec
                                         (Arg (SwP .. P2), False).all);
                                    end if;

                                    SwP := P2 + 2;
                                 end;
                              end loop;

                           when T_Directory =>
                              if SwP + 1 > Arg'Last then
                                 Put (Standard_Error,
                                      "missing directory for: ");
                                 Put_Line (Standard_Error, Arg.all);
                                 Errors := Errors + 1;

                              else
                                 Place_Unix_Switches (Sw.Unix_String);

                                 --  Some switches end in "=". No space here

                                 if Sw.Unix_String
                                   (Sw.Unix_String'Last) /= '='
                                 then
                                    Place (' ');
                                 end if;

                                 Place_Lower (To_Canonical_Dir_Spec
                                   (Arg (SwP + 2 .. Arg'Last), False).all);
                              end if;

                           when T_File =>
                              if SwP + 1 > Arg'Last then
                                 Put (Standard_Error, "missing file for: ");
                                 Put_Line (Standard_Error, Arg.all);
                                 Errors := Errors + 1;

                              else
                                 Place_Unix_Switches (Sw.Unix_String);

                                 --  Some switches end in "=". No space here

                                 if Sw.Unix_String
                                   (Sw.Unix_String'Last) /= '='
                                 then
                                    Place (' ');
                                 end if;

                                 Place_Lower (To_Canonical_File_Spec
                                   (Arg (SwP + 2 .. Arg'Last)).all);
                              end if;

                           when T_Numeric =>
                              if OK_Integer (Arg (SwP + 2 .. Arg'Last)) then
                                 Place_Unix_Switches (Sw.Unix_String);
                                 Place (Arg (SwP + 2 .. Arg'Last));

                              else
                                 Put (Standard_Error, "argument for ");
                                 Put (Standard_Error, Sw.Name.all);
                                 Put_Line (Standard_Error, " must be numeric");
                                 Errors := Errors + 1;
                              end if;

                           when T_Alphanumplus =>
                              if
                                OK_Alphanumerplus (Arg (SwP + 2 .. Arg'Last))
                              then
                                 Place_Unix_Switches (Sw.Unix_String);
                                 Place (Arg (SwP + 2 .. Arg'Last));

                              else
                                 Put (Standard_Error, "argument for ");
                                 Put (Standard_Error, Sw.Name.all);
                                 Put_Line (Standard_Error,
                                   " must be alphanumeric");
                                 Errors := Errors + 1;
                              end if;

                           when T_String =>

                              --  A String value must be extended to the
                              --  end of the Argv, otherwise strings like
                              --  "foo/bar" get split at the slash.
                              --
                              --  The begining and ending of the string
                              --  are flagged with embedded nulls which
                              --  are removed when building the Spawn
                              --  call. Nulls are use because they won't
                              --  show up in a /? output. Quotes aren't
                              --  used because that would make it difficult
                              --  to embed them.

                              Place_Unix_Switches (Sw.Unix_String);
                              if Next_Arg_Idx /= Argv'Last then
                                 Next_Arg_Idx := Argv'Last;
                                 Arg := new String'
                                   (Argv (Arg_Idx .. Next_Arg_Idx));

                                 SwP := Arg'First;
                                 while SwP < Arg'Last and then
                                   Arg (SwP + 1) /= '=' loop
                                    SwP := SwP + 1;
                                 end loop;
                              end if;
                              Place (ASCII.NUL);
                              Place (Arg (SwP + 2 .. Arg'Last));
                              Place (ASCII.NUL);

                           when T_Commands =>

                              --  Output -largs/-bargs/-cargs

                              Place (' ');
                              Place (Sw.Unix_String
                                      (Sw.Unix_String'First ..
                                       Sw.Unix_String'First + 5));

                              --  Set source of new commands, also setting this
                              --  non-null indicates that we are in the special
                              --  commands mode for processing the -xargs case.

                              Make_Commands_Active :=
                                Matching_Name
                                  (Sw.Unix_String
                                    (Sw.Unix_String'First + 7 ..
                                     Sw.Unix_String'Last),
                                   Commands);

                           when T_Options =>
                              if SwP + 1 > Arg'Last then
                                 Place_Unix_Switches (Sw.Options.Unix_String);
                                 SwP := Endp + 1;

                              elsif Arg (SwP + 2) /= '(' then
                                 SwP := SwP + 2;
                                 Endp := Arg'Last;

                              elsif Arg (Arg'Last) /= ')' then
                                 Put (Standard_Error,
                                      "incorrectly parenthesized argument: ");
                                 Put_Line (Standard_Error, Arg.all);
                                 Errors := Errors + 1;
                                 SwP := Endp + 1;

                              else
                                 SwP := SwP + 3;
                                 Endp := Arg'Last - 1;
                              end if;

                              while SwP <= Endp loop
                                 P2 := SwP;

                                 while P2 < Endp
                                       and then Arg (P2 + 1) /= ','
                                 loop
                                    P2 := P2 + 1;
                                 end loop;

                                 --  Option name is in Arg (SwP .. P2)

                                 Opt := Matching_Name (Arg (SwP .. P2),
                                                       Sw.Options);

                                 if Opt /= null then
                                    Place_Unix_Switches (Opt.Unix_String);
                                 end if;

                                 SwP := P2 + 2;
                              end loop;

                           when T_Other =>
                              Place_Unix_Switches
                                (new String'(Sw.Unix_String.all & Arg.all));

                        end case;
                     end if;
                  end;
               end if;

               Arg_Idx := Next_Arg_Idx + 1;
            end;

            exit when Arg_Idx > Argv'Last;

         end loop;
      end;

      Arg_Num := Arg_Num + 1;
   end loop;

   if Display_Command then
      Put (Standard_Error, "generated command -->");
      Put (Standard_Error, String (Buffer.Table (1 .. Buffer.Last)));
      Put (Standard_Error, "<--");
      New_Line (Standard_Error);
      raise Normal_Exit;
   end if;

   --  Gross error checking that the number of parameters is correct.
   --  Not applicable to Unlimited_Files parameters.

   if not ((Param_Count = Command.Params'Length - 1 and then
             Command.Params (Param_Count + 1) = Unlimited_Files)
     or else (Param_Count <= Command.Params'Length))
   then
      Put_Line (Standard_Error,
        "Parameter count of "
        & Integer'Image (Param_Count)
        & " not equal to expected "
        & Integer'Image (Command.Params'Length));
      Put (Standard_Error, "usage: ");
      Put_Line (Standard_Error, Command.Usage.all);
      Errors := Errors + 1;
   end if;

   if Errors > 0 then
      raise Error_Exit;
   else
      --  Prepare arguments for a call to spawn, filtering out
      --  embedded nulls place there to delineate strings.

      declare
         Pname_Ptr  : Natural;
         Args       : Argument_List (1 .. 500);
         Nargs      : Natural;
         P1, P2     : Natural;
         Exec_Path  : String_Access;
         Inside_Nul : Boolean := False;
         Arg        : String (1 .. 1024);
         Arg_Ctr    : Natural;

      begin
         Pname_Ptr := 1;

         while Pname_Ptr < Buffer.Last
           and then Buffer.Table (Pname_Ptr + 1) /= ' '
         loop
            Pname_Ptr := Pname_Ptr + 1;
         end loop;

         P1 := Pname_Ptr + 2;
         Arg_Ctr := 1;
         Arg (Arg_Ctr) := Buffer.Table (P1);

         Nargs := 0;
         while P1 <= Buffer.Last loop

            if Buffer.Table (P1) = ASCII.NUL then
               if Inside_Nul then
                  Inside_Nul := False;
               else
                  Inside_Nul := True;
               end if;
            end if;

            if Buffer.Table (P1) = ' ' and then not Inside_Nul then
               P1 := P1 + 1;
               Arg_Ctr := Arg_Ctr + 1;
               Arg (Arg_Ctr) := Buffer.Table (P1);

            else
               Nargs := Nargs + 1;
               P2 := P1;

               while P2 < Buffer.Last
                 and then (Buffer.Table (P2 + 1) /= ' ' or else
                           Inside_Nul)
               loop
                  P2 := P2 + 1;
                  Arg_Ctr := Arg_Ctr + 1;
                  Arg (Arg_Ctr) := Buffer.Table (P2);
                  if Buffer.Table (P2) = ASCII.NUL then
                     Arg_Ctr := Arg_Ctr - 1;
                     if Inside_Nul then
                        Inside_Nul := False;
                     else
                        Inside_Nul := True;
                     end if;
                  end if;
               end loop;

               Args (Nargs) := new String'(String (Arg (1 .. Arg_Ctr)));
               P1 := P2 + 2;
               Arg_Ctr := 1;
               Arg (Arg_Ctr) := Buffer.Table (P1);
            end if;
         end loop;

         Exec_Path := Locate_Exec_On_Path
           (String (Buffer.Table (1 .. Pname_Ptr)));

         if Exec_Path = null then
            Put_Line (Standard_Error,
                      "Couldn't locate "
                       & String (Buffer.Table (1 .. Pname_Ptr)));
            raise Error_Exit;
         end if;

         My_Exit_Status
           := Exit_Status (Spawn (Exec_Path.all, Args (1 .. Nargs)));

      end;

      raise Normal_Exit;
   end if;

exception
   when Error_Exit =>
      Set_Exit_Status (Failure);

   when Normal_Exit =>
      Set_Exit_Status (My_Exit_Status);

end GNATCmd;
