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