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