gcc/ada/vms_conv.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                            V M S _ C O N V                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1996-2009, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Gnatvsn;  use Gnatvsn;
  27 with Hostparm;
  28 with Opt;
  29 with Osint;    use Osint;
  30 with Targparm; use Targparm;
  31
  32 with Ada.Characters.Handling; use Ada.Characters.Handling;
  33 with Ada.Command_Line;        use Ada.Command_Line;
  34 with Ada.Text_IO;             use Ada.Text_IO;
  35
  36 package body VMS_Conv is
  37
  38    -------------------------
  39    -- Internal Structures --
  40    -------------------------
  41
  42    --  The switches and commands are defined by strings in the previous
  43    --  section so that they are easy to modify, but internally, they are
  44    --  kept in a more conveniently accessible form described in this
  45    --  section.
  46
  47    --  Commands, command qualifiers and options have a similar common format
  48    --  so that searching for matching names can be done in a common manner.
  49
  50    type Item_Id is (Id_Command, Id_Switch, Id_Option);
  51
  52    type Translation_Type is
  53      (
  54       T_Direct,
  55       --  A qualifier with no options.
  56       --  Example: GNAT MAKE /VERBOSE
  57
  58       T_Directories,
  59       --  A qualifier followed by a list of directories
  60       --  Example: GNAT COMPILE /SEARCH=([], [.FOO], [.BAR])
  61
  62       T_Directory,
  63       --  A qualifier followed by one directory
  64       --  Example: GNAT LIBRARY /SET=[.VAXFLOATLIB]
  65
  66       T_File,
  67       --  A qualifier followed by a filename
  68       --  Example: GNAT LINK /EXECUTABLE=FOO.EXE
  69
  70       T_No_Space_File,
  71       --  A qualifier followed by a filename
  72       --  Example: GNAT MAKE /PROJECT_FILE=PRJ.GPR
  73
  74       T_Numeric,
  75       --  A qualifier followed by a numeric value.
  76       --  Example: GNAT CHOP /FILE_NAME_MAX_LENGTH=39
  77
  78       T_String,
  79       --  A qualifier followed by a quoted string. Only used by
  80       --  /IDENTIFICATION qualifier.
  81       --  Example: GNAT LINK /IDENTIFICATION="3.14a1 version"
  82
  83       T_Options,
  84       --  A qualifier followed by a list of options.
  85       --  Example: GNAT COMPILE /REPRESENTATION_INFO=(ARRAYS,OBJECTS)
  86
  87       T_Commands,
  88       --  A qualifier followed by a list. Only used for
  89       --  MAKE /COMPILER_QUALIFIERS /BINDER_QUALIFIERS /LINKER_QUALIFIERS
  90       --  (gnatmake -cargs -bargs -largs )
  91       --  Example: GNAT MAKE ... /LINKER_QUALIFIERS /VERBOSE FOOBAR.OBJ
  92
  93       T_Other,
  94       --  A qualifier passed directly to the linker. Only used
  95       --  for LINK and SHARED if no other match is found.
  96       --  Example: GNAT LINK FOO.ALI /SYSSHR
  97
  98       T_Alphanumplus
  99       --  A qualifier followed by a legal linker symbol prefix. Only used
 100       --  for BIND /BUILD_LIBRARY (gnatbind -Lxyz).
 101       --  Example: GNAT BIND /BUILD_LIBRARY=foobar
 102       );
 103
 104    type Item (Id : Item_Id);
 105    type Item_Ptr is access all Item;
 106
 107    type Item (Id : Item_Id) is record
 108       Name : String_Ptr;
 109       --  Name of the command, switch (with slash) or option
 110
 111       Next : Item_Ptr;
 112       --  Pointer to next item on list, always has the same Id value
 113
 114       Command : Command_Type := Undefined;
 115
 116       Unix_String : String_Ptr := null;
 117       --  Corresponding Unix string. For a command, this is the unix command
 118       --  name and possible default switches. For a switch or option it is
 119       --  the unix switch string.
 120
 121       case Id is
 122
 123          when Id_Command =>
 124
 125             Switches : Item_Ptr;
 126             --  Pointer to list of switch items for the command, linked
 127             --  through the Next fields with null terminating the list.
 128
 129             Usage : String_Ptr;
 130             --  Usage information, used only for errors and the default
 131             --  list of commands output.
 132
 133             Params : Parameter_Ref;
 134             --  Array of parameters
 135
 136             Defext : String (1 .. 3);
 137             --  Default extension. If non-blank, then this extension is
 138             --  supplied by default as the extension for any file parameter
 139             --  which does not have an extension already.
 140
 141          when Id_Switch =>
 142
 143             Translation : Translation_Type;
 144             --  Type of switch translation. For all cases, except Options,
 145             --  this is the only field needed, since the Unix translation
 146             --  is found in Unix_String.
 147
 148             Options : Item_Ptr;
 149             --  For the Options case, this field is set to point to a list
 150             --  of options item (for this case Unix_String is null in the
 151             --  main switch item). The end of the list is marked by null.
 152
 153          when Id_Option =>
 154
 155             null;
 156             --  No special fields needed, since Name and Unix_String are
 157             --  sufficient to completely described an option.
 158
 159       end case;
 160    end record;
 161
 162    subtype Command_Item is Item (Id_Command);
 163    subtype Switch_Item  is Item (Id_Switch);
 164    subtype Option_Item  is Item (Id_Option);
 165
 166    Keep_Temps_Option : constant Item_Ptr :=
 167                          new Item'
 168                            (Id          => Id_Option,
 169                             Name        =>
 170                               new String'("/KEEP_TEMPORARY_FILES"),
 171                             Next        => null,
 172                             Command     => Undefined,
 173                             Unix_String => null);
 174
 175    Param_Count : Natural := 0;
 176    --  Number of parameter arguments so far
 177
 178    Arg_Num : Natural;
 179    --  Argument number
 180
 181    Arg_File : Ada.Text_IO.File_Type;
 182    --  A file where arguments are read from
 183
 184    Commands : Item_Ptr;
 185    --  Pointer to head of list of command items, one for each command, with
 186    --  the end of the list marked by a null pointer.
 187
 188    Last_Command : Item_Ptr;
 189    --  Pointer to last item in Commands list
 190
 191    Command : Item_Ptr;
 192    --  Pointer to command item for current command
 193
 194    Make_Commands_Active : Item_Ptr := null;
 195    --  Set to point to Command entry for COMPILE, BIND, or LINK as appropriate
 196    --  if a COMMANDS_TRANSLATION switch has been encountered while processing
 197    --  a MAKE Command.
 198
 199    Output_File_Expected : Boolean := False;
 200    --  True for GNAT LINK after -o switch, so that the ".ali" extension is
 201    --  not added to the executable file name.
 202
 203    package Buffer is new Table.Table
 204      (Table_Component_Type => Character,
 205       Table_Index_Type     => Integer,
 206       Table_Low_Bound      => 1,
 207       Table_Initial        => 4096,
 208       Table_Increment      => 100,
 209       Table_Name           => "Buffer");
 210    --  Table to store the command to be used
 211
 212    package Cargs_Buffer is new Table.Table
 213      (Table_Component_Type => Character,
 214       Table_Index_Type     => Integer,
 215       Table_Low_Bound      => 1,
 216       Table_Initial        => 4096,
 217       Table_Increment      => 100,
 218       Table_Name           => "Cargs_Buffer");
 219    --  Table to store the compiler switches for GNAT COMPILE
 220
 221    Cargs : Boolean := False;
 222    --  When True, commands should go to Cargs_Buffer instead of Buffer table
 223
 224    function Init_Object_Dirs return Argument_List;
 225    --  Get the list of the object directories
 226
 227    function Invert_Sense (S : String) return VMS_Data.String_Ptr;
 228    --  Given a unix switch string S, computes the inverse (adding or
 229    --  removing ! characters as required), and returns a pointer to
 230    --  the allocated result on the heap.
 231
 232    function Is_Extensionless (F : String) return Boolean;
 233    --  Returns true if the filename has no extension
 234
 235    function Match (S1, S2 : String) return Boolean;
 236    --  Determines whether S1 and S2 match (this is a case insensitive match)
 237
 238    function Match_Prefix (S1, S2 : String) return Boolean;
 239    --  Determines whether S1 matches a prefix of S2. This is also a case
 240    --  insensitive match (for example Match ("AB","abc") is True).
 241
 242    function Matching_Name
 243      (S     : String;
 244       Itm   : Item_Ptr;
 245       Quiet : Boolean := False) return Item_Ptr;
 246    --  Determines if the item list headed by Itm and threaded through the
 247    --  Next fields (with null marking the end of the list), contains an
 248    --  entry that uniquely matches the given string. The match is case
 249    --  insensitive and permits unique abbreviation. If the match succeeds,
 250    --  then a pointer to the matching item is returned. Otherwise, an
 251    --  appropriate error message is written. Note that the discriminant
 252    --  of Itm is used to determine the appropriate form of this message.
 253    --  Quiet is normally False as shown, if it is set to True, then no
 254    --  error message is generated in a not found situation (null is still
 255    --  returned to indicate the not-found situation).
 256
 257    function OK_Alphanumerplus (S : String) return Boolean;
 258    --  Checks that S is a string of alphanumeric characters,
 259    --  returning True if all alphanumeric characters,
 260    --  False if empty or a non-alphanumeric character is present.
 261
 262    function OK_Integer (S : String) return Boolean;
 263    --  Checks that S is a string of digits, returning True if all digits,
 264    --  False if empty or a non-digit is present.
 265
 266    procedure Place (C : Character);
 267    --  Place a single character in the buffer, updating Ptr
 268
 269    procedure Place (S : String);
 270    --  Place a string character in the buffer, updating Ptr
 271
 272    procedure Place_Lower (S : String);
 273    --  Place string in buffer, forcing letters to lower case, updating Ptr
 274
 275    procedure Place_Unix_Switches (S : VMS_Data.String_Ptr);
 276    --  Given a unix switch string, place corresponding switches in Buffer,
 277    --  updating Ptr appropriately. Note that in the case of use of ! the
 278    --  result may be to remove a previously placed switch.
 279
 280    procedure Preprocess_Command_Data;
 281    --  Preprocess the string form of the command and options list into the
 282    --  internal form.
 283
 284    procedure Process_Argument (The_Command : in out Command_Type);
 285    --  Process one argument from the command line, or one line from
 286    --  from a command line file. For the first call, set The_Command.
 287
 288    procedure Process_Buffer (S : String);
 289    --  Process the characters in the Buffer table or the Cargs_Buffer table
 290    --  to convert these into arguments.
 291
 292    procedure Validate_Command_Or_Option (N : VMS_Data.String_Ptr);
 293    --  Check that N is a valid command or option name, i.e. that it is of the
 294    --  form of an Ada identifier with upper case letters and underscores.
 295
 296    procedure Validate_Unix_Switch (S : VMS_Data.String_Ptr);
 297    --  Check that S is a valid switch string as described in the syntax for
 298    --  the switch table item UNIX_SWITCH or else begins with a backquote.
 299
 300    ----------------------
 301    -- Init_Object_Dirs --
 302    ----------------------
 303
 304    function Init_Object_Dirs return Argument_List is
 305       Object_Dirs     : Integer;
 306       Object_Dir      : Argument_List (1 .. 256);
 307       Object_Dir_Name : String_Access;
 308
 309    begin
 310       Object_Dirs := 0;
 311       Object_Dir_Name := new String'(Object_Dir_Default_Prefix);
 312       Get_Next_Dir_In_Path_Init (Object_Dir_Name);
 313
 314       loop
 315          declare
 316             Dir : constant String_Access :=
 317                     String_Access (Get_Next_Dir_In_Path (Object_Dir_Name));
 318          begin
 319             exit when Dir = null;
 320             Object_Dirs := Object_Dirs + 1;
 321             Object_Dir (Object_Dirs) :=
 322               new String'("-L" &
 323                           To_Canonical_Dir_Spec
 324                           (To_Host_Dir_Spec
 325                            (Normalize_Directory_Name (Dir.all).all,
 326                             True).all, True).all);
 327          end;
 328       end loop;
 329
 330       Object_Dirs := Object_Dirs + 1;
 331       Object_Dir (Object_Dirs) := new String'("-lgnat");
 332
 333       if OpenVMS_On_Target then
 334          Object_Dirs := Object_Dirs + 1;
 335          Object_Dir (Object_Dirs) := new String'("-ldecgnat");
 336       end if;
 337
 338       return Object_Dir (1 .. Object_Dirs);
 339    end Init_Object_Dirs;
 340
 341    ----------------
 342    -- Initialize --
 343    ----------------
 344
 345    procedure Initialize is
 346    begin
 347       Command_List :=
 348         (Bind =>
 349            (Cname    => new S'("BIND"),
 350             Usage    => new S'("GNAT BIND file[.ali] /qualifiers"),
 351             VMS_Only => False,
 352             Unixcmd  => new S'("gnatbind"),
 353             Unixsws  => null,
 354             Switches => Bind_Switches'Access,
 355             Params   => new Parameter_Array'(1 => Unlimited_Files),
 356             Defext   => "ali"),
 357
 358          Chop =>
 359            (Cname    => new S'("CHOP"),
 360             Usage    => new S'("GNAT CHOP file [directory] /qualifiers"),
 361             VMS_Only => False,
 362             Unixcmd  => new S'("gnatchop"),
 363             Unixsws  => null,
 364             Switches => Chop_Switches'Access,
 365             Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
 366             Defext   => "   "),
 367
 368          Clean =>
 369            (Cname    => new S'("CLEAN"),
 370             Usage    => new S'("GNAT CLEAN /qualifiers files"),
 371             VMS_Only => False,
 372             Unixcmd  => new S'("gnatclean"),
 373             Unixsws  => null,
 374             Switches => Clean_Switches'Access,
 375             Params   => new Parameter_Array'(1 => File),
 376             Defext   => "   "),
 377
 378          Compile =>
 379            (Cname    => new S'("COMPILE"),
 380             Usage    => new S'("GNAT COMPILE filespec[,...] /qualifiers"),
 381             VMS_Only => False,
 382             Unixcmd  => new S'("gnatmake"),
 383             Unixsws  => new Argument_List'(1 => new String'("-f"),
 384                                            2 => new String'("-u"),
 385                                            3 => new String'("-c")),
 386             Switches => GCC_Switches'Access,
 387             Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
 388             Defext   => "   "),
 389
 390          Check =>
 391            (Cname    => new S'("CHECK"),
 392             Usage    => new S'("GNAT CHECK name /qualifiers"),
 393             VMS_Only => False,
 394             Unixcmd  => new S'("gnatcheck"),
 395             Unixsws  => null,
 396             Switches => Check_Switches'Access,
 397             Params   => new Parameter_Array'(1 => Unlimited_Files),
 398             Defext   => "   "),
 399
 400          Sync =>
 401            (Cname    => new S'("SYNC"),
 402             Usage    => new S'("GNAT SYNC name /qualifiers"),
 403             VMS_Only => False,
 404             Unixcmd  => new S'("gnatsync"),
 405             Unixsws  => null,
 406             Switches => Sync_Switches'Access,
 407             Params   => new Parameter_Array'(1 => Unlimited_Files),
 408             Defext   => "   "),
 409
 410          Elim =>
 411            (Cname    => new S'("ELIM"),
 412             Usage    => new S'("GNAT ELIM name /qualifiers"),
 413             VMS_Only => False,
 414             Unixcmd  => new S'("gnatelim"),
 415             Unixsws  => null,
 416             Switches => Elim_Switches'Access,
 417             Params   => new Parameter_Array'(1 => Other_As_Is),
 418             Defext   => "ali"),
 419
 420          Find =>
 421            (Cname    => new S'("FIND"),
 422             Usage    => new S'("GNAT FIND pattern[:sourcefile[:line"
 423                                & "[:column]]] filespec[,...] /qualifiers"),
 424             VMS_Only => False,
 425             Unixcmd  => new S'("gnatfind"),
 426             Unixsws  => null,
 427             Switches => Find_Switches'Access,
 428             Params   => new Parameter_Array'(1 => Other_As_Is,
 429                                              2 => Files_Or_Wildcard),
 430             Defext   => "ali"),
 431
 432          Krunch =>
 433            (Cname    => new S'("KRUNCH"),
 434             Usage    => new S'("GNAT KRUNCH file [/COUNT=nnn]"),
 435             VMS_Only => False,
 436             Unixcmd  => new S'("gnatkr"),
 437             Unixsws  => null,
 438             Switches => Krunch_Switches'Access,
 439             Params   => new Parameter_Array'(1 => File),
 440             Defext   => "   "),
 441
 442          Link =>
 443            (Cname    => new S'("LINK"),
 444             Usage    => new S'("GNAT LINK file[.ali]"
 445                                & " [extra obj_&_lib_&_exe_&_opt files]"
 446                                & " /qualifiers"),
 447             VMS_Only => False,
 448             Unixcmd  => new S'("gnatlink"),
 449             Unixsws  => null,
 450             Switches => Link_Switches'Access,
 451             Params   => new Parameter_Array'(1 => Unlimited_Files),
 452             Defext   => "ali"),
 453
 454          List =>
 455            (Cname    => new S'("LIST"),
 456             Usage    => new S'("GNAT LIST /qualifiers object_or_ali_file"),
 457             VMS_Only => False,
 458             Unixcmd  => new S'("gnatls"),
 459             Unixsws  => null,
 460             Switches => List_Switches'Access,
 461             Params   => new Parameter_Array'(1 => Unlimited_Files),
 462             Defext   => "ali"),
 463
 464          Make =>
 465            (Cname    => new S'("MAKE"),
 466             Usage    => new S'("GNAT MAKE file(s) /qualifiers (includes "
 467                                & "COMPILE /qualifiers)"),
 468             VMS_Only => False,
 469             Unixcmd  => new S'("gnatmake"),
 470             Unixsws  => null,
 471             Switches => Make_Switches'Access,
 472             Params   => new Parameter_Array'(1 => Unlimited_Files),
 473             Defext   => "   "),
 474
 475          Metric =>
 476            (Cname    => new S'("METRIC"),
 477             Usage    => new S'("GNAT METRIC /qualifiers source_file"),
 478             VMS_Only => False,
 479             Unixcmd  => new S'("gnatmetric"),
 480             Unixsws  => null,
 481             Switches => Metric_Switches'Access,
 482             Params   => new Parameter_Array'(1 => Unlimited_Files),
 483             Defext   => "   "),
 484
 485          Name =>
 486            (Cname    => new S'("NAME"),
 487             Usage    => new S'("GNAT NAME /qualifiers naming-pattern "
 488                                & "[naming-patterns]"),
 489             VMS_Only => False,
 490             Unixcmd  => new S'("gnatname"),
 491             Unixsws  => null,
 492             Switches => Name_Switches'Access,
 493             Params   => new Parameter_Array'(1 => Unlimited_As_Is),
 494             Defext   => "   "),
 495
 496          Preprocess =>
 497            (Cname    => new S'("PREPROCESS"),
 498             Usage    =>
 499               new S'("GNAT PREPROCESS ifile ofile dfile /qualifiers"),
 500             VMS_Only => False,
 501             Unixcmd  => new S'("gnatprep"),
 502             Unixsws  => null,
 503             Switches => Prep_Switches'Access,
 504             Params   => new Parameter_Array'(1 .. 3 => File),
 505             Defext   => "   "),
 506
 507          Pretty =>
 508            (Cname    => new S'("PRETTY"),
 509             Usage    => new S'("GNAT PRETTY /qualifiers source_file"),
 510             VMS_Only => False,
 511             Unixcmd  => new S'("gnatpp"),
 512             Unixsws  => null,
 513             Switches => Pretty_Switches'Access,
 514             Params   => new Parameter_Array'(1 => Unlimited_Files),
 515             Defext   => "   "),
 516
 517          Shared =>
 518            (Cname    => new S'("SHARED"),
 519             Usage    => new S'("GNAT SHARED [obj_&_lib_&_exe_&_opt"
 520                                & "files] /qualifiers"),
 521             VMS_Only => True,
 522             Unixcmd  => new S'("gcc"),
 523             Unixsws  =>
 524             new Argument_List'(new String'("-shared") & Init_Object_Dirs),
 525             Switches => Shared_Switches'Access,
 526             Params   => new Parameter_Array'(1 => Unlimited_Files),
 527             Defext   => "   "),
 528
 529          Stack =>
 530            (Cname    => new S'("STACK"),
 531             Usage    => new S'("GNAT STACK /qualifiers ci_files"),
 532             VMS_Only => False,
 533             Unixcmd  => new S'("gnatstack"),
 534             Unixsws  => null,
 535             Switches => Stack_Switches'Access,
 536             Params   => new Parameter_Array'(1 => Unlimited_Files),
 537             Defext   => "ci" & ASCII.NUL),
 538
 539          Stub =>
 540            (Cname    => new S'("STUB"),
 541             Usage    => new S'("GNAT STUB file [directory]/qualifiers"),
 542             VMS_Only => False,
 543             Unixcmd  => new S'("gnatstub"),
 544             Unixsws  => null,
 545             Switches => Stub_Switches'Access,
 546             Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
 547             Defext   => "   "),
 548
 549          Xref =>
 550            (Cname    => new S'("XREF"),
 551             Usage    => new S'("GNAT XREF filespec[,...] /qualifiers"),
 552             VMS_Only => False,
 553             Unixcmd  => new S'("gnatxref"),
 554             Unixsws  => null,
 555             Switches => Xref_Switches'Access,
 556             Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
 557             Defext   => "ali")
 558         );
 559    end Initialize;
 560
 561    ------------------
 562    -- Invert_Sense --
 563    ------------------
 564
 565    function Invert_Sense (S : String) return VMS_Data.String_Ptr is
 566       Sinv : String (1 .. S'Length * 2);
 567       --  Result (for sure long enough)
 568
 569       Sinvp : Natural := 0;
 570       --  Pointer to output string
 571
 572    begin
 573       for Sp in S'Range loop
 574          if Sp = S'First or else S (Sp - 1) = ',' then
 575             if S (Sp) = '!' then
 576                null;
 577             else
 578                Sinv (Sinvp + 1) := '!';
 579                Sinv (Sinvp + 2) := S (Sp);
 580                Sinvp := Sinvp + 2;
 581             end if;
 582
 583          else
 584             Sinv (Sinvp + 1) := S (Sp);
 585             Sinvp := Sinvp + 1;
 586          end if;
 587       end loop;
 588
 589       return new String'(Sinv (1 .. Sinvp));
 590    end Invert_Sense;
 591
 592    ----------------------
 593    -- Is_Extensionless --
 594    ----------------------
 595
 596    function Is_Extensionless (F : String) return Boolean is
 597    begin
 598       for J in reverse F'Range loop
 599          if F (J) = '.' then
 600             return False;
 601          elsif F (J) = '/' or else F (J) = ']' or else F (J) = ':' then
 602             return True;
 603          end if;
 604       end loop;
 605
 606       return True;
 607    end Is_Extensionless;
 608
 609    -----------
 610    -- Match --
 611    -----------
 612
 613    function Match (S1, S2 : String) return Boolean is
 614       Dif : constant Integer := S2'First - S1'First;
 615
 616    begin
 617
 618       if S1'Length /= S2'Length then
 619          return False;
 620
 621       else
 622          for J in S1'Range loop
 623             if To_Lower (S1 (J)) /= To_Lower (S2 (J + Dif)) then
 624                return False;
 625             end if;
 626          end loop;
 627
 628          return True;
 629       end if;
 630    end Match;
 631
 632    ------------------
 633    -- Match_Prefix --
 634    ------------------
 635
 636    function Match_Prefix (S1, S2 : String) return Boolean is
 637    begin
 638       if S1'Length > S2'Length then
 639          return False;
 640       else
 641          return Match (S1, S2 (S2'First .. S2'First + S1'Length - 1));
 642       end if;
 643    end Match_Prefix;
 644
 645    -------------------
 646    -- Matching_Name --
 647    -------------------
 648
 649    function Matching_Name
 650      (S     : String;
 651       Itm   : Item_Ptr;
 652       Quiet : Boolean := False) return Item_Ptr
 653    is
 654       P1, P2 : Item_Ptr;
 655
 656       procedure Err;
 657       --  Little procedure to output command/qualifier/option as appropriate
 658       --  and bump error count.
 659
 660       ---------
 661       -- Err --
 662       ---------
 663
 664       procedure Err is
 665       begin
 666          if Quiet then
 667             return;
 668          end if;
 669
 670          Errors := Errors + 1;
 671
 672          if Itm /= null then
 673             case Itm.Id is
 674                when Id_Command =>
 675                   Put (Standard_Error, "command");
 676
 677                when Id_Switch =>
 678                   if Hostparm.OpenVMS then
 679                      Put (Standard_Error, "qualifier");
 680                   else
 681                      Put (Standard_Error, "switch");
 682                   end if;
 683
 684                when Id_Option =>
 685                   Put (Standard_Error, "option");
 686
 687             end case;
 688          else
 689             Put (Standard_Error, "input");
 690
 691          end if;
 692
 693          Put (Standard_Error, ": ");
 694          Put (Standard_Error, S);
 695       end Err;
 696
 697    --  Start of processing for Matching_Name
 698
 699    begin
 700       --  If exact match, that's the one we want
 701
 702       P1 := Itm;
 703       while P1 /= null loop
 704          if Match (S, P1.Name.all) then
 705             return P1;
 706          else
 707             P1 := P1.Next;
 708          end if;
 709       end loop;
 710
 711       --  Now check for prefix matches
 712
 713       P1 := Itm;
 714       while P1 /= null loop
 715          if P1.Name.all = "/<other>" then
 716             return P1;
 717
 718          elsif not Match_Prefix (S, P1.Name.all) then
 719             P1 := P1.Next;
 720
 721          else
 722             --  Here we have found one matching prefix, so see if there is
 723             --  another one (which is an ambiguity)
 724
 725             P2 := P1.Next;
 726             while P2 /= null loop
 727                if Match_Prefix (S, P2.Name.all) then
 728                   if not Quiet then
 729                      Put (Standard_Error, "ambiguous ");
 730                      Err;
 731                      Put (Standard_Error, " (matches ");
 732                      Put (Standard_Error, P1.Name.all);
 733
 734                      while P2 /= null loop
 735                         if Match_Prefix (S, P2.Name.all) then
 736                            Put (Standard_Error, ',');
 737                            Put (Standard_Error, P2.Name.all);
 738                         end if;
 739
 740                         P2 := P2.Next;
 741                      end loop;
 742
 743                      Put_Line (Standard_Error, ")");
 744                   end if;
 745
 746                   return null;
 747                end if;
 748
 749                P2 := P2.Next;
 750             end loop;
 751
 752             --  If we fall through that loop, then there was only one match
 753
 754             return P1;
 755          end if;
 756       end loop;
 757
 758       --  If we fall through outer loop, there was no match
 759
 760       if not Quiet then
 761          Put (Standard_Error, "unrecognized ");
 762          Err;
 763          New_Line (Standard_Error);
 764       end if;
 765
 766       return null;
 767    end Matching_Name;
 768
 769    -----------------------
 770    -- OK_Alphanumerplus --
 771    -----------------------
 772
 773    function OK_Alphanumerplus (S : String) return Boolean is
 774    begin
 775       if S'Length = 0 then
 776          return False;
 777
 778       else
 779          for J in S'Range loop
 780             if not (Is_Alphanumeric (S (J)) or else
 781                     S (J) = '_' or else S (J) = '$')
 782             then
 783                return False;
 784             end if;
 785          end loop;
 786
 787          return True;
 788       end if;
 789    end OK_Alphanumerplus;
 790
 791    ----------------
 792    -- OK_Integer --
 793    ----------------
 794
 795    function OK_Integer (S : String) return Boolean is
 796    begin
 797       if S'Length = 0 then
 798          return False;
 799
 800       else
 801          for J in S'Range loop
 802             if not Is_Digit (S (J)) then
 803                return False;
 804             end if;
 805          end loop;
 806
 807          return True;
 808       end if;
 809    end OK_Integer;
 810
 811    --------------------
 812    -- Output_Version --
 813    --------------------
 814
 815    procedure Output_Version is
 816    begin
 817       if AAMP_On_Target then
 818          Put ("GNAAMP ");
 819       else
 820          Put ("GNAT ");
 821       end if;
 822
 823       Put_Line (Gnatvsn.Gnat_Version_String);
 824       Put_Line ("Copyright 1996-" &
 825                 Current_Year &
 826                 ", Free Software Foundation, Inc.");
 827    end Output_Version;
 828
 829    -----------
 830    -- Place --
 831    -----------
 832
 833    procedure Place (C : Character) is
 834    begin
 835       if Cargs then
 836          Cargs_Buffer.Append (C);
 837       else
 838          Buffer.Append (C);
 839       end if;
 840    end Place;
 841
 842    procedure Place (S : String) is
 843    begin
 844       for J in S'Range loop
 845          Place (S (J));
 846       end loop;
 847    end Place;
 848
 849    -----------------
 850    -- Place_Lower --
 851    -----------------
 852
 853    procedure Place_Lower (S : String) is
 854    begin
 855       for J in S'Range loop
 856          Place (To_Lower (S (J)));
 857       end loop;
 858    end Place_Lower;
 859
 860    -------------------------
 861    -- Place_Unix_Switches --
 862    -------------------------
 863
 864    procedure Place_Unix_Switches (S : VMS_Data.String_Ptr) is
 865       P1, P2, P3 : Natural;
 866       Remove     : Boolean;
 867       Slen, Sln2 : Natural;
 868       Wild_Card  : Boolean := False;
 869
 870    begin
 871       P1 := S'First;
 872       while P1 <= S'Last loop
 873          if S (P1) = '!' then
 874             P1 := P1 + 1;
 875             Remove := True;
 876          else
 877             Remove := False;
 878          end if;
 879
 880          P2 := P1;
 881          pragma Assert (S (P1) = '-' or else S (P1) = '`');
 882
 883          while P2 < S'Last and then S (P2 + 1) /= ',' loop
 884             P2 := P2 + 1;
 885          end loop;
 886
 887          --  Switch is now in S (P1 .. P2)
 888
 889          Slen := P2 - P1 + 1;
 890
 891          if Remove then
 892             Wild_Card := S (P2) = '*';
 893
 894             if Wild_Card then
 895                Slen := Slen - 1;
 896                P2   := P2 - 1;
 897             end if;
 898
 899             P3 := 1;
 900             while P3 <= Buffer.Last - Slen loop
 901                if Buffer.Table (P3) = ' '
 902                  and then String (Buffer.Table (P3 + 1 .. P3 + Slen)) =
 903                                                              S (P1 .. P2)
 904                  and then (Wild_Card
 905                              or else
 906                            P3 + Slen = Buffer.Last
 907                              or else
 908                            Buffer.Table (P3 + Slen + 1) = ' ')
 909                then
 910                   Sln2 := Slen;
 911
 912                   if Wild_Card then
 913                      while P3 + Sln2 /= Buffer.Last
 914                        and then Buffer.Table (P3 + Sln2 + 1) /= ' '
 915                      loop
 916                         Sln2 := Sln2 + 1;
 917                      end loop;
 918                   end if;
 919
 920                   Buffer.Table (P3 .. Buffer.Last - Sln2 - 1) :=
 921                     Buffer.Table (P3 + Sln2 + 1 .. Buffer.Last);
 922                   Buffer.Set_Last (Buffer.Last - Sln2 - 1);
 923
 924                else
 925                   P3 := P3 + 1;
 926                end if;
 927             end loop;
 928
 929             if Wild_Card then
 930                P2 := P2 + 1;
 931             end if;
 932
 933          else
 934             pragma Assert (S (P2) /= '*');
 935             Place (' ');
 936
 937             if S (P1) = '`' then
 938                P1 := P1 + 1;
 939             end if;
 940
 941             Place (S (P1 .. P2));
 942          end if;
 943
 944          P1 := P2 + 2;
 945       end loop;
 946    end Place_Unix_Switches;
 947
 948    -----------------------------
 949    -- Preprocess_Command_Data --
 950    -----------------------------
 951
 952    procedure Preprocess_Command_Data is
 953    begin
 954       for C in Real_Command_Type loop
 955          declare
 956             Command : constant Item_Ptr := new Command_Item;
 957
 958             Last_Switch : Item_Ptr;
 959             --  Last switch in list
 960
 961          begin
 962             --  Link new command item into list of commands
 963
 964             if Last_Command = null then
 965                Commands := Command;
 966             else
 967                Last_Command.Next := Command;
 968             end if;
 969
 970             Last_Command := Command;
 971
 972             --  Fill in fields of new command item
 973
 974             Command.Name    := Command_List (C).Cname;
 975             Command.Usage   := Command_List (C).Usage;
 976             Command.Command := C;
 977
 978             if Command_List (C).Unixsws = null then
 979                Command.Unix_String := Command_List (C).Unixcmd;
 980             else
 981                declare
 982                   Cmd  : String (1 .. 5_000);
 983                   Last : Natural := 0;
 984                   Sws  : constant Argument_List_Access :=
 985                            Command_List (C).Unixsws;
 986
 987                begin
 988                   Cmd (1 .. Command_List (C).Unixcmd'Length) :=
 989                     Command_List (C).Unixcmd.all;
 990                   Last := Command_List (C).Unixcmd'Length;
 991
 992                   for J in Sws'Range loop
 993                      Last := Last + 1;
 994                      Cmd (Last) := ' ';
 995                      Cmd (Last + 1 .. Last + Sws (J)'Length) :=
 996                        Sws (J).all;
 997                      Last := Last + Sws (J)'Length;
 998                   end loop;
 999
1000                   Command.Unix_String := new String'(Cmd (1 .. Last));
1001                end;
1002             end if;
1003
1004             Command.Params := Command_List (C).Params;
1005             Command.Defext := Command_List (C).Defext;
1006
1007             Validate_Command_Or_Option (Command.Name);
1008
1009             --  Process the switch list
1010
1011             for S in Command_List (C).Switches'Range loop
1012                declare
1013                   SS : constant VMS_Data.String_Ptr :=
1014                          Command_List (C).Switches (S);
1015                   P  : Natural := SS'First;
1016                   Sw : Item_Ptr := new Switch_Item;
1017
1018                   Last_Opt : Item_Ptr;
1019                   --  Pointer to last option
1020
1021                begin
1022                   --  Link new switch item into list of switches
1023
1024                   if Last_Switch = null then
1025                      Command.Switches := Sw;
1026                   else
1027                      Last_Switch.Next := Sw;
1028                   end if;
1029
1030                   Last_Switch := Sw;
1031
1032                   --  Process switch string, first get name
1033
1034                   while SS (P) /= ' ' and then SS (P) /= '=' loop
1035                      P := P + 1;
1036                   end loop;
1037
1038                   Sw.Name := new String'(SS (SS'First .. P - 1));
1039
1040                   --  Direct translation case
1041
1042                   if SS (P) = ' ' then
1043                      Sw.Translation := T_Direct;
1044                      Sw.Unix_String := new String'(SS (P + 1 .. SS'Last));
1045                      Validate_Unix_Switch (Sw.Unix_String);
1046
1047                      if SS (P - 1) = '>' then
1048                         Sw.Translation := T_Other;
1049
1050                      elsif SS (P + 1) = '`' then
1051                         null;
1052
1053                         --  Create the inverted case (/NO ..)
1054
1055                      elsif SS (SS'First + 1 .. SS'First + 2) /= "NO" then
1056                         Sw := new Switch_Item;
1057                         Last_Switch.Next := Sw;
1058                         Last_Switch := Sw;
1059
1060                         Sw.Name :=
1061                           new String'("/NO" & SS (SS'First + 1 .. P - 1));
1062                         Sw.Translation := T_Direct;
1063                         Sw.Unix_String := Invert_Sense (SS (P + 1 .. SS'Last));
1064                         Validate_Unix_Switch (Sw.Unix_String);
1065                      end if;
1066
1067                   --  Directories translation case
1068
1069                   elsif SS (P + 1) = '*' then
1070                      pragma Assert (SS (SS'Last) = '*');
1071                      Sw.Translation := T_Directories;
1072                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1073                      Validate_Unix_Switch (Sw.Unix_String);
1074
1075                   --  Directory translation case
1076
1077                   elsif SS (P + 1) = '%' then
1078                      pragma Assert (SS (SS'Last) = '%');
1079                      Sw.Translation := T_Directory;
1080                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1081                      Validate_Unix_Switch (Sw.Unix_String);
1082
1083                   --  File translation case
1084
1085                   elsif SS (P + 1) = '@' then
1086                      pragma Assert (SS (SS'Last) = '@');
1087                      Sw.Translation := T_File;
1088                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1089                      Validate_Unix_Switch (Sw.Unix_String);
1090
1091                   --  No space file translation case
1092
1093                   elsif SS (P + 1) = '<' then
1094                      pragma Assert (SS (SS'Last) = '>');
1095                      Sw.Translation := T_No_Space_File;
1096                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1097                      Validate_Unix_Switch (Sw.Unix_String);
1098
1099                   --  Numeric translation case
1100
1101                   elsif SS (P + 1) = '#' then
1102                      pragma Assert (SS (SS'Last) = '#');
1103                      Sw.Translation := T_Numeric;
1104                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1105                      Validate_Unix_Switch (Sw.Unix_String);
1106
1107                   --  Alphanumerplus translation case
1108
1109                   elsif SS (P + 1) = '|' then
1110                      pragma Assert (SS (SS'Last) = '|');
1111                      Sw.Translation := T_Alphanumplus;
1112                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1113                      Validate_Unix_Switch (Sw.Unix_String);
1114
1115                   --  String translation case
1116
1117                   elsif SS (P + 1) = '"' then
1118                      pragma Assert (SS (SS'Last) = '"');
1119                      Sw.Translation := T_String;
1120                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1121                      Validate_Unix_Switch (Sw.Unix_String);
1122
1123                   --  Commands translation case
1124
1125                   elsif SS (P + 1) = '?' then
1126                      Sw.Translation := T_Commands;
1127                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last));
1128
1129                   --  Options translation case
1130
1131                   else
1132                      Sw.Translation := T_Options;
1133                      Sw.Unix_String := new String'("");
1134
1135                      P := P + 1; -- bump past =
1136                      while P <= SS'Last loop
1137                         declare
1138                            Opt : constant Item_Ptr := new Option_Item;
1139                            Q   : Natural;
1140
1141                         begin
1142                            --  Link new option item into options list
1143
1144                            if Last_Opt = null then
1145                               Sw.Options := Opt;
1146                            else
1147                               Last_Opt.Next := Opt;
1148                            end if;
1149
1150                            Last_Opt := Opt;
1151
1152                            --  Fill in fields of new option item
1153
1154                            Q := P;
1155                            while SS (Q) /= ' ' loop
1156                               Q := Q + 1;
1157                            end loop;
1158
1159                            Opt.Name := new String'(SS (P .. Q - 1));
1160                            Validate_Command_Or_Option (Opt.Name);
1161
1162                            P := Q + 1;
1163                            Q := P;
1164
1165                            while Q <= SS'Last and then SS (Q) /= ' ' loop
1166                               Q := Q + 1;
1167                            end loop;
1168
1169                            Opt.Unix_String := new String'(SS (P .. Q - 1));
1170                            Validate_Unix_Switch (Opt.Unix_String);
1171                            P := Q + 1;
1172                         end;
1173                      end loop;
1174                   end if;
1175                end;
1176             end loop;
1177          end;
1178       end loop;
1179    end Preprocess_Command_Data;
1180
1181    ----------------------
1182    -- Process_Argument --
1183    ----------------------
1184
1185    procedure Process_Argument (The_Command : in out Command_Type) is
1186       Argv    : String_Access;
1187       Arg_Idx : Integer;
1188
1189       function Get_Arg_End
1190         (Argv    : String;
1191          Arg_Idx : Integer) return Integer;
1192       --  Begins looking at Arg_Idx + 1 and returns the index of the
1193       --  last character before a slash or else the index of the last
1194       --  character in the string Argv.
1195
1196       -----------------
1197       -- Get_Arg_End --
1198       -----------------
1199
1200       function Get_Arg_End
1201         (Argv    : String;
1202          Arg_Idx : Integer) return Integer
1203       is
1204       begin
1205          for J in Arg_Idx + 1 .. Argv'Last loop
1206             if Argv (J) = '/' then
1207                return J - 1;
1208             end if;
1209          end loop;
1210
1211          return Argv'Last;
1212       end Get_Arg_End;
1213
1214       --  Start of processing for Process_Argument
1215
1216    begin
1217       Cargs := False;
1218
1219       --  If an argument file is open, read the next non empty line
1220
1221       if Is_Open (Arg_File) then
1222          declare
1223             Line : String (1 .. 256);
1224             Last : Natural;
1225          begin
1226             loop
1227                Get_Line (Arg_File, Line, Last);
1228                exit when Last /= 0 or else End_Of_File (Arg_File);
1229             end loop;
1230
1231             --  If the end of the argument file has been reached, close it
1232
1233             if End_Of_File (Arg_File) then
1234                Close (Arg_File);
1235
1236                --  If the last line was empty, return after increasing Arg_Num
1237                --  to go to the next argument on the comment line.
1238
1239                if Last = 0 then
1240                   Arg_Num := Arg_Num + 1;
1241                   return;
1242                end if;
1243             end if;
1244
1245             Argv := new String'(Line (1 .. Last));
1246             Arg_Idx := 1;
1247
1248             if Argv (1) = '@' then
1249                Put_Line (Standard_Error, "argument file cannot contain @cmd");
1250                raise Error_Exit;
1251             end if;
1252          end;
1253
1254       else
1255          --  No argument file is open, get the argument on the command line
1256
1257          Argv := new String'(Argument (Arg_Num));
1258          Arg_Idx := Argv'First;
1259
1260          --  Check if this is the specification of an argument file
1261
1262          if Argv (Arg_Idx) = '@' then
1263             --  The first argument on the command line cannot be an argument
1264             --  file.
1265
1266             if Arg_Num = 1 then
1267                Put_Line
1268                  (Standard_Error,
1269                   "Cannot specify argument line before command");
1270                raise Error_Exit;
1271             end if;
1272
1273             --  Open the file, after conversion of the name to canonical form.
1274             --  Fail if file is not found.
1275
1276             declare
1277                Canonical_File_Name : String_Access :=
1278                  To_Canonical_File_Spec (Argv (Arg_Idx + 1 .. Argv'Last));
1279             begin
1280                Open (Arg_File, In_File, Canonical_File_Name.all);
1281                Free (Canonical_File_Name);
1282                return;
1283
1284             exception
1285                when others =>
1286                   Put (Standard_Error, "Cannot open argument file """);
1287                   Put (Standard_Error, Argv (Arg_Idx + 1 .. Argv'Last));
1288                   Put_Line (Standard_Error, """");
1289                   raise Error_Exit;
1290             end;
1291          end if;
1292       end if;
1293
1294       <<Tryagain_After_Coalesce>>
1295       loop
1296          declare
1297             Next_Arg_Idx : Integer;
1298             Arg          : String_Access;
1299
1300          begin
1301             Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
1302             Arg := new String'(Argv (Arg_Idx .. Next_Arg_Idx));
1303
1304             --  The first one must be a command name
1305
1306             if Arg_Num = 1 and then Arg_Idx = Argv'First then
1307                Command := Matching_Name (Arg.all, Commands);
1308
1309                if Command = null then
1310                   raise Error_Exit;
1311                end if;
1312
1313                The_Command := Command.Command;
1314                Output_File_Expected := False;
1315
1316                --  Give usage information if only command given
1317
1318                if Argument_Count = 1
1319                  and then Next_Arg_Idx = Argv'Last
1320                then
1321                   Output_Version;
1322                   New_Line;
1323                   Put_Line
1324                     ("List of available qualifiers and options");
1325                   New_Line;
1326
1327                   Put (Command.Usage.all);
1328                   Set_Col (53);
1329                   Put_Line (Command.Unix_String.all);
1330
1331                   declare
1332                      Sw : Item_Ptr := Command.Switches;
1333
1334                   begin
1335                      while Sw /= null loop
1336                         Put ("   ");
1337                         Put (Sw.Name.all);
1338
1339                         case Sw.Translation is
1340
1341                            when T_Other =>
1342                               Set_Col (53);
1343                               Put_Line (Sw.Unix_String.all &
1344                                         "/<other>");
1345
1346                            when T_Direct =>
1347                               Set_Col (53);
1348                               Put_Line (Sw.Unix_String.all);
1349
1350                            when T_Directories =>
1351                               Put ("=(direc,direc,..direc)");
1352                               Set_Col (53);
1353                               Put (Sw.Unix_String.all);
1354                               Put (" direc ");
1355                               Put (Sw.Unix_String.all);
1356                               Put_Line (" direc ...");
1357
1358                            when T_Directory =>
1359                               Put ("=directory");
1360                               Set_Col (53);
1361                               Put (Sw.Unix_String.all);
1362
1363                               if Sw.Unix_String (Sw.Unix_String'Last)
1364                               /= '='
1365                               then
1366                                  Put (' ');
1367                               end if;
1368
1369                               Put_Line ("directory ");
1370
1371                            when T_File | T_No_Space_File =>
1372                               Put ("=file");
1373                               Set_Col (53);
1374                               Put (Sw.Unix_String.all);
1375
1376                               if Sw.Translation = T_File
1377                                 and then Sw.Unix_String
1378                                   (Sw.Unix_String'Last) /= '='
1379                               then
1380                                  Put (' ');
1381                               end if;
1382
1383                               Put_Line ("file ");
1384
1385                            when T_Numeric =>
1386                               Put ("=nnn");
1387                               Set_Col (53);
1388
1389                               if Sw.Unix_String
1390                                 (Sw.Unix_String'First) = '`'
1391                               then
1392                                  Put (Sw.Unix_String
1393                                         (Sw.Unix_String'First + 1
1394                                          .. Sw.Unix_String'Last));
1395                               else
1396                                  Put (Sw.Unix_String.all);
1397                               end if;
1398
1399                               Put_Line ("nnn");
1400
1401                            when T_Alphanumplus =>
1402                               Put ("=xyz");
1403                               Set_Col (53);
1404
1405                               if Sw.Unix_String
1406                                 (Sw.Unix_String'First) = '`'
1407                               then
1408                                  Put (Sw.Unix_String
1409                                         (Sw.Unix_String'First + 1
1410                                          .. Sw.Unix_String'Last));
1411                               else
1412                                  Put (Sw.Unix_String.all);
1413                               end if;
1414
1415                               Put_Line ("xyz");
1416
1417                            when T_String =>
1418                               Put ("=");
1419                               Put ('"');
1420                               Put ("<string>");
1421                               Put ('"');
1422                               Set_Col (53);
1423
1424                               Put (Sw.Unix_String.all);
1425
1426                               if Sw.Unix_String
1427                                 (Sw.Unix_String'Last) /= '='
1428                               then
1429                                  Put (' ');
1430                               end if;
1431
1432                               Put ("<string>");
1433                               New_Line;
1434
1435                            when T_Commands =>
1436                               Put (" (switches for ");
1437                               Put (Sw.Unix_String
1438                                      (Sw.Unix_String'First + 7
1439                                       .. Sw.Unix_String'Last));
1440                               Put (')');
1441                               Set_Col (53);
1442                               Put (Sw.Unix_String
1443                                      (Sw.Unix_String'First
1444                                       .. Sw.Unix_String'First + 5));
1445                               Put_Line (" switches");
1446
1447                            when T_Options =>
1448                               declare
1449                                  Opt : Item_Ptr := Sw.Options;
1450
1451                               begin
1452                                  Put_Line ("=(option,option..)");
1453
1454                                  while Opt /= null loop
1455                                     Put ("      ");
1456                                     Put (Opt.Name.all);
1457
1458                                     if Opt = Sw.Options then
1459                                        Put (" (D)");
1460                                     end if;
1461
1462                                     Set_Col (53);
1463                                     Put_Line (Opt.Unix_String.all);
1464                                     Opt := Opt.Next;
1465                                  end loop;
1466                               end;
1467
1468                         end case;
1469
1470                         Sw := Sw.Next;
1471                      end loop;
1472                   end;
1473
1474                   raise Normal_Exit;
1475                end if;
1476
1477             --  Special handling for internal debugging switch /?
1478
1479             elsif Arg.all = "/?" then
1480                Display_Command := True;
1481                Output_File_Expected := False;
1482
1483             --  Special handling of internal option /KEEP_TEMPORARY_FILES
1484
1485             elsif Arg'Length >= 7
1486               and then Matching_Name
1487                          (Arg.all, Keep_Temps_Option, True) /= null
1488             then
1489                Opt.Keep_Temporary_Files := True;
1490
1491             --  Copy -switch unchanged, as well as +rule
1492
1493             elsif Arg (Arg'First) = '-' or else Arg (Arg'First) = '+' then
1494                Place (' ');
1495                Place (Arg.all);
1496
1497                --  Set Output_File_Expected for the next argument
1498
1499                Output_File_Expected :=
1500                  Arg.all = "-o" and then The_Command = Link;
1501
1502                --  Copy quoted switch with quotes stripped
1503
1504             elsif Arg (Arg'First) = '"' then
1505                if Arg (Arg'Last) /= '"' then
1506                   Put (Standard_Error, "misquoted argument: ");
1507                   Put_Line (Standard_Error, Arg.all);
1508                   Errors := Errors + 1;
1509
1510                else
1511                   Place (' ');
1512                   Place (Arg (Arg'First + 1 .. Arg'Last - 1));
1513                end if;
1514
1515                Output_File_Expected := False;
1516
1517                --  Parameter Argument
1518
1519             elsif Arg (Arg'First) /= '/'
1520               and then Make_Commands_Active = null
1521             then
1522                Param_Count := Param_Count + 1;
1523
1524                if Param_Count <= Command.Params'Length then
1525
1526                   case Command.Params (Param_Count) is
1527
1528                      when File | Optional_File =>
1529                         declare
1530                            Normal_File : constant String_Access :=
1531                              To_Canonical_File_Spec
1532                                (Arg.all);
1533
1534                         begin
1535                            Place (' ');
1536                            Place_Lower (Normal_File.all);
1537
1538                            if Is_Extensionless (Normal_File.all)
1539                              and then Command.Defext /= "   "
1540                            then
1541                               Place ('.');
1542                               Place (Command.Defext);
1543                            end if;
1544                         end;
1545
1546                      when Unlimited_Files =>
1547                         declare
1548                            Normal_File : constant String_Access :=
1549                              To_Canonical_File_Spec
1550                                (Arg.all);
1551
1552                            File_Is_Wild : Boolean := False;
1553                            File_List    : String_Access_List_Access;
1554
1555                         begin
1556                            for J in Arg'Range loop
1557                               if Arg (J) = '*'
1558                                 or else Arg (J) = '%'
1559                               then
1560                                  File_Is_Wild := True;
1561                               end if;
1562                            end loop;
1563
1564                            if File_Is_Wild then
1565                               File_List := To_Canonical_File_List
1566                                 (Arg.all, False);
1567
1568                               for J in File_List.all'Range loop
1569                                  Place (' ');
1570                                  Place_Lower (File_List.all (J).all);
1571                               end loop;
1572
1573                            else
1574                               Place (' ');
1575                               Place_Lower (Normal_File.all);
1576
1577                               --  Add extension if not present, except after
1578                               --  switch -o.
1579
1580                               if Is_Extensionless (Normal_File.all)
1581                                 and then Command.Defext /= "   "
1582                                 and then not Output_File_Expected
1583                               then
1584                                  Place ('.');
1585                                  Place (Command.Defext);
1586                               end if;
1587                            end if;
1588
1589                            Param_Count := Param_Count - 1;
1590                         end;
1591
1592                      when Other_As_Is =>
1593                         Place (' ');
1594                         Place (Arg.all);
1595
1596                      when Unlimited_As_Is =>
1597                         Place (' ');
1598                         Place (Arg.all);
1599                         Param_Count := Param_Count - 1;
1600
1601                      when Files_Or_Wildcard =>
1602
1603                         --  Remove spaces from a comma separated list
1604                         --  of file names and adjust control variables
1605                         --  accordingly.
1606
1607                         while Arg_Num < Argument_Count and then
1608                           (Argv (Argv'Last) = ',' xor
1609                              Argument (Arg_Num + 1)
1610                              (Argument (Arg_Num + 1)'First) = ',')
1611                         loop
1612                            Argv := new String'
1613                              (Argv.all & Argument (Arg_Num + 1));
1614                            Arg_Num := Arg_Num + 1;
1615                            Arg_Idx := Argv'First;
1616                            Next_Arg_Idx :=
1617                              Get_Arg_End (Argv.all, Arg_Idx);
1618                            Arg := new String'
1619                              (Argv (Arg_Idx .. Next_Arg_Idx));
1620                         end loop;
1621
1622                         --  Parse the comma separated list of VMS
1623                         --  filenames and place them on the command
1624                         --  line as space separated Unix style
1625                         --  filenames. Lower case and add default
1626                         --  extension as appropriate.
1627
1628                         declare
1629                            Arg1_Idx : Integer := Arg'First;
1630
1631                            function Get_Arg1_End
1632                              (Arg     : String;
1633                               Arg_Idx : Integer) return Integer;
1634                            --  Begins looking at Arg_Idx + 1 and
1635                            --  returns the index of the last character
1636                            --  before a comma or else the index of the
1637                            --  last character in the string Arg.
1638
1639                            ------------------
1640                            -- Get_Arg1_End --
1641                            ------------------
1642
1643                            function Get_Arg1_End
1644                              (Arg     : String;
1645                               Arg_Idx : Integer) return Integer
1646                            is
1647                            begin
1648                               for J in Arg_Idx + 1 .. Arg'Last loop
1649                                  if Arg (J) = ',' then
1650                                     return J - 1;
1651                                  end if;
1652                               end loop;
1653
1654                               return Arg'Last;
1655                            end Get_Arg1_End;
1656
1657                         begin
1658                            loop
1659                               declare
1660                                  Next_Arg1_Idx :
1661                                  constant Integer :=
1662                                    Get_Arg1_End (Arg.all, Arg1_Idx);
1663
1664                                  Arg1 :
1665                                  constant String :=
1666                                    Arg (Arg1_Idx .. Next_Arg1_Idx);
1667
1668                                  Normal_File :
1669                                  constant String_Access :=
1670                                    To_Canonical_File_Spec (Arg1);
1671
1672                               begin
1673                                  Place (' ');
1674                                  Place_Lower (Normal_File.all);
1675
1676                                  if Is_Extensionless (Normal_File.all)
1677                                    and then Command.Defext /= "   "
1678                                  then
1679                                     Place ('.');
1680                                     Place (Command.Defext);
1681                                  end if;
1682
1683                                  Arg1_Idx := Next_Arg1_Idx + 1;
1684                               end;
1685
1686                               exit when Arg1_Idx > Arg'Last;
1687
1688                               --  Don't allow two or more commas in
1689                               --  a row
1690
1691                               if Arg (Arg1_Idx) = ',' then
1692                                  Arg1_Idx := Arg1_Idx + 1;
1693                                  if Arg1_Idx > Arg'Last or else
1694                                    Arg (Arg1_Idx) = ','
1695                                  then
1696                                     Put_Line
1697                                       (Standard_Error,
1698                                        "Malformed Parameter: " &
1699                                        Arg.all);
1700                                     Put (Standard_Error, "usage: ");
1701                                     Put_Line (Standard_Error,
1702                                               Command.Usage.all);
1703                                     raise Error_Exit;
1704                                  end if;
1705                               end if;
1706
1707                            end loop;
1708                         end;
1709                   end case;
1710                end if;
1711
1712                --  Reset Output_File_Expected, in case it was True
1713
1714                Output_File_Expected := False;
1715
1716                --  Qualifier argument
1717
1718             else
1719                Output_File_Expected := False;
1720
1721                Cargs := Command.Name.all = "COMPILE";
1722
1723                --  This code is too heavily nested, should be
1724                --  separated out as separate subprogram ???
1725
1726                declare
1727                   Sw   : Item_Ptr;
1728                   SwP  : Natural;
1729                   P2   : Natural;
1730                   Endp : Natural := 0; -- avoid warning!
1731                   Opt  : Item_Ptr;
1732
1733                begin
1734                   SwP := Arg'First;
1735                   while SwP < Arg'Last
1736                     and then Arg (SwP + 1) /= '='
1737                   loop
1738                      SwP := SwP + 1;
1739                   end loop;
1740
1741                   --  At this point, the switch name is in
1742                   --  Arg (Arg'First..SwP) and if that is not the
1743                   --  whole switch, then there is an equal sign at
1744                   --  Arg (SwP + 1) and the rest of Arg is what comes
1745                   --  after the equal sign.
1746
1747                   --  If make commands are active, see if we have
1748                   --  another COMMANDS_TRANSLATION switch belonging
1749                   --  to gnatmake.
1750
1751                   if Make_Commands_Active /= null then
1752                      Sw :=
1753                        Matching_Name
1754                          (Arg (Arg'First .. SwP),
1755                           Command.Switches,
1756                           Quiet => True);
1757
1758                      if Sw /= null
1759                        and then Sw.Translation = T_Commands
1760                      then
1761                         null;
1762
1763                      else
1764                         Sw :=
1765                           Matching_Name
1766                             (Arg (Arg'First .. SwP),
1767                              Make_Commands_Active.Switches,
1768                              Quiet => False);
1769                      end if;
1770
1771                      --  For case of GNAT MAKE or CHOP, if we cannot
1772                      --  find the switch, then see if it is a
1773                      --  recognized compiler switch instead, and if
1774                      --  so process the compiler switch.
1775
1776                   elsif Command.Name.all = "MAKE"
1777                     or else Command.Name.all = "CHOP" then
1778                      Sw :=
1779                        Matching_Name
1780                          (Arg (Arg'First .. SwP),
1781                           Command.Switches,
1782                           Quiet => True);
1783
1784                      if Sw = null then
1785                         Sw :=
1786                           Matching_Name
1787                             (Arg (Arg'First .. SwP),
1788                              Matching_Name
1789                                ("COMPILE", Commands).Switches,
1790                              Quiet => False);
1791                      end if;
1792
1793                      --  For all other cases, just search the relevant
1794                      --  command.
1795
1796                   else
1797                      Sw :=
1798                        Matching_Name
1799                          (Arg (Arg'First .. SwP),
1800                           Command.Switches,
1801                           Quiet => False);
1802                   end if;
1803
1804                   if Sw /= null then
1805                      if Cargs
1806                        and then Sw.Name /= null
1807                        and then
1808                          (Sw.Name.all = "/PROJECT_FILE"          or else
1809                           Sw.Name.all = "/MESSAGES_PROJECT_FILE" or else
1810                           Sw.Name.all = "/EXTERNAL_REFERENCE")
1811                      then
1812                         Cargs := False;
1813                      end if;
1814
1815                      case Sw.Translation is
1816                         when T_Direct =>
1817                            Place_Unix_Switches (Sw.Unix_String);
1818                            if SwP < Arg'Last
1819                              and then Arg (SwP + 1) = '='
1820                            then
1821                               Put (Standard_Error,
1822                                    "qualifier options ignored: ");
1823                               Put_Line (Standard_Error, Arg.all);
1824                            end if;
1825
1826                         when T_Directories =>
1827                            if SwP + 1 > Arg'Last then
1828                               Put (Standard_Error,
1829                                    "missing directories for: ");
1830                               Put_Line (Standard_Error, Arg.all);
1831                               Errors := Errors + 1;
1832
1833                            elsif Arg (SwP + 2) /= '(' then
1834                               SwP := SwP + 2;
1835                               Endp := Arg'Last;
1836
1837                            elsif Arg (Arg'Last) /= ')' then
1838
1839                               --  Remove spaces from a comma separated
1840                               --  list of file names and adjust
1841                               --  control variables accordingly.
1842
1843                               if Arg_Num < Argument_Count and then
1844                                 (Argv (Argv'Last) = ',' xor
1845                                    Argument (Arg_Num + 1)
1846                                    (Argument (Arg_Num + 1)'First) = ',')
1847                               then
1848                                  Argv :=
1849                                    new String'(Argv.all
1850                                                & Argument
1851                                                  (Arg_Num + 1));
1852                                  Arg_Num := Arg_Num + 1;
1853                                  Arg_Idx := Argv'First;
1854                                  Next_Arg_Idx :=
1855                                    Get_Arg_End (Argv.all, Arg_Idx);
1856                                  Arg := new String'
1857                                    (Argv (Arg_Idx .. Next_Arg_Idx));
1858                                  goto Tryagain_After_Coalesce;
1859                               end if;
1860
1861                               Put (Standard_Error,
1862                                    "incorrectly parenthesized " &
1863                                    "or malformed argument: ");
1864                               Put_Line (Standard_Error, Arg.all);
1865                               Errors := Errors + 1;
1866
1867                            else
1868                               SwP := SwP + 3;
1869                               Endp := Arg'Last - 1;
1870                            end if;
1871
1872                            while SwP <= Endp loop
1873                               declare
1874                                  Dir_Is_Wild       : Boolean := False;
1875                                  Dir_Maybe_Is_Wild : Boolean := False;
1876
1877                                  Dir_List : String_Access_List_Access;
1878
1879                               begin
1880                                  P2 := SwP;
1881
1882                                  while P2 < Endp
1883                                    and then Arg (P2 + 1) /= ','
1884                                  loop
1885                                     --  A wildcard directory spec on
1886                                     --  VMS will contain either * or
1887                                     --  % or ...
1888
1889                                     if Arg (P2) = '*' then
1890                                        Dir_Is_Wild := True;
1891
1892                                     elsif Arg (P2) = '%' then
1893                                        Dir_Is_Wild := True;
1894
1895                                     elsif Dir_Maybe_Is_Wild
1896                                       and then Arg (P2) = '.'
1897                                       and then Arg (P2 + 1) = '.'
1898                                     then
1899                                        Dir_Is_Wild := True;
1900                                        Dir_Maybe_Is_Wild := False;
1901
1902                                     elsif Dir_Maybe_Is_Wild then
1903                                        Dir_Maybe_Is_Wild := False;
1904
1905                                     elsif Arg (P2) = '.'
1906                                       and then Arg (P2 + 1) = '.'
1907                                     then
1908                                        Dir_Maybe_Is_Wild := True;
1909
1910                                     end if;
1911
1912                                     P2 := P2 + 1;
1913                                  end loop;
1914
1915                                  if Dir_Is_Wild then
1916                                     Dir_List :=
1917                                       To_Canonical_File_List
1918                                         (Arg (SwP .. P2), True);
1919
1920                                     for J in Dir_List.all'Range loop
1921                                        Place_Unix_Switches
1922                                          (Sw.Unix_String);
1923                                        Place_Lower
1924                                          (Dir_List.all (J).all);
1925                                     end loop;
1926
1927                                  else
1928                                     Place_Unix_Switches
1929                                       (Sw.Unix_String);
1930                                     Place_Lower
1931                                       (To_Canonical_Dir_Spec
1932                                          (Arg (SwP .. P2), False).all);
1933                                  end if;
1934
1935                                  SwP := P2 + 2;
1936                               end;
1937                            end loop;
1938
1939                         when T_Directory =>
1940                            if SwP + 1 > Arg'Last then
1941                               Put (Standard_Error,
1942                                    "missing directory for: ");
1943                               Put_Line (Standard_Error, Arg.all);
1944                               Errors := Errors + 1;
1945
1946                            else
1947                               Place_Unix_Switches (Sw.Unix_String);
1948
1949                               --  Some switches end in "=". No space
1950                               --  here
1951
1952                               if Sw.Unix_String
1953                                 (Sw.Unix_String'Last) /= '='
1954                               then
1955                                  Place (' ');
1956                               end if;
1957
1958                               Place_Lower
1959                                 (To_Canonical_Dir_Spec
1960                                    (Arg (SwP + 2 .. Arg'Last),
1961                                     False).all);
1962                            end if;
1963
1964                         when T_File | T_No_Space_File =>
1965                            if SwP + 1 > Arg'Last then
1966                               Put (Standard_Error,
1967                                    "missing file for: ");
1968                               Put_Line (Standard_Error, Arg.all);
1969                               Errors := Errors + 1;
1970
1971                            else
1972                               Place_Unix_Switches (Sw.Unix_String);
1973
1974                               --  Some switches end in "=". No space
1975                               --  here.
1976
1977                               if Sw.Translation = T_File
1978                                 and then Sw.Unix_String
1979                                   (Sw.Unix_String'Last) /= '='
1980                               then
1981                                  Place (' ');
1982                               end if;
1983
1984                               Place_Lower
1985                                 (To_Canonical_File_Spec
1986                                    (Arg (SwP + 2 .. Arg'Last)).all);
1987                            end if;
1988
1989                         when T_Numeric =>
1990                            if OK_Integer (Arg (SwP + 2 .. Arg'Last)) then
1991                               Place_Unix_Switches (Sw.Unix_String);
1992                               Place (Arg (SwP + 2 .. Arg'Last));
1993
1994                            else
1995                               Put (Standard_Error, "argument for ");
1996                               Put (Standard_Error, Sw.Name.all);
1997                               Put_Line
1998                                 (Standard_Error, " must be numeric");
1999                               Errors := Errors + 1;
2000                            end if;
2001
2002                         when T_Alphanumplus =>
2003                            if OK_Alphanumerplus
2004                              (Arg (SwP + 2 .. Arg'Last))
2005                            then
2006                               Place_Unix_Switches (Sw.Unix_String);
2007                               Place (Arg (SwP + 2 .. Arg'Last));
2008
2009                            else
2010                               Put (Standard_Error, "argument for ");
2011                               Put (Standard_Error, Sw.Name.all);
2012                               Put_Line (Standard_Error,
2013                                         " must be alphanumeric");
2014                               Errors := Errors + 1;
2015                            end if;
2016
2017                         when T_String =>
2018
2019                            --  A String value must be extended to the
2020                            --  end of the Argv, otherwise strings like
2021                            --  "foo/bar" get split at the slash.
2022
2023                            --  The beginning and ending of the string
2024                            --  are flagged with embedded nulls which
2025                            --  are removed when building the Spawn
2026                            --  call. Nulls are use because they won't
2027                            --  show up in a /? output. Quotes aren't
2028                            --  used because that would make it
2029                            --  difficult to embed them.
2030
2031                            Place_Unix_Switches (Sw.Unix_String);
2032
2033                            if Next_Arg_Idx /= Argv'Last then
2034                               Next_Arg_Idx := Argv'Last;
2035                               Arg := new String'
2036                                 (Argv (Arg_Idx .. Next_Arg_Idx));
2037
2038                               SwP := Arg'First;
2039                               while SwP < Arg'Last and then
2040                               Arg (SwP + 1) /= '=' loop
2041                                  SwP := SwP + 1;
2042                               end loop;
2043                            end if;
2044
2045                            Place (ASCII.NUL);
2046                            Place (Arg (SwP + 2 .. Arg'Last));
2047                            Place (ASCII.NUL);
2048
2049                         when T_Commands =>
2050
2051                            --  Output -largs/-bargs/-cargs
2052
2053                            Place (' ');
2054                            Place (Sw.Unix_String
2055                                     (Sw.Unix_String'First ..
2056                                        Sw.Unix_String'First + 5));
2057
2058                            if Sw.Unix_String
2059                              (Sw.Unix_String'First + 7 ..
2060                                 Sw.Unix_String'Last) = "MAKE"
2061                            then
2062                               Make_Commands_Active := null;
2063
2064                            else
2065                               --  Set source of new commands, also
2066                               --  setting this non-null indicates that
2067                               --  we are in the special commands mode
2068                               --  for processing the -xargs case.
2069
2070                               Make_Commands_Active :=
2071                                 Matching_Name
2072                                   (Sw.Unix_String
2073                                        (Sw.Unix_String'First + 7 ..
2074                                             Sw.Unix_String'Last),
2075                                    Commands);
2076                            end if;
2077
2078                         when T_Options =>
2079                            if SwP + 1 > Arg'Last then
2080                               Place_Unix_Switches
2081                                 (Sw.Options.Unix_String);
2082                               SwP := Endp + 1;
2083
2084                            elsif Arg (SwP + 2) /= '(' then
2085                               SwP := SwP + 2;
2086                               Endp := Arg'Last;
2087
2088                            elsif Arg (Arg'Last) /= ')' then
2089                               Put (Standard_Error,
2090                                    "incorrectly parenthesized argument: ");
2091                               Put_Line (Standard_Error, Arg.all);
2092                               Errors := Errors + 1;
2093                               SwP := Endp + 1;
2094
2095                            else
2096                               SwP := SwP + 3;
2097                               Endp := Arg'Last - 1;
2098                            end if;
2099
2100                            while SwP <= Endp loop
2101                               P2 := SwP;
2102
2103                               while P2 < Endp
2104                                 and then Arg (P2 + 1) /= ','
2105                               loop
2106                                  P2 := P2 + 1;
2107                               end loop;
2108
2109                               --  Option name is in Arg (SwP .. P2)
2110
2111                               Opt := Matching_Name (Arg (SwP .. P2),
2112                                                     Sw.Options);
2113
2114                               if Opt /= null then
2115                                  Place_Unix_Switches
2116                                    (Opt.Unix_String);
2117                               end if;
2118
2119                               SwP := P2 + 2;
2120                            end loop;
2121
2122                         when T_Other =>
2123                            Place_Unix_Switches
2124                              (new String'(Sw.Unix_String.all &
2125                                           Arg.all));
2126
2127                      end case;
2128                   end if;
2129                end;
2130             end if;
2131
2132             Arg_Idx := Next_Arg_Idx + 1;
2133          end;
2134
2135          exit when Arg_Idx > Argv'Last;
2136
2137       end loop;
2138
2139       if not Is_Open (Arg_File) then
2140          Arg_Num := Arg_Num + 1;
2141       end if;
2142    end Process_Argument;
2143
2144    --------------------
2145    -- Process_Buffer --
2146    --------------------
2147
2148    procedure Process_Buffer (S : String) is
2149       P1, P2     : Natural;
2150       Inside_Nul : Boolean := False;
2151       Arg        : String (1 .. 1024);
2152       Arg_Ctr    : Natural;
2153
2154    begin
2155       P1 := 1;
2156       while P1 <= S'Last and then S (P1) = ' ' loop
2157          P1 := P1 + 1;
2158       end loop;
2159
2160       Arg_Ctr := 1;
2161       Arg (Arg_Ctr) := S (P1);
2162
2163       while P1 <= S'Last loop
2164          if S (P1) = ASCII.NUL then
2165             if Inside_Nul then
2166                Inside_Nul := False;
2167             else
2168                Inside_Nul := True;
2169             end if;
2170          end if;
2171
2172          if S (P1) = ' ' and then not Inside_Nul then
2173             P1 := P1 + 1;
2174             Arg_Ctr := Arg_Ctr + 1;
2175             Arg (Arg_Ctr) := S (P1);
2176
2177          else
2178             Last_Switches.Increment_Last;
2179             P2 := P1;
2180
2181             while P2 < S'Last
2182               and then (S (P2 + 1) /= ' ' or else
2183                         Inside_Nul)
2184             loop
2185                P2 := P2 + 1;
2186                Arg_Ctr := Arg_Ctr + 1;
2187                Arg (Arg_Ctr) := S (P2);
2188                if S (P2) = ASCII.NUL then
2189                   Arg_Ctr := Arg_Ctr - 1;
2190
2191                   if Inside_Nul then
2192                      Inside_Nul := False;
2193                   else
2194                      Inside_Nul := True;
2195                   end if;
2196                end if;
2197             end loop;
2198
2199             Last_Switches.Table (Last_Switches.Last) :=
2200               new String'(String (Arg (1 .. Arg_Ctr)));
2201             P1 := P2 + 2;
2202
2203             exit when P1 > S'Last;
2204
2205             Arg_Ctr := 1;
2206             Arg (Arg_Ctr) := S (P1);
2207          end if;
2208       end loop;
2209    end Process_Buffer;
2210
2211    --------------------------------
2212    -- Validate_Command_Or_Option --
2213    --------------------------------
2214
2215    procedure Validate_Command_Or_Option (N : VMS_Data.String_Ptr) is
2216    begin
2217       pragma Assert (N'Length > 0);
2218
2219       for J in N'Range loop
2220          if N (J) = '_' then
2221             pragma Assert (N (J - 1) /= '_');
2222             null;
2223          else
2224             pragma Assert (Is_Upper (N (J)) or else Is_Digit (N (J)));
2225             null;
2226          end if;
2227       end loop;
2228    end Validate_Command_Or_Option;
2229
2230    --------------------------
2231    -- Validate_Unix_Switch --
2232    --------------------------
2233
2234    procedure Validate_Unix_Switch (S : VMS_Data.String_Ptr) is
2235    begin
2236       if S (S'First) = '`' then
2237          return;
2238       end if;
2239
2240       pragma Assert (S (S'First) = '-' or else S (S'First) = '!');
2241
2242       for J in S'First + 1 .. S'Last loop
2243          pragma Assert (S (J) /= ' ');
2244
2245          if S (J) = '!' then
2246             pragma Assert (S (J - 1) = ',' and then S (J + 1) = '-');
2247             null;
2248          end if;
2249       end loop;
2250    end Validate_Unix_Switch;
2251
2252    --------------------
2253    -- VMS_Conversion --
2254    --------------------
2255
2256    procedure VMS_Conversion (The_Command : out Command_Type) is
2257       Result     : Command_Type := Undefined;
2258       Result_Set : Boolean      := False;
2259
2260    begin
2261       Buffer.Init;
2262
2263       --  First we must preprocess the string form of the command and options
2264       --  list into the internal form that we use.
2265
2266       Preprocess_Command_Data;
2267
2268       --  If no parameters, give complete list of commands
2269
2270       if Argument_Count = 0 then
2271          Output_Version;
2272          New_Line;
2273          Put_Line ("List of available commands");
2274          New_Line;
2275
2276          while Commands /= null loop
2277             Put (Commands.Usage.all);
2278             Set_Col (53);
2279             Put_Line (Commands.Unix_String.all);
2280             Commands := Commands.Next;
2281          end loop;
2282
2283          raise Normal_Exit;
2284       end if;
2285
2286       --  Loop through arguments
2287
2288       Arg_Num := 1;
2289       while Arg_Num <= Argument_Count loop
2290          Process_Argument (Result);
2291
2292          if not Result_Set then
2293             The_Command := Result;
2294             Result_Set := True;
2295          end if;
2296       end loop;
2297
2298       --  Gross error checking that the number of parameters is correct.
2299       --  Not applicable to Unlimited_Files parameters.
2300
2301       if (Param_Count = Command.Params'Length - 1
2302             and then Command.Params (Param_Count + 1) = Unlimited_Files)
2303         or else Param_Count <= Command.Params'Length
2304       then
2305          null;
2306
2307       else
2308          Put_Line (Standard_Error,
2309                    "Parameter count of "
2310                    & Integer'Image (Param_Count)
2311                    & " not equal to expected "
2312                    & Integer'Image (Command.Params'Length));
2313          Put (Standard_Error, "usage: ");
2314          Put_Line (Standard_Error, Command.Usage.all);
2315          Errors := Errors + 1;
2316       end if;
2317
2318       if Errors > 0 then
2319          raise Error_Exit;
2320       else
2321          --  Prepare arguments for a call to spawn, filtering out
2322          --  embedded nulls place there to delineate strings.
2323
2324          Process_Buffer (String (Buffer.Table (1 .. Buffer.Last)));
2325
2326          if Cargs_Buffer.Last > 1 then
2327             Last_Switches.Append (new String'("-cargs"));
2328             Process_Buffer
2329               (String (Cargs_Buffer.Table (1 .. Cargs_Buffer.Last)));
2330          end if;
2331       end if;
2332    end VMS_Conversion;
2333
2334 end VMS_Conv;