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