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