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