gnatcmd.adb   [plain text]

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              G N A T C M D                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                                                                          --
--          Copyright (C) 1996-2002 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 GNAT.Directory_Operations; use GNAT.Directory_Operations;

with Csets;
with MLib.Tgt;
with MLib.Utl;
with Namet;    use Namet;
with Opt;
with Osint;    use Osint;
with Output;
with Prj;      use Prj;
with Prj.Env;
with Prj.Ext;  use Prj.Ext;
with Prj.Pars;
with Prj.Util; use Prj.Util;
with Sdefault; use Sdefault;
with Snames;   use Snames;
with Stringt;  use Stringt;
with Table;
with Types;    use Types;
with Hostparm; use Hostparm;
--  Used to determine if we are in VMS or not for error message purposes

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 Gnatvsn;
with GNAT.OS_Lib;             use GNAT.OS_Lib;

with Table;

procedure GNATCmd is

   Ada_Include_Path : constant String := "ADA_INCLUDE_PATH";
   Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH";

   Project_File      : String_Access;
   Project           : Prj.Project_Id;
   Current_Verbosity : Prj.Verbosity := Prj.Default;
   Tool_Package_Name : Name_Id       := No_Name;

   --  This flag indicates a switch -p (for gnatxref and gnatfind) for
   --  an old fashioned project file. -p cannot be used in conjonction
   --  with -P.

   Old_Project_File_Used : Boolean := False;

   --  A table to keep the switches on the command line

   package Last_Switches is new Table.Table
     (Table_Component_Type => String_Access,
      Table_Index_Type     => Integer,
      Table_Low_Bound      => 1,
      Table_Initial        => 20,
      Table_Increment      => 100,
      Table_Name           => "Gnatcmd.Last_Switches");

   --  A table to keep the switches from the project file

   package First_Switches is new Table.Table
     (Table_Component_Type => String_Access,
      Table_Index_Type     => Integer,
      Table_Low_Bound      => 1,
      Table_Initial        => 20,
      Table_Increment      => 100,
      Table_Name           => "Gnatcmd.First_Switches");

   ------------------
   -- 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
   --    | NO_SPACE_FILE_TRANSL
   --    | 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 @
   --    NO_SPACE_FILE_TRANSL     ::= =< 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 NO_SPACE_FILE_TRANSL is similar to FILE_TRANSLATION, except that
   --  no space is inserted between the switch and the file name.

   --  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_Help    : aliased constant S := "/HELP "                         &
                                            "-h";

   S_Bind_Init    : aliased constant S := "/INITIALIZE_SCALARS="           &
                                            "INVALID "                     &
                                               "-Sin "                     &
                                            "LOW "                         &
                                               "-Slo "                     &
                                            "HIGH "                        &
                                               "-Shi";

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

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

   S_Bind_List    : aliased constant S := "/LIST_RESTRICTIONS "            &
                                            "-r";

   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_No_Time : aliased constant S := "/NO_TIME_STAMP_CHECK "          &
                                            "-t";

   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=<"                  &
                                            "-M>";

   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_Restr   : aliased constant S := "/RESTRICTION_LIST "             &
                                            "-r";

   S_Bind_RTS     : aliased constant S := "/RUNTIME_SYSTEM=|"              &
                                            "--RTS=|";

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

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

   S_Bind_Slice   : aliased constant S := "/TIME_SLICE=#"                  &
                                            "-T#";

   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_Help    'Access,
      S_Bind_Init    'Access,
      S_Bind_Library 'Access,
      S_Bind_Linker  'Access,
      S_Bind_List    'Access,
      S_Bind_Main    'Access,
      S_Bind_Nostinc 'Access,
      S_Bind_Nostlib 'Access,
      S_Bind_No_Time '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_Restr   'Access,
      S_Bind_RTS     'Access,
      S_Bind_Search  'Access,
      S_Bind_Shared  'Access,
      S_Bind_Slice   '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_Config  : aliased constant S := "/CONFIGURATION_PRAGMAS_FILE=<"   &
                                             "-gnatec>";

   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_Help    : aliased constant S := "/HELP "                     &
                                            "-gnath";

   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_Immed   : aliased constant S := "/IMMEDIATE_ERRORS "    &
                                             "-gnatdO";

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

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

   S_GCC_Jumps   : aliased constant S := "/LONGJMP_SETJMP "                &
                                             "-gnatL";

   S_GCC_Length  : aliased constant S := "/MAX_LINE_LENGTH=#"              &
                                             "-gnatyM#";

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

   S_GCC_Noadc   : aliased constant S := "/NO_GNAT_ADC "                   &
                                             "-gnatA";

   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_Polling : aliased constant S := "/POLLING "                       &
                                            "-gnatP";

   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 "                  &
                                            "RM_COLUMN_LAYOUT "            &
                                               "-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 "                    &
                                            "BIASED_ROUNDING "             &
                                               "-gnatwb "                  &
                                            "NOBIASED_ROUNDING "           &
                                               "-gnatwB "                  &
                                            "CONDITIONALS "                &
                                               "-gnatwc "                  &
                                            "NOCONDITIONALS "              &
                                               "-gnatwC "                  &
                                            "IMPLICIT_DEREFERENCE "        &
                                               "-gnatwd "                  &
                                            "NO_IMPLICIT_DEREFERENCE "     &
                                               "-gnatwD "                  &
                                            "ELABORATION "                 &
                                               "-gnatwl "                  &
                                            "NOELABORATION "               &
                                               "-gnatwL "                  &
                                            "ERRORS "                      &
                                               "-gnatwe "                  &
                                            "HIDING "                      &
                                               "-gnatwh "                  &
                                            "NOHIDING "                    &
                                               "-gnatwH "                  &
                                            "IMPLEMENTATION "              &
                                               "-gnatwi "                  &
                                            "NOIMPLEMENTATION "            &
                                               "-gnatwI "                  &
                                            "INEFFECTIVE_INLINE "          &
                                               "-gnatwp "                  &
                                            "NOINEFFECTIVE_INLINE "        &
                                               "-gnatwP "                  &
                                            "OPTIONAL "                    &
                                               "-gnatwa "                  &
                                            "NOOPTIONAL "                  &
                                               "-gnatwA "                  &
                                            "OVERLAYS "                    &
                                               "-gnatwo "                  &
                                            "NOOVERLAYS "                  &
                                               "-gnatwO "                  &
                                            "REDUNDANT "                   &
                                               "-gnatwr "                  &
                                            "NOREDUNDANT "                 &
                                               "-gnatwR "                  &
                                            "SUPPRESS "                    &
                                               "-gnatws "                  &
                                            "UNINITIALIZED "               &
                                               "-Wuninitialized "          &
                                            "UNREFERENCED_FORMALS "        &
                                               "-gnatwf "                  &
                                            "NOUNREFERENCED_FORMALS "      &
                                               "-gnatwF "                  &
                                            "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_Config  '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_Ext_Ref     'Access,
      S_GCC_File    'Access,
      S_GCC_Force   'Access,
      S_GCC_Help    'Access,
      S_GCC_Ident   'Access,
      S_GCC_IdentX  'Access,
      S_GCC_Immed   'Access,
      S_GCC_Inline  'Access,
      S_GCC_InlineX 'Access,
      S_GCC_Jumps   'Access,
      S_GCC_Length  'Access,
      S_GCC_List    'Access,
      S_GCC_Noadc   'Access,
      S_GCC_Noload  'Access,
      S_GCC_Nostinc 'Access,
      S_GCC_Opt     'Access,
      S_GCC_OptX    'Access,
      S_GCC_Polling 'Access,
      S_Project_File'Access,
      S_Project_Verb'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_Bind   : aliased constant S := "/BIND_FILE=<"                    &
                                            "-b>";

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

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

   S_Elim_Tree   : aliased constant S := "/TREE_DIRS=*"                    &
                                            "-T*";

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

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

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

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

   S_Find_Deriv   : aliased constant S := "/DERIVED_TYPE_INFORMATION "     &
                                            "-d";

   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_Nostinc : aliased constant S := "/NOSTD_INCLUDES "               &
                                            "-nostdinc";

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

   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*";

   S_Find_Types   : aliased constant S := "/TYPE_HIERARCHY "               &
                                            "-t";

   Find_Switches : aliased constant Switches :=
     (S_Find_All     'Access,
      S_Find_Deriv   'Access,
      S_Find_Expr    'Access,
      S_Ext_Ref      'Access,
      S_Find_Full    'Access,
      S_Find_Ignore  'Access,
      S_Find_Nostinc 'Access,
      S_Find_Nostlib '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,
      S_Find_Types   '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_Force   : aliased constant S := "/FORCE_OBJECT_FILE_LIST "       &
                                            "-f";

   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_Force   '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_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 "                       &
                                            "DEPEND "                      &
                                               "-d "                       &
                                            "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_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_Mapping : aliased constant S := "/MAPPING "                      &
                                            "-C";

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

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

   S_Make_Nomain  : aliased constant S := "/NOMAIN "                       &
                                            "-z";

   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_RTS     : aliased constant S := "/RUNTIME_SYSTEM=|"              &
                                            "--RTS=|";

   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_Switch  : aliased constant S := "/SWITCH_CHECK "               &
                                            "-s";

   S_Make_Unique  : aliased constant S := "/UNIQUE "                       &
                                            "-u";

   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_Mapping 'Access,
      S_Make_Minimal 'Access,
      S_Make_Nolink  'Access,
      S_Make_Nomain  '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_RTS     'Access,
      S_Make_Search  'Access,
      S_Make_Skip    'Access,
      S_Make_Source  'Access,
      S_Make_Switch  'Access,
      S_Make_Unique  'Access,
      S_Make_Verbose 'Access);

   ----------------------------
   -- Switches for GNAT Name --
   ----------------------------

   S_Name_Conf    : aliased constant S := "/CONFIG_FILE=<"                   &
                                            "-c>";

   S_Name_Dirs    : aliased constant S := "/SOURCE_DIRS=*"                   &
                                            "-d*";

   S_Name_Dfile   : aliased constant S := "/DIRS_FILE=<"                     &
                                            "-D>";

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

   S_Name_Proj    : aliased constant S := "/PROJECT_FILE=<"                  &
                                            "-P>";

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

   Name_Switches : aliased constant Switches :=
     (S_Name_Conf         'Access,
      S_Name_Dirs         'Access,
      S_Name_Dfile        'Access,
      S_Name_Help         'Access,
      S_Name_Proj         'Access,
      S_Name_Verbose      'Access);

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

   S_Prep_Assoc   : aliased constant S := "/ASSOCIATE=" & '"'               &
                                            "-D" & '"';

   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";

   Prep_Switches : aliased constant Switches :=
     (S_Prep_Assoc   'Access,
      S_Prep_Blank   'Access,
      S_Prep_Com     'Access,
      S_Prep_Ref     'Access,
      S_Prep_Remove  'Access,
      S_Prep_Symbols 'Access,
      S_Prep_Undef   '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 XREF --
   ----------------------------

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

   S_Xref_Deriv   : aliased constant S := "/DERIVED_TYPES "                &
                                            "-d";

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

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

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

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

   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";

   S_Xref_Tags    : aliased constant S := "/TAGS "                         &
                                            "-v";

   Xref_Switches : aliased constant Switches :=
     (S_Xref_All     'Access,
      S_Xref_Deriv   'Access,
      S_Ext_Ref      'Access,
      S_Xref_Full    'Access,
      S_Xref_Global  'Access,
      S_Xref_Nostinc 'Access,
      S_Xref_Nostlib '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,
      S_Xref_Tags    '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 whitespace separate file or directory
      --  parameters including wildcard specifications.

      Unlimited_As_Is,
      --  Un unlimited number of whitespace separated paameters that are
      --  passed through as is (not canonicalized).

      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_Type is
     (Bind, Chop, Compile, Elim, Find, Krunch, Library, Link, List,
      Make, Name, Preprocess, Shared, Standard, Stub, Xref, Undefined);

   type Alternate_Command is (Comp, Ls, Kr, Prep, Psta);
   --  Alternate command libel for non VMS system

   Corresponding_To : constant array (Alternate_Command) of Command_Type :=
     (Comp  => Compile,
      Ls    => List,
      Kr    => Krunch,
      Prep  => Preprocess,
      Psta  => Standard);
   --  Mapping of alternate commands to commands

   subtype Real_Command_Type is Command_Type range Bind .. Xref;

   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

      Unixsws : Argument_List_Access;
      --  Switches for the Unix command

      VMS_Only : Boolean;
      --  When True, the command can only be used on VMS

      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 qualifier followed by a filename
      --  Example: GNAT LINK /EXECUTABLE=FOO.EXE

      T_No_Space_File,
      --  A qualifier followed by a filename
      --  Example: GNAT MAKE /PROJECT_FILE=PRJ.GPR

      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

      Command : Command_Type := Undefined;

      Unix_String : String_Ptr := null;
      --  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_Arg : Positive := 1;

   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 (on VMS)

   The_Command : Command_Type;
   --  The command used

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

   function Index (Char : Character; Str : String) return Natural;
   --  Returns the first occurrence of Char in Str.
   --  Returns 0 if Char is not in Str.

   function Init_Object_Dirs return Argument_List;

   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).

   procedure Non_VMS_Usage;
   --  Display usage for platforms other than VMS

   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 Output_Version;
   --  Output the version of this program

   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 Set_Library_For
     (Project             : Project_Id;
      There_Are_Libraries : in out Boolean);
   --  If Project is a library project, add the correct
   --  -L and -l switches to the linker invocation.

   procedure Set_Libraries is
      new For_Every_Project_Imported (Boolean, Set_Library_For);
   --  Add the -L and -l switches to the linker for all
   --  of the library projects.

   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.

   procedure VMS_Conversion (The_Command : out Command_Type);
   --  Converts VMS command line to equivalent Unix command line

   -----------
   -- Index --
   -----------

   function Index (Char : Character; Str : String) return Natural is
   begin
      for Index in Str'Range loop
         if Str (Index) = Char then
            return Index;
         end if;
      end loop;

      return 0;
   end Index;

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

   function Init_Object_Dirs return Argument_List is
      Object_Dirs     : Integer;
      Object_Dir      : Argument_List (1 .. 256);
      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) :=
              new String'("-L" &
                          To_Canonical_Dir_Spec
                          (To_Host_Dir_Spec
                           (Normalize_Directory_Name (Dir.all).all,
                            True).all, True).all);
         end;
      end loop;

      Object_Dirs := Object_Dirs + 1;
      Object_Dir (Object_Dirs) := new String'("-lgnat");

      if Hostparm.OpenVMS then
         Object_Dirs := Object_Dirs + 1;
         Object_Dir (Object_Dirs) := new String'("-ldecgnat");
      end if;

      return Object_Dir (1 .. Object_Dirs);
   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.

      ---------
      -- Err --
      ---------

      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;

   --------------------
   -- Output_Version --
   --------------------

   procedure Output_Version is
   begin
      Put ("GNAT ");
      Put (Gnatvsn.Gnat_Version_String);
      Put_Line (" Copyright 1996-2002 Free Software Foundation, Inc.");
   end Output_Version;

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

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

      --  Do not put a space as the first character in the buffer
      if C = ' ' and then Buffer.Last = 1 then
         Buffer.Decrement_Last;
      end if;
   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;

   ---------------------
   -- Set_Library_For --
   ---------------------

   procedure Set_Library_For
     (Project             : Project_Id;
      There_Are_Libraries : in out Boolean)
   is
   begin
      --  Case of library project

      if Projects.Table (Project).Library then
         There_Are_Libraries := True;

         --  Add the -L switch

         Last_Switches.Increment_Last;
         Last_Switches.Table (Last_Switches.Last) :=
           new String'("-L" &
                       Get_Name_String
                       (Projects.Table (Project).Library_Dir));

         --  Add the -l switch

         Last_Switches.Increment_Last;
         Last_Switches.Table (Last_Switches.Last) :=
           new String'("-l" &
                       Get_Name_String
                       (Projects.Table (Project).Library_Name));

         --  Add the Wl,-rpath switch if library non static

         if Projects.Table (Project).Library_Kind /= Static then
            declare
               Option : constant String_Access :=
                          MLib.Tgt.Linker_Library_Path_Option
                            (Get_Name_String
                              (Projects.Table (Project).Library_Dir));

            begin
               if Option /= null then
                  Last_Switches.Increment_Last;
                  Last_Switches.Table (Last_Switches.Last) :=
                    Option;
               end if;

            end;

         end if;

      end if;
   end Set_Library_For;

   --------------------------------
   -- 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 (except Non_VMS_Usage
   --  and VMS_Conversion that use Command_List) to avoid some access before
   --  elaboration problems.

   Command_List : constant array (Real_Command_Type) of Command_Entry :=
     (Bind =>
       (Cname    => new S'("BIND"),
        Usage    => new S'("GNAT BIND file[.ali] /qualifiers"),
        VMS_Only => False,
        Unixcmd  => new S'("gnatbind"),
        Unixsws  => null,
        Switches => Bind_Switches'Access,
        Params   => new Parameter_Array'(1 => File),
        Defext   => "ali"),

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

      Compile =>
        (Cname    => new S'("COMPILE"),
         Usage    => new S'("GNAT COMPILE filespec[,...] /qualifiers"),
         VMS_Only => False,
         Unixcmd  => new S'("gnatmake"),
         Unixsws  => new Argument_List' (1 => new String'("-f"),
                                         2 => new String'("-u"),
                                         3 => new String'("-c")),
         Switches => GCC_Switches'Access,
         Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
         Defext   => "   "),

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

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

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

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

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

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

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

      Name =>
        (Cname    => new S'("NAME"),
         Usage    => new S'("GNAT NAME /qualifiers naming-pattern "
                            & "[naming-patterns]"),
         VMS_Only => False,
         Unixcmd  => new S'("gnatname"),
         Unixsws  => null,
         Switches => Name_Switches'Access,
         Params   => new Parameter_Array'(1 => Unlimited_As_Is),
         Defext   => "   "),

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

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

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

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

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

   -------------------
   -- Non_VMS_Usage --
   -------------------

   procedure Non_VMS_Usage is
   begin
      Output_Version;
      New_Line;
      Put_Line ("List of available commands");
      New_Line;

      for C in Command_List'Range loop
         if not Command_List (C).VMS_Only then
            Put ("GNAT " & Command_List (C).Cname.all);
            Set_Col (25);
            Put (Command_List (C).Unixcmd.all);

            declare
               Sws : Argument_List_Access renames Command_List (C).Unixsws;
            begin
               if Sws /= null then
                  for J in Sws'Range loop
                     Put (' ');
                     Put (Sws (J).all);
                  end loop;
               end if;
            end;

            New_Line;
         end if;
      end loop;

      New_Line;
      Put_Line ("Commands FIND, LIST and XREF accept project file " &
                "switches -vPx, -Pprj and -Xnam=val");
      New_Line;
   end Non_VMS_Usage;

   --------------------
   -- VMS_Conversion --
   --------------------

   procedure VMS_Conversion (The_Command : out Command_Type) is
   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 Real_Command_Type 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.Command := C;

            if Command_List (C).Unixsws = null then
               Command.Unix_String := Command_List (C).Unixcmd;
            else
               declare
                  Cmd  : String (1 .. 5_000);
                  Last : Natural := 0;
                  Sws  : Argument_List_Access := Command_List (C).Unixsws;

               begin
                  Cmd (1 .. Command_List (C).Unixcmd'Length) :=
                    Command_List (C).Unixcmd.all;
                  Last := Command_List (C).Unixcmd'Length;

                  for J in Sws'Range loop
                     Last := Last + 1;
                     Cmd (Last) := ' ';
                     Cmd (Last + 1 .. Last + Sws (J)'Length) :=
                       Sws (J).all;
                     Last := Last + Sws (J)'Length;
                  end loop;

                  Command.Unix_String := new String'(Cmd (1 .. Last));
               end;
            end if;

            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);

                     --  No space file translation case

                  elsif SS (P + 1) = '<' then
                     pragma Assert (SS (SS'Last) = '>');
                     Sw.Translation := T_No_Space_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
         Output_Version;
         New_Line;
         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 through arguments

      while Arg_Num <= Argument_Count loop

         Process_Argument : 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.

            -----------------
            -- Get_Arg_End --
            -----------------

            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;

         --  Start of processing for Process_Argument

         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;

                        The_Command := Command.Command;

                        --  Give usage information if only command given

                        if Argument_Count = 1 and then Next_Arg_Idx = Argv'Last
                          and then Command.Command /= Standard
                        then
                           Output_Version;
                           New_Line;
                           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 | T_No_Space_File =>
                                       Put ("=file");
                                       Set_Col (53);
                                       Put (Sw.Unix_String.all);

                                       if Sw.Translation = T_File
                                         and then 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
                           Place (' ');
                           Place (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 Unlimited_As_Is =>
                                 Place (' ');
                                 Place (Arg.all);
                                 Param_Count := Param_Count - 1;

                              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 SwP < Arg'Last
                                      and then 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 | T_No_Space_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.Translation = T_File
                                         and then 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 Process_Argument;

         Arg_Num := Arg_Num + 1;
      end loop;

      if Display_Command then
         Put (Standard_Error, "generated command -->");
         Put (Standard_Error, Command_List (The_Command).Unixcmd.all);

         if Command_List (The_Command).Unixsws /= null then
            for J in Command_List (The_Command).Unixsws'Range loop
               Put (Standard_Error, " ");
               Put (Standard_Error,
                    Command_List (The_Command).Unixsws (J).all);
            end loop;
         end if;

         Put (Standard_Error, " ");
         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 (Param_Count = Command.Params'Length - 1
            and then Command.Params (Param_Count + 1) = Unlimited_Files)
        or else Param_Count <= Command.Params'Length
      then
         null;

      else
         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
            P1, P2     : Natural;
            Inside_Nul : Boolean := False;
            Arg        : String (1 .. 1024);
            Arg_Ctr    : Natural;

         begin
            P1 := 1;

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

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

            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
                  Last_Switches.Increment_Last;
                  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;

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

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

begin
   --  Initializations

   Namet.Initialize;
   Csets.Initialize;

   Snames.Initialize;

   Prj.Initialize;

   Last_Switches.Init;
   Last_Switches.Set_Last (0);

   First_Switches.Init;
   First_Switches.Set_Last (0);

   --  If on VMS, or if VMS emulation is on, convert VMS style /qualifiers,
   --  filenames and pathnames to Unix style.

   if Hostparm.OpenVMS
     or else To_Lower (Getenv ("EMULATE_VMS").all) = "true"
   then
      VMS_Conversion (The_Command);

   --  If not on VMS, scan the command line directly

   else
      if Argument_Count = 0 then
         Non_VMS_Usage;
         return;
      else
         begin
            if Argument_Count > 1 and then Argument (1) = "-v" then
               Opt.Verbose_Mode := True;
               Command_Arg := 2;
            end if;

            The_Command := Real_Command_Type'Value (Argument (Command_Arg));

            if Command_List (The_Command).VMS_Only then
               Non_VMS_Usage;
               Fail ("Command """ & Command_List (The_Command).Cname.all &
                     """ can only be used on VMS");
            end if;
         exception
            when Constraint_Error =>

               --  Check if it is an alternate command
               declare
                  Alternate : Alternate_Command;

               begin
                  Alternate := Alternate_Command'Value
                                              (Argument (Command_Arg));
                  The_Command := Corresponding_To (Alternate);

               exception
                  when Constraint_Error =>
                     Non_VMS_Usage;
                     Fail ("Unknown command: " & Argument (Command_Arg));
               end;
         end;

         for Arg in Command_Arg + 1 .. Argument_Count loop
            Last_Switches.Increment_Last;
            Last_Switches.Table (Last_Switches.Last) :=
              new String'(Argument (Arg));
         end loop;
      end if;
   end if;

   declare
      Program : constant String :=
        Program_Name (Command_List (The_Command).Unixcmd.all).all;

      Exec_Path : String_Access;

   begin
      --  Locate the executable for the command

      Exec_Path := Locate_Exec_On_Path (Program);

      if Exec_Path = null then
         Put_Line (Standard_Error, "Couldn't locate " & Program);
         raise Error_Exit;
      end if;

      --  If there are switches for the executable, put them as first switches

      if Command_List (The_Command).Unixsws /= null then
         for J in Command_List (The_Command).Unixsws'Range loop
            First_Switches.Increment_Last;
            First_Switches.Table (First_Switches.Last) :=
              Command_List (The_Command).Unixsws (J);
         end loop;
      end if;

      --  For BIND, FIND, LINK, LIST and XREF, look for project file related
      --  switches.

      if The_Command = Bind
        or else The_Command = Find
        or else The_Command = Link
        or else The_Command = List
        or else The_Command = Xref
      then
         case The_Command is
            when Bind =>
               Tool_Package_Name := Name_Binder;
            when Find =>
               Tool_Package_Name := Name_Finder;
            when Link =>
               Tool_Package_Name := Name_Linker;
            when List =>
               Tool_Package_Name := Name_Gnatls;
            when Xref =>
               Tool_Package_Name := Name_Cross_Reference;
            when others =>
               null;
         end case;

         declare
            Arg_Num : Positive := 1;
            Argv    : String_Access;

            procedure Remove_Switch (Num : Positive);
            --  Remove a project related switch from table Last_Switches

            -------------------
            -- Remove_Switch --
            -------------------

            procedure Remove_Switch (Num : Positive) is
            begin
               Last_Switches.Table (Num .. Last_Switches.Last - 1) :=
                 Last_Switches.Table (Num + 1 .. Last_Switches.Last);
               Last_Switches.Decrement_Last;
            end Remove_Switch;

         --  Start of processing for ??? (need block name here)

         begin
            while Arg_Num <= Last_Switches.Last loop
               Argv := Last_Switches.Table (Arg_Num);

               if Argv (Argv'First) = '-' then
                  if Argv'Length = 1 then
                     Fail ("switch character cannot be followed by a blank");
                  end if;

                  --  The two style project files (-p and -P) cannot be used
                  --  together

                  if (The_Command = Find or else The_Command = Xref)
                    and then Argv (2) = 'p'
                  then
                     Old_Project_File_Used := True;
                     if Project_File /= null then
                        Fail ("-P and -p cannot be used together");
                     end if;
                  end if;

                  --  -vPx  Specify verbosity while parsing project files

                  if Argv'Length = 4
                    and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
                  then
                     case Argv (Argv'Last) is
                        when '0' =>
                           Current_Verbosity := Prj.Default;
                        when '1' =>
                           Current_Verbosity := Prj.Medium;
                        when '2' =>
                           Current_Verbosity := Prj.High;
                        when others =>
                           Fail ("Invalid switch: " & Argv.all);
                     end case;

                     Remove_Switch (Arg_Num);

                  --  -Pproject_file  Specify project file to be used

                  elsif Argv'Length >= 3
                    and then Argv (Argv'First + 1) = 'P'
                  then

                     --  Only one -P switch can be used

                     if Project_File /= null then
                        Fail (Argv.all &
                              ": second project file forbidden (first is """ &
                              Project_File.all & """)");

                     --  The two style project files (-p and -P) cannot be
                     --  used together.

                     elsif Old_Project_File_Used then
                        Fail ("-p and -P cannot be used together");

                     else
                        Project_File :=
                          new String'(Argv (Argv'First + 2 .. Argv'Last));
                     end if;

                     Remove_Switch (Arg_Num);

                  --  -Xexternal=value Specify an external reference to be
                  --                   used in project files

                  elsif Argv'Length >= 5
                    and then Argv (Argv'First + 1) = 'X'
                  then
                     declare
                        Equal_Pos : constant Natural :=
                          Index ('=', Argv (Argv'First + 2 .. Argv'Last));
                     begin
                        if Equal_Pos >= Argv'First + 3 and then
                          Equal_Pos /= Argv'Last then
                           Add (External_Name =>
                                  Argv (Argv'First + 2 .. Equal_Pos - 1),
                                Value => Argv (Equal_Pos + 1 .. Argv'Last));
                        else
                           Fail (Argv.all &
                                 " is not a valid external assignment.");
                        end if;
                     end;

                     Remove_Switch (Arg_Num);

                  else
                     Arg_Num := Arg_Num + 1;
                  end if;

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

      --  If there is a project file specified, parse it, get the switches
      --  for the tool and setup PATH environment variables.

      if Project_File /= null then
         Prj.Pars.Set_Verbosity (To => Current_Verbosity);

         Prj.Pars.Parse
           (Project           => Project,
            Project_File_Name => Project_File.all);

         if Project = Prj.No_Project then
            Fail ("""" & Project_File.all & """ processing failed");
         end if;

         --  Check if a package with the name of the tool is in the project
         --  file and if there is one, get the switches, if any, and scan them.

         declare
            Data : Prj.Project_Data := Prj.Projects.Table (Project);
            Pkg  : Prj.Package_Id :=
                     Prj.Util.Value_Of
                       (Name        => Tool_Package_Name,
                        In_Packages => Data.Decl.Packages);

            Element : Package_Element;

            Default_Switches_Array : Array_Element_Id;

            The_Switches : Prj.Variable_Value;
            Current      : Prj.String_List_Id;
            The_String   : String_Element;

         begin
            if Pkg /= No_Package then
               Element := Packages.Table (Pkg);

               --  Packages Gnatls has a single attribute Switches, that is
               --  not an associative array.

               if The_Command = List then
                  The_Switches :=
                    Prj.Util.Value_Of
                    (Variable_Name => Snames.Name_Switches,
                     In_Variables => Element.Decl.Attributes);

               --  Packages Binder (for gnatbind), Cross_Reference (for
               --  gnatxref), Linker (for gnatlink) and Finder
               --  (for gnatfind) have an attributed Default_Switches,
               --  an associative array, indexed by the name of the
               --  programming language.
               else
                  Default_Switches_Array :=
                    Prj.Util.Value_Of
                    (Name => Name_Default_Switches,
                     In_Arrays => Packages.Table (Pkg).Decl.Arrays);
                  The_Switches := Prj.Util.Value_Of
                    (Index => Name_Ada,
                     In_Array => Default_Switches_Array);

               end if;

               --  If there are switches specified in the package of the
               --  project file corresponding to the tool, scan them.

               case The_Switches.Kind is
                  when Prj.Undefined =>
                     null;

                  when Prj.Single =>
                     if String_Length (The_Switches.Value) > 0 then
                        String_To_Name_Buffer (The_Switches.Value);
                        First_Switches.Increment_Last;
                        First_Switches.Table (First_Switches.Last) :=
                          new String'(Name_Buffer (1 .. Name_Len));
                     end if;

                  when Prj.List =>
                     Current := The_Switches.Values;
                     while Current /= Prj.Nil_String loop
                        The_String := String_Elements.Table (Current);

                        if String_Length (The_String.Value) > 0 then
                           String_To_Name_Buffer (The_String.Value);
                           First_Switches.Increment_Last;
                           First_Switches.Table (First_Switches.Last) :=
                             new String'(Name_Buffer (1 .. Name_Len));
                        end if;

                        Current := The_String.Next;
                     end loop;
               end case;
            end if;
         end;

         --  Set up the environment variables ADA_INCLUDE_PATH and
         --  ADA_OBJECTS_PATH.

         Setenv
           (Name  => Ada_Include_Path,
            Value => Prj.Env.Ada_Include_Path (Project).all);
         Setenv
           (Name  => Ada_Objects_Path,
            Value => Prj.Env.Ada_Objects_Path
            (Project, Including_Libraries => False).all);

         if The_Command = Bind or else The_Command = Link then
            Change_Dir
              (Get_Name_String
                 (Projects.Table (Project).Object_Directory));
         end if;

         if The_Command = Link then

            --  Add the default search directories, to be able to find
            --  libgnat in call to MLib.Utl.Lib_Directory.

            Add_Default_Search_Dirs;

            declare
               There_Are_Libraries  : Boolean := False;

            begin
               --  Check if there are library project files

               if MLib.Tgt.Libraries_Are_Supported then
                  Set_Libraries (Project, There_Are_Libraries);
               end if;

               --  If there are, add the necessary additional switches

               if There_Are_Libraries then

                  --  Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>

                  Last_Switches.Increment_Last;
                  Last_Switches.Table (Last_Switches.Last) :=
                    new String'("-L" & MLib.Utl.Lib_Directory);
                  Last_Switches.Increment_Last;
                  Last_Switches.Table (Last_Switches.Last) :=
                    new String'("-lgnarl");
                  Last_Switches.Increment_Last;
                  Last_Switches.Table (Last_Switches.Last) :=
                    new String'("-lgnat");

                  declare
                     Option : constant String_Access :=
                       MLib.Tgt.Linker_Library_Path_Option
                       (MLib.Utl.Lib_Directory);

                  begin
                     if Option /= null then
                        Last_Switches.Increment_Last;
                        Last_Switches.Table (Last_Switches.Last) :=
                          Option;
                     end if;
                  end;
               end if;
            end;
         end if;
      end if;

      --  Gather all the arguments and invoke the executable

      declare
         The_Args : Argument_List
           (1 .. First_Switches.Last + Last_Switches.Last);
         Arg_Num : Natural := 0;
      begin
         for J in 1 .. First_Switches.Last loop
            Arg_Num := Arg_Num + 1;
            The_Args (Arg_Num) := First_Switches.Table (J);
         end loop;

         for J in 1 .. Last_Switches.Last loop
            Arg_Num := Arg_Num + 1;
            The_Args (Arg_Num) := Last_Switches.Table (J);
         end loop;

         if Opt.Verbose_Mode then
            Output.Write_Str (Exec_Path.all);

            for Arg in The_Args'Range loop
               Output.Write_Char (' ');
               Output.Write_Str (The_Args (Arg).all);
            end loop;

            Output.Write_Eol;
         end if;

         My_Exit_Status
           := Exit_Status (Spawn (Exec_Path.all, The_Args));
         raise Normal_Exit;
      end;
   end;

exception
   when Error_Exit =>
      Set_Exit_Status (Failure);

   when Normal_Exit =>
      Set_Exit_Status (My_Exit_Status);

end GNATCmd;