gcc/ada/gnatcmd.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              G N A T C M D                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.84 $
  10 --                                                                          --
  11 --          Copyright (C) 1996-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Ada.Characters.Handling; use Ada.Characters.Handling;
  30 with Ada.Command_Line;        use Ada.Command_Line;
  31 with Ada.Text_IO;             use Ada.Text_IO;
  32
  33 with Osint;    use Osint;
  34 with Sdefault; use Sdefault;
  35 with Hostparm; use Hostparm;
  36 --  Used to determine if we are in VMS or not for error message purposes
  37
  38 with Gnatvsn;
  39 with GNAT.OS_Lib;             use GNAT.OS_Lib;
  40
  41 with Table;
  42
  43 procedure GNATCmd is
  44    pragma Ident (Gnatvsn.Gnat_Version_String);
  45
  46    ------------------
  47    -- SWITCH TABLE --
  48    ------------------
  49
  50    --  The switch tables contain an entry for each switch recognized by the
  51    --  command processor. The syntax of entries is as follows:
  52
  53    --    SWITCH_STRING ::= "/ command-qualifier-name TRANSLATION"
  54
  55    --    TRANSLATION ::=
  56    --      DIRECT_TRANSLATION
  57    --    | DIRECTORIES_TRANSLATION
  58    --    | FILE_TRANSLATION
  59    --    | NUMERIC_TRANSLATION
  60    --    | STRING_TRANSLATION
  61    --    | OPTIONS_TRANSLATION
  62    --    | COMMANDS_TRANSLATION
  63    --    | ALPHANUMPLUS_TRANSLATION
  64    --    | OTHER_TRANSLATION
  65
  66    --    DIRECT_TRANSLATION       ::= space UNIX_SWITCHES
  67    --    DIRECTORIES_TRANSLATION  ::= =* UNIX_SWITCH *
  68    --    DIRECTORY_TRANSLATION    ::= =% UNIX_SWITCH %
  69    --    FILE_TRANSLATION         ::= =@ UNIX_SWITCH @
  70    --    NUMERIC_TRANSLATION      ::= =# UNIX_SWITCH # | # number #
  71    --    STRING_TRANSLATION       ::= =" UNIX_SWITCH "
  72    --    OPTIONS_TRANSLATION      ::= =OPTION {space OPTION}
  73    --    COMMANDS_TRANSLATION     ::= =? ARGS space command-name
  74    --    ALPHANUMPLUS_TRANSLATION ::= =| UNIX_SWITCH |
  75
  76    --    UNIX_SWITCHES ::= UNIX_SWITCH {, UNIX_SWITCH}
  77
  78    --    UNIX_SWITCH ::= unix-switch-string | !unix-switch-string | `string'
  79
  80    --    OPTION ::= option-name space UNIX_SWITCHES
  81
  82    --    ARGS ::= -cargs | -bargs | -largs
  83
  84    --  Here command-qual is the name of the switch recognized by the GNATCmd.
  85    --  This is always given in upper case in the templates, although in the
  86    --  actual commands, either upper or lower case is allowed.
  87
  88    --  The unix-switch-string always starts with a minus, and has no commas
  89    --  or spaces in it. Case is significant in the unix switch string. If a
  90    --  unix switch string is preceded by the not sign (!) it means that the
  91    --  effect of the corresponding command qualifer is to remove any previous
  92    --  occurrence of the given switch in the command line.
  93
  94    --  The DIRECTORIES_TRANSLATION format is used where a list of directories
  95    --  is given. This possible corresponding formats recognized by GNATCmd are
  96    --  as shown by the following example for the case of PATH
  97
  98    --    PATH=direc
  99    --    PATH=(direc,direc,direc,direc)
 100
 101    --  When more than one directory is present for the DIRECTORIES case, then
 102    --  multiple instances of the corresponding unix switch are generated,
 103    --  with the file name being substituted for the occurrence of *.
 104
 105    --  The FILE_TRANSLATION format is similar except that only a single
 106    --  file is allowed, not a list of files, and only one unix switch is
 107    --  generated as a result.
 108
 109    --  The NUMERIC_TRANSLATION format is similar to the FILE_TRANSLATION case
 110    --  except that the parameter is a decimal integer in the range 0 to 999.
 111
 112    --  For the OPTIONS_TRANSLATION case, GNATCmd similarly permits one or
 113    --  more options to appear (although only in some cases does the use of
 114    --  multiple options make logical sense). For example, taking the
 115    --  case of ERRORS for GCC, the following are all allowed:
 116
 117    --    /ERRORS=BRIEF
 118    --    /ERRORS=(FULL,VERBOSE)
 119    --    /ERRORS=(BRIEF IMMEDIATE)
 120
 121    --  If no option is provided (e.g. just /ERRORS is written), then the
 122    --  first option in the list is the default option. For /ERRORS this
 123    --  is NORMAL, so /ERRORS with no option is equivalent to /ERRORS=NORMAL.
 124
 125    --  The COMMANDS_TRANSLATION case is only used for gnatmake, to correspond
 126    --  to the use of -cargs, -bargs and -largs (the ARGS string as indicated
 127    --  is one of these three possibilities). The name given by COMMAND is the
 128    --  corresponding command name to be used to interprete the switches to be
 129    --  passed on. Switches of this type set modes, e.g. /COMPILER_QUALIFIERS
 130    --  sets the mode so that all subsequent switches, up to another switch
 131    --  with COMMANDS_TRANSLATION apply to the corresponding commands issued
 132    --  by the make utility. For example
 133
 134    --    /COMPILER_QUALIFIERS /LIST /BINDER_QUALIFIERS /MAIN
 135    --    /COMPILER_QUALIFIERS /NOLIST /COMPILE_CHECKS=SYNTAX
 136
 137    --  Clearly these switches must come at the end of the list of switches
 138    --  since all subsequent switches apply to an issued command.
 139
 140    --  For the DIRECT_TRANSLATION case, an implicit additional entry is
 141    --  created by prepending NO to the name of the qualifer, and then
 142    --  inverting the sense of the UNIX_SWITCHES string. For example,
 143    --  given the entry:
 144
 145    --     "/LIST -gnatl"
 146
 147    --  An implicit entry is created:
 148
 149    --     "/NOLIST !-gnatl"
 150
 151    --  In the case where, a ! is already present, inverting the sense of the
 152    --  switch means removing it.
 153
 154    subtype S is String;
 155    --  A synonym to shorten the table
 156
 157    type String_Ptr is access constant String;
 158    --  String pointer type used throughout
 159
 160    type Switches is array (Natural range <>) of String_Ptr;
 161    --  Type used for array of swtiches
 162
 163    type Switches_Ptr is access constant Switches;
 164
 165    ----------------------------
 166    -- Switches for GNAT BIND --
 167    ----------------------------
 168
 169    S_Bind_Bind    : aliased constant S := "/BIND_FILE="                    &
 170                                             "ADA "                         &
 171                                                "-A "                       &
 172                                             "C "                           &
 173                                                "-C";
 174
 175    S_Bind_Build   : aliased constant S := "/BUILD_LIBRARY=|"               &
 176                                             "-L|";
 177
 178    S_Bind_Current : aliased constant S := "/CURRENT_DIRECTORY "            &
 179                                             "!-I-";
 180
 181    S_Bind_Debug   : aliased constant S := "/DEBUG="                        &
 182                                             "TRACEBACK "                   &
 183                                                "-g2 "                      &
 184                                             "ALL "                         &
 185                                                "-g3 "                      &
 186                                             "NONE "                        &
 187                                                "-g0 "                      &
 188                                             "SYMBOLS "                     &
 189                                                "-g1 "                      &
 190                                             "NOSYMBOLS "                   &
 191                                                "!-g1 "                     &
 192                                             "LINK "                        &
 193                                                "-g3 "                      &
 194                                             "NOTRACEBACK "                 &
 195                                                "!-g2";
 196
 197    S_Bind_DebugX  : aliased constant S := "/NODEBUG "                      &
 198                                             "!-g";
 199
 200    S_Bind_Elab    : aliased constant S := "/ELABORATION_DEPENDENCIES "     &
 201                                             "-e";
 202
 203    S_Bind_Error   : aliased constant S := "/ERROR_LIMIT=#"                 &
 204                                             "-m#";
 205
 206    S_Bind_Full    : aliased constant S := "/FULL_ELABORATION "             &
 207                                             "-f";
 208
 209    S_Bind_Library : aliased constant S := "/LIBRARY_SEARCH=*"              &
 210                                             "-aO*";
 211
 212    S_Bind_Linker  : aliased constant S := "/LINKER_OPTION_LIST "           &
 213                                             "-K";
 214
 215    S_Bind_Main    : aliased constant S := "/MAIN "                         &
 216                                             "!-n";
 217
 218    S_Bind_Nostinc : aliased constant S := "/NOSTD_INCLUDES "               &
 219                                             "-nostdinc";
 220
 221    S_Bind_Nostlib : aliased constant S := "/NOSTD_LIBRARIES "              &
 222                                             "-nostdlib";
 223
 224    S_Bind_Object  : aliased constant S := "/OBJECT_LIST "                  &
 225                                             "-O";
 226
 227    S_Bind_Order   : aliased constant S := "/ORDER_OF_ELABORATION "         &
 228                                             "-l";
 229
 230    S_Bind_Output  : aliased constant S := "/OUTPUT=@"                      &
 231                                             "-o@";
 232
 233    S_Bind_OutputX : aliased constant S := "/NOOUTPUT "                     &
 234                                             "-c";
 235
 236    S_Bind_Pess    : aliased constant S := "/PESSIMISTIC_ELABORATION "      &
 237                                             "-p";
 238
 239    S_Bind_Read    : aliased constant S := "/READ_SOURCES="                 &
 240                                             "ALL "                         &
 241                                                "-s "                       &
 242                                             "NONE "                        &
 243                                                "-x "                       &
 244                                             "AVAILABLE "                   &
 245                                                "!-x,!-s";
 246
 247    S_Bind_ReadX   : aliased constant S := "/NOREAD_SOURCES "               &
 248                                             "-x";
 249
 250    S_Bind_Rename  : aliased constant S := "/RENAME_MAIN "                  &
 251                                            "-r";
 252
 253    S_Bind_Report  : aliased constant S := "/REPORT_ERRORS="                &
 254                                             "VERBOSE "                     &
 255                                                "-v "                       &
 256                                             "BRIEF "                       &
 257                                                "-b "                       &
 258                                             "DEFAULT "                     &
 259                                                "!-b,!-v";
 260
 261    S_Bind_ReportX : aliased constant S := "/NOREPORT_ERRORS "              &
 262                                             "!-b,!-v";
 263
 264    S_Bind_Search  : aliased constant S := "/SEARCH=*"                      &
 265                                             "-I*";
 266
 267    S_Bind_Shared  : aliased constant S := "/SHARED "                       &
 268                                            "-shared";
 269
 270    S_Bind_Source  : aliased constant S := "/SOURCE_SEARCH=*"               &
 271                                             "-aI*";
 272
 273    S_Bind_Time    : aliased constant S := "/TIME_STAMP_CHECK "             &
 274                                             "!-t";
 275
 276    S_Bind_Verbose : aliased constant S := "/VERBOSE "                      &
 277                                             "-v";
 278
 279    S_Bind_Warn    : aliased constant S := "/WARNINGS="                     &
 280                                             "NORMAL "                      &
 281                                                "!-ws,!-we "                &
 282                                             "SUPPRESS "                    &
 283                                                "-ws "                      &
 284                                             "ERROR "                       &
 285                                                "-we";
 286
 287    S_Bind_WarnX   : aliased constant S := "/NOWARNINGS "                   &
 288                                             "-ws";
 289
 290    Bind_Switches : aliased constant Switches := (
 291      S_Bind_Bind    'Access,
 292      S_Bind_Build   'Access,
 293      S_Bind_Current 'Access,
 294      S_Bind_Debug   'Access,
 295      S_Bind_DebugX  'Access,
 296      S_Bind_Elab    'Access,
 297      S_Bind_Error   'Access,
 298      S_Bind_Full    'Access,
 299      S_Bind_Library 'Access,
 300      S_Bind_Linker  'Access,
 301      S_Bind_Main    'Access,
 302      S_Bind_Nostinc 'Access,
 303      S_Bind_Nostlib 'Access,
 304      S_Bind_Object  'Access,
 305      S_Bind_Order   'Access,
 306      S_Bind_Output  'Access,
 307      S_Bind_OutputX 'Access,
 308      S_Bind_Pess    'Access,
 309      S_Bind_Read    'Access,
 310      S_Bind_ReadX   'Access,
 311      S_Bind_Rename  'Access,
 312      S_Bind_Report  'Access,
 313      S_Bind_ReportX 'Access,
 314      S_Bind_Search  'Access,
 315      S_Bind_Shared  'Access,
 316      S_Bind_Source  'Access,
 317      S_Bind_Time    'Access,
 318      S_Bind_Verbose 'Access,
 319      S_Bind_Warn    'Access,
 320      S_Bind_WarnX   'Access);
 321
 322    ----------------------------
 323    -- Switches for GNAT CHOP --
 324    ----------------------------
 325
 326    S_Chop_Comp   : aliased constant S := "/COMPILATION "                   &
 327                                             "-c";
 328
 329    S_Chop_File   : aliased constant S := "/FILE_NAME_MAX_LENGTH=#"         &
 330                                             "-k#";
 331
 332    S_Chop_Help   : aliased constant S := "/HELP "                          &
 333                                             "-h";
 334
 335    S_Chop_Over   : aliased constant S := "/OVERWRITE "                     &
 336                                             "-w";
 337
 338    S_Chop_Quiet  : aliased constant S := "/QUIET "                         &
 339                                             "-q";
 340
 341    S_Chop_Ref    : aliased constant S := "/REFERENCE "                     &
 342                                             "-r";
 343
 344    S_Chop_Verb   : aliased constant S := "/VERBOSE "                       &
 345                                             "-v";
 346
 347    Chop_Switches : aliased constant Switches := (
 348      S_Chop_Comp   'Access,
 349      S_Chop_File   'Access,
 350      S_Chop_Help   'Access,
 351      S_Chop_Over   'Access,
 352      S_Chop_Quiet  'Access,
 353      S_Chop_Ref    'Access,
 354      S_Chop_Verb   'Access);
 355
 356    -------------------------------
 357    -- Switches for GNAT COMPILE --
 358    -------------------------------
 359
 360    S_GCC_Ada_83  : aliased constant S := "/83 "                            &
 361                                             "-gnat83";
 362
 363    S_GCC_Ada_95  : aliased constant S := "/95 "                            &
 364                                             "!-gnat83";
 365
 366    S_GCC_Asm     : aliased constant S := "/ASM "                           &
 367                                             "-S,!-c";
 368
 369    S_GCC_Checks  : aliased constant S := "/CHECKS="                        &
 370                                              "FULL "                       &
 371                                                 "-gnato,!-gnatE,!-gnatp "  &
 372                                              "OVERFLOW "                   &
 373                                                 "-gnato "                  &
 374                                              "ELABORATION "                &
 375                                                 "-gnatE "                  &
 376                                              "ASSERTIONS "                 &
 377                                                 "-gnata "                  &
 378                                              "DEFAULT "                    &
 379                                                 "!-gnato,!-gnatp "         &
 380                                              "SUPPRESS_ALL "               &
 381                                                 "-gnatp";
 382
 383    S_GCC_ChecksX : aliased constant S := "/NOCHECKS "                      &
 384                                              "-gnatp,!-gnato,!-gnatE";
 385
 386    S_GCC_Compres : aliased constant S := "/COMPRESS_NAMES "                &
 387                                             "-gnatC";
 388
 389    S_GCC_Current : aliased constant S := "/CURRENT_DIRECTORY "             &
 390                                             "!-I-";
 391
 392    S_GCC_Debug   : aliased constant S := "/DEBUG="                         &
 393                                             "SYMBOLS "                     &
 394                                                "-g2 "                      &
 395                                             "NOSYMBOLS "                   &
 396                                                "!-g2 "                     &
 397                                             "TRACEBACK "                   &
 398                                                "-g1 "                      &
 399                                             "ALL "                         &
 400                                                "-g3 "                      &
 401                                             "NONE "                        &
 402                                                "-g0 "                      &
 403                                             "NOTRACEBACK "                 &
 404                                                "-g0";
 405
 406    S_GCC_DebugX  : aliased constant S := "/NODEBUG "                       &
 407                                             "!-g";
 408
 409    S_GCC_Dist    : aliased constant S := "/DISTRIBUTION_STUBS="            &
 410                                             "RECEIVER "                    &
 411                                                "-gnatzr "                  &
 412                                             "CALLER "                      &
 413                                                "-gnatzc";
 414
 415    S_GCC_DistX   : aliased constant S := "/NODISTRIBUTION_STUBS "          &
 416                                             "!-gnatzr,!-gnatzc";
 417
 418    S_GCC_Error   : aliased constant S := "/ERROR_LIMIT=#"                  &
 419                                             "-gnatm#";
 420
 421    S_GCC_ErrorX  : aliased constant S := "/NOERROR_LIMIT "                 &
 422                                             "-gnatm999";
 423
 424    S_GCC_Expand  : aliased constant S := "/EXPAND_SOURCE "                 &
 425                                             "-gnatG";
 426
 427    S_GCC_Extend  : aliased constant S := "/EXTENSIONS_ALLOWED "            &
 428                                             "-gnatX";
 429
 430    S_GCC_File    : aliased constant S := "/FILE_NAME_MAX_LENGTH=#"         &
 431                                             "-gnatk#";
 432
 433    S_GCC_Force   : aliased constant S := "/FORCE_ALI "                     &
 434                                             "-gnatQ";
 435
 436    S_GCC_Ident   : aliased constant S := "/IDENTIFIER_CHARACTER_SET="      &
 437                                              "DEFAULT "                    &
 438                                                 "-gnati1 "                 &
 439                                              "1 "                          &
 440                                                 "-gnati1 "                 &
 441                                              "2 "                          &
 442                                                 "-gnati2 "                 &
 443                                              "3 "                          &
 444                                                 "-gnati3 "                 &
 445                                              "4 "                          &
 446                                                 "-gnati4 "                 &
 447                                              "PC "                         &
 448                                                 "-gnatip "                 &
 449                                              "PC850 "                      &
 450                                                 "-gnati8 "                 &
 451                                              "FULL_UPPER "                 &
 452                                                 "-gnatif "                 &
 453                                              "NO_UPPER "                   &
 454                                                 "-gnatin "                 &
 455                                              "WIDE "                       &
 456                                                 "-gnatiw";
 457
 458    S_GCC_IdentX  : aliased constant S := "/NOIDENTIFIER_CHARACTER_SET "    &
 459                                              "-gnati1";
 460
 461    S_GCC_Inline  : aliased constant S := "/INLINE="                        &
 462                                             "PRAGMA "                      &
 463                                               "-gnatn "                    &
 464                                             "SUPPRESS "                    &
 465                                             "-fno-inline";
 466
 467    S_GCC_InlineX : aliased constant S := "/NOINLINE "                      &
 468                                             "!-gnatn";
 469
 470    S_GCC_List    : aliased constant S := "/LIST "                          &
 471                                             "-gnatl";
 472
 473    S_GCC_Noload  : aliased constant S := "/NOLOAD "                        &
 474                                             "-gnatc";
 475
 476    S_GCC_Nostinc : aliased constant S := "/NOSTD_INCLUDES "                &
 477                                             "-nostdinc";
 478
 479    S_GCC_Opt     : aliased constant S := "/OPTIMIZE="                      &
 480                                             "ALL "                         &
 481                                                "-O2,!-O0,!-O1,!-O3 "       &
 482                                             "NONE "                        &
 483                                                "-O0,!-O1,!-O2,!-O3 "       &
 484                                             "SOME "                        &
 485                                                "-O1,!-O0,!-O2,!-O3 "       &
 486                                             "DEVELOPMENT "                 &
 487                                                "-O1,!-O0,!-O2,!-O3 "       &
 488                                             "UNROLL_LOOPS "                &
 489                                                "-funroll-loops "           &
 490                                             "INLINING "                    &
 491                                                "-O3,!-O0,!-O1,!-O2";
 492
 493    S_GCC_OptX    : aliased constant S := "/NOOPTIMIZE "                    &
 494                                             "-O0,!-O1,!-O2,!-O3";
 495
 496    S_GCC_Report  : aliased constant S := "/REPORT_ERRORS="                 &
 497                                             "VERBOSE "                     &
 498                                                "-gnatv "                   &
 499                                             "BRIEF "                       &
 500                                                "-gnatb "                   &
 501                                             "FULL "                        &
 502                                                "-gnatf "                   &
 503                                             "IMMEDIATE "                   &
 504                                                "-gnate "                   &
 505                                             "DEFAULT "                     &
 506                                                "!-gnatb,!-gnatv";
 507
 508    S_GCC_ReportX : aliased constant S := "/NOREPORT_ERRORS "               &
 509                                             "!-gnatb,!-gnatv";
 510
 511    S_GCC_Repinfo : aliased constant S := "/REPRESENTATION_INFO="           &
 512                                             "ARRAYS "                      &
 513                                             "-gnatR1 "                     &
 514                                             "NONE "                        &
 515                                             "-gnatR0 "                     &
 516                                             "OBJECTS "                     &
 517                                             "-gnatR2 "                     &
 518                                             "SYMBOLIC "                    &
 519                                             "-gnatR3 "                     &
 520                                             "DEFAULT "                     &
 521                                             "-gnatR";
 522
 523    S_GCC_RepinfX : aliased constant S := "/NOREPRESENTATION_INFO "         &
 524                                             "!-gnatR";
 525
 526    S_GCC_Search  : aliased constant S := "/SEARCH=*"                       &
 527                                             "-I*";
 528
 529    S_GCC_Style   : aliased constant S := "/STYLE_CHECKS="                  &
 530                                             "ALL_BUILTIN "                 &
 531                                                "-gnaty "                   &
 532                                             "1 "                           &
 533                                                "-gnaty1 "                  &
 534                                             "2 "                           &
 535                                                "-gnaty2 "                  &
 536                                             "3 "                           &
 537                                                "-gnaty3 "                  &
 538                                             "4 "                           &
 539                                                "-gnaty4 "                  &
 540                                             "5 "                           &
 541                                                "-gnaty5 "                  &
 542                                             "6 "                           &
 543                                                "-gnaty6 "                  &
 544                                             "7 "                           &
 545                                                "-gnaty7 "                  &
 546                                             "8 "                           &
 547                                                "-gnaty8 "                  &
 548                                             "9 "                           &
 549                                                "-gnaty9 "                  &
 550                                             "ATTRIBUTE "                   &
 551                                                "-gnatya "                  &
 552                                             "BLANKS "                      &
 553                                                "-gnatyb "                  &
 554                                             "COMMENTS "                    &
 555                                                "-gnatyc "                  &
 556                                             "END "                         &
 557                                                "-gnatye "                  &
 558                                             "VTABS "                       &
 559                                                "-gnatyf "                  &
 560                                             "GNAT "                        &
 561                                                "-gnatg "                   &
 562                                             "HTABS "                       &
 563                                                "-gnatyh "                  &
 564                                             "IF_THEN "                     &
 565                                                "-gnatyi "                  &
 566                                             "KEYWORD "                     &
 567                                                "-gnatyk "                  &
 568                                             "LAYOUT "                      &
 569                                                "-gnatyl "                  &
 570                                             "LINE_LENGTH "                 &
 571                                                "-gnatym "                  &
 572                                             "STANDARD_CASING "             &
 573                                                "-gnatyn "                  &
 574                                             "ORDERED_SUBPROGRAMS "         &
 575                                                "-gnatyo "                  &
 576                                             "NONE "                        &
 577                                                "!-gnatg,!-gnatr "          &
 578                                             "PRAGMA "                      &
 579                                                "-gnatyp "                  &
 580                                             "REFERENCES "                  &
 581                                                "-gnatr "                   &
 582                                             "SPECS "                       &
 583                                                "-gnatys "                  &
 584                                             "TOKEN "                       &
 585                                                "-gnatyt ";
 586
 587    S_GCC_StyleX  : aliased constant S := "/NOSTYLE_CHECKS "                &
 588                                             "!-gnatg,!-gnatr";
 589
 590    S_GCC_Syntax  : aliased constant S := "/SYNTAX_ONLY "                   &
 591                                             "-gnats";
 592
 593    S_GCC_Trace   : aliased constant S := "/TRACE_UNITS "                   &
 594                                             "-gnatdc";
 595
 596    S_GCC_Tree    : aliased constant S := "/TREE_OUTPUT "                   &
 597                                             "-gnatt";
 598
 599    S_GCC_Trys    : aliased constant S := "/TRY_SEMANTICS "                 &
 600                                             "-gnatq";
 601
 602    S_GCC_Units   : aliased constant S := "/UNITS_LIST "                    &
 603                                             "-gnatu";
 604
 605    S_GCC_Unique  : aliased constant S := "/UNIQUE_ERROR_TAG "              &
 606                                             "-gnatU";
 607
 608    S_GCC_Upcase  : aliased constant S := "/UPPERCASE_EXTERNALS "           &
 609                                             "-gnatF";
 610
 611    S_GCC_Valid   : aliased constant S := "/VALIDITY_CHECKING="             &
 612                                             "RM "                          &
 613                                             "-gnatVd "                     &
 614                                             "NONE "                        &
 615                                             "-gnatV0 "                     &
 616                                             "FULL "                        &
 617                                             "-gnatVf";
 618
 619    S_GCC_Verbose : aliased constant S := "/VERBOSE "                       &
 620                                             "-v";
 621
 622    S_GCC_Warn    : aliased constant S := "/WARNINGS="                      &
 623                                             "DEFAULT "                     &
 624                                                "!-gnatws,!-gnatwe "        &
 625                                             "ALL_GCC "                     &
 626                                                "-Wall "                    &
 627                                             "CONDITIONALS "                &
 628                                                "-gnatwc "                  &
 629                                             "NOCONDITIONALS "              &
 630                                                "-gnatwC "                  &
 631                                             "ELABORATION "                 &
 632                                                "-gnatwl "                  &
 633                                             "NOELABORATION "               &
 634                                                "-gnatwL "                  &
 635                                             "ERRORS "                      &
 636                                                "-gnatwe "                  &
 637                                             "HIDING "                      &
 638                                                "-gnatwh "                  &
 639                                             "NOHIDING "                    &
 640                                                "-gnatwH "                  &
 641                                             "IMPLEMENTATION "              &
 642                                                "-gnatwi "                  &
 643                                             "NOIMPLEMENTATION "            &
 644                                                "-gnatwI "                  &
 645                                             "OPTIONAL "                    &
 646                                                "-gnatwa "                  &
 647                                             "NOOPTIONAL "                  &
 648                                                "-gnatwA "                  &
 649                                             "OVERLAYS "                    &
 650                                                "-gnatwo "                  &
 651                                             "NOOVERLAYS "                  &
 652                                                "-gnatwO "                  &
 653                                             "REDUNDANT "                   &
 654                                                "-gnatwr "                  &
 655                                             "NOREDUNDANT "                 &
 656                                                "-gnatwR "                  &
 657                                             "SUPPRESS "                    &
 658                                                "-gnatws "                  &
 659                                             "UNINITIALIZED "               &
 660                                                "-Wuninitialized "          &
 661                                             "UNUSED "                      &
 662                                                "-gnatwu "                  &
 663                                             "NOUNUSED "                    &
 664                                                "-gnatwU";
 665
 666    S_GCC_WarnX   : aliased constant S := "/NOWARNINGS "                    &
 667                                             "-gnatws";
 668
 669    S_GCC_Wide    : aliased constant S := "/WIDE_CHARACTER_ENCODING="       &
 670                                              "BRACKETS "                   &
 671                                                 "-gnatWb "                 &
 672                                              "NONE "                       &
 673                                                 "-gnatWn "                 &
 674                                              "HEX "                        &
 675                                                 "-gnatWh "                 &
 676                                              "UPPER "                      &
 677                                                 "-gnatWu "                 &
 678                                              "SHIFT_JIS "                  &
 679                                                 "-gnatWs "                 &
 680                                              "UTF8 "                       &
 681                                                 "-gnatW8 "                 &
 682                                              "EUC "                        &
 683                                                 "-gnatWe";
 684
 685    S_GCC_WideX   : aliased constant S := "/NOWIDE_CHARACTER_ENCODING "     &
 686                                             "-gnatWn";
 687
 688    S_GCC_Xdebug  : aliased constant S := "/XDEBUG "                        &
 689                                             "-gnatD";
 690
 691    S_GCC_Xref    : aliased constant S := "/XREF="                          &
 692                                             "GENERATE "                    &
 693                                               "!-gnatx "                   &
 694                                             "SUPPRESS "                    &
 695                                               "-gnatx";
 696
 697    GCC_Switches : aliased constant Switches := (
 698      S_GCC_Ada_83  'Access,
 699      S_GCC_Ada_95  'Access,
 700      S_GCC_Asm     'Access,
 701      S_GCC_Checks  'Access,
 702      S_GCC_ChecksX 'Access,
 703      S_GCC_Compres 'Access,
 704      S_GCC_Current 'Access,
 705      S_GCC_Debug   'Access,
 706      S_GCC_DebugX  'Access,
 707      S_GCC_Dist    'Access,
 708      S_GCC_DistX   'Access,
 709      S_GCC_Error   'Access,
 710      S_GCC_ErrorX  'Access,
 711      S_GCC_Expand  'Access,
 712      S_GCC_Extend  'Access,
 713      S_GCC_File    'Access,
 714      S_GCC_Force   'Access,
 715      S_GCC_Ident   'Access,
 716      S_GCC_IdentX  'Access,
 717      S_GCC_Inline  'Access,
 718      S_GCC_InlineX 'Access,
 719      S_GCC_List    'Access,
 720      S_GCC_Noload  'Access,
 721      S_GCC_Nostinc 'Access,
 722      S_GCC_Opt     'Access,
 723      S_GCC_OptX    'Access,
 724      S_GCC_Report  'Access,
 725      S_GCC_ReportX 'Access,
 726      S_GCC_Repinfo 'Access,
 727      S_GCC_RepinfX 'Access,
 728      S_GCC_Search  'Access,
 729      S_GCC_Style   'Access,
 730      S_GCC_StyleX  'Access,
 731      S_GCC_Syntax  'Access,
 732      S_GCC_Trace   'Access,
 733      S_GCC_Tree    'Access,
 734      S_GCC_Trys    'Access,
 735      S_GCC_Units   'Access,
 736      S_GCC_Unique  'Access,
 737      S_GCC_Upcase  'Access,
 738      S_GCC_Valid   'Access,
 739      S_GCC_Verbose 'Access,
 740      S_GCC_Warn    'Access,
 741      S_GCC_WarnX   'Access,
 742      S_GCC_Wide    'Access,
 743      S_GCC_WideX   'Access,
 744      S_GCC_Xdebug  'Access,
 745      S_GCC_Xref    'Access);
 746
 747    ----------------------------
 748    -- Switches for GNAT ELIM --
 749    ----------------------------
 750
 751    S_Elim_All    : aliased constant S := "/ALL "                           &
 752                                             "-a";
 753
 754    S_Elim_Miss   : aliased constant S := "/MISSED "                        &
 755                                             "-m";
 756
 757    S_Elim_Verb   : aliased constant S := "/VERBOSE "                       &
 758                                             "-v";
 759
 760    Elim_Switches : aliased constant Switches := (
 761      S_Elim_All    'Access,
 762      S_Elim_Miss   'Access,
 763      S_Elim_Verb   'Access);
 764
 765    ----------------------------
 766    -- Switches for GNAT FIND --
 767    ----------------------------
 768
 769    S_Find_All     : aliased constant S := "/ALL_FILES "                    &
 770                                             "-a";
 771
 772    S_Find_Expr    : aliased constant S := "/EXPRESSIONS "                  &
 773                                             "-e";
 774
 775    S_Find_Full    : aliased constant S := "/FULL_PATHNAME "                &
 776                                             "-f";
 777
 778    S_Find_Ignore  : aliased constant S := "/IGNORE_LOCALS "                &
 779                                             "-g";
 780
 781    S_Find_Object  : aliased constant S := "/OBJECT_SEARCH=*"               &
 782                                             "-aO*";
 783
 784    S_Find_Print   : aliased constant S := "/PRINT_LINES "                  &
 785                                             "-s";
 786
 787    S_Find_Project : aliased constant S := "/PROJECT=@"                     &
 788                                             "-p@";
 789
 790    S_Find_Ref     : aliased constant S := "/REFERENCES "                   &
 791                                             "-r";
 792
 793    S_Find_Search  : aliased constant S := "/SEARCH=*"                      &
 794                                             "-I*";
 795
 796    S_Find_Source  : aliased constant S := "/SOURCE_SEARCH=*"               &
 797                                             "-aI*";
 798
 799    Find_Switches : aliased constant Switches := (
 800       S_Find_All     'Access,
 801       S_Find_Expr    'Access,
 802       S_Find_Full    'Access,
 803       S_Find_Ignore  'Access,
 804       S_Find_Object  'Access,
 805       S_Find_Print   'Access,
 806       S_Find_Project 'Access,
 807       S_Find_Ref     'Access,
 808       S_Find_Search  'Access,
 809       S_Find_Source  'Access);
 810
 811    ------------------------------
 812    -- Switches for GNAT KRUNCH --
 813    ------------------------------
 814
 815    S_Krunch_Count  : aliased constant S := "/COUNT=#"                      &
 816                                             "`#";
 817
 818    Krunch_Switches : aliased constant Switches  := (1 .. 1 =>
 819      S_Krunch_Count  'Access);
 820
 821    -------------------------------
 822    -- Switches for GNAT LIBRARY --
 823    -------------------------------
 824
 825    S_Lbr_Config    : aliased constant S := "/CONFIG=@"                     &
 826                                             "--config=@";
 827
 828    S_Lbr_Create    : aliased constant S := "/CREATE=%"                     &
 829                                                "--create=%";
 830
 831    S_Lbr_Delete    : aliased constant S := "/DELETE=%"                     &
 832                                                "--delete=%";
 833
 834    S_Lbr_Set       : aliased constant S := "/SET=%"                        &
 835                                                "--set=%";
 836
 837    Lbr_Switches : aliased constant Switches  := (
 838      S_Lbr_Config 'Access,
 839      S_Lbr_Create 'Access,
 840      S_Lbr_Delete 'Access,
 841      S_Lbr_Set    'Access);
 842
 843    ----------------------------
 844    -- Switches for GNAT LINK --
 845    ----------------------------
 846
 847    S_Link_Bind    : aliased constant S := "/BIND_FILE="                    &
 848                                             "ADA "                         &
 849                                                "-A "                       &
 850                                             "C "                           &
 851                                                "-C";
 852
 853    S_Link_Debug   : aliased constant S := "/DEBUG="                        &
 854                                             "ALL "                         &
 855                                                "-g3 "                      &
 856                                             "NONE "                        &
 857                                                "-g0 "                      &
 858                                             "TRACEBACK "                   &
 859                                                "-g1 "                      &
 860                                             "NOTRACEBACK "                 &
 861                                                "-g0";
 862
 863    S_Link_Execut  : aliased constant S := "/EXECUTABLE=@"                  &
 864                                             "-o@";
 865
 866    S_Link_Ident   : aliased constant S := "/IDENTIFICATION=" & '"'         &
 867                                             "--for-linker=IDENT="          &
 868                                             '"';
 869
 870    S_Link_Nocomp  : aliased constant S := "/NOCOMPILE "                    &
 871                                             "-n";
 872
 873    S_Link_Nofiles : aliased constant S := "/NOSTART_FILES "                &
 874                                             "-nostartfiles";
 875
 876    S_Link_Noinhib : aliased constant S := "/NOINHIBIT-EXEC "               &
 877                                             "--for-linker=--noinhibit-exec";
 878
 879    S_Link_Static  : aliased constant S := "/STATIC "                       &
 880                                             "--for-linker=-static";
 881
 882    S_Link_Verb    : aliased constant S := "/VERBOSE "                      &
 883                                             "-v";
 884
 885    S_Link_ZZZZZ   : aliased constant S := "/<other> "                      &
 886                                             "--for-linker=";
 887
 888    Link_Switches : aliased constant Switches := (
 889       S_Link_Bind    'Access,
 890       S_Link_Debug   'Access,
 891       S_Link_Execut  'Access,
 892       S_Link_Ident   'Access,
 893       S_Link_Nocomp  'Access,
 894       S_Link_Nofiles 'Access,
 895       S_Link_Noinhib 'Access,
 896       S_Link_Static  'Access,
 897       S_Link_Verb    'Access,
 898       S_Link_ZZZZZ   'Access);
 899
 900    ----------------------------
 901    -- Switches for GNAT LIST --
 902    ----------------------------
 903
 904    S_List_All     : aliased constant S := "/ALL_UNITS "                    &
 905                                             "-a";
 906
 907    S_List_Current : aliased constant S := "/CURRENT_DIRECTORY "            &
 908                                             "!-I-";
 909
 910    S_List_Depend  : aliased constant S := "/DEPENDENCIES "                 &
 911                                             "-d";
 912
 913    S_List_Nostinc : aliased constant S := "/NOSTD_INCLUDES "               &
 914                                             "-nostdinc";
 915
 916    S_List_Object  : aliased constant S := "/OBJECT_SEARCH=*"               &
 917                                             "-aO*";
 918
 919    S_List_Output  : aliased constant S := "/OUTPUT="                       &
 920                                             "SOURCES "                     &
 921                                                "-s "                       &
 922                                             "OBJECTS "                     &
 923                                                "-o "                       &
 924                                             "UNITS "                       &
 925                                                "-u "                       &
 926                                             "OPTIONS "                     &
 927                                                "-h "                       &
 928                                             "VERBOSE "                     &
 929                                                "-v ";
 930
 931    S_List_Search  : aliased constant S := "/SEARCH=*"                      &
 932                                             "-I*";
 933
 934    S_List_Source  : aliased constant S := "/SOURCE_SEARCH=*"               &
 935                                             "-aI*";
 936
 937    List_Switches : aliased constant Switches := (
 938      S_List_All     'Access,
 939      S_List_Current 'Access,
 940      S_List_Depend  'Access,
 941      S_List_Nostinc 'Access,
 942      S_List_Object  'Access,
 943      S_List_Output  'Access,
 944      S_List_Search  'Access,
 945      S_List_Source  'Access);
 946
 947    ----------------------------
 948    -- Switches for GNAT MAKE --
 949    ----------------------------
 950
 951    S_Make_All     : aliased constant S := "/ALL_FILES "                    &
 952                                             "-a";
 953
 954    S_Make_Bind    : aliased constant S := "/BINDER_QUALIFIERS=?"           &
 955                                             "-bargs BIND";
 956
 957    S_Make_Comp    : aliased constant S := "/COMPILER_QUALIFIERS=?"         &
 958                                             "-cargs COMPILE";
 959
 960    S_Make_Cond    : aliased constant S := "/CONDITIONAL_SOURCE_SEARCH=*"   &
 961                                             "-A*";
 962
 963    S_Make_Cont    : aliased constant S := "/CONTINUE_ON_ERROR "            &
 964                                             "-k";
 965
 966    S_Make_Current : aliased constant S := "/CURRENT_DIRECTORY "            &
 967                                             "!-I-";
 968
 969    S_Make_Dep     : aliased constant S := "/DEPENDENCIES_LIST "            &
 970                                             "-M";
 971
 972    S_Make_Doobj   : aliased constant S := "/DO_OBJECT_CHECK "              &
 973                                             "-n";
 974
 975    S_Make_Execut  : aliased constant S := "/EXECUTABLE=@"                  &
 976                                             "-o@";
 977
 978    S_Make_Force   : aliased constant S := "/FORCE_COMPILE "                &
 979                                             "-f";
 980
 981    S_Make_Inplace : aliased constant S := "/IN_PLACE "                     &
 982                                            "-i";
 983
 984    S_Make_Library : aliased constant S := "/LIBRARY_SEARCH=*"              &
 985                                             "-L*";
 986
 987    S_Make_Link    : aliased constant S := "/LINKER_QUALIFIERS=?"           &
 988                                             "-largs LINK";
 989
 990    S_Make_Minimal : aliased constant S := "/MINIMAL_RECOMPILATION "        &
 991                                            "-m";
 992
 993    S_Make_Nolink  : aliased constant S := "/NOLINK "                       &
 994                                             "-c";
 995
 996    S_Make_Nostinc : aliased constant S := "/NOSTD_INCLUDES "               &
 997                                             "-nostdinc";
 998
 999    S_Make_Nostlib : aliased constant S := "/NOSTD_LIBRARIES "              &
1000                                             "-nostdlib";
1001
1002    S_Make_Object  : aliased constant S := "/OBJECT_SEARCH=*"               &
1003                                             "-aO*";
1004
1005    S_Make_Proc    : aliased constant S := "/PROCESSES=#"                   &
1006                                             "-j#";
1007
1008    S_Make_Nojobs  : aliased constant S := "/NOPROCESSES "                  &
1009                                             "-j1";
1010
1011    S_Make_Quiet   : aliased constant S := "/QUIET "                        &
1012                                             "-q";
1013
1014    S_Make_Reason  : aliased constant S := "/REASONS "                      &
1015                                             "-v";
1016
1017    S_Make_Search  : aliased constant S := "/SEARCH=*"                      &
1018                                             "-I*";
1019
1020    S_Make_Skip    : aliased constant S := "/SKIP_MISSING=*"                &
1021                                             "-aL*";
1022
1023    S_Make_Source  : aliased constant S := "/SOURCE_SEARCH=*"               &
1024                                             "-aI*";
1025
1026    S_Make_Verbose : aliased constant S := "/VERBOSE "                      &
1027                                             "-v";
1028
1029    Make_Switches : aliased constant Switches := (
1030      S_Make_All     'Access,
1031      S_Make_Bind    'Access,
1032      S_Make_Comp    'Access,
1033      S_Make_Cond    'Access,
1034      S_Make_Cont    'Access,
1035      S_Make_Current 'Access,
1036      S_Make_Dep     'Access,
1037      S_Make_Doobj   'Access,
1038      S_Make_Execut  'Access,
1039      S_Make_Force   'Access,
1040      S_Make_Inplace 'Access,
1041      S_Make_Library 'Access,
1042      S_Make_Link    'Access,
1043      S_Make_Minimal 'Access,
1044      S_Make_Nolink  'Access,
1045      S_Make_Nostinc 'Access,
1046      S_Make_Nostlib 'Access,
1047      S_Make_Object  'Access,
1048      S_Make_Proc    'Access,
1049      S_Make_Nojobs  'Access,
1050      S_Make_Quiet   'Access,
1051      S_Make_Reason  'Access,
1052      S_Make_Search  'Access,
1053      S_Make_Skip    'Access,
1054      S_Make_Source  'Access,
1055      S_Make_Verbose 'Access);
1056
1057    ----------------------------------
1058    -- Switches for GNAT PREPROCESS --
1059    ----------------------------------
1060
1061    S_Prep_Blank   : aliased constant S := "/BLANK_LINES "                   &
1062                                             "-b";
1063
1064    S_Prep_Com     : aliased constant S := "/COMMENTS "                      &
1065                                             "-c";
1066
1067    S_Prep_Ref     : aliased constant S := "/REFERENCE "                     &
1068                                             "-r";
1069
1070    S_Prep_Remove  : aliased constant S := "/REMOVE "                        &
1071                                             "!-b,!-c";
1072
1073    S_Prep_Symbols : aliased constant S := "/SYMBOLS "                       &
1074                                             "-s";
1075
1076    S_Prep_Undef   : aliased constant S := "/UNDEFINED "                     &
1077                                             "-u";
1078
1079    S_Prep_Verbose : aliased constant S := "/VERBOSE "                       &
1080                                             "-v";
1081
1082    S_Prep_Version : aliased constant S := "/VERSION "                       &
1083                                             "-v";
1084
1085    Prep_Switches : aliased constant Switches := (
1086      S_Prep_Blank   'Access,
1087      S_Prep_Com     'Access,
1088      S_Prep_Ref     'Access,
1089      S_Prep_Remove  'Access,
1090      S_Prep_Symbols 'Access,
1091      S_Prep_Undef   'Access,
1092      S_Prep_Verbose 'Access,
1093      S_Prep_Version 'Access);
1094
1095    ------------------------------
1096    -- Switches for GNAT SHARED --
1097    ------------------------------
1098
1099    S_Shared_Debug   : aliased constant S := "/DEBUG="                      &
1100                                             "ALL "                         &
1101                                                "-g3 "                      &
1102                                             "NONE "                        &
1103                                                "-g0 "                      &
1104                                             "TRACEBACK "                   &
1105                                                "-g1 "                      &
1106                                             "NOTRACEBACK "                 &
1107                                                "-g0";
1108
1109    S_Shared_Image  : aliased constant S := "/IMAGE=@"                      &
1110                                             "-o@";
1111
1112    S_Shared_Ident   : aliased constant S := "/IDENTIFICATION=" & '"'       &
1113                                             "--for-linker=IDENT="          &
1114                                             '"';
1115
1116    S_Shared_Nofiles : aliased constant S := "/NOSTART_FILES "              &
1117                                             "-nostartfiles";
1118
1119    S_Shared_Noinhib : aliased constant S := "/NOINHIBIT-IMAGE "            &
1120                                             "--for-linker=--noinhibit-exec";
1121
1122    S_Shared_Verb    : aliased constant S := "/VERBOSE "                    &
1123                                             "-v";
1124
1125    S_Shared_ZZZZZ   : aliased constant S := "/<other> "                    &
1126                                             "--for-linker=";
1127
1128    Shared_Switches : aliased constant Switches := (
1129       S_Shared_Debug   'Access,
1130       S_Shared_Image   'Access,
1131       S_Shared_Ident   'Access,
1132       S_Shared_Nofiles 'Access,
1133       S_Shared_Noinhib 'Access,
1134       S_Shared_Verb    'Access,
1135       S_Shared_ZZZZZ   'Access);
1136
1137    --------------------------------
1138    -- Switches for GNAT STANDARD --
1139    --------------------------------
1140
1141    Standard_Switches : aliased constant Switches := (1 .. 0 => null);
1142
1143    ----------------------------
1144    -- Switches for GNAT STUB --
1145    ----------------------------
1146
1147    S_Stub_Current : aliased constant S := "/CURRENT_DIRECTORY "            &
1148                                             "!-I-";
1149
1150    S_Stub_Full    : aliased constant S := "/FULL "                         &
1151                                             "-f";
1152
1153    S_Stub_Header  : aliased constant S := "/HEADER="                       &
1154                                             "GENERAL "                     &
1155                                                "-hg "                      &
1156                                             "SPEC "                        &
1157                                                "-hs";
1158
1159    S_Stub_Indent  : aliased constant S := "/INDENTATION=#"                 &
1160                                             "-i#";
1161
1162    S_Stub_Length  : aliased constant S := "/LINE_LENGTH=#"                 &
1163                                             "-l#";
1164
1165    S_Stub_Quiet   : aliased constant S := "/QUIET "                        &
1166                                             "-q";
1167
1168    S_Stub_Search  : aliased constant S := "/SEARCH=*"                      &
1169                                             "-I*";
1170
1171    S_Stub_Tree    : aliased constant S := "/TREE_FILE="                    &
1172                                             "OVERWRITE "                   &
1173                                                "-t "                       &
1174                                             "SAVE "                        &
1175                                                "-k "                       &
1176                                             "REUSE "                       &
1177                                                "-r";
1178
1179    S_Stub_Verbose : aliased constant S := "/VERBOSE "                      &
1180                                             "-v";
1181
1182    Stub_Switches : aliased constant Switches := (
1183      S_Stub_Current 'Access,
1184      S_Stub_Full    'Access,
1185      S_Stub_Header  'Access,
1186      S_Stub_Indent  'Access,
1187      S_Stub_Length  'Access,
1188      S_Stub_Quiet   'Access,
1189      S_Stub_Search  'Access,
1190      S_Stub_Tree    'Access,
1191      S_Stub_Verbose 'Access);
1192
1193    ------------------------------
1194    -- Switches for GNAT SYSTEM --
1195    ------------------------------
1196
1197    System_Switches : aliased constant Switches  := (1 .. 0 => null);
1198
1199    ----------------------------
1200    -- Switches for GNAT XREF --
1201    ----------------------------
1202
1203    S_Xref_All     : aliased constant S := "/ALL_FILES "                    &
1204                                             "-a";
1205
1206    S_Xref_Full    : aliased constant S := "/FULL_PATHNAME "                &
1207                                             "-f";
1208
1209    S_Xref_Global  : aliased constant S := "/IGNORE_LOCALS "                &
1210                                             "-g";
1211
1212    S_Xref_Object  : aliased constant S := "/OBJECT_SEARCH=*"               &
1213                                             "-aO*";
1214
1215    S_Xref_Project : aliased constant S := "/PROJECT=@"                     &
1216                                             "-p@";
1217
1218    S_Xref_Search  : aliased constant S := "/SEARCH=*"                      &
1219                                             "-I*";
1220
1221    S_Xref_Source  : aliased constant S := "/SOURCE_SEARCH=*"               &
1222                                             "-aI*";
1223
1224    S_Xref_Output  : aliased constant S := "/UNUSED "                       &
1225                                             "-u";
1226
1227    Xref_Switches : aliased constant Switches := (
1228       S_Xref_All     'Access,
1229       S_Xref_Full    'Access,
1230       S_Xref_Global  'Access,
1231       S_Xref_Object  'Access,
1232       S_Xref_Project 'Access,
1233       S_Xref_Search  'Access,
1234       S_Xref_Source  'Access,
1235       S_Xref_Output  'Access);
1236
1237    -------------------
1238    -- COMMAND TABLE --
1239    -------------------
1240
1241    --  The command table contains an entry for each command recognized by
1242    --  GNATCmd. The entries are represented by an array of records.
1243
1244    type Parameter_Type is
1245    --  A parameter is defined as a whitespace bounded string, not begining
1246    --   with a slash. (But see note under FILES_OR_WILDCARD).
1247      (File,
1248       --  A required file or directory parameter.
1249
1250       Optional_File,
1251       --  An optional file or directory parameter.
1252
1253       Other_As_Is,
1254       --  A parameter that's passed through as is (not canonicalized)
1255
1256       Unlimited_Files,
1257       --  An unlimited number of writespace separate file or directory
1258       --  parameters including wildcard specifications.
1259
1260       Files_Or_Wildcard);
1261       --  A comma separated list of files and/or wildcard file specifications.
1262       --  A comma preceded by or followed by whitespace is considered as a
1263       --  single comma character w/o whitespace.
1264
1265    type Parameter_Array is array (Natural range <>) of Parameter_Type;
1266    type Parameter_Ref is access all Parameter_Array;
1267
1268    type Command_Entry is record
1269       Cname : String_Ptr;
1270       --  Command name for GNAT xxx command
1271
1272       Usage : String_Ptr;
1273       --  A usage string, used for error messages
1274
1275       Unixcmd  : String_Ptr;
1276       --  Corresponding Unix command
1277
1278       Switches : Switches_Ptr;
1279       --  Pointer to array of switch strings
1280
1281       Params : Parameter_Ref;
1282       --  Describes the allowable types of parameters.
1283       --  Params (1) is the type of the first parameter, etc.
1284       --  An empty parameter array means this command takes no parameters.
1285
1286       Defext : String (1 .. 3);
1287       --  Default extension. If non-blank, then this extension is supplied by
1288       --  default as the extension for any file parameter which does not have
1289       --  an extension already.
1290    end record;
1291
1292    -------------------------
1293    -- INTERNAL STRUCTURES --
1294    -------------------------
1295
1296    --  The switches and commands are defined by strings in the previous
1297    --  section so that they are easy to modify, but internally, they are
1298    --  kept in a more conveniently accessible form described in this
1299    --  section.
1300
1301    --  Commands, command qualifers and options have a similar common format
1302    --  so that searching for matching names can be done in a common manner.
1303
1304    type Item_Id is (Id_Command, Id_Switch, Id_Option);
1305
1306    type Translation_Type is
1307      (
1308       T_Direct,
1309       --  A qualifier with no options.
1310       --  Example: GNAT MAKE /VERBOSE
1311
1312       T_Directories,
1313       --  A qualifier followed by a list of directories
1314       --  Example: GNAT COMPILE /SEARCH=([], [.FOO], [.BAR])
1315
1316       T_Directory,
1317       --  A qualifier followed by one directory
1318       --  Example: GNAT LIBRARY /SET=[.VAXFLOATLIB]
1319
1320       T_File,
1321       --  A quailifier followed by a filename
1322       --  Example: GNAT LINK /EXECUTABLE=FOO.EXE
1323
1324       T_Numeric,
1325       --  A qualifier followed by a numeric value.
1326       --  Example: GNAT CHOP /FILE_NAME_MAX_LENGTH=39
1327
1328       T_String,
1329       --  A qualifier followed by a quoted string. Only used by
1330       --  /IDENTIFICATION qualfier.
1331       --  Example: GNAT LINK /IDENTIFICATION="3.14a1 version"
1332
1333       T_Options,
1334       --  A qualifier followed by a list of options.
1335       --  Example: GNAT COMPILE /REPRESENTATION_INFO=(ARRAYS,OBJECTS)
1336
1337       T_Commands,
1338       --  A qualifier followed by a list. Only used for
1339       --  MAKE /COMPILER_QUALIFIERS /BINDER_QUALIFIERS /LINKER_QUALIFIERS
1340       --  (gnatmake -cargs -bargs -largs )
1341       --  Example: GNAT MAKE ... /LINKER_QUALIFIERS /VERBOSE FOOBAR.OBJ
1342
1343       T_Other,
1344       --  A qualifier passed directly to the linker. Only used
1345       --  for LINK and SHARED if no other match is found.
1346       --  Example: GNAT LINK FOO.ALI /SYSSHR
1347
1348       T_Alphanumplus
1349       --  A qualifier followed by a legal linker symbol prefix. Only used
1350       --  for BIND /BUILD_LIBRARY (gnatbind -Lxyz).
1351       --  Example: GNAT BIND /BUILD_LIBRARY=foobar
1352      );
1353
1354    type Item (Id : Item_Id);
1355    type Item_Ptr is access all Item;
1356
1357    type Item (Id : Item_Id) is record
1358       Name : String_Ptr;
1359       --  Name of the command, switch (with slash) or option
1360
1361       Next : Item_Ptr;
1362       --  Pointer to next item on list, always has the same Id value
1363
1364       Unix_String : String_Ptr;
1365       --  Corresponding Unix string. For a command, this is the unix command
1366       --  name and possible default switches. For a switch or option it is
1367       --  the unix switch string.
1368
1369       case Id is
1370
1371          when Id_Command =>
1372
1373             Switches : Item_Ptr;
1374             --  Pointer to list of switch items for the command, linked
1375             --  through the Next fields with null terminating the list.
1376
1377             Usage : String_Ptr;
1378             --  Usage information, used only for errors and the default
1379             --  list of commands output.
1380
1381             Params : Parameter_Ref;
1382             --  Array of parameters
1383
1384             Defext : String (1 .. 3);
1385             --  Default extension. If non-blank, then this extension is
1386             --  supplied by default as the extension for any file parameter
1387             --  which does not have an extension already.
1388
1389          when Id_Switch =>
1390
1391             Translation : Translation_Type;
1392             --  Type of switch translation. For all cases, except Options,
1393             --  this is the only field needed, since the Unix translation
1394             --  is found in Unix_String.
1395
1396             Options : Item_Ptr;
1397             --  For the Options case, this field is set to point to a list
1398             --  of options item (for this case Unix_String is null in the
1399             --  main switch item). The end of the list is marked by null.
1400
1401          when Id_Option =>
1402
1403             null;
1404             --  No special fields needed, since Name and Unix_String are
1405             --  sufficient to completely described an option.
1406
1407       end case;
1408    end record;
1409
1410    subtype Command_Item is Item (Id_Command);
1411    subtype Switch_Item  is Item (Id_Switch);
1412    subtype Option_Item  is Item (Id_Option);
1413
1414    ----------------------------------
1415    -- Declarations for GNATCMD use --
1416    ----------------------------------
1417
1418    Commands : Item_Ptr;
1419    --  Pointer to head of list of command items, one for each command, with
1420    --  the end of the list marked by a null pointer.
1421
1422    Last_Command : Item_Ptr;
1423    --  Pointer to last item in Commands list
1424
1425    Normal_Exit : exception;
1426    --  Raise this exception for normal program termination
1427
1428    Error_Exit : exception;
1429    --  Raise this exception if error detected
1430
1431    Errors : Natural := 0;
1432    --  Count errors detected
1433
1434    Command : Item_Ptr;
1435    --  Pointer to command item for current command
1436
1437    Make_Commands_Active : Item_Ptr := null;
1438    --  Set to point to Command entry for COMPILE, BIND, or LINK as appropriate
1439    --  if a COMMANDS_TRANSLATION switch has been encountered while processing
1440    --  a MAKE Command.
1441
1442    My_Exit_Status : Exit_Status := Success;
1443
1444    package Buffer is new Table.Table (
1445      Table_Component_Type => Character,
1446      Table_Index_Type     => Integer,
1447      Table_Low_Bound      => 1,
1448      Table_Initial        => 4096,
1449      Table_Increment      => 2,
1450      Table_Name           => "Buffer");
1451
1452    Param_Count : Natural := 0;
1453    --  Number of parameter arguments so far
1454
1455    Arg_Num : Natural;
1456    --  Argument number
1457
1458    Display_Command : Boolean := False;
1459    --  Set true if /? switch causes display of generated command
1460
1461    -----------------------
1462    -- Local Subprograms --
1463    -----------------------
1464
1465    function Init_Object_Dirs return String_Ptr;
1466
1467    function Invert_Sense (S : String) return String_Ptr;
1468    --  Given a unix switch string S, computes the inverse (adding or
1469    --  removing ! characters as required), and returns a pointer to
1470    --  the allocated result on the heap.
1471
1472    function Is_Extensionless (F : String) return Boolean;
1473    --  Returns true if the filename has no extension.
1474
1475    function Match (S1, S2 : String) return Boolean;
1476    --  Determines whether S1 and S2 match. This is a case insensitive match.
1477
1478    function Match_Prefix (S1, S2 : String) return Boolean;
1479    --  Determines whether S1 matches a prefix of S2. This is also a case
1480    --  insensitive match (for example Match ("AB","abc") is True).
1481
1482    function Matching_Name
1483      (S     : String;
1484       Itm   : Item_Ptr;
1485       Quiet : Boolean := False)
1486       return  Item_Ptr;
1487    --  Determines if the item list headed by Itm and threaded through the
1488    --  Next fields (with null marking the end of the list), contains an
1489    --  entry that uniquely matches the given string. The match is case
1490    --  insensitive and permits unique abbreviation. If the match succeeds,
1491    --  then a pointer to the matching item is returned. Otherwise, an
1492    --  appropriate error message is written. Note that the discriminant
1493    --  of Itm is used to determine the appropriate form of this message.
1494    --  Quiet is normally False as shown, if it is set to True, then no
1495    --  error message is generated in a not found situation (null is still
1496    --  returned to indicate the not-found situation).
1497
1498    function OK_Alphanumerplus (S : String) return Boolean;
1499    --  Checks that S is a string of alphanumeric characters,
1500    --  returning True if all alphanumeric characters,
1501    --  False if empty or a non-alphanumeric character is present.
1502
1503    function OK_Integer (S : String) return Boolean;
1504    --  Checks that S is a string of digits, returning True if all digits,
1505    --  False if empty or a non-digit is present.
1506
1507    procedure Place (C : Character);
1508    --  Place a single character in the buffer, updating Ptr
1509
1510    procedure Place (S : String);
1511    --  Place a string character in the buffer, updating Ptr
1512
1513    procedure Place_Lower (S : String);
1514    --  Place string in buffer, forcing letters to lower case, updating Ptr
1515
1516    procedure Place_Unix_Switches (S : String_Ptr);
1517    --  Given a unix switch string, place corresponding switches in Buffer,
1518    --  updating Ptr appropriatelly. Note that in the case of use of ! the
1519    --  result may be to remove a previously placed switch.
1520
1521    procedure Validate_Command_Or_Option (N : String_Ptr);
1522    --  Check that N is a valid command or option name, i.e. that it is of the
1523    --  form of an Ada identifier with upper case letters and underscores.
1524
1525    procedure Validate_Unix_Switch (S : String_Ptr);
1526    --  Check that S is a valid switch string as described in the syntax for
1527    --  the switch table item UNIX_SWITCH or else begins with a backquote.
1528
1529    ----------------------
1530    -- Init_Object_Dirs --
1531    ----------------------
1532
1533    function Init_Object_Dirs return String_Ptr is
1534       Object_Dirs     : Integer;
1535       Object_Dir      : array (Integer range 1 .. 256) of String_Access;
1536       Object_Dir_Name : String_Access;
1537
1538    begin
1539       Object_Dirs := 0;
1540       Object_Dir_Name := String_Access (Object_Dir_Default_Name);
1541       Get_Next_Dir_In_Path_Init (Object_Dir_Name);
1542
1543       loop
1544          declare
1545             Dir : String_Access := String_Access
1546               (Get_Next_Dir_In_Path (Object_Dir_Name));
1547          begin
1548             exit when Dir = null;
1549             Object_Dirs := Object_Dirs + 1;
1550             Object_Dir (Object_Dirs)
1551               := String_Access (Normalize_Directory_Name (Dir.all));
1552          end;
1553       end loop;
1554
1555       for Dirs in 1 .. Object_Dirs loop
1556          Buffer.Increment_Last;
1557          Buffer.Table (Buffer.Last) := '-';
1558          Buffer.Increment_Last;
1559          Buffer.Table (Buffer.Last) := 'L';
1560          Object_Dir_Name := new String'(
1561            To_Canonical_Dir_Spec
1562              (To_Host_Dir_Spec (Object_Dir (Dirs).all, True).all, True).all);
1563
1564          for J in Object_Dir_Name'Range loop
1565             Buffer.Increment_Last;
1566             Buffer.Table (Buffer.Last) := Object_Dir_Name (J);
1567          end loop;
1568
1569          Buffer.Increment_Last;
1570          Buffer.Table (Buffer.Last) := ' ';
1571       end loop;
1572
1573       Buffer.Increment_Last;
1574       Buffer.Table (Buffer.Last) := '-';
1575       Buffer.Increment_Last;
1576       Buffer.Table (Buffer.Last) := 'l';
1577       Buffer.Increment_Last;
1578       Buffer.Table (Buffer.Last) := 'g';
1579       Buffer.Increment_Last;
1580       Buffer.Table (Buffer.Last) := 'n';
1581       Buffer.Increment_Last;
1582       Buffer.Table (Buffer.Last) := 'a';
1583       Buffer.Increment_Last;
1584       Buffer.Table (Buffer.Last) := 't';
1585
1586       if Hostparm.OpenVMS then
1587          Buffer.Increment_Last;
1588          Buffer.Table (Buffer.Last) := ' ';
1589          Buffer.Increment_Last;
1590          Buffer.Table (Buffer.Last) := '-';
1591          Buffer.Increment_Last;
1592          Buffer.Table (Buffer.Last) := 'l';
1593          Buffer.Increment_Last;
1594          Buffer.Table (Buffer.Last) := 'd';
1595          Buffer.Increment_Last;
1596          Buffer.Table (Buffer.Last) := 'e';
1597          Buffer.Increment_Last;
1598          Buffer.Table (Buffer.Last) := 'c';
1599          Buffer.Increment_Last;
1600          Buffer.Table (Buffer.Last) := 'g';
1601          Buffer.Increment_Last;
1602          Buffer.Table (Buffer.Last) := 'n';
1603          Buffer.Increment_Last;
1604          Buffer.Table (Buffer.Last) := 'a';
1605          Buffer.Increment_Last;
1606          Buffer.Table (Buffer.Last) := 't';
1607       end if;
1608
1609       return new String'(String (Buffer.Table (1 .. Buffer.Last)));
1610    end Init_Object_Dirs;
1611
1612    ------------------
1613    -- Invert_Sense --
1614    ------------------
1615
1616    function Invert_Sense (S : String) return String_Ptr is
1617       Sinv : String (1 .. S'Length * 2);
1618       --  Result (for sure long enough)
1619
1620       Sinvp : Natural := 0;
1621       --  Pointer to output string
1622
1623    begin
1624       for Sp in S'Range loop
1625          if Sp = S'First or else S (Sp - 1) = ',' then
1626             if S (Sp) = '!' then
1627                null;
1628             else
1629                Sinv (Sinvp + 1) := '!';
1630                Sinv (Sinvp + 2) := S (Sp);
1631                Sinvp := Sinvp + 2;
1632             end if;
1633
1634          else
1635             Sinv (Sinvp + 1) := S (Sp);
1636             Sinvp := Sinvp + 1;
1637          end if;
1638       end loop;
1639
1640       return new String'(Sinv (1 .. Sinvp));
1641    end Invert_Sense;
1642
1643    ----------------------
1644    -- Is_Extensionless --
1645    ----------------------
1646
1647    function Is_Extensionless (F : String) return Boolean is
1648    begin
1649       for J in reverse F'Range loop
1650          if F (J) = '.' then
1651             return False;
1652          elsif F (J) = '/' or else F (J) = ']' or else F (J) = ':' then
1653             return True;
1654          end if;
1655       end loop;
1656
1657       return True;
1658    end Is_Extensionless;
1659
1660    -----------
1661    -- Match --
1662    -----------
1663
1664    function Match (S1, S2 : String) return Boolean is
1665       Dif : constant Integer := S2'First - S1'First;
1666
1667    begin
1668
1669       if S1'Length /= S2'Length then
1670          return False;
1671
1672       else
1673          for J in S1'Range loop
1674             if To_Lower (S1 (J)) /= To_Lower (S2 (J + Dif)) then
1675                return False;
1676             end if;
1677          end loop;
1678
1679          return True;
1680       end if;
1681    end Match;
1682
1683    ------------------
1684    -- Match_Prefix --
1685    ------------------
1686
1687    function Match_Prefix (S1, S2 : String) return Boolean is
1688    begin
1689       if S1'Length > S2'Length then
1690          return False;
1691       else
1692          return Match (S1, S2 (S2'First .. S2'First + S1'Length - 1));
1693       end if;
1694    end Match_Prefix;
1695
1696    -------------------
1697    -- Matching_Name --
1698    -------------------
1699
1700    function Matching_Name
1701      (S     : String;
1702       Itm   : Item_Ptr;
1703       Quiet : Boolean := False)
1704       return  Item_Ptr
1705    is
1706       P1, P2 : Item_Ptr;
1707
1708       procedure Err;
1709       --  Little procedure to output command/qualifier/option as appropriate
1710       --  and bump error count.
1711
1712       procedure Err is
1713       begin
1714          if Quiet then
1715             return;
1716          end if;
1717
1718          Errors := Errors + 1;
1719
1720          if Itm /= null then
1721             case Itm.Id is
1722                when Id_Command =>
1723                   Put (Standard_Error, "command");
1724
1725                when Id_Switch =>
1726                   if OpenVMS then
1727                      Put (Standard_Error, "qualifier");
1728                   else
1729                      Put (Standard_Error, "switch");
1730                   end if;
1731
1732                when Id_Option =>
1733                   Put (Standard_Error, "option");
1734
1735             end case;
1736          else
1737             Put (Standard_Error, "input");
1738
1739          end if;
1740
1741          Put (Standard_Error, ": ");
1742          Put (Standard_Error, S);
1743
1744       end Err;
1745
1746    --  Start of processing for Matching_Name
1747
1748    begin
1749       --  If exact match, that's the one we want
1750
1751       P1 := Itm;
1752       while P1 /= null loop
1753          if Match (S, P1.Name.all) then
1754             return P1;
1755          else
1756             P1 := P1.Next;
1757          end if;
1758       end loop;
1759
1760       --  Now check for prefix matches
1761
1762       P1 := Itm;
1763       while P1 /= null loop
1764          if P1.Name.all = "/<other>" then
1765             return P1;
1766
1767          elsif not Match_Prefix (S, P1.Name.all) then
1768             P1 := P1.Next;
1769
1770          else
1771             --  Here we have found one matching prefix, so see if there is
1772             --  another one (which is an ambiguity)
1773
1774             P2 := P1.Next;
1775             while P2 /= null loop
1776                if Match_Prefix (S, P2.Name.all) then
1777                   if not Quiet then
1778                      Put (Standard_Error, "ambiguous ");
1779                      Err;
1780                      Put (Standard_Error, " (matches ");
1781                      Put (Standard_Error, P1.Name.all);
1782
1783                      while P2 /= null loop
1784                         if Match_Prefix (S, P2.Name.all) then
1785                            Put (Standard_Error, ',');
1786                            Put (Standard_Error, P2.Name.all);
1787                         end if;
1788
1789                         P2 := P2.Next;
1790                      end loop;
1791
1792                      Put_Line (Standard_Error, ")");
1793                   end if;
1794
1795                   return null;
1796                end if;
1797
1798                P2 := P2.Next;
1799             end loop;
1800
1801             --  If we fall through that loop, then there was only one match
1802
1803             return P1;
1804          end if;
1805       end loop;
1806
1807       --  If we fall through outer loop, there was no match
1808
1809       if not Quiet then
1810          Put (Standard_Error, "unrecognized ");
1811          Err;
1812          New_Line (Standard_Error);
1813       end if;
1814
1815       return null;
1816    end Matching_Name;
1817
1818    -----------------------
1819    -- OK_Alphanumerplus --
1820    -----------------------
1821
1822    function OK_Alphanumerplus (S : String) return Boolean is
1823    begin
1824       if S'Length = 0 then
1825          return False;
1826
1827       else
1828          for J in S'Range loop
1829             if not (Is_Alphanumeric (S (J)) or else
1830                     S (J) = '_' or else S (J) = '$')
1831             then
1832                return False;
1833             end if;
1834          end loop;
1835
1836          return True;
1837       end if;
1838    end OK_Alphanumerplus;
1839
1840    ----------------
1841    -- OK_Integer --
1842    ----------------
1843
1844    function OK_Integer (S : String) return Boolean is
1845    begin
1846       if S'Length = 0 then
1847          return False;
1848
1849       else
1850          for J in S'Range loop
1851             if not Is_Digit (S (J)) then
1852                return False;
1853             end if;
1854          end loop;
1855
1856          return True;
1857       end if;
1858    end OK_Integer;
1859
1860    -----------
1861    -- Place --
1862    -----------
1863
1864    procedure Place (C : Character) is
1865    begin
1866       Buffer.Increment_Last;
1867       Buffer.Table (Buffer.Last) := C;
1868    end Place;
1869
1870    procedure Place (S : String) is
1871    begin
1872       for J in S'Range loop
1873          Place (S (J));
1874       end loop;
1875    end Place;
1876
1877    -----------------
1878    -- Place_Lower --
1879    -----------------
1880
1881    procedure Place_Lower (S : String) is
1882    begin
1883       for J in S'Range loop
1884          Place (To_Lower (S (J)));
1885       end loop;
1886    end Place_Lower;
1887
1888    -------------------------
1889    -- Place_Unix_Switches --
1890    -------------------------
1891
1892    procedure Place_Unix_Switches (S : String_Ptr) is
1893       P1, P2, P3 : Natural;
1894       Remove     : Boolean;
1895       Slen       : Natural;
1896
1897    begin
1898       P1 := S'First;
1899       while P1 <= S'Last loop
1900          if S (P1) = '!' then
1901             P1 := P1 + 1;
1902             Remove := True;
1903          else
1904             Remove := False;
1905          end if;
1906
1907          P2 := P1;
1908          pragma Assert (S (P1) = '-' or else S (P1) = '`');
1909
1910          while P2 < S'Last and then S (P2 + 1) /= ',' loop
1911             P2 := P2 + 1;
1912          end loop;
1913
1914          --  Switch is now in S (P1 .. P2)
1915
1916          Slen := P2 - P1 + 1;
1917
1918          if Remove then
1919             P3 := 2;
1920             while P3 <= Buffer.Last - Slen loop
1921                if Buffer.Table (P3) = ' '
1922                  and then String (Buffer.Table (P3 + 1 .. P3 + Slen))
1923                           = S (P1 .. P2)
1924                  and then (P3 + Slen = Buffer.Last
1925                              or else
1926                            Buffer.Table (P3 + Slen + 1) = ' ')
1927                then
1928                   Buffer.Table (P3 .. Buffer.Last - Slen - 1) :=
1929                     Buffer.Table (P3 + Slen + 1 .. Buffer.Last);
1930                   Buffer.Set_Last (Buffer.Last - Slen - 1);
1931
1932                else
1933                   P3 := P3 + 1;
1934                end if;
1935             end loop;
1936
1937          else
1938             Place (' ');
1939
1940             if S (P1) = '`' then
1941                P1 := P1 + 1;
1942             end if;
1943
1944             Place (S (P1 .. P2));
1945          end if;
1946
1947          P1 := P2 + 2;
1948       end loop;
1949    end Place_Unix_Switches;
1950
1951    --------------------------------
1952    -- Validate_Command_Or_Option --
1953    --------------------------------
1954
1955    procedure Validate_Command_Or_Option (N : String_Ptr) is
1956    begin
1957       pragma Assert (N'Length > 0);
1958
1959       for J in N'Range loop
1960          if N (J) = '_' then
1961             pragma Assert (N (J - 1) /= '_');
1962             null;
1963          else
1964             pragma Assert (Is_Upper (N (J)) or else Is_Digit (N (J)));
1965             null;
1966          end if;
1967       end loop;
1968    end Validate_Command_Or_Option;
1969
1970    --------------------------
1971    -- Validate_Unix_Switch --
1972    --------------------------
1973
1974    procedure Validate_Unix_Switch (S : String_Ptr) is
1975    begin
1976       if S (S'First) = '`' then
1977          return;
1978       end if;
1979
1980       pragma Assert (S (S'First) = '-' or else S (S'First) = '!');
1981
1982       for J in S'First + 1 .. S'Last loop
1983          pragma Assert (S (J) /= ' ');
1984
1985          if S (J) = '!' then
1986             pragma Assert (S (J - 1) = ',' and then S (J + 1) = '-');
1987             null;
1988          end if;
1989       end loop;
1990    end Validate_Unix_Switch;
1991
1992    ----------------------
1993    -- List of Commands --
1994    ----------------------
1995
1996    --  Note that we put this after all the local bodies to avoid
1997    --  some access before elaboration problems.
1998
1999    Command_List : array (Natural range <>) of Command_Entry := (
2000
2001       (Cname    => new S'("BIND"),
2002        Usage    => new S'("GNAT BIND file[.ali] /qualifiers"),
2003        Unixcmd  => new S'("gnatbind"),
2004        Switches => Bind_Switches'Access,
2005        Params   => new Parameter_Array'(1 => File),
2006        Defext   => "ali"),
2007
2008       (Cname    => new S'("CHOP"),
2009        Usage    => new S'("GNAT CHOP file [directory] /qualifiers"),
2010        Unixcmd  => new S'("gnatchop"),
2011        Switches => Chop_Switches'Access,
2012        Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
2013        Defext   => "   "),
2014
2015       (Cname    => new S'("COMPILE"),
2016        Usage    => new S'("GNAT COMPILE filespec[,...] /qualifiers"),
2017        Unixcmd  => new S'("gcc -c -x ada"),
2018        Switches => GCC_Switches'Access,
2019        Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
2020        Defext   => "   "),
2021
2022       (Cname    => new S'("ELIM"),
2023        Usage    => new S'("GNAT ELIM name /qualifiers"),
2024        Unixcmd  => new S'("gnatelim"),
2025        Switches => Elim_Switches'Access,
2026        Params   => new Parameter_Array'(1 => Other_As_Is),
2027        Defext   => "ali"),
2028
2029       (Cname    => new S'("FIND"),
2030        Usage    => new S'("GNAT FIND pattern[:sourcefile[:line[:column]]]" &
2031                           " filespec[,...] /qualifiers"),
2032        Unixcmd  => new S'("gnatfind"),
2033        Switches => Find_Switches'Access,
2034        Params   => new Parameter_Array'(1 => Other_As_Is,
2035                                         2 => Files_Or_Wildcard),
2036        Defext   => "ali"),
2037
2038       (Cname    => new S'("KRUNCH"),
2039        Usage    => new S'("GNAT KRUNCH file [/COUNT=nnn]"),
2040        Unixcmd  => new S'("gnatkr"),
2041        Switches => Krunch_Switches'Access,
2042        Params   => new Parameter_Array'(1 => File),
2043        Defext   => "   "),
2044
2045       (Cname    => new S'("LIBRARY"),
2046        Usage    => new S'("GNAT LIBRARY /[CREATE | SET | DELETE]=directory"
2047                           & " [/CONFIG=file]"),
2048        Unixcmd  => new S'("gnatlbr"),
2049        Switches => Lbr_Switches'Access,
2050        Params   => new Parameter_Array'(1 .. 0 => File),
2051        Defext   => "   "),
2052
2053       (Cname    => new S'("LINK"),
2054        Usage    => new S'("GNAT LINK file[.ali]"
2055                    & " [extra obj_&_lib_&_exe_&_opt files]"
2056                    & " /qualifiers"),
2057        Unixcmd  => new S'("gnatlink"),
2058        Switches => Link_Switches'Access,
2059        Params   => new Parameter_Array'(1 => Unlimited_Files),
2060        Defext   => "ali"),
2061
2062       (Cname    => new S'("LIST"),
2063        Usage    => new S'("GNAT LIST /qualifiers object_or_ali_file"),
2064        Unixcmd  => new S'("gnatls"),
2065        Switches => List_Switches'Access,
2066        Params   => new Parameter_Array'(1 => File),
2067        Defext   => "ali"),
2068
2069       (Cname    => new S'("MAKE"),
2070        Usage    =>
2071          new S'("GNAT MAKE file /qualifiers (includes COMPILE /qualifiers)"),
2072        Unixcmd  => new S'("gnatmake"),
2073        Switches => Make_Switches'Access,
2074        Params   => new Parameter_Array'(1 => File),
2075        Defext   => "   "),
2076
2077       (Cname    => new S'("PREPROCESS"),
2078        Usage    => new S'("GNAT PREPROCESS ifile ofile dfile /qualifiers"),
2079        Unixcmd  => new S'("gnatprep"),
2080        Switches => Prep_Switches'Access,
2081        Params   => new Parameter_Array'(1 .. 3 => File),
2082        Defext   => "   "),
2083
2084       (Cname    => new S'("SHARED"),
2085        Usage    => new S'("GNAT SHARED [obj_&_lib_&_exe_&_opt files]"
2086                    & " /qualifiers"),
2087        Unixcmd  => new S'("gcc -shared " & Init_Object_Dirs.all),
2088        Switches => Shared_Switches'Access,
2089        Params   => new Parameter_Array'(1 => Unlimited_Files),
2090        Defext   => "   "),
2091
2092       (Cname    => new S'("STANDARD"),
2093        Usage    => new S'("GNAT STANDARD"),
2094        Unixcmd  => new S'("gnatpsta"),
2095        Switches => Standard_Switches'Access,
2096        Params   => new Parameter_Array'(1 .. 0 => File),
2097        Defext   => "   "),
2098
2099       (Cname    => new S'("STUB"),
2100        Usage    => new S'("GNAT STUB file [directory] /qualifiers"),
2101        Unixcmd  => new S'("gnatstub"),
2102        Switches => Stub_Switches'Access,
2103        Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
2104        Defext   => "   "),
2105
2106       (Cname    => new S'("SYSTEM"),
2107        Usage    => new S'("GNAT SYSTEM"),
2108        Unixcmd  => new S'("gnatpsys"),
2109        Switches => System_Switches'Access,
2110        Params   => new Parameter_Array'(1 .. 0 => File),
2111        Defext   => "   "),
2112
2113       (Cname    => new S'("XREF"),
2114        Usage    => new S'("GNAT XREF filespec[,...] /qualifiers"),
2115        Unixcmd  => new S'("gnatxref"),
2116        Switches => Xref_Switches'Access,
2117        Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
2118        Defext   => "ali")
2119    );
2120
2121 -------------------------------------
2122 -- Start of processing for GNATCmd --
2123 -------------------------------------
2124
2125 begin
2126    Buffer.Init;
2127
2128    --  First we must preprocess the string form of the command and options
2129    --  list into the internal form that we use.
2130
2131    for C in Command_List'Range loop
2132
2133       declare
2134          Command : Item_Ptr := new Command_Item;
2135
2136          Last_Switch : Item_Ptr;
2137          --  Last switch in list
2138
2139       begin
2140          --  Link new command item into list of commands
2141
2142          if Last_Command = null then
2143             Commands := Command;
2144          else
2145             Last_Command.Next := Command;
2146          end if;
2147
2148          Last_Command := Command;
2149
2150          --  Fill in fields of new command item
2151
2152          Command.Name        := Command_List (C).Cname;
2153          Command.Usage       := Command_List (C).Usage;
2154          Command.Unix_String := Command_List (C).Unixcmd;
2155          Command.Params      := Command_List (C).Params;
2156          Command.Defext      := Command_List (C).Defext;
2157
2158          Validate_Command_Or_Option (Command.Name);
2159
2160          --  Process the switch list
2161
2162          for S in Command_List (C).Switches'Range loop
2163             declare
2164                SS : constant String_Ptr := Command_List (C).Switches (S);
2165
2166                P  : Natural := SS'First;
2167                Sw : Item_Ptr := new Switch_Item;
2168
2169                Last_Opt : Item_Ptr;
2170                --  Pointer to last option
2171
2172             begin
2173                --  Link new switch item into list of switches
2174
2175                if Last_Switch = null then
2176                   Command.Switches := Sw;
2177                else
2178                   Last_Switch.Next := Sw;
2179                end if;
2180
2181                Last_Switch := Sw;
2182
2183                --  Process switch string, first get name
2184
2185                while SS (P) /= ' ' and SS (P) /= '=' loop
2186                   P := P + 1;
2187                end loop;
2188
2189                Sw.Name := new String'(SS (SS'First .. P - 1));
2190
2191                --  Direct translation case
2192
2193                if SS (P) = ' ' then
2194                   Sw.Translation := T_Direct;
2195                   Sw.Unix_String := new String'(SS (P + 1 .. SS'Last));
2196                   Validate_Unix_Switch (Sw.Unix_String);
2197
2198                   if SS (P - 1) = '>' then
2199                      Sw.Translation := T_Other;
2200
2201                   elsif SS (P + 1) = '`' then
2202                      null;
2203
2204                   --  Create the inverted case (/NO ..)
2205
2206                   elsif SS (SS'First + 1 .. SS'First + 2) /= "NO" then
2207                      Sw := new Switch_Item;
2208                      Last_Switch.Next := Sw;
2209                      Last_Switch := Sw;
2210
2211                      Sw.Name :=
2212                        new String'("/NO" & SS (SS'First + 1 .. P - 1));
2213                      Sw.Translation := T_Direct;
2214                      Sw.Unix_String := Invert_Sense (SS (P + 1 .. SS'Last));
2215                      Validate_Unix_Switch (Sw.Unix_String);
2216                   end if;
2217
2218                --  Directories translation case
2219
2220                elsif SS (P + 1) = '*' then
2221                   pragma Assert (SS (SS'Last) = '*');
2222                   Sw.Translation := T_Directories;
2223                   Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2224                   Validate_Unix_Switch (Sw.Unix_String);
2225
2226                --  Directory translation case
2227
2228                elsif SS (P + 1) = '%' then
2229                   pragma Assert (SS (SS'Last) = '%');
2230                   Sw.Translation := T_Directory;
2231                   Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2232                   Validate_Unix_Switch (Sw.Unix_String);
2233
2234                --  File translation case
2235
2236                elsif SS (P + 1) = '@' then
2237                   pragma Assert (SS (SS'Last) = '@');
2238                   Sw.Translation := T_File;
2239                   Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2240                   Validate_Unix_Switch (Sw.Unix_String);
2241
2242                --  Numeric translation case
2243
2244                elsif SS (P + 1) = '#' then
2245                   pragma Assert (SS (SS'Last) = '#');
2246                   Sw.Translation := T_Numeric;
2247                   Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2248                   Validate_Unix_Switch (Sw.Unix_String);
2249
2250                --  Alphanumerplus translation case
2251
2252                elsif SS (P + 1) = '|' then
2253                   pragma Assert (SS (SS'Last) = '|');
2254                   Sw.Translation := T_Alphanumplus;
2255                   Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2256                   Validate_Unix_Switch (Sw.Unix_String);
2257
2258                --  String translation case
2259
2260                elsif SS (P + 1) = '"' then
2261                   pragma Assert (SS (SS'Last) = '"');
2262                   Sw.Translation := T_String;
2263                   Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
2264                   Validate_Unix_Switch (Sw.Unix_String);
2265
2266                --  Commands translation case
2267
2268                elsif SS (P + 1) = '?' then
2269                   Sw.Translation := T_Commands;
2270                   Sw.Unix_String := new String'(SS (P + 2 .. SS'Last));
2271
2272                --  Options translation case
2273
2274                else
2275                   Sw.Translation := T_Options;
2276                   Sw.Unix_String := new String'("");
2277
2278                   P := P + 1; -- bump past =
2279                   while P <= SS'Last loop
2280                      declare
2281                         Opt : Item_Ptr := new Option_Item;
2282                         Q   : Natural;
2283
2284                      begin
2285                         --  Link new option item into options list
2286
2287                         if Last_Opt = null then
2288                            Sw.Options := Opt;
2289                         else
2290                            Last_Opt.Next := Opt;
2291                         end if;
2292
2293                         Last_Opt := Opt;
2294
2295                         --  Fill in fields of new option item
2296
2297                         Q := P;
2298                         while SS (Q) /= ' ' loop
2299                            Q := Q + 1;
2300                         end loop;
2301
2302                         Opt.Name := new String'(SS (P .. Q - 1));
2303                         Validate_Command_Or_Option (Opt.Name);
2304
2305                         P := Q + 1;
2306                         Q := P;
2307
2308                         while Q <= SS'Last and then SS (Q) /= ' ' loop
2309                            Q := Q + 1;
2310                         end loop;
2311
2312                         Opt.Unix_String := new String'(SS (P .. Q - 1));
2313                         Validate_Unix_Switch (Opt.Unix_String);
2314                         P := Q + 1;
2315                      end;
2316                   end loop;
2317                end if;
2318             end;
2319          end loop;
2320       end;
2321    end loop;
2322
2323    --  If no parameters, give complete list of commands
2324
2325    if Argument_Count = 0 then
2326       Put_Line ("List of available commands");
2327       New_Line;
2328
2329       while Commands /= null loop
2330          Put (Commands.Usage.all);
2331          Set_Col (53);
2332          Put_Line (Commands.Unix_String.all);
2333          Commands := Commands.Next;
2334       end loop;
2335
2336       raise Normal_Exit;
2337    end if;
2338
2339    Arg_Num := 1;
2340
2341    loop
2342       exit when Arg_Num > Argument_Count;
2343
2344       declare
2345          Argv    : String_Access;
2346          Arg_Idx : Integer;
2347
2348          function Get_Arg_End
2349            (Argv    : String;
2350             Arg_Idx : Integer)
2351             return    Integer;
2352          --  Begins looking at Arg_Idx + 1 and returns the index of the
2353          --  last character before a slash or else the index of the last
2354          --  character in the string Argv.
2355
2356          function Get_Arg_End
2357            (Argv    : String;
2358             Arg_Idx : Integer)
2359             return    Integer
2360          is
2361          begin
2362             for J in Arg_Idx + 1 .. Argv'Last loop
2363                if Argv (J) = '/' then
2364                   return J - 1;
2365                end if;
2366             end loop;
2367
2368             return Argv'Last;
2369          end Get_Arg_End;
2370
2371       begin
2372          Argv := new String'(Argument (Arg_Num));
2373          Arg_Idx := Argv'First;
2374
2375       <<Tryagain_After_Coalesce>>
2376          loop
2377             declare
2378                Next_Arg_Idx : Integer;
2379                Arg          : String_Access;
2380
2381             begin
2382                Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
2383                Arg          := new String'(Argv (Arg_Idx .. Next_Arg_Idx));
2384
2385                --  The first one must be a command name
2386
2387                if Arg_Num = 1 and then Arg_Idx = Argv'First then
2388
2389                   Command := Matching_Name (Arg.all, Commands);
2390
2391                   if Command = null then
2392                      raise Error_Exit;
2393                   end if;
2394
2395                   --  Give usage information if only command given
2396
2397                   if Argument_Count = 1 and then Next_Arg_Idx = Argv'Last
2398                     and then
2399                      not (Command.Name.all = "SYSTEM"
2400                           or else Command.Name.all = "STANDARD")
2401                   then
2402                      Put_Line ("List of available qualifiers and options");
2403                      New_Line;
2404
2405                      Put (Command.Usage.all);
2406                      Set_Col (53);
2407                      Put_Line (Command.Unix_String.all);
2408
2409                      declare
2410                         Sw : Item_Ptr := Command.Switches;
2411
2412                      begin
2413                         while Sw /= null loop
2414                            Put ("   ");
2415                            Put (Sw.Name.all);
2416
2417                            case Sw.Translation is
2418
2419                               when T_Other =>
2420                                  Set_Col (53);
2421                                  Put_Line (Sw.Unix_String.all & "/<other>");
2422
2423                               when T_Direct =>
2424                                  Set_Col (53);
2425                                  Put_Line (Sw.Unix_String.all);
2426
2427                               when T_Directories =>
2428                                  Put ("=(direc,direc,..direc)");
2429                                  Set_Col (53);
2430                                  Put (Sw.Unix_String.all);
2431                                  Put (" direc ");
2432                                  Put (Sw.Unix_String.all);
2433                                  Put_Line (" direc ...");
2434
2435                               when T_Directory =>
2436                                  Put ("=directory");
2437                                  Set_Col (53);
2438                                  Put (Sw.Unix_String.all);
2439
2440                                  if Sw.Unix_String (Sw.Unix_String'Last)
2441                                    /= '='
2442                                  then
2443                                     Put (' ');
2444                                  end if;
2445
2446                                  Put_Line ("directory ");
2447
2448                               when T_File =>
2449                                  Put ("=file");
2450                                  Set_Col (53);
2451                                  Put (Sw.Unix_String.all);
2452
2453                                  if Sw.Unix_String (Sw.Unix_String'Last)
2454                                    /= '='
2455                                  then
2456                                     Put (' ');
2457                                  end if;
2458
2459                                  Put_Line ("file ");
2460
2461                               when T_Numeric =>
2462                                  Put ("=nnn");
2463                                  Set_Col (53);
2464
2465                                  if Sw.Unix_String (Sw.Unix_String'First)
2466                                    = '`'
2467                                  then
2468                                     Put (Sw.Unix_String
2469                                       (Sw.Unix_String'First + 1
2470                                        .. Sw.Unix_String'Last));
2471                                  else
2472                                     Put (Sw.Unix_String.all);
2473                                  end if;
2474
2475                                  Put_Line ("nnn");
2476
2477                               when T_Alphanumplus =>
2478                                  Put ("=xyz");
2479                                  Set_Col (53);
2480
2481                                  if Sw.Unix_String (Sw.Unix_String'First)
2482                                    = '`'
2483                                  then
2484                                     Put (Sw.Unix_String
2485                                       (Sw.Unix_String'First + 1
2486                                        .. Sw.Unix_String'Last));
2487                                  else
2488                                     Put (Sw.Unix_String.all);
2489                                  end if;
2490
2491                                  Put_Line ("xyz");
2492
2493                               when T_String =>
2494                                  Put ("=");
2495                                  Put ('"');
2496                                  Put ("<string>");
2497                                  Put ('"');
2498                                  Set_Col (53);
2499
2500                                  Put (Sw.Unix_String.all);
2501
2502                                  if Sw.Unix_String (Sw.Unix_String'Last)
2503                                    /= '='
2504                                  then
2505                                     Put (' ');
2506                                  end if;
2507
2508                                  Put ("<string>");
2509                                  New_Line;
2510
2511                               when T_Commands =>
2512                                  Put (" (switches for ");
2513                                  Put (Sw.Unix_String (
2514                                       Sw.Unix_String'First + 7
2515                                        .. Sw.Unix_String'Last));
2516                                  Put (')');
2517                                  Set_Col (53);
2518                                  Put (Sw.Unix_String (
2519                                       Sw.Unix_String'First
2520                                        .. Sw.Unix_String'First + 5));
2521                                  Put_Line (" switches");
2522
2523                               when T_Options =>
2524                                  declare
2525                                     Opt : Item_Ptr := Sw.Options;
2526
2527                                  begin
2528                                     Put_Line ("=(option,option..)");
2529
2530                                     while Opt /= null loop
2531                                        Put ("      ");
2532                                        Put (Opt.Name.all);
2533
2534                                        if Opt = Sw.Options then
2535                                           Put (" (D)");
2536                                        end if;
2537
2538                                        Set_Col (53);
2539                                        Put_Line (Opt.Unix_String.all);
2540                                        Opt := Opt.Next;
2541                                     end loop;
2542                                  end;
2543
2544                            end case;
2545
2546                            Sw := Sw.Next;
2547                         end loop;
2548                      end;
2549
2550                      raise Normal_Exit;
2551                   end if;
2552
2553                   Place (Command.Unix_String.all);
2554
2555                --  Special handling for internal debugging switch /?
2556
2557                elsif Arg.all = "/?" then
2558                   Display_Command := True;
2559
2560                --  Copy -switch unchanged
2561
2562                elsif Arg (Arg'First) = '-' then
2563                   Place (' ');
2564                   Place (Arg.all);
2565
2566                --  Copy quoted switch with quotes stripped
2567
2568                elsif Arg (Arg'First) = '"' then
2569                   if Arg (Arg'Last) /= '"' then
2570                      Put (Standard_Error, "misquoted argument: ");
2571                      Put_Line (Standard_Error, Arg.all);
2572                      Errors := Errors + 1;
2573
2574                   else
2575                      Put (Arg (Arg'First + 1 .. Arg'Last - 1));
2576                   end if;
2577
2578                --  Parameter Argument
2579
2580                elsif Arg (Arg'First) /= '/'
2581                  and then Make_Commands_Active = null
2582                then
2583                   Param_Count := Param_Count + 1;
2584
2585                   if Param_Count <= Command.Params'Length then
2586
2587                      case Command.Params (Param_Count) is
2588
2589                         when File | Optional_File =>
2590                            declare
2591                               Normal_File : String_Access
2592                                 := To_Canonical_File_Spec (Arg.all);
2593                            begin
2594                               Place (' ');
2595                               Place_Lower (Normal_File.all);
2596
2597                               if Is_Extensionless (Normal_File.all)
2598                                 and then Command.Defext /= "   "
2599                               then
2600                                  Place ('.');
2601                                  Place (Command.Defext);
2602                               end if;
2603                            end;
2604
2605                         when Unlimited_Files =>
2606                            declare
2607                               Normal_File : String_Access
2608                                 := To_Canonical_File_Spec (Arg.all);
2609
2610                               File_Is_Wild  : Boolean := False;
2611                               File_List     : String_Access_List_Access;
2612                            begin
2613                               for I in Arg'Range loop
2614                                  if Arg (I) = '*'
2615                                    or else Arg (I) = '%'
2616                                  then
2617                                     File_Is_Wild := True;
2618                                  end if;
2619                               end loop;
2620
2621                               if File_Is_Wild then
2622                                  File_List := To_Canonical_File_List
2623                                                 (Arg.all, False);
2624
2625                                  for I in File_List.all'Range loop
2626                                     Place (' ');
2627                                     Place_Lower (File_List.all (I).all);
2628                                  end loop;
2629                               else
2630                                  Place (' ');
2631                                  Place_Lower (Normal_File.all);
2632
2633                                  if Is_Extensionless (Normal_File.all)
2634                                    and then Command.Defext /= "   "
2635                                  then
2636                                     Place ('.');
2637                                     Place (Command.Defext);
2638                                  end if;
2639                               end if;
2640
2641                               Param_Count := Param_Count - 1;
2642                            end;
2643
2644                         when Other_As_Is =>
2645                            Place (' ');
2646                            Place (Arg.all);
2647
2648                         when Files_Or_Wildcard =>
2649
2650                            --  Remove spaces from a comma separated list
2651                            --  of file names and adjust control variables
2652                            --  accordingly.
2653
2654                            while Arg_Num < Argument_Count and then
2655                              (Argv (Argv'Last) = ',' xor
2656                               Argument (Arg_Num + 1)
2657                                (Argument (Arg_Num + 1)'First) = ',')
2658                            loop
2659                               Argv := new String'(Argv.all
2660                                                   & Argument (Arg_Num + 1));
2661                               Arg_Num := Arg_Num + 1;
2662                               Arg_Idx := Argv'First;
2663                               Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
2664                               Arg :=
2665                                 new String'(Argv (Arg_Idx .. Next_Arg_Idx));
2666                            end loop;
2667
2668                            --  Parse the comma separated list of VMS filenames
2669                            --  and place them on the command line as space
2670                            --  separated Unix style filenames. Lower case and
2671                            --  add default extension as appropriate.
2672
2673                            declare
2674                               Arg1_Idx : Integer := Arg'First;
2675
2676                               function Get_Arg1_End
2677                                 (Arg : String; Arg_Idx : Integer)
2678                                 return Integer;
2679                               --  Begins looking at Arg_Idx + 1 and
2680                               --  returns the index of the last character
2681                               --  before a comma or else the index of the
2682                               --  last character in the string Arg.
2683
2684                               function Get_Arg1_End
2685                                 (Arg : String; Arg_Idx : Integer)
2686                                 return Integer
2687                               is
2688                               begin
2689                                  for I in Arg_Idx + 1 .. Arg'Last loop
2690                                     if Arg (I) = ',' then
2691                                        return I - 1;
2692                                     end if;
2693                                  end loop;
2694
2695                                  return Arg'Last;
2696                               end Get_Arg1_End;
2697
2698                            begin
2699                               loop
2700                                  declare
2701                                     Next_Arg1_Idx : Integer
2702                                       := Get_Arg1_End (Arg.all, Arg1_Idx);
2703
2704                                     Arg1          : String
2705                                       := Arg (Arg1_Idx .. Next_Arg1_Idx);
2706
2707                                     Normal_File   : String_Access
2708                                       := To_Canonical_File_Spec (Arg1);
2709
2710                                  begin
2711                                     Place (' ');
2712                                     Place_Lower (Normal_File.all);
2713
2714                                     if Is_Extensionless (Normal_File.all)
2715                                       and then Command.Defext /= "   "
2716                                     then
2717                                        Place ('.');
2718                                        Place (Command.Defext);
2719                                     end if;
2720
2721                                     Arg1_Idx := Next_Arg1_Idx + 1;
2722                                  end;
2723
2724                                  exit when Arg1_Idx > Arg'Last;
2725
2726                                  --  Don't allow two or more commas in a row
2727
2728                                  if Arg (Arg1_Idx) = ',' then
2729                                     Arg1_Idx := Arg1_Idx + 1;
2730                                     if Arg1_Idx > Arg'Last or else
2731                                        Arg (Arg1_Idx) = ','
2732                                     then
2733                                        Put_Line (Standard_Error,
2734                                          "Malformed Parameter: " & Arg.all);
2735                                        Put (Standard_Error, "usage: ");
2736                                        Put_Line (Standard_Error,
2737                                          Command.Usage.all);
2738                                        raise Error_Exit;
2739                                     end if;
2740                                  end if;
2741
2742                               end loop;
2743                            end;
2744                      end case;
2745                   end if;
2746
2747                --  Qualifier argument
2748
2749                else
2750                   declare
2751                      Sw   : Item_Ptr;
2752                      SwP  : Natural;
2753                      P2   : Natural;
2754                      Endp : Natural := 0; -- avoid warning!
2755                      Opt  : Item_Ptr;
2756
2757                   begin
2758                      SwP := Arg'First;
2759                      while SwP < Arg'Last and then Arg (SwP + 1) /= '=' loop
2760                         SwP := SwP + 1;
2761                      end loop;
2762
2763                      --  At this point, the switch name is in
2764                      --  Arg (Arg'First..SwP) and if that is not the whole
2765                      --  switch, then there is an equal sign at
2766                      --  Arg (SwP + 1) and the rest of Arg is what comes
2767                      --  after the equal sign.
2768
2769                      --  If make commands are active, see if we have another
2770                      --  COMMANDS_TRANSLATION switch belonging to gnatmake.
2771
2772                      if Make_Commands_Active /= null then
2773                         Sw :=
2774                           Matching_Name
2775                             (Arg (Arg'First .. SwP),
2776                              Command.Switches,
2777                              Quiet => True);
2778
2779                         if Sw /= null and then Sw.Translation = T_Commands then
2780                            null;
2781
2782                         else
2783                            Sw :=
2784                              Matching_Name
2785                                (Arg (Arg'First .. SwP),
2786                                 Make_Commands_Active.Switches,
2787                                 Quiet => False);
2788                         end if;
2789
2790                      --  For case of GNAT MAKE or CHOP, if we cannot find the
2791                      --  switch, then see if it is a recognized compiler switch
2792                      --  instead, and if so process the compiler switch.
2793
2794                      elsif Command.Name.all = "MAKE"
2795                        or else Command.Name.all = "CHOP" then
2796                         Sw :=
2797                           Matching_Name
2798                             (Arg (Arg'First .. SwP),
2799                              Command.Switches,
2800                              Quiet => True);
2801
2802                         if Sw = null then
2803                            Sw :=
2804                              Matching_Name
2805                                (Arg (Arg'First .. SwP),
2806                                 Matching_Name ("COMPILE", Commands).Switches,
2807                                 Quiet => False);
2808                         end if;
2809
2810                      --  For all other cases, just search the relevant command
2811
2812                      else
2813                         Sw :=
2814                           Matching_Name
2815                             (Arg (Arg'First .. SwP),
2816                              Command.Switches,
2817                              Quiet => False);
2818                      end if;
2819
2820                      if Sw /= null then
2821                         case Sw.Translation is
2822
2823                            when T_Direct =>
2824                               Place_Unix_Switches (Sw.Unix_String);
2825                               if Arg (SwP + 1) = '=' then
2826                                  Put (Standard_Error,
2827                                       "qualifier options ignored: ");
2828                                  Put_Line (Standard_Error, Arg.all);
2829                               end if;
2830
2831                            when T_Directories =>
2832                               if SwP + 1 > Arg'Last then
2833                                  Put (Standard_Error,
2834                                       "missing directories for: ");
2835                                  Put_Line (Standard_Error, Arg.all);
2836                                  Errors := Errors + 1;
2837
2838                               elsif Arg (SwP + 2) /= '(' then
2839                                  SwP := SwP + 2;
2840                                  Endp := Arg'Last;
2841
2842                               elsif Arg (Arg'Last) /= ')' then
2843
2844                                  --  Remove spaces from a comma separated list
2845                                  --  of file names and adjust control
2846                                  --  variables accordingly.
2847
2848                                  if Arg_Num < Argument_Count and then
2849                                    (Argv (Argv'Last) = ',' xor
2850                                     Argument (Arg_Num + 1)
2851                                      (Argument (Arg_Num + 1)'First) = ',')
2852                                  then
2853                                     Argv := new String'(Argv.all
2854                                                 & Argument (Arg_Num + 1));
2855                                     Arg_Num := Arg_Num + 1;
2856                                     Arg_Idx := Argv'First;
2857                                     Next_Arg_Idx
2858                                       := Get_Arg_End (Argv.all, Arg_Idx);
2859                                     Arg := new String'
2860                                       (Argv (Arg_Idx .. Next_Arg_Idx));
2861                                     goto Tryagain_After_Coalesce;
2862                                  end if;
2863
2864                                  Put (Standard_Error,
2865                                       "incorrectly parenthesized " &
2866                                       "or malformed argument: ");
2867                                  Put_Line (Standard_Error, Arg.all);
2868                                  Errors := Errors + 1;
2869
2870                               else
2871                                  SwP := SwP + 3;
2872                                  Endp := Arg'Last - 1;
2873                               end if;
2874
2875                               while SwP <= Endp loop
2876                                  declare
2877                                     Dir_Is_Wild       : Boolean := False;
2878                                     Dir_Maybe_Is_Wild : Boolean := False;
2879                                     Dir_List : String_Access_List_Access;
2880                                  begin
2881                                     P2 := SwP;
2882
2883                                     while P2 < Endp
2884                                           and then Arg (P2 + 1) /= ','
2885                                     loop
2886
2887                                        --  A wildcard directory spec on VMS
2888                                        --  will contain either * or % or ...
2889
2890                                        if Arg (P2) = '*' then
2891                                           Dir_Is_Wild := True;
2892
2893                                        elsif Arg (P2) = '%' then
2894                                           Dir_Is_Wild := True;
2895
2896                                        elsif Dir_Maybe_Is_Wild
2897                                          and then Arg (P2) = '.'
2898                                          and then Arg (P2 + 1) = '.'
2899                                        then
2900                                           Dir_Is_Wild := True;
2901                                           Dir_Maybe_Is_Wild := False;
2902
2903                                        elsif Dir_Maybe_Is_Wild then
2904                                           Dir_Maybe_Is_Wild := False;
2905
2906                                        elsif Arg (P2) = '.'
2907                                          and then Arg (P2 + 1) = '.'
2908                                        then
2909                                           Dir_Maybe_Is_Wild := True;
2910
2911                                        end if;
2912
2913                                        P2 := P2 + 1;
2914                                     end loop;
2915
2916                                     if (Dir_Is_Wild) then
2917                                        Dir_List := To_Canonical_File_List
2918                                                       (Arg (SwP .. P2), True);
2919
2920                                        for I in Dir_List.all'Range loop
2921                                           Place_Unix_Switches (Sw.Unix_String);
2922                                           Place_Lower (Dir_List.all (I).all);
2923                                        end loop;
2924                                     else
2925                                        Place_Unix_Switches (Sw.Unix_String);
2926                                        Place_Lower (To_Canonical_Dir_Spec
2927                                          (Arg (SwP .. P2), False).all);
2928                                     end if;
2929
2930                                     SwP := P2 + 2;
2931                                  end;
2932                               end loop;
2933
2934                            when T_Directory =>
2935                               if SwP + 1 > Arg'Last then
2936                                  Put (Standard_Error,
2937                                       "missing directory for: ");
2938                                  Put_Line (Standard_Error, Arg.all);
2939                                  Errors := Errors + 1;
2940
2941                               else
2942                                  Place_Unix_Switches (Sw.Unix_String);
2943
2944                                  --  Some switches end in "=". No space here
2945
2946                                  if Sw.Unix_String
2947                                    (Sw.Unix_String'Last) /= '='
2948                                  then
2949                                     Place (' ');
2950                                  end if;
2951
2952                                  Place_Lower (To_Canonical_Dir_Spec
2953                                    (Arg (SwP + 2 .. Arg'Last), False).all);
2954                               end if;
2955
2956                            when T_File =>
2957                               if SwP + 1 > Arg'Last then
2958                                  Put (Standard_Error, "missing file for: ");
2959                                  Put_Line (Standard_Error, Arg.all);
2960                                  Errors := Errors + 1;
2961
2962                               else
2963                                  Place_Unix_Switches (Sw.Unix_String);
2964
2965                                  --  Some switches end in "=". No space here
2966
2967                                  if Sw.Unix_String
2968                                    (Sw.Unix_String'Last) /= '='
2969                                  then
2970                                     Place (' ');
2971                                  end if;
2972
2973                                  Place_Lower (To_Canonical_File_Spec
2974                                    (Arg (SwP + 2 .. Arg'Last)).all);
2975                               end if;
2976
2977                            when T_Numeric =>
2978                               if OK_Integer (Arg (SwP + 2 .. Arg'Last)) then
2979                                  Place_Unix_Switches (Sw.Unix_String);
2980                                  Place (Arg (SwP + 2 .. Arg'Last));
2981
2982                               else
2983                                  Put (Standard_Error, "argument for ");
2984                                  Put (Standard_Error, Sw.Name.all);
2985                                  Put_Line (Standard_Error, " must be numeric");
2986                                  Errors := Errors + 1;
2987                               end if;
2988
2989                            when T_Alphanumplus =>
2990                               if
2991                                 OK_Alphanumerplus (Arg (SwP + 2 .. Arg'Last))
2992                               then
2993                                  Place_Unix_Switches (Sw.Unix_String);
2994                                  Place (Arg (SwP + 2 .. Arg'Last));
2995
2996                               else
2997                                  Put (Standard_Error, "argument for ");
2998                                  Put (Standard_Error, Sw.Name.all);
2999                                  Put_Line (Standard_Error,
3000                                    " must be alphanumeric");
3001                                  Errors := Errors + 1;
3002                               end if;
3003
3004                            when T_String =>
3005
3006                               --  A String value must be extended to the
3007                               --  end of the Argv, otherwise strings like
3008                               --  "foo/bar" get split at the slash.
3009                               --
3010                               --  The begining and ending of the string
3011                               --  are flagged with embedded nulls which
3012                               --  are removed when building the Spawn
3013                               --  call. Nulls are use because they won't
3014                               --  show up in a /? output. Quotes aren't
3015                               --  used because that would make it difficult
3016                               --  to embed them.
3017
3018                               Place_Unix_Switches (Sw.Unix_String);
3019                               if Next_Arg_Idx /= Argv'Last then
3020                                  Next_Arg_Idx := Argv'Last;
3021                                  Arg := new String'
3022                                    (Argv (Arg_Idx .. Next_Arg_Idx));
3023
3024                                  SwP := Arg'First;
3025                                  while SwP < Arg'Last and then
3026                                    Arg (SwP + 1) /= '=' loop
3027                                     SwP := SwP + 1;
3028                                  end loop;
3029                               end if;
3030                               Place (ASCII.NUL);
3031                               Place (Arg (SwP + 2 .. Arg'Last));
3032                               Place (ASCII.NUL);
3033
3034                            when T_Commands =>
3035
3036                               --  Output -largs/-bargs/-cargs
3037
3038                               Place (' ');
3039                               Place (Sw.Unix_String
3040                                       (Sw.Unix_String'First ..
3041                                        Sw.Unix_String'First + 5));
3042
3043                               --  Set source of new commands, also setting this
3044                               --  non-null indicates that we are in the special
3045                               --  commands mode for processing the -xargs case.
3046
3047                               Make_Commands_Active :=
3048                                 Matching_Name
3049                                   (Sw.Unix_String
3050                                     (Sw.Unix_String'First + 7 ..
3051                                      Sw.Unix_String'Last),
3052                                    Commands);
3053
3054                            when T_Options =>
3055                               if SwP + 1 > Arg'Last then
3056                                  Place_Unix_Switches (Sw.Options.Unix_String);
3057                                  SwP := Endp + 1;
3058
3059                               elsif Arg (SwP + 2) /= '(' then
3060                                  SwP := SwP + 2;
3061                                  Endp := Arg'Last;
3062
3063                               elsif Arg (Arg'Last) /= ')' then
3064                                  Put (Standard_Error,
3065                                       "incorrectly parenthesized argument: ");
3066                                  Put_Line (Standard_Error, Arg.all);
3067                                  Errors := Errors + 1;
3068                                  SwP := Endp + 1;
3069
3070                               else
3071                                  SwP := SwP + 3;
3072                                  Endp := Arg'Last - 1;
3073                               end if;
3074
3075                               while SwP <= Endp loop
3076                                  P2 := SwP;
3077
3078                                  while P2 < Endp
3079                                        and then Arg (P2 + 1) /= ','
3080                                  loop
3081                                     P2 := P2 + 1;
3082                                  end loop;
3083
3084                                  --  Option name is in Arg (SwP .. P2)
3085
3086                                  Opt := Matching_Name (Arg (SwP .. P2),
3087                                                        Sw.Options);
3088
3089                                  if Opt /= null then
3090                                     Place_Unix_Switches (Opt.Unix_String);
3091                                  end if;
3092
3093                                  SwP := P2 + 2;
3094                               end loop;
3095
3096                            when T_Other =>
3097                               Place_Unix_Switches
3098                                 (new String'(Sw.Unix_String.all & Arg.all));
3099
3100                         end case;
3101                      end if;
3102                   end;
3103                end if;
3104
3105                Arg_Idx := Next_Arg_Idx + 1;
3106             end;
3107
3108             exit when Arg_Idx > Argv'Last;
3109
3110          end loop;
3111       end;
3112
3113       Arg_Num := Arg_Num + 1;
3114    end loop;
3115
3116    if Display_Command then
3117       Put (Standard_Error, "generated command -->");
3118       Put (Standard_Error, String (Buffer.Table (1 .. Buffer.Last)));
3119       Put (Standard_Error, "<--");
3120       New_Line (Standard_Error);
3121       raise Normal_Exit;
3122    end if;
3123
3124    --  Gross error checking that the number of parameters is correct.
3125    --  Not applicable to Unlimited_Files parameters.
3126
3127    if not ((Param_Count = Command.Params'Length - 1 and then
3128              Command.Params (Param_Count + 1) = Unlimited_Files)
3129      or else (Param_Count <= Command.Params'Length))
3130    then
3131       Put_Line (Standard_Error,
3132         "Parameter count of "
3133         & Integer'Image (Param_Count)
3134         & " not equal to expected "
3135         & Integer'Image (Command.Params'Length));
3136       Put (Standard_Error, "usage: ");
3137       Put_Line (Standard_Error, Command.Usage.all);
3138       Errors := Errors + 1;
3139    end if;
3140
3141    if Errors > 0 then
3142       raise Error_Exit;
3143    else
3144       --  Prepare arguments for a call to spawn, filtering out
3145       --  embedded nulls place there to delineate strings.
3146
3147       declare
3148          Pname_Ptr  : Natural;
3149          Args       : Argument_List (1 .. 500);
3150          Nargs      : Natural;
3151          P1, P2     : Natural;
3152          Exec_Path  : String_Access;
3153          Inside_Nul : Boolean := False;
3154          Arg        : String (1 .. 1024);
3155          Arg_Ctr    : Natural;
3156
3157       begin
3158          Pname_Ptr := 1;
3159
3160          while Pname_Ptr < Buffer.Last
3161            and then Buffer.Table (Pname_Ptr + 1) /= ' '
3162          loop
3163             Pname_Ptr := Pname_Ptr + 1;
3164          end loop;
3165
3166          P1 := Pname_Ptr + 2;
3167          Arg_Ctr := 1;
3168          Arg (Arg_Ctr) := Buffer.Table (P1);
3169
3170          Nargs := 0;
3171          while P1 <= Buffer.Last loop
3172
3173             if Buffer.Table (P1) = ASCII.NUL then
3174                if Inside_Nul then
3175                   Inside_Nul := False;
3176                else
3177                   Inside_Nul := True;
3178                end if;
3179             end if;
3180
3181             if Buffer.Table (P1) = ' ' and then not Inside_Nul then
3182                P1 := P1 + 1;
3183                Arg_Ctr := Arg_Ctr + 1;
3184                Arg (Arg_Ctr) := Buffer.Table (P1);
3185
3186             else
3187                Nargs := Nargs + 1;
3188                P2 := P1;
3189
3190                while P2 < Buffer.Last
3191                  and then (Buffer.Table (P2 + 1) /= ' ' or else
3192                            Inside_Nul)
3193                loop
3194                   P2 := P2 + 1;
3195                   Arg_Ctr := Arg_Ctr + 1;
3196                   Arg (Arg_Ctr) := Buffer.Table (P2);
3197                   if Buffer.Table (P2) = ASCII.NUL then
3198                      Arg_Ctr := Arg_Ctr - 1;
3199                      if Inside_Nul then
3200                         Inside_Nul := False;
3201                      else
3202                         Inside_Nul := True;
3203                      end if;
3204                   end if;
3205                end loop;
3206
3207                Args (Nargs) := new String'(String (Arg (1 .. Arg_Ctr)));
3208                P1 := P2 + 2;
3209                Arg_Ctr := 1;
3210                Arg (Arg_Ctr) := Buffer.Table (P1);
3211             end if;
3212          end loop;
3213
3214          Exec_Path := Locate_Exec_On_Path
3215            (String (Buffer.Table (1 .. Pname_Ptr)));
3216
3217          if Exec_Path = null then
3218             Put_Line (Standard_Error,
3219                       "Couldn't locate "
3220                        & String (Buffer.Table (1 .. Pname_Ptr)));
3221             raise Error_Exit;
3222          end if;
3223
3224          My_Exit_Status
3225            := Exit_Status (Spawn (Exec_Path.all, Args (1 .. Nargs)));
3226
3227       end;
3228
3229       raise Normal_Exit;
3230    end if;
3231
3232 exception
3233    when Error_Exit =>
3234       Set_Exit_Status (Failure);
3235
3236    when Normal_Exit =>
3237       Set_Exit_Status (My_Exit_Status);
3238
3239 end GNATCmd;