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-2007, 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 qualifers 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 appropriatelly. 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          Elim =>
 401            (Cname    => new S'("ELIM"),
 402             Usage    => new S'("GNAT ELIM name /qualifiers"),
 403             VMS_Only => False,
 404             Unixcmd  => new S'("gnatelim"),
 405             Unixsws  => null,
 406             Switches => Elim_Switches'Access,
 407             Params   => new Parameter_Array'(1 => Other_As_Is),
 408             Defext   => "ali"),
 409
 410          Find =>
 411            (Cname    => new S'("FIND"),
 412             Usage    => new S'("GNAT FIND pattern[:sourcefile[:line"
 413                                & "[:column]]] filespec[,...] /qualifiers"),
 414             VMS_Only => False,
 415             Unixcmd  => new S'("gnatfind"),
 416             Unixsws  => null,
 417             Switches => Find_Switches'Access,
 418             Params   => new Parameter_Array'(1 => Other_As_Is,
 419                                              2 => Files_Or_Wildcard),
 420             Defext   => "ali"),
 421
 422          Krunch =>
 423            (Cname    => new S'("KRUNCH"),
 424             Usage    => new S'("GNAT KRUNCH file [/COUNT=nnn]"),
 425             VMS_Only => False,
 426             Unixcmd  => new S'("gnatkr"),
 427             Unixsws  => null,
 428             Switches => Krunch_Switches'Access,
 429             Params   => new Parameter_Array'(1 => File),
 430             Defext   => "   "),
 431
 432          Link =>
 433            (Cname    => new S'("LINK"),
 434             Usage    => new S'("GNAT LINK file[.ali]"
 435                                & " [extra obj_&_lib_&_exe_&_opt files]"
 436                                & " /qualifiers"),
 437             VMS_Only => False,
 438             Unixcmd  => new S'("gnatlink"),
 439             Unixsws  => null,
 440             Switches => Link_Switches'Access,
 441             Params   => new Parameter_Array'(1 => Unlimited_Files),
 442             Defext   => "ali"),
 443
 444          List =>
 445            (Cname    => new S'("LIST"),
 446             Usage    => new S'("GNAT LIST /qualifiers object_or_ali_file"),
 447             VMS_Only => False,
 448             Unixcmd  => new S'("gnatls"),
 449             Unixsws  => null,
 450             Switches => List_Switches'Access,
 451             Params   => new Parameter_Array'(1 => Unlimited_Files),
 452             Defext   => "ali"),
 453
 454          Make =>
 455            (Cname    => new S'("MAKE"),
 456             Usage    => new S'("GNAT MAKE file(s) /qualifiers (includes "
 457                                & "COMPILE /qualifiers)"),
 458             VMS_Only => False,
 459             Unixcmd  => new S'("gnatmake"),
 460             Unixsws  => null,
 461             Switches => Make_Switches'Access,
 462             Params   => new Parameter_Array'(1 => Unlimited_Files),
 463             Defext   => "   "),
 464
 465          Metric =>
 466            (Cname    => new S'("METRIC"),
 467             Usage    => new S'("GNAT METRIC /qualifiers source_file"),
 468             VMS_Only => False,
 469             Unixcmd  => new S'("gnatmetric"),
 470             Unixsws  => null,
 471             Switches => Metric_Switches'Access,
 472             Params   => new Parameter_Array'(1 => Unlimited_Files),
 473             Defext   => "   "),
 474
 475          Name =>
 476            (Cname    => new S'("NAME"),
 477             Usage    => new S'("GNAT NAME /qualifiers naming-pattern "
 478                                & "[naming-patterns]"),
 479             VMS_Only => False,
 480             Unixcmd  => new S'("gnatname"),
 481             Unixsws  => null,
 482             Switches => Name_Switches'Access,
 483             Params   => new Parameter_Array'(1 => Unlimited_As_Is),
 484             Defext   => "   "),
 485
 486          Preprocess =>
 487            (Cname    => new S'("PREPROCESS"),
 488             Usage    =>
 489               new S'("GNAT PREPROCESS ifile ofile dfile /qualifiers"),
 490             VMS_Only => False,
 491             Unixcmd  => new S'("gnatprep"),
 492             Unixsws  => null,
 493             Switches => Prep_Switches'Access,
 494             Params   => new Parameter_Array'(1 .. 3 => File),
 495             Defext   => "   "),
 496
 497          Pretty =>
 498            (Cname    => new S'("PRETTY"),
 499             Usage    => new S'("GNAT PRETTY /qualifiers source_file"),
 500             VMS_Only => False,
 501             Unixcmd  => new S'("gnatpp"),
 502             Unixsws  => null,
 503             Switches => Pretty_Switches'Access,
 504             Params   => new Parameter_Array'(1 => Unlimited_Files),
 505             Defext   => "   "),
 506
 507          Shared =>
 508            (Cname    => new S'("SHARED"),
 509             Usage    => new S'("GNAT SHARED [obj_&_lib_&_exe_&_opt"
 510                                & "files] /qualifiers"),
 511             VMS_Only => True,
 512             Unixcmd  => new S'("gcc"),
 513             Unixsws  =>
 514             new Argument_List'(new String'("-shared") & Init_Object_Dirs),
 515             Switches => Shared_Switches'Access,
 516             Params   => new Parameter_Array'(1 => Unlimited_Files),
 517             Defext   => "   "),
 518
 519          Stack =>
 520            (Cname    => new S'("STACK"),
 521             Usage    => new S'("GNAT STACK /qualifiers ci_files"),
 522             VMS_Only => False,
 523             Unixcmd  => new S'("gnatstack"),
 524             Unixsws  => null,
 525             Switches => Stack_Switches'Access,
 526             Params   => new Parameter_Array'(1 => Unlimited_Files),
 527             Defext   => "ci" & ASCII.NUL),
 528
 529          Stub =>
 530            (Cname    => new S'("STUB"),
 531             Usage    => new S'("GNAT STUB file [directory]/qualifiers"),
 532             VMS_Only => False,
 533             Unixcmd  => new S'("gnatstub"),
 534             Unixsws  => null,
 535             Switches => Stub_Switches'Access,
 536             Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
 537             Defext   => "   "),
 538
 539          Xref =>
 540            (Cname    => new S'("XREF"),
 541             Usage    => new S'("GNAT XREF filespec[,...] /qualifiers"),
 542             VMS_Only => False,
 543             Unixcmd  => new S'("gnatxref"),
 544             Unixsws  => null,
 545             Switches => Xref_Switches'Access,
 546             Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
 547             Defext   => "ali")
 548         );
 549    end Initialize;
 550
 551    ------------------
 552    -- Invert_Sense --
 553    ------------------
 554
 555    function Invert_Sense (S : String) return VMS_Data.String_Ptr is
 556       Sinv : String (1 .. S'Length * 2);
 557       --  Result (for sure long enough)
 558
 559       Sinvp : Natural := 0;
 560       --  Pointer to output string
 561
 562    begin
 563       for Sp in S'Range loop
 564          if Sp = S'First or else S (Sp - 1) = ',' then
 565             if S (Sp) = '!' then
 566                null;
 567             else
 568                Sinv (Sinvp + 1) := '!';
 569                Sinv (Sinvp + 2) := S (Sp);
 570                Sinvp := Sinvp + 2;
 571             end if;
 572
 573          else
 574             Sinv (Sinvp + 1) := S (Sp);
 575             Sinvp := Sinvp + 1;
 576          end if;
 577       end loop;
 578
 579       return new String'(Sinv (1 .. Sinvp));
 580    end Invert_Sense;
 581
 582    ----------------------
 583    -- Is_Extensionless --
 584    ----------------------
 585
 586    function Is_Extensionless (F : String) return Boolean is
 587    begin
 588       for J in reverse F'Range loop
 589          if F (J) = '.' then
 590             return False;
 591          elsif F (J) = '/' or else F (J) = ']' or else F (J) = ':' then
 592             return True;
 593          end if;
 594       end loop;
 595
 596       return True;
 597    end Is_Extensionless;
 598
 599    -----------
 600    -- Match --
 601    -----------
 602
 603    function Match (S1, S2 : String) return Boolean is
 604       Dif : constant Integer := S2'First - S1'First;
 605
 606    begin
 607
 608       if S1'Length /= S2'Length then
 609          return False;
 610
 611       else
 612          for J in S1'Range loop
 613             if To_Lower (S1 (J)) /= To_Lower (S2 (J + Dif)) then
 614                return False;
 615             end if;
 616          end loop;
 617
 618          return True;
 619       end if;
 620    end Match;
 621
 622    ------------------
 623    -- Match_Prefix --
 624    ------------------
 625
 626    function Match_Prefix (S1, S2 : String) return Boolean is
 627    begin
 628       if S1'Length > S2'Length then
 629          return False;
 630       else
 631          return Match (S1, S2 (S2'First .. S2'First + S1'Length - 1));
 632       end if;
 633    end Match_Prefix;
 634
 635    -------------------
 636    -- Matching_Name --
 637    -------------------
 638
 639    function Matching_Name
 640      (S     : String;
 641       Itm   : Item_Ptr;
 642       Quiet : Boolean := False) return Item_Ptr
 643    is
 644       P1, P2 : Item_Ptr;
 645
 646       procedure Err;
 647       --  Little procedure to output command/qualifier/option as appropriate
 648       --  and bump error count.
 649
 650       ---------
 651       -- Err --
 652       ---------
 653
 654       procedure Err is
 655       begin
 656          if Quiet then
 657             return;
 658          end if;
 659
 660          Errors := Errors + 1;
 661
 662          if Itm /= null then
 663             case Itm.Id is
 664                when Id_Command =>
 665                   Put (Standard_Error, "command");
 666
 667                when Id_Switch =>
 668                   if Hostparm.OpenVMS then
 669                      Put (Standard_Error, "qualifier");
 670                   else
 671                      Put (Standard_Error, "switch");
 672                   end if;
 673
 674                when Id_Option =>
 675                   Put (Standard_Error, "option");
 676
 677             end case;
 678          else
 679             Put (Standard_Error, "input");
 680
 681          end if;
 682
 683          Put (Standard_Error, ": ");
 684          Put (Standard_Error, S);
 685       end Err;
 686
 687    --  Start of processing for Matching_Name
 688
 689    begin
 690       --  If exact match, that's the one we want
 691
 692       P1 := Itm;
 693       while P1 /= null loop
 694          if Match (S, P1.Name.all) then
 695             return P1;
 696          else
 697             P1 := P1.Next;
 698          end if;
 699       end loop;
 700
 701       --  Now check for prefix matches
 702
 703       P1 := Itm;
 704       while P1 /= null loop
 705          if P1.Name.all = "/<other>" then
 706             return P1;
 707
 708          elsif not Match_Prefix (S, P1.Name.all) then
 709             P1 := P1.Next;
 710
 711          else
 712             --  Here we have found one matching prefix, so see if there is
 713             --  another one (which is an ambiguity)
 714
 715             P2 := P1.Next;
 716             while P2 /= null loop
 717                if Match_Prefix (S, P2.Name.all) then
 718                   if not Quiet then
 719                      Put (Standard_Error, "ambiguous ");
 720                      Err;
 721                      Put (Standard_Error, " (matches ");
 722                      Put (Standard_Error, P1.Name.all);
 723
 724                      while P2 /= null loop
 725                         if Match_Prefix (S, P2.Name.all) then
 726                            Put (Standard_Error, ',');
 727                            Put (Standard_Error, P2.Name.all);
 728                         end if;
 729
 730                         P2 := P2.Next;
 731                      end loop;
 732
 733                      Put_Line (Standard_Error, ")");
 734                   end if;
 735
 736                   return null;
 737                end if;
 738
 739                P2 := P2.Next;
 740             end loop;
 741
 742             --  If we fall through that loop, then there was only one match
 743
 744             return P1;
 745          end if;
 746       end loop;
 747
 748       --  If we fall through outer loop, there was no match
 749
 750       if not Quiet then
 751          Put (Standard_Error, "unrecognized ");
 752          Err;
 753          New_Line (Standard_Error);
 754       end if;
 755
 756       return null;
 757    end Matching_Name;
 758
 759    -----------------------
 760    -- OK_Alphanumerplus --
 761    -----------------------
 762
 763    function OK_Alphanumerplus (S : String) return Boolean is
 764    begin
 765       if S'Length = 0 then
 766          return False;
 767
 768       else
 769          for J in S'Range loop
 770             if not (Is_Alphanumeric (S (J)) or else
 771                     S (J) = '_' or else S (J) = '$')
 772             then
 773                return False;
 774             end if;
 775          end loop;
 776
 777          return True;
 778       end if;
 779    end OK_Alphanumerplus;
 780
 781    ----------------
 782    -- OK_Integer --
 783    ----------------
 784
 785    function OK_Integer (S : String) return Boolean is
 786    begin
 787       if S'Length = 0 then
 788          return False;
 789
 790       else
 791          for J in S'Range loop
 792             if not Is_Digit (S (J)) then
 793                return False;
 794             end if;
 795          end loop;
 796
 797          return True;
 798       end if;
 799    end OK_Integer;
 800
 801    --------------------
 802    -- Output_Version --
 803    --------------------
 804
 805    procedure Output_Version is
 806    begin
 807       Put ("GNAT ");
 808       Put_Line (Gnatvsn.Gnat_Version_String);
 809       Put_Line ("Copyright 1996-" &
 810                 Current_Year &
 811                 ", Free Software Foundation, Inc.");
 812    end Output_Version;
 813
 814    -----------
 815    -- Place --
 816    -----------
 817
 818    procedure Place (C : Character) is
 819    begin
 820       if Cargs then
 821          Cargs_Buffer.Append (C);
 822       else
 823          Buffer.Append (C);
 824       end if;
 825    end Place;
 826
 827    procedure Place (S : String) is
 828    begin
 829       for J in S'Range loop
 830          Place (S (J));
 831       end loop;
 832    end Place;
 833
 834    -----------------
 835    -- Place_Lower --
 836    -----------------
 837
 838    procedure Place_Lower (S : String) is
 839    begin
 840       for J in S'Range loop
 841          Place (To_Lower (S (J)));
 842       end loop;
 843    end Place_Lower;
 844
 845    -------------------------
 846    -- Place_Unix_Switches --
 847    -------------------------
 848
 849    procedure Place_Unix_Switches (S : VMS_Data.String_Ptr) is
 850       P1, P2, P3 : Natural;
 851       Remove     : Boolean;
 852       Slen, Sln2 : Natural;
 853       Wild_Card  : Boolean := False;
 854
 855    begin
 856       P1 := S'First;
 857       while P1 <= S'Last loop
 858          if S (P1) = '!' then
 859             P1 := P1 + 1;
 860             Remove := True;
 861          else
 862             Remove := False;
 863          end if;
 864
 865          P2 := P1;
 866          pragma Assert (S (P1) = '-' or else S (P1) = '`');
 867
 868          while P2 < S'Last and then S (P2 + 1) /= ',' loop
 869             P2 := P2 + 1;
 870          end loop;
 871
 872          --  Switch is now in S (P1 .. P2)
 873
 874          Slen := P2 - P1 + 1;
 875
 876          if Remove then
 877             Wild_Card := S (P2) = '*';
 878
 879             if Wild_Card then
 880                Slen := Slen - 1;
 881                P2   := P2 - 1;
 882             end if;
 883
 884             P3 := 1;
 885             while P3 <= Buffer.Last - Slen loop
 886                if Buffer.Table (P3) = ' '
 887                  and then String (Buffer.Table (P3 + 1 .. P3 + Slen)) =
 888                                                              S (P1 .. P2)
 889                  and then (Wild_Card
 890                              or else
 891                            P3 + Slen = Buffer.Last
 892                              or else
 893                            Buffer.Table (P3 + Slen + 1) = ' ')
 894                then
 895                   Sln2 := Slen;
 896
 897                   if Wild_Card then
 898                      while P3 + Sln2 /= Buffer.Last
 899                        and then Buffer.Table (P3 + Sln2 + 1) /= ' '
 900                      loop
 901                         Sln2 := Sln2 + 1;
 902                      end loop;
 903                   end if;
 904
 905                   Buffer.Table (P3 .. Buffer.Last - Sln2 - 1) :=
 906                     Buffer.Table (P3 + Sln2 + 1 .. Buffer.Last);
 907                   Buffer.Set_Last (Buffer.Last - Sln2 - 1);
 908
 909                else
 910                   P3 := P3 + 1;
 911                end if;
 912             end loop;
 913
 914             if Wild_Card then
 915                P2 := P2 + 1;
 916             end if;
 917
 918          else
 919             pragma Assert (S (P2) /= '*');
 920             Place (' ');
 921
 922             if S (P1) = '`' then
 923                P1 := P1 + 1;
 924             end if;
 925
 926             Place (S (P1 .. P2));
 927          end if;
 928
 929          P1 := P2 + 2;
 930       end loop;
 931    end Place_Unix_Switches;
 932
 933    -----------------------------
 934    -- Preprocess_Command_Data --
 935    -----------------------------
 936
 937    procedure Preprocess_Command_Data is
 938    begin
 939       for C in Real_Command_Type loop
 940          declare
 941             Command : constant Item_Ptr := new Command_Item;
 942
 943             Last_Switch : Item_Ptr;
 944             --  Last switch in list
 945
 946          begin
 947             --  Link new command item into list of commands
 948
 949             if Last_Command = null then
 950                Commands := Command;
 951             else
 952                Last_Command.Next := Command;
 953             end if;
 954
 955             Last_Command := Command;
 956
 957             --  Fill in fields of new command item
 958
 959             Command.Name    := Command_List (C).Cname;
 960             Command.Usage   := Command_List (C).Usage;
 961             Command.Command := C;
 962
 963             if Command_List (C).Unixsws = null then
 964                Command.Unix_String := Command_List (C).Unixcmd;
 965             else
 966                declare
 967                   Cmd  : String (1 .. 5_000);
 968                   Last : Natural := 0;
 969                   Sws  : constant Argument_List_Access :=
 970                            Command_List (C).Unixsws;
 971
 972                begin
 973                   Cmd (1 .. Command_List (C).Unixcmd'Length) :=
 974                     Command_List (C).Unixcmd.all;
 975                   Last := Command_List (C).Unixcmd'Length;
 976
 977                   for J in Sws'Range loop
 978                      Last := Last + 1;
 979                      Cmd (Last) := ' ';
 980                      Cmd (Last + 1 .. Last + Sws (J)'Length) :=
 981                        Sws (J).all;
 982                      Last := Last + Sws (J)'Length;
 983                   end loop;
 984
 985                   Command.Unix_String := new String'(Cmd (1 .. Last));
 986                end;
 987             end if;
 988
 989             Command.Params := Command_List (C).Params;
 990             Command.Defext := Command_List (C).Defext;
 991
 992             Validate_Command_Or_Option (Command.Name);
 993
 994             --  Process the switch list
 995
 996             for S in Command_List (C).Switches'Range loop
 997                declare
 998                   SS : constant VMS_Data.String_Ptr :=
 999                          Command_List (C).Switches (S);
1000                   P  : Natural := SS'First;
1001                   Sw : Item_Ptr := new Switch_Item;
1002
1003                   Last_Opt : Item_Ptr;
1004                   --  Pointer to last option
1005
1006                begin
1007                   --  Link new switch item into list of switches
1008
1009                   if Last_Switch = null then
1010                      Command.Switches := Sw;
1011                   else
1012                      Last_Switch.Next := Sw;
1013                   end if;
1014
1015                   Last_Switch := Sw;
1016
1017                   --  Process switch string, first get name
1018
1019                   while SS (P) /= ' ' and SS (P) /= '=' loop
1020                      P := P + 1;
1021                   end loop;
1022
1023                   Sw.Name := new String'(SS (SS'First .. P - 1));
1024
1025                   --  Direct translation case
1026
1027                   if SS (P) = ' ' then
1028                      Sw.Translation := T_Direct;
1029                      Sw.Unix_String := new String'(SS (P + 1 .. SS'Last));
1030                      Validate_Unix_Switch (Sw.Unix_String);
1031
1032                      if SS (P - 1) = '>' then
1033                         Sw.Translation := T_Other;
1034
1035                      elsif SS (P + 1) = '`' then
1036                         null;
1037
1038                         --  Create the inverted case (/NO ..)
1039
1040                      elsif SS (SS'First + 1 .. SS'First + 2) /= "NO" then
1041                         Sw := new Switch_Item;
1042                         Last_Switch.Next := Sw;
1043                         Last_Switch := Sw;
1044
1045                         Sw.Name :=
1046                           new String'("/NO" & SS (SS'First + 1 .. P - 1));
1047                         Sw.Translation := T_Direct;
1048                         Sw.Unix_String := Invert_Sense (SS (P + 1 .. SS'Last));
1049                         Validate_Unix_Switch (Sw.Unix_String);
1050                      end if;
1051
1052                   --  Directories translation case
1053
1054                   elsif SS (P + 1) = '*' then
1055                      pragma Assert (SS (SS'Last) = '*');
1056                      Sw.Translation := T_Directories;
1057                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1058                      Validate_Unix_Switch (Sw.Unix_String);
1059
1060                   --  Directory translation case
1061
1062                   elsif SS (P + 1) = '%' then
1063                      pragma Assert (SS (SS'Last) = '%');
1064                      Sw.Translation := T_Directory;
1065                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1066                      Validate_Unix_Switch (Sw.Unix_String);
1067
1068                   --  File translation case
1069
1070                   elsif SS (P + 1) = '@' then
1071                      pragma Assert (SS (SS'Last) = '@');
1072                      Sw.Translation := T_File;
1073                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1074                      Validate_Unix_Switch (Sw.Unix_String);
1075
1076                   --  No space file translation case
1077
1078                   elsif SS (P + 1) = '<' then
1079                      pragma Assert (SS (SS'Last) = '>');
1080                      Sw.Translation := T_No_Space_File;
1081                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1082                      Validate_Unix_Switch (Sw.Unix_String);
1083
1084                   --  Numeric translation case
1085
1086                   elsif SS (P + 1) = '#' then
1087                      pragma Assert (SS (SS'Last) = '#');
1088                      Sw.Translation := T_Numeric;
1089                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1090                      Validate_Unix_Switch (Sw.Unix_String);
1091
1092                   --  Alphanumerplus translation case
1093
1094                   elsif SS (P + 1) = '|' then
1095                      pragma Assert (SS (SS'Last) = '|');
1096                      Sw.Translation := T_Alphanumplus;
1097                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1098                      Validate_Unix_Switch (Sw.Unix_String);
1099
1100                   --  String translation case
1101
1102                   elsif SS (P + 1) = '"' then
1103                      pragma Assert (SS (SS'Last) = '"');
1104                      Sw.Translation := T_String;
1105                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
1106                      Validate_Unix_Switch (Sw.Unix_String);
1107
1108                   --  Commands translation case
1109
1110                   elsif SS (P + 1) = '?' then
1111                      Sw.Translation := T_Commands;
1112                      Sw.Unix_String := new String'(SS (P + 2 .. SS'Last));
1113
1114                   --  Options translation case
1115
1116                   else
1117                      Sw.Translation := T_Options;
1118                      Sw.Unix_String := new String'("");
1119
1120                      P := P + 1; -- bump past =
1121                      while P <= SS'Last loop
1122                         declare
1123                            Opt : constant Item_Ptr := new Option_Item;
1124                            Q   : Natural;
1125
1126                         begin
1127                            --  Link new option item into options list
1128
1129                            if Last_Opt = null then
1130                               Sw.Options := Opt;
1131                            else
1132                               Last_Opt.Next := Opt;
1133                            end if;
1134
1135                            Last_Opt := Opt;
1136
1137                            --  Fill in fields of new option item
1138
1139                            Q := P;
1140                            while SS (Q) /= ' ' loop
1141                               Q := Q + 1;
1142                            end loop;
1143
1144                            Opt.Name := new String'(SS (P .. Q - 1));
1145                            Validate_Command_Or_Option (Opt.Name);
1146
1147                            P := Q + 1;
1148                            Q := P;
1149
1150                            while Q <= SS'Last and then SS (Q) /= ' ' loop
1151                               Q := Q + 1;
1152                            end loop;
1153
1154                            Opt.Unix_String := new String'(SS (P .. Q - 1));
1155                            Validate_Unix_Switch (Opt.Unix_String);
1156                            P := Q + 1;
1157                         end;
1158                      end loop;
1159                   end if;
1160                end;
1161             end loop;
1162          end;
1163       end loop;
1164    end Preprocess_Command_Data;
1165
1166    ----------------------
1167    -- Process_Argument --
1168    ----------------------
1169
1170    procedure Process_Argument (The_Command : in out Command_Type) is
1171       Argv    : String_Access;
1172       Arg_Idx : Integer;
1173
1174       function Get_Arg_End
1175         (Argv    : String;
1176          Arg_Idx : Integer) return Integer;
1177       --  Begins looking at Arg_Idx + 1 and returns the index of the
1178       --  last character before a slash or else the index of the last
1179       --  character in the string Argv.
1180
1181       -----------------
1182       -- Get_Arg_End --
1183       -----------------
1184
1185       function Get_Arg_End
1186         (Argv    : String;
1187          Arg_Idx : Integer) return Integer
1188       is
1189       begin
1190          for J in Arg_Idx + 1 .. Argv'Last loop
1191             if Argv (J) = '/' then
1192                return J - 1;
1193             end if;
1194          end loop;
1195
1196          return Argv'Last;
1197       end Get_Arg_End;
1198
1199       --  Start of processing for Process_Argument
1200
1201    begin
1202       Cargs := False;
1203
1204       --  If an argument file is open, read the next non empty line
1205
1206       if Is_Open (Arg_File) then
1207          declare
1208             Line : String (1 .. 256);
1209             Last : Natural;
1210          begin
1211             loop
1212                Get_Line (Arg_File, Line, Last);
1213                exit when Last /= 0 or else End_Of_File (Arg_File);
1214             end loop;
1215
1216             --  If the end of the argument file has been reached, close it
1217
1218             if End_Of_File (Arg_File) then
1219                Close (Arg_File);
1220
1221                --  If the last line was empty, return after increasing Arg_Num
1222                --  to go to the next argument on the comment line.
1223
1224                if Last = 0 then
1225                   Arg_Num := Arg_Num + 1;
1226                   return;
1227                end if;
1228             end if;
1229
1230             Argv := new String'(Line (1 .. Last));
1231             Arg_Idx := 1;
1232
1233             if Argv (1) = '@' then
1234                Put_Line (Standard_Error, "argument file cannot contain @cmd");
1235                raise Error_Exit;
1236             end if;
1237          end;
1238
1239       else
1240          --  No argument file is open, get the argument on the command line
1241
1242          Argv := new String'(Argument (Arg_Num));
1243          Arg_Idx := Argv'First;
1244
1245          --  Check if this is the specification of an argument file
1246
1247          if Argv (Arg_Idx) = '@' then
1248             --  The first argument on the command line cannot be an argument
1249             --  file.
1250
1251             if Arg_Num = 1 then
1252                Put_Line
1253                  (Standard_Error,
1254                   "Cannot specify argument line before command");
1255                raise Error_Exit;
1256             end if;
1257
1258             --  Open the file, after conversion of the name to canonical form.
1259             --  Fail if file is not found.
1260
1261             declare
1262                Canonical_File_Name : String_Access :=
1263                  To_Canonical_File_Spec (Argv (Arg_Idx + 1 .. Argv'Last));
1264             begin
1265                Open (Arg_File, In_File, Canonical_File_Name.all);
1266                Free (Canonical_File_Name);
1267                return;
1268
1269             exception
1270                when others =>
1271                   Put (Standard_Error, "Cannot open argument file """);
1272                   Put (Standard_Error, Argv (Arg_Idx + 1 .. Argv'Last));
1273                   Put_Line (Standard_Error, """");
1274                   raise Error_Exit;
1275             end;
1276          end if;
1277       end if;
1278
1279       <<Tryagain_After_Coalesce>>
1280       loop
1281          declare
1282             Next_Arg_Idx : Integer;
1283             Arg          : String_Access;
1284
1285          begin
1286             Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
1287             Arg := new String'(Argv (Arg_Idx .. Next_Arg_Idx));
1288
1289             --  The first one must be a command name
1290
1291             if Arg_Num = 1 and then Arg_Idx = Argv'First then
1292                Command := Matching_Name (Arg.all, Commands);
1293
1294                if Command = null then
1295                   raise Error_Exit;
1296                end if;
1297
1298                The_Command := Command.Command;
1299                Output_File_Expected := False;
1300
1301                --  Give usage information if only command given
1302
1303                if Argument_Count = 1
1304                  and then Next_Arg_Idx = Argv'Last
1305                then
1306                   Output_Version;
1307                   New_Line;
1308                   Put_Line
1309                     ("List of available qualifiers and options");
1310                   New_Line;
1311
1312                   Put (Command.Usage.all);
1313                   Set_Col (53);
1314                   Put_Line (Command.Unix_String.all);
1315
1316                   declare
1317                      Sw : Item_Ptr := Command.Switches;
1318
1319                   begin
1320                      while Sw /= null loop
1321                         Put ("   ");
1322                         Put (Sw.Name.all);
1323
1324                         case Sw.Translation is
1325
1326                            when T_Other =>
1327                               Set_Col (53);
1328                               Put_Line (Sw.Unix_String.all &
1329                                         "/<other>");
1330
1331                            when T_Direct =>
1332                               Set_Col (53);
1333                               Put_Line (Sw.Unix_String.all);
1334
1335                            when T_Directories =>
1336                               Put ("=(direc,direc,..direc)");
1337                               Set_Col (53);
1338                               Put (Sw.Unix_String.all);
1339                               Put (" direc ");
1340                               Put (Sw.Unix_String.all);
1341                               Put_Line (" direc ...");
1342
1343                            when T_Directory =>
1344                               Put ("=directory");
1345                               Set_Col (53);
1346                               Put (Sw.Unix_String.all);
1347
1348                               if Sw.Unix_String (Sw.Unix_String'Last)
1349                               /= '='
1350                               then
1351                                  Put (' ');
1352                               end if;
1353
1354                               Put_Line ("directory ");
1355
1356                            when T_File | T_No_Space_File =>
1357                               Put ("=file");
1358                               Set_Col (53);
1359                               Put (Sw.Unix_String.all);
1360
1361                               if Sw.Translation = T_File
1362                                 and then Sw.Unix_String
1363                                   (Sw.Unix_String'Last) /= '='
1364                               then
1365                                  Put (' ');
1366                               end if;
1367
1368                               Put_Line ("file ");
1369
1370                            when T_Numeric =>
1371                               Put ("=nnn");
1372                               Set_Col (53);
1373
1374                               if Sw.Unix_String
1375                                 (Sw.Unix_String'First) = '`'
1376                               then
1377                                  Put (Sw.Unix_String
1378                                         (Sw.Unix_String'First + 1
1379                                          .. Sw.Unix_String'Last));
1380                               else
1381                                  Put (Sw.Unix_String.all);
1382                               end if;
1383
1384                               Put_Line ("nnn");
1385
1386                            when T_Alphanumplus =>
1387                               Put ("=xyz");
1388                               Set_Col (53);
1389
1390                               if Sw.Unix_String
1391                                 (Sw.Unix_String'First) = '`'
1392                               then
1393                                  Put (Sw.Unix_String
1394                                         (Sw.Unix_String'First + 1
1395                                          .. Sw.Unix_String'Last));
1396                               else
1397                                  Put (Sw.Unix_String.all);
1398                               end if;
1399
1400                               Put_Line ("xyz");
1401
1402                            when T_String =>
1403                               Put ("=");
1404                               Put ('"');
1405                               Put ("<string>");
1406                               Put ('"');
1407                               Set_Col (53);
1408
1409                               Put (Sw.Unix_String.all);
1410
1411                               if Sw.Unix_String
1412                                 (Sw.Unix_String'Last) /= '='
1413                               then
1414                                  Put (' ');
1415                               end if;
1416
1417                               Put ("<string>");
1418                               New_Line;
1419
1420                            when T_Commands =>
1421                               Put (" (switches for ");
1422                               Put (Sw.Unix_String
1423                                      (Sw.Unix_String'First + 7
1424                                       .. Sw.Unix_String'Last));
1425                               Put (')');
1426                               Set_Col (53);
1427                               Put (Sw.Unix_String
1428                                      (Sw.Unix_String'First
1429                                       .. Sw.Unix_String'First + 5));
1430                               Put_Line (" switches");
1431
1432                            when T_Options =>
1433                               declare
1434                                  Opt : Item_Ptr := Sw.Options;
1435
1436                               begin
1437                                  Put_Line ("=(option,option..)");
1438
1439                                  while Opt /= null loop
1440                                     Put ("      ");
1441                                     Put (Opt.Name.all);
1442
1443                                     if Opt = Sw.Options then
1444                                        Put (" (D)");
1445                                     end if;
1446
1447                                     Set_Col (53);
1448                                     Put_Line (Opt.Unix_String.all);
1449                                     Opt := Opt.Next;
1450                                  end loop;
1451                               end;
1452
1453                         end case;
1454
1455                         Sw := Sw.Next;
1456                      end loop;
1457                   end;
1458
1459                   raise Normal_Exit;
1460                end if;
1461
1462             --  Special handling for internal debugging switch /?
1463
1464             elsif Arg.all = "/?" then
1465                Display_Command := True;
1466                Output_File_Expected := False;
1467
1468             --  Special handling of internal option /KEEP_TEMPORARY_FILES
1469
1470             elsif Arg'Length >= 7
1471               and then Matching_Name
1472                          (Arg.all, Keep_Temps_Option, True) /= null
1473             then
1474                Opt.Keep_Temporary_Files := True;
1475
1476             --  Copy -switch unchanged, as well as +rule
1477
1478             elsif Arg (Arg'First) = '-' or else Arg (Arg'First) = '+' then
1479                Place (' ');
1480                Place (Arg.all);
1481
1482                --  Set Output_File_Expected for the next argument
1483
1484                Output_File_Expected :=
1485                  Arg.all = "-o" and then The_Command = Link;
1486
1487                --  Copy quoted switch with quotes stripped
1488
1489             elsif Arg (Arg'First) = '"' then
1490                if Arg (Arg'Last) /= '"' then
1491                   Put (Standard_Error, "misquoted argument: ");
1492                   Put_Line (Standard_Error, Arg.all);
1493                   Errors := Errors + 1;
1494
1495                else
1496                   Place (' ');
1497                   Place (Arg (Arg'First + 1 .. Arg'Last - 1));
1498                end if;
1499
1500                Output_File_Expected := False;
1501
1502                --  Parameter Argument
1503
1504             elsif Arg (Arg'First) /= '/'
1505               and then Make_Commands_Active = null
1506             then
1507                Param_Count := Param_Count + 1;
1508
1509                if Param_Count <= Command.Params'Length then
1510
1511                   case Command.Params (Param_Count) is
1512
1513                      when File | Optional_File =>
1514                         declare
1515                            Normal_File : constant String_Access :=
1516                              To_Canonical_File_Spec
1517                                (Arg.all);
1518
1519                         begin
1520                            Place (' ');
1521                            Place_Lower (Normal_File.all);
1522
1523                            if Is_Extensionless (Normal_File.all)
1524                              and then Command.Defext /= "   "
1525                            then
1526                               Place ('.');
1527                               Place (Command.Defext);
1528                            end if;
1529                         end;
1530
1531                      when Unlimited_Files =>
1532                         declare
1533                            Normal_File : constant String_Access :=
1534                              To_Canonical_File_Spec
1535                                (Arg.all);
1536
1537                            File_Is_Wild : Boolean := False;
1538                            File_List    : String_Access_List_Access;
1539
1540                         begin
1541                            for J in Arg'Range loop
1542                               if Arg (J) = '*'
1543                                 or else Arg (J) = '%'
1544                               then
1545                                  File_Is_Wild := True;
1546                               end if;
1547                            end loop;
1548
1549                            if File_Is_Wild then
1550                               File_List := To_Canonical_File_List
1551                                 (Arg.all, False);
1552
1553                               for J in File_List.all'Range loop
1554                                  Place (' ');
1555                                  Place_Lower (File_List.all (J).all);
1556                               end loop;
1557
1558                            else
1559                               Place (' ');
1560                               Place_Lower (Normal_File.all);
1561
1562                               --  Add extension if not present, except after
1563                               --  switch -o.
1564
1565                               if Is_Extensionless (Normal_File.all)
1566                                 and then Command.Defext /= "   "
1567                                 and then not Output_File_Expected
1568                               then
1569                                  Place ('.');
1570                                  Place (Command.Defext);
1571                               end if;
1572                            end if;
1573
1574                            Param_Count := Param_Count - 1;
1575                         end;
1576
1577                      when Other_As_Is =>
1578                         Place (' ');
1579                         Place (Arg.all);
1580
1581                      when Unlimited_As_Is =>
1582                         Place (' ');
1583                         Place (Arg.all);
1584                         Param_Count := Param_Count - 1;
1585
1586                      when Files_Or_Wildcard =>
1587
1588                         --  Remove spaces from a comma separated list
1589                         --  of file names and adjust control variables
1590                         --  accordingly.
1591
1592                         while Arg_Num < Argument_Count and then
1593                           (Argv (Argv'Last) = ',' xor
1594                              Argument (Arg_Num + 1)
1595                              (Argument (Arg_Num + 1)'First) = ',')
1596                         loop
1597                            Argv := new String'
1598                              (Argv.all & Argument (Arg_Num + 1));
1599                            Arg_Num := Arg_Num + 1;
1600                            Arg_Idx := Argv'First;
1601                            Next_Arg_Idx :=
1602                              Get_Arg_End (Argv.all, Arg_Idx);
1603                            Arg := new String'
1604                              (Argv (Arg_Idx .. Next_Arg_Idx));
1605                         end loop;
1606
1607                         --  Parse the comma separated list of VMS
1608                         --  filenames and place them on the command
1609                         --  line as space separated Unix style
1610                         --  filenames. Lower case and add default
1611                         --  extension as appropriate.
1612
1613                         declare
1614                            Arg1_Idx : Integer := Arg'First;
1615
1616                            function Get_Arg1_End
1617                              (Arg     : String;
1618                               Arg_Idx : Integer) return Integer;
1619                            --  Begins looking at Arg_Idx + 1 and
1620                            --  returns the index of the last character
1621                            --  before a comma or else the index of the
1622                            --  last character in the string Arg.
1623
1624                            ------------------
1625                            -- Get_Arg1_End --
1626                            ------------------
1627
1628                            function Get_Arg1_End
1629                              (Arg     : String;
1630                               Arg_Idx : Integer) return Integer
1631                            is
1632                            begin
1633                               for J in Arg_Idx + 1 .. Arg'Last loop
1634                                  if Arg (J) = ',' then
1635                                     return J - 1;
1636                                  end if;
1637                               end loop;
1638
1639                               return Arg'Last;
1640                            end Get_Arg1_End;
1641
1642                         begin
1643                            loop
1644                               declare
1645                                  Next_Arg1_Idx :
1646                                  constant Integer :=
1647                                    Get_Arg1_End (Arg.all, Arg1_Idx);
1648
1649                                  Arg1 :
1650                                  constant String :=
1651                                    Arg (Arg1_Idx .. Next_Arg1_Idx);
1652
1653                                  Normal_File :
1654                                  constant String_Access :=
1655                                    To_Canonical_File_Spec (Arg1);
1656
1657                               begin
1658                                  Place (' ');
1659                                  Place_Lower (Normal_File.all);
1660
1661                                  if Is_Extensionless (Normal_File.all)
1662                                    and then Command.Defext /= "   "
1663                                  then
1664                                     Place ('.');
1665                                     Place (Command.Defext);
1666                                  end if;
1667
1668                                  Arg1_Idx := Next_Arg1_Idx + 1;
1669                               end;
1670
1671                               exit when Arg1_Idx > Arg'Last;
1672
1673                               --  Don't allow two or more commas in
1674                               --  a row
1675
1676                               if Arg (Arg1_Idx) = ',' then
1677                                  Arg1_Idx := Arg1_Idx + 1;
1678                                  if Arg1_Idx > Arg'Last or else
1679                                    Arg (Arg1_Idx) = ','
1680                                  then
1681                                     Put_Line
1682                                       (Standard_Error,
1683                                        "Malformed Parameter: " &
1684                                        Arg.all);
1685                                     Put (Standard_Error, "usage: ");
1686                                     Put_Line (Standard_Error,
1687                                               Command.Usage.all);
1688                                     raise Error_Exit;
1689                                  end if;
1690                               end if;
1691
1692                            end loop;
1693                         end;
1694                   end case;
1695                end if;
1696
1697                --  Reset Output_File_Expected, in case it was True
1698
1699                Output_File_Expected := False;
1700
1701                --  Qualifier argument
1702
1703             else
1704                Output_File_Expected := False;
1705
1706                Cargs := Command.Name.all = "COMPILE";
1707
1708                --  This code is too heavily nested, should be
1709                --  separated out as separate subprogram ???
1710
1711                declare
1712                   Sw   : Item_Ptr;
1713                   SwP  : Natural;
1714                   P2   : Natural;
1715                   Endp : Natural := 0; -- avoid warning!
1716                   Opt  : Item_Ptr;
1717
1718                begin
1719                   SwP := Arg'First;
1720                   while SwP < Arg'Last
1721                     and then Arg (SwP + 1) /= '='
1722                   loop
1723                      SwP := SwP + 1;
1724                   end loop;
1725
1726                   --  At this point, the switch name is in
1727                   --  Arg (Arg'First..SwP) and if that is not the
1728                   --  whole switch, then there is an equal sign at
1729                   --  Arg (SwP + 1) and the rest of Arg is what comes
1730                   --  after the equal sign.
1731
1732                   --  If make commands are active, see if we have
1733                   --  another COMMANDS_TRANSLATION switch belonging
1734                   --  to gnatmake.
1735
1736                   if Make_Commands_Active /= null then
1737                      Sw :=
1738                        Matching_Name
1739                          (Arg (Arg'First .. SwP),
1740                           Command.Switches,
1741                           Quiet => True);
1742
1743                      if Sw /= null
1744                        and then Sw.Translation = T_Commands
1745                      then
1746                         null;
1747
1748                      else
1749                         Sw :=
1750                           Matching_Name
1751                             (Arg (Arg'First .. SwP),
1752                              Make_Commands_Active.Switches,
1753                              Quiet => False);
1754                      end if;
1755
1756                      --  For case of GNAT MAKE or CHOP, if we cannot
1757                      --  find the switch, then see if it is a
1758                      --  recognized compiler switch instead, and if
1759                      --  so process the compiler switch.
1760
1761                   elsif Command.Name.all = "MAKE"
1762                     or else Command.Name.all = "CHOP" then
1763                      Sw :=
1764                        Matching_Name
1765                          (Arg (Arg'First .. SwP),
1766                           Command.Switches,
1767                           Quiet => True);
1768
1769                      if Sw = null then
1770                         Sw :=
1771                           Matching_Name
1772                             (Arg (Arg'First .. SwP),
1773                              Matching_Name
1774                                ("COMPILE", Commands).Switches,
1775                              Quiet => False);
1776                      end if;
1777
1778                      --  For all other cases, just search the relevant
1779                      --  command.
1780
1781                   else
1782                      Sw :=
1783                        Matching_Name
1784                          (Arg (Arg'First .. SwP),
1785                           Command.Switches,
1786                           Quiet => False);
1787                   end if;
1788
1789                   if Sw /= null then
1790                      if Cargs
1791                        and then Sw.Name /= null
1792                        and then
1793                          (Sw.Name.all = "/PROJECT_FILE"          or else
1794                           Sw.Name.all = "/MESSAGES_PROJECT_FILE" or else
1795                           Sw.Name.all = "/EXTERNAL_REFERENCE")
1796                      then
1797                         Cargs := False;
1798                      end if;
1799
1800                      case Sw.Translation is
1801                         when T_Direct =>
1802                            Place_Unix_Switches (Sw.Unix_String);
1803                            if SwP < Arg'Last
1804                              and then Arg (SwP + 1) = '='
1805                            then
1806                               Put (Standard_Error,
1807                                    "qualifier options ignored: ");
1808                               Put_Line (Standard_Error, Arg.all);
1809                            end if;
1810
1811                         when T_Directories =>
1812                            if SwP + 1 > Arg'Last then
1813                               Put (Standard_Error,
1814                                    "missing directories for: ");
1815                               Put_Line (Standard_Error, Arg.all);
1816                               Errors := Errors + 1;
1817
1818                            elsif Arg (SwP + 2) /= '(' then
1819                               SwP := SwP + 2;
1820                               Endp := Arg'Last;
1821
1822                            elsif Arg (Arg'Last) /= ')' then
1823
1824                               --  Remove spaces from a comma separated
1825                               --  list of file names and adjust
1826                               --  control variables accordingly.
1827
1828                               if Arg_Num < Argument_Count and then
1829                                 (Argv (Argv'Last) = ',' xor
1830                                    Argument (Arg_Num + 1)
1831                                    (Argument (Arg_Num + 1)'First) = ',')
1832                               then
1833                                  Argv :=
1834                                    new String'(Argv.all
1835                                                & Argument
1836                                                  (Arg_Num + 1));
1837                                  Arg_Num := Arg_Num + 1;
1838                                  Arg_Idx := Argv'First;
1839                                  Next_Arg_Idx :=
1840                                    Get_Arg_End (Argv.all, Arg_Idx);
1841                                  Arg := new String'
1842                                    (Argv (Arg_Idx .. Next_Arg_Idx));
1843                                  goto Tryagain_After_Coalesce;
1844                               end if;
1845
1846                               Put (Standard_Error,
1847                                    "incorrectly parenthesized " &
1848                                    "or malformed argument: ");
1849                               Put_Line (Standard_Error, Arg.all);
1850                               Errors := Errors + 1;
1851
1852                            else
1853                               SwP := SwP + 3;
1854                               Endp := Arg'Last - 1;
1855                            end if;
1856
1857                            while SwP <= Endp loop
1858                               declare
1859                                  Dir_Is_Wild       : Boolean := False;
1860                                  Dir_Maybe_Is_Wild : Boolean := False;
1861
1862                                  Dir_List : String_Access_List_Access;
1863
1864                               begin
1865                                  P2 := SwP;
1866
1867                                  while P2 < Endp
1868                                    and then Arg (P2 + 1) /= ','
1869                                  loop
1870                                     --  A wildcard directory spec on
1871                                     --  VMS will contain either * or
1872                                     --  % or ...
1873
1874                                     if Arg (P2) = '*' then
1875                                        Dir_Is_Wild := True;
1876
1877                                     elsif Arg (P2) = '%' then
1878                                        Dir_Is_Wild := True;
1879
1880                                     elsif Dir_Maybe_Is_Wild
1881                                       and then Arg (P2) = '.'
1882                                       and then Arg (P2 + 1) = '.'
1883                                     then
1884                                        Dir_Is_Wild := True;
1885                                        Dir_Maybe_Is_Wild := False;
1886
1887                                     elsif Dir_Maybe_Is_Wild then
1888                                        Dir_Maybe_Is_Wild := False;
1889
1890                                     elsif Arg (P2) = '.'
1891                                       and then Arg (P2 + 1) = '.'
1892                                     then
1893                                        Dir_Maybe_Is_Wild := True;
1894
1895                                     end if;
1896
1897                                     P2 := P2 + 1;
1898                                  end loop;
1899
1900                                  if Dir_Is_Wild then
1901                                     Dir_List :=
1902                                       To_Canonical_File_List
1903                                         (Arg (SwP .. P2), True);
1904
1905                                     for J in Dir_List.all'Range loop
1906                                        Place_Unix_Switches
1907                                          (Sw.Unix_String);
1908                                        Place_Lower
1909                                          (Dir_List.all (J).all);
1910                                     end loop;
1911
1912                                  else
1913                                     Place_Unix_Switches
1914                                       (Sw.Unix_String);
1915                                     Place_Lower
1916                                       (To_Canonical_Dir_Spec
1917                                          (Arg (SwP .. P2), False).all);
1918                                  end if;
1919
1920                                  SwP := P2 + 2;
1921                               end;
1922                            end loop;
1923
1924                         when T_Directory =>
1925                            if SwP + 1 > Arg'Last then
1926                               Put (Standard_Error,
1927                                    "missing directory for: ");
1928                               Put_Line (Standard_Error, Arg.all);
1929                               Errors := Errors + 1;
1930
1931                            else
1932                               Place_Unix_Switches (Sw.Unix_String);
1933
1934                               --  Some switches end in "=". No space
1935                               --  here
1936
1937                               if Sw.Unix_String
1938                                 (Sw.Unix_String'Last) /= '='
1939                               then
1940                                  Place (' ');
1941                               end if;
1942
1943                               Place_Lower
1944                                 (To_Canonical_Dir_Spec
1945                                    (Arg (SwP + 2 .. Arg'Last),
1946                                     False).all);
1947                            end if;
1948
1949                         when T_File | T_No_Space_File =>
1950                            if SwP + 1 > Arg'Last then
1951                               Put (Standard_Error,
1952                                    "missing file for: ");
1953                               Put_Line (Standard_Error, Arg.all);
1954                               Errors := Errors + 1;
1955
1956                            else
1957                               Place_Unix_Switches (Sw.Unix_String);
1958
1959                               --  Some switches end in "=". No space
1960                               --  here.
1961
1962                               if Sw.Translation = T_File
1963                                 and then Sw.Unix_String
1964                                   (Sw.Unix_String'Last) /= '='
1965                               then
1966                                  Place (' ');
1967                               end if;
1968
1969                               Place_Lower
1970                                 (To_Canonical_File_Spec
1971                                    (Arg (SwP + 2 .. Arg'Last)).all);
1972                            end if;
1973
1974                         when T_Numeric =>
1975                            if OK_Integer (Arg (SwP + 2 .. Arg'Last)) then
1976                               Place_Unix_Switches (Sw.Unix_String);
1977                               Place (Arg (SwP + 2 .. Arg'Last));
1978
1979                            else
1980                               Put (Standard_Error, "argument for ");
1981                               Put (Standard_Error, Sw.Name.all);
1982                               Put_Line
1983                                 (Standard_Error, " must be numeric");
1984                               Errors := Errors + 1;
1985                            end if;
1986
1987                         when T_Alphanumplus =>
1988                            if OK_Alphanumerplus
1989                              (Arg (SwP + 2 .. Arg'Last))
1990                            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 (Standard_Error,
1998                                         " must be alphanumeric");
1999                               Errors := Errors + 1;
2000                            end if;
2001
2002                         when T_String =>
2003
2004                            --  A String value must be extended to the
2005                            --  end of the Argv, otherwise strings like
2006                            --  "foo/bar" get split at the slash.
2007
2008                            --  The begining and ending of the string
2009                            --  are flagged with embedded nulls which
2010                            --  are removed when building the Spawn
2011                            --  call. Nulls are use because they won't
2012                            --  show up in a /? output. Quotes aren't
2013                            --  used because that would make it
2014                            --  difficult to embed them.
2015
2016                            Place_Unix_Switches (Sw.Unix_String);
2017
2018                            if Next_Arg_Idx /= Argv'Last then
2019                               Next_Arg_Idx := Argv'Last;
2020                               Arg := new String'
2021                                 (Argv (Arg_Idx .. Next_Arg_Idx));
2022
2023                               SwP := Arg'First;
2024                               while SwP < Arg'Last and then
2025                               Arg (SwP + 1) /= '=' loop
2026                                  SwP := SwP + 1;
2027                               end loop;
2028                            end if;
2029
2030                            Place (ASCII.NUL);
2031                            Place (Arg (SwP + 2 .. Arg'Last));
2032                            Place (ASCII.NUL);
2033
2034                         when T_Commands =>
2035
2036                            --  Output -largs/-bargs/-cargs
2037
2038                            Place (' ');
2039                            Place (Sw.Unix_String
2040                                     (Sw.Unix_String'First ..
2041                                        Sw.Unix_String'First + 5));
2042
2043                            if Sw.Unix_String
2044                              (Sw.Unix_String'First + 7 ..
2045                                 Sw.Unix_String'Last) = "MAKE"
2046                            then
2047                               Make_Commands_Active := null;
2048
2049                            else
2050                               --  Set source of new commands, also
2051                               --  setting this non-null indicates that
2052                               --  we are in the special commands mode
2053                               --  for processing the -xargs case.
2054
2055                               Make_Commands_Active :=
2056                                 Matching_Name
2057                                   (Sw.Unix_String
2058                                        (Sw.Unix_String'First + 7 ..
2059                                             Sw.Unix_String'Last),
2060                                    Commands);
2061                            end if;
2062
2063                         when T_Options =>
2064                            if SwP + 1 > Arg'Last then
2065                               Place_Unix_Switches
2066                                 (Sw.Options.Unix_String);
2067                               SwP := Endp + 1;
2068
2069                            elsif Arg (SwP + 2) /= '(' then
2070                               SwP := SwP + 2;
2071                               Endp := Arg'Last;
2072
2073                            elsif Arg (Arg'Last) /= ')' then
2074                               Put (Standard_Error,
2075                                    "incorrectly parenthesized argument: ");
2076                               Put_Line (Standard_Error, Arg.all);
2077                               Errors := Errors + 1;
2078                               SwP := Endp + 1;
2079
2080                            else
2081                               SwP := SwP + 3;
2082                               Endp := Arg'Last - 1;
2083                            end if;
2084
2085                            while SwP <= Endp loop
2086                               P2 := SwP;
2087
2088                               while P2 < Endp
2089                                 and then Arg (P2 + 1) /= ','
2090                               loop
2091                                  P2 := P2 + 1;
2092                               end loop;
2093
2094                               --  Option name is in Arg (SwP .. P2)
2095
2096                               Opt := Matching_Name (Arg (SwP .. P2),
2097                                                     Sw.Options);
2098
2099                               if Opt /= null then
2100                                  Place_Unix_Switches
2101                                    (Opt.Unix_String);
2102                               end if;
2103
2104                               SwP := P2 + 2;
2105                            end loop;
2106
2107                         when T_Other =>
2108                            Place_Unix_Switches
2109                              (new String'(Sw.Unix_String.all &
2110                                           Arg.all));
2111
2112                      end case;
2113                   end if;
2114                end;
2115             end if;
2116
2117             Arg_Idx := Next_Arg_Idx + 1;
2118          end;
2119
2120          exit when Arg_Idx > Argv'Last;
2121
2122       end loop;
2123
2124       if not Is_Open (Arg_File) then
2125          Arg_Num := Arg_Num + 1;
2126       end if;
2127    end Process_Argument;
2128
2129    --------------------
2130    -- Process_Buffer --
2131    --------------------
2132
2133    procedure Process_Buffer (S : String) is
2134       P1, P2     : Natural;
2135       Inside_Nul : Boolean := False;
2136       Arg        : String (1 .. 1024);
2137       Arg_Ctr    : Natural;
2138
2139    begin
2140       P1 := 1;
2141       while P1 <= S'Last and then S (P1) = ' ' loop
2142          P1 := P1 + 1;
2143       end loop;
2144
2145       Arg_Ctr := 1;
2146       Arg (Arg_Ctr) := S (P1);
2147
2148       while P1 <= S'Last loop
2149          if S (P1) = ASCII.NUL then
2150             if Inside_Nul then
2151                Inside_Nul := False;
2152             else
2153                Inside_Nul := True;
2154             end if;
2155          end if;
2156
2157          if S (P1) = ' ' and then not Inside_Nul then
2158             P1 := P1 + 1;
2159             Arg_Ctr := Arg_Ctr + 1;
2160             Arg (Arg_Ctr) := S (P1);
2161
2162          else
2163             Last_Switches.Increment_Last;
2164             P2 := P1;
2165
2166             while P2 < S'Last
2167               and then (S (P2 + 1) /= ' ' or else
2168                         Inside_Nul)
2169             loop
2170                P2 := P2 + 1;
2171                Arg_Ctr := Arg_Ctr + 1;
2172                Arg (Arg_Ctr) := S (P2);
2173                if S (P2) = ASCII.NUL then
2174                   Arg_Ctr := Arg_Ctr - 1;
2175
2176                   if Inside_Nul then
2177                      Inside_Nul := False;
2178                   else
2179                      Inside_Nul := True;
2180                   end if;
2181                end if;
2182             end loop;
2183
2184             Last_Switches.Table (Last_Switches.Last) :=
2185               new String'(String (Arg (1 .. Arg_Ctr)));
2186             P1 := P2 + 2;
2187
2188             exit when P1 > S'Last;
2189
2190             Arg_Ctr := 1;
2191             Arg (Arg_Ctr) := S (P1);
2192          end if;
2193       end loop;
2194    end Process_Buffer;
2195
2196    --------------------------------
2197    -- Validate_Command_Or_Option --
2198    --------------------------------
2199
2200    procedure Validate_Command_Or_Option (N : VMS_Data.String_Ptr) is
2201    begin
2202       pragma Assert (N'Length > 0);
2203
2204       for J in N'Range loop
2205          if N (J) = '_' then
2206             pragma Assert (N (J - 1) /= '_');
2207             null;
2208          else
2209             pragma Assert (Is_Upper (N (J)) or else Is_Digit (N (J)));
2210             null;
2211          end if;
2212       end loop;
2213    end Validate_Command_Or_Option;
2214
2215    --------------------------
2216    -- Validate_Unix_Switch --
2217    --------------------------
2218
2219    procedure Validate_Unix_Switch (S : VMS_Data.String_Ptr) is
2220    begin
2221       if S (S'First) = '`' then
2222          return;
2223       end if;
2224
2225       pragma Assert (S (S'First) = '-' or else S (S'First) = '!');
2226
2227       for J in S'First + 1 .. S'Last loop
2228          pragma Assert (S (J) /= ' ');
2229
2230          if S (J) = '!' then
2231             pragma Assert (S (J - 1) = ',' and then S (J + 1) = '-');
2232             null;
2233          end if;
2234       end loop;
2235    end Validate_Unix_Switch;
2236
2237    --------------------
2238    -- VMS_Conversion --
2239    --------------------
2240
2241    procedure VMS_Conversion (The_Command : out Command_Type) is
2242       Result     : Command_Type := Undefined;
2243       Result_Set : Boolean      := False;
2244
2245    begin
2246       Buffer.Init;
2247
2248       --  First we must preprocess the string form of the command and options
2249       --  list into the internal form that we use.
2250
2251       Preprocess_Command_Data;
2252
2253       --  If no parameters, give complete list of commands
2254
2255       if Argument_Count = 0 then
2256          Output_Version;
2257          New_Line;
2258          Put_Line ("List of available commands");
2259          New_Line;
2260
2261          while Commands /= null loop
2262             Put (Commands.Usage.all);
2263             Set_Col (53);
2264             Put_Line (Commands.Unix_String.all);
2265             Commands := Commands.Next;
2266          end loop;
2267
2268          raise Normal_Exit;
2269       end if;
2270
2271       --  Loop through arguments
2272
2273       Arg_Num := 1;
2274       while Arg_Num <= Argument_Count loop
2275          Process_Argument (Result);
2276
2277          if not Result_Set then
2278             The_Command := Result;
2279             Result_Set := True;
2280          end if;
2281       end loop;
2282
2283       --  Gross error checking that the number of parameters is correct.
2284       --  Not applicable to Unlimited_Files parameters.
2285
2286       if (Param_Count = Command.Params'Length - 1
2287             and then Command.Params (Param_Count + 1) = Unlimited_Files)
2288         or else Param_Count <= Command.Params'Length
2289       then
2290          null;
2291
2292       else
2293          Put_Line (Standard_Error,
2294                    "Parameter count of "
2295                    & Integer'Image (Param_Count)
2296                    & " not equal to expected "
2297                    & Integer'Image (Command.Params'Length));
2298          Put (Standard_Error, "usage: ");
2299          Put_Line (Standard_Error, Command.Usage.all);
2300          Errors := Errors + 1;
2301       end if;
2302
2303       if Errors > 0 then
2304          raise Error_Exit;
2305       else
2306          --  Prepare arguments for a call to spawn, filtering out
2307          --  embedded nulls place there to delineate strings.
2308
2309          Process_Buffer (String (Buffer.Table (1 .. Buffer.Last)));
2310
2311          if Cargs_Buffer.Last > 1 then
2312             Last_Switches.Append (new String'("-cargs"));
2313             Process_Buffer
2314               (String (Cargs_Buffer.Table (1 .. Cargs_Buffer.Last)));
2315          end if;
2316       end if;
2317    end VMS_Conversion;
2318
2319 end VMS_Conv;