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