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