path: root/gcc/ada/vms_conv.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                            V M S _ C O N V                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1996-2010, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Gnatvsn;  use Gnatvsn;
with Hostparm;
with Opt;
with Osint;    use Osint;
with Targparm; use Targparm;

with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Command_Line;        use Ada.Command_Line;
with Ada.Text_IO;             use Ada.Text_IO;

package body VMS_Conv is

   -------------------------
   -- Internal Structures --
   -------------------------

   --  The switches and commands are defined by strings in the previous
   --  section so that they are easy to modify, but internally, they are
   --  kept in a more conveniently accessible form described in this
   --  section.

   --  Commands, command qualifiers and options have a similar common format
   --  so that searching for matching names can be done in a common manner.

   type Item_Id is (Id_Command, Id_Switch, Id_Option);

   type Translation_Type is
     (
      T_Direct,
      --  A qualifier with no options.
      --  Example: GNAT MAKE /VERBOSE

      T_Directories,
      --  A qualifier followed by a list of directories
      --  Example: GNAT COMPILE /SEARCH=([], [.FOO], [.BAR])

      T_Directory,
      --  A qualifier followed by one directory
      --  Example: GNAT LIBRARY /SET=[.VAXFLOATLIB]

      T_File,
      --  A qualifier followed by a filename
      --  Example: GNAT LINK /EXECUTABLE=FOO.EXE

      T_No_Space_File,
      --  A qualifier followed by a filename
      --  Example: GNAT MAKE /PROJECT_FILE=PRJ.GPR

      T_Numeric,
      --  A qualifier followed by a numeric value.
      --  Example: GNAT CHOP /FILE_NAME_MAX_LENGTH=39

      T_String,
      --  A qualifier followed by a quoted string. Only used by
      --  /IDENTIFICATION qualifier.
      --  Example: GNAT LINK /IDENTIFICATION="3.14a1 version"

      T_Options,
      --  A qualifier followed by a list of options.
      --  Example: GNAT COMPILE /REPRESENTATION_INFO=(ARRAYS,OBJECTS)

      T_Commands,
      --  A qualifier followed by a list. Only used for
      --  MAKE /COMPILER_QUALIFIERS /BINDER_QUALIFIERS /LINKER_QUALIFIERS
      --  (gnatmake -cargs -bargs -largs )
      --  Example: GNAT MAKE ... /LINKER_QUALIFIERS /VERBOSE FOOBAR.OBJ

      T_Other,
      --  A qualifier passed directly to the linker. Only used
      --  for LINK and SHARED if no other match is found.
      --  Example: GNAT LINK FOO.ALI /SYSSHR

      T_Alphanumplus
      --  A qualifier followed by a legal linker symbol prefix. Only used
      --  for BIND /BUILD_LIBRARY (gnatbind -Lxyz).
      --  Example: GNAT BIND /BUILD_LIBRARY=foobar
      );

   type Item (Id : Item_Id);
   type Item_Ptr is access all Item;

   type Item (Id : Item_Id) is record
      Name : String_Ptr;
      --  Name of the command, switch (with slash) or option

      Next : Item_Ptr;
      --  Pointer to next item on list, always has the same Id value

      Command : Command_Type := Undefined;

      Unix_String : String_Ptr := null;
      --  Corresponding Unix string. For a command, this is the unix command
      --  name and possible default switches. For a switch or option it is
      --  the unix switch string.

      case Id is

         when Id_Command =>

            Switches : Item_Ptr;
            --  Pointer to list of switch items for the command, linked
            --  through the Next fields with null terminating the list.

            Usage : String_Ptr;
            --  Usage information, used only for errors and the default
            --  list of commands output.

            Params : Parameter_Ref;
            --  Array of parameters

            Defext : String (1 .. 3);
            --  Default extension. If non-blank, then this extension is
            --  supplied by default as the extension for any file parameter
            --  which does not have an extension already.

         when Id_Switch =>

            Translation : Translation_Type;
            --  Type of switch translation. For all cases, except Options,
            --  this is the only field needed, since the Unix translation
            --  is found in Unix_String.

            Options : Item_Ptr;
            --  For the Options case, this field is set to point to a list
            --  of options item (for this case Unix_String is null in the
            --  main switch item). The end of the list is marked by null.

         when Id_Option =>

            null;
            --  No special fields needed, since Name and Unix_String are
            --  sufficient to completely described an option.

      end case;
   end record;

   subtype Command_Item is Item (Id_Command);
   subtype Switch_Item  is Item (Id_Switch);
   subtype Option_Item  is Item (Id_Option);

   Keep_Temps_Option : constant Item_Ptr :=
                         new Item'
                           (Id          => Id_Option,
                            Name        =>
                              new String'("/KEEP_TEMPORARY_FILES"),
                            Next        => null,
                            Command     => Undefined,
                            Unix_String => null);

   Param_Count : Natural := 0;
   --  Number of parameter arguments so far

   Arg_Num : Natural;
   --  Argument number

   Arg_File : Ada.Text_IO.File_Type;
   --  A file where arguments are read from

   Commands : Item_Ptr;
   --  Pointer to head of list of command items, one for each command, with
   --  the end of the list marked by a null pointer.

   Last_Command : Item_Ptr;
   --  Pointer to last item in Commands list

   Command : Item_Ptr;
   --  Pointer to command item for current command

   Make_Commands_Active : Item_Ptr := null;
   --  Set to point to Command entry for COMPILE, BIND, or LINK as appropriate
   --  if a COMMANDS_TRANSLATION switch has been encountered while processing
   --  a MAKE Command.

   Output_File_Expected : Boolean := False;
   --  True for GNAT LINK after -o switch, so that the ".ali" extension is
   --  not added to the executable file name.

   package Buffer is new Table.Table
     (Table_Component_Type => Character,
      Table_Index_Type     => Integer,
      Table_Low_Bound      => 1,
      Table_Initial        => 4096,
      Table_Increment      => 100,
      Table_Name           => "Buffer");
   --  Table to store the command to be used

   package Cargs_Buffer is new Table.Table
     (Table_Component_Type => Character,
      Table_Index_Type     => Integer,
      Table_Low_Bound      => 1,
      Table_Initial        => 4096,
      Table_Increment      => 100,
      Table_Name           => "Cargs_Buffer");
   --  Table to store the compiler switches for GNAT COMPILE

   Cargs : Boolean := False;
   --  When True, commands should go to Cargs_Buffer instead of Buffer table

   function Init_Object_Dirs return Argument_List;
   --  Get the list of the object directories

   function Invert_Sense (S : String) return VMS_Data.String_Ptr;
   --  Given a unix switch string S, computes the inverse (adding or
   --  removing ! characters as required), and returns a pointer to
   --  the allocated result on the heap.

   function Is_Extensionless (F : String) return Boolean;
   --  Returns true if the filename has no extension

   function Match (S1, S2 : String) return Boolean;
   --  Determines whether S1 and S2 match (this is a case insensitive match)

   function Match_Prefix (S1, S2 : String) return Boolean;
   --  Determines whether S1 matches a prefix of S2. This is also a case
   --  insensitive match (for example Match ("AB","abc") is True).

   function Matching_Name
     (S     : String;
      Itm   : Item_Ptr;
      Quiet : Boolean := False) return Item_Ptr;
   --  Determines if the item list headed by Itm and threaded through the
   --  Next fields (with null marking the end of the list), contains an
   --  entry that uniquely matches the given string. The match is case
   --  insensitive and permits unique abbreviation. If the match succeeds,
   --  then a pointer to the matching item is returned. Otherwise, an
   --  appropriate error message is written. Note that the discriminant
   --  of Itm is used to determine the appropriate form of this message.
   --  Quiet is normally False as shown, if it is set to True, then no
   --  error message is generated in a not found situation (null is still
   --  returned to indicate the not-found situation).

   function OK_Alphanumerplus (S : String) return Boolean;
   --  Checks that S is a string of alphanumeric characters,
   --  returning True if all alphanumeric characters,
   --  False if empty or a non-alphanumeric character is present.

   function OK_Integer (S : String) return Boolean;
   --  Checks that S is a string of digits, returning True if all digits,
   --  False if empty or a non-digit is present.

   procedure Place (C : Character);
   --  Place a single character in the buffer, updating Ptr

   procedure Place (S : String);
   --  Place a string character in the buffer, updating Ptr

   procedure Place_Lower (S : String);
   --  Place string in buffer, forcing letters to lower case, updating Ptr

   procedure Place_Unix_Switches (S : VMS_Data.String_Ptr);
   --  Given a unix switch string, place corresponding switches in Buffer,
   --  updating Ptr appropriately. Note that in the case of use of ! the
   --  result may be to remove a previously placed switch.

   procedure Preprocess_Command_Data;
   --  Preprocess the string form of the command and options list into the
   --  internal form.

   procedure Process_Argument (The_Command : in out Command_Type);
   --  Process one argument from the command line, or one line from
   --  from a command line file. For the first call, set The_Command.

   procedure Process_Buffer (S : String);
   --  Process the characters in the Buffer table or the Cargs_Buffer table
   --  to convert these into arguments.

   procedure Validate_Command_Or_Option (N : VMS_Data.String_Ptr);
   --  Check that N is a valid command or option name, i.e. that it is of the
   --  form of an Ada identifier with upper case letters and underscores.

   procedure Validate_Unix_Switch (S : VMS_Data.String_Ptr);
   --  Check that S is a valid switch string as described in the syntax for
   --  the switch table item UNIX_SWITCH or else begins with a backquote.

   ----------------------
   -- Init_Object_Dirs --
   ----------------------

   function Init_Object_Dirs return Argument_List is
      Object_Dirs     : Integer;
      Object_Dir      : Argument_List (1 .. 256);
      Object_Dir_Name : String_Access;

   begin
      Object_Dirs := 0;
      Object_Dir_Name := new String'(Object_Dir_Default_Prefix);
      Get_Next_Dir_In_Path_Init (Object_Dir_Name);

      loop
         declare
            Dir : constant String_Access :=
                    Get_Next_Dir_In_Path (Object_Dir_Name);
         begin
            exit when Dir = null;
            Object_Dirs := Object_Dirs + 1;
            Object_Dir (Object_Dirs) :=
              new String'("-L" &
                          To_Canonical_Dir_Spec
                            (To_Host_Dir_Spec
                              (Normalize_Directory_Name (Dir.all).all,
                               True).all, True).all);
         end;
      end loop;

      Object_Dirs := Object_Dirs + 1;
      Object_Dir (Object_Dirs) := new String'("-lgnat");

      if OpenVMS_On_Target then
         Object_Dirs := Object_Dirs + 1;
         Object_Dir (Object_Dirs) := new String'("-ldecgnat");
      end if;

      return Object_Dir (1 .. Object_Dirs);
   end Init_Object_Dirs;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
   begin
      Command_List :=
        (Bind =>
           (Cname    => new S'("BIND"),
            Usage    => new S'("GNAT BIND file[.ali] /qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatbind"),
            Unixsws  => null,
            Switches => Bind_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_Files),
            Defext   => "ali"),

         Chop =>
           (Cname    => new S'("CHOP"),
            Usage    => new S'("GNAT CHOP file [directory] /qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatchop"),
            Unixsws  => null,
            Switches => Chop_Switches'Access,
            Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
            Defext   => "   "),

         Clean =>
           (Cname    => new S'("CLEAN"),
            Usage    => new S'("GNAT CLEAN /qualifiers files"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatclean"),
            Unixsws  => null,
            Switches => Clean_Switches'Access,
            Params   => new Parameter_Array'(1 => File),
            Defext   => "   "),

         Compile =>
           (Cname    => new S'("COMPILE"),
            Usage    => new S'("GNAT COMPILE filespec[,...] /qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatmake"),
            Unixsws  => new Argument_List'(1 => new String'("-f"),
                                           2 => new String'("-u"),
                                           3 => new String'("-c")),
            Switches => GCC_Switches'Access,
            Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
            Defext   => "   "),

         Check =>
           (Cname    => new S'("CHECK"),
            Usage    => new S'("GNAT CHECK name /qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatcheck"),
            Unixsws  => null,
            Switches => Check_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_Files),
            Defext   => "   "),

         Sync =>
           (Cname    => new S'("SYNC"),
            Usage    => new S'("GNAT SYNC name /qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatsync"),
            Unixsws  => null,
            Switches => Sync_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_Files),
            Defext   => "   "),

         Elim =>
           (Cname    => new S'("ELIM"),
            Usage    => new S'("GNAT ELIM name /qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatelim"),
            Unixsws  => null,
            Switches => Elim_Switches'Access,
            Params   => new Parameter_Array'(1 => Other_As_Is),
            Defext   => "ali"),

         Find =>
           (Cname    => new S'("FIND"),
            Usage    => new S'("GNAT FIND pattern[:sourcefile[:line"
                               & "[:column]]] filespec[,...] /qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatfind"),
            Unixsws  => null,
            Switches => Find_Switches'Access,
            Params   => new Parameter_Array'(1 => Other_As_Is,
                                             2 => Files_Or_Wildcard),
            Defext   => "ali"),

         Krunch =>
           (Cname    => new S'("KRUNCH"),
            Usage    => new S'("GNAT KRUNCH file [/COUNT=nnn]"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatkr"),
            Unixsws  => null,
            Switches => Krunch_Switches'Access,
            Params   => new Parameter_Array'(1 => File),
            Defext   => "   "),

         Link =>
           (Cname    => new S'("LINK"),
            Usage    => new S'("GNAT LINK file[.ali]"
                               & " [extra obj_&_lib_&_exe_&_opt files]"
                               & " /qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatlink"),
            Unixsws  => null,
            Switches => Link_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_Files),
            Defext   => "ali"),

         List =>
           (Cname    => new S'("LIST"),
            Usage    => new S'("GNAT LIST /qualifiers object_or_ali_file"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatls"),
            Unixsws  => null,
            Switches => List_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_Files),
            Defext   => "ali"),

         Make =>
           (Cname    => new S'("MAKE"),
            Usage    => new S'("GNAT MAKE file(s) /qualifiers (includes "
                               & "COMPILE /qualifiers)"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatmake"),
            Unixsws  => null,
            Switches => Make_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_Files),
            Defext   => "   "),

         Metric =>
           (Cname    => new S'("METRIC"),
            Usage    => new S'("GNAT METRIC /qualifiers source_file"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatmetric"),
            Unixsws  => null,
            Switches => Metric_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_Files),
            Defext   => "   "),

         Name =>
           (Cname    => new S'("NAME"),
            Usage    => new S'("GNAT NAME /qualifiers naming-pattern "
                               & "[naming-patterns]"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatname"),
            Unixsws  => null,
            Switches => Name_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_As_Is),
            Defext   => "   "),

         Preprocess =>
           (Cname    => new S'("PREPROCESS"),
            Usage    =>
              new S'("GNAT PREPROCESS ifile ofile dfile /qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatprep"),
            Unixsws  => null,
            Switches => Prep_Switches'Access,
            Params   => new Parameter_Array'(1 .. 3 => File),
            Defext   => "   "),

         Pretty =>
           (Cname    => new S'("PRETTY"),
            Usage    => new S'("GNAT PRETTY /qualifiers source_file"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatpp"),
            Unixsws  => null,
            Switches => Pretty_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_Files),
            Defext   => "   "),

         Shared =>
           (Cname    => new S'("SHARED"),
            Usage    => new S'("GNAT SHARED [obj_&_lib_&_exe_&_opt"
                               & "files] /qualifiers"),
            VMS_Only => True,
            Unixcmd  => new S'("gcc"),
            Unixsws  =>
            new Argument_List'(new String'("-shared") & Init_Object_Dirs),
            Switches => Shared_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_Files),
            Defext   => "   "),

         Stack =>
           (Cname    => new S'("STACK"),
            Usage    => new S'("GNAT STACK /qualifiers ci_files"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatstack"),
            Unixsws  => null,
            Switches => Stack_Switches'Access,
            Params   => new Parameter_Array'(1 => Unlimited_Files),
            Defext   => "ci" & ASCII.NUL),

         Stub =>
           (Cname    => new S'("STUB"),
            Usage    => new S'("GNAT STUB file [directory]/qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatstub"),
            Unixsws  => null,
            Switches => Stub_Switches'Access,
            Params   => new Parameter_Array'(1 => File, 2 => Optional_File),
            Defext   => "   "),

         Xref =>
           (Cname    => new S'("XREF"),
            Usage    => new S'("GNAT XREF filespec[,...] /qualifiers"),
            VMS_Only => False,
            Unixcmd  => new S'("gnatxref"),
            Unixsws  => null,
            Switches => Xref_Switches'Access,
            Params   => new Parameter_Array'(1 => Files_Or_Wildcard),
            Defext   => "ali")
        );
   end Initialize;

   ------------------
   -- Invert_Sense --
   ------------------

   function Invert_Sense (S : String) return VMS_Data.String_Ptr is
      Sinv : String (1 .. S'Length * 2);
      --  Result (for sure long enough)

      Sinvp : Natural := 0;
      --  Pointer to output string

   begin
      for Sp in S'Range loop
         if Sp = S'First or else S (Sp - 1) = ',' then
            if S (Sp) = '!' then
               null;
            else
               Sinv (Sinvp + 1) := '!';
               Sinv (Sinvp + 2) := S (Sp);
               Sinvp := Sinvp + 2;
            end if;

         else
            Sinv (Sinvp + 1) := S (Sp);
            Sinvp := Sinvp + 1;
         end if;
      end loop;

      return new String'(Sinv (1 .. Sinvp));
   end Invert_Sense;

   ----------------------
   -- Is_Extensionless --
   ----------------------

   function Is_Extensionless (F : String) return Boolean is
   begin
      for J in reverse F'Range loop
         if F (J) = '.' then
            return False;
         elsif F (J) = '/' or else F (J) = ']' or else F (J) = ':' then
            return True;
         end if;
      end loop;

      return True;
   end Is_Extensionless;

   -----------
   -- Match --
   -----------

   function Match (S1, S2 : String) return Boolean is
      Dif : constant Integer := S2'First - S1'First;

   begin

      if S1'Length /= S2'Length then
         return False;

      else
         for J in S1'Range loop
            if To_Lower (S1 (J)) /= To_Lower (S2 (J + Dif)) then
               return False;
            end if;
         end loop;

         return True;
      end if;
   end Match;

   ------------------
   -- Match_Prefix --
   ------------------

   function Match_Prefix (S1, S2 : String) return Boolean is
   begin
      if S1'Length > S2'Length then
         return False;
      else
         return Match (S1, S2 (S2'First .. S2'First + S1'Length - 1));
      end if;
   end Match_Prefix;

   -------------------
   -- Matching_Name --
   -------------------

   function Matching_Name
     (S     : String;
      Itm   : Item_Ptr;
      Quiet : Boolean := False) return Item_Ptr
   is
      P1, P2 : Item_Ptr;

      procedure Err;
      --  Little procedure to output command/qualifier/option as appropriate
      --  and bump error count.

      ---------
      -- Err --
      ---------

      procedure Err is
      begin
         if Quiet then
            return;
         end if;

         Errors := Errors + 1;

         if Itm /= null then
            case Itm.Id is
               when Id_Command =>
                  Put (Standard_Error, "command");

               when Id_Switch =>
                  if Hostparm.OpenVMS then
                     Put (Standard_Error, "qualifier");
                  else
                     Put (Standard_Error, "switch");
                  end if;

               when Id_Option =>
                  Put (Standard_Error, "option");

            end case;
         else
            Put (Standard_Error, "input");

         end if;

         Put (Standard_Error, ": ");
         Put (Standard_Error, S);
      end Err;

   --  Start of processing for Matching_Name

   begin
      --  If exact match, that's the one we want

      P1 := Itm;
      while P1 /= null loop
         if Match (S, P1.Name.all) then
            return P1;
         else
            P1 := P1.Next;
         end if;
      end loop;

      --  Now check for prefix matches

      P1 := Itm;
      while P1 /= null loop
         if P1.Name.all = "/<other>" then
            return P1;

         elsif not Match_Prefix (S, P1.Name.all) then
            P1 := P1.Next;

         else
            --  Here we have found one matching prefix, so see if there is
            --  another one (which is an ambiguity)

            P2 := P1.Next;
            while P2 /= null loop
               if Match_Prefix (S, P2.Name.all) then
                  if not Quiet then
                     Put (Standard_Error, "ambiguous ");
                     Err;
                     Put (Standard_Error, " (matches ");
                     Put (Standard_Error, P1.Name.all);

                     while P2 /= null loop
                        if Match_Prefix (S, P2.Name.all) then
                           Put (Standard_Error, ',');
                           Put (Standard_Error, P2.Name.all);
                        end if;

                        P2 := P2.Next;
                     end loop;

                     Put_Line (Standard_Error, ")");
                  end if;

                  return null;
               end if;

               P2 := P2.Next;
            end loop;

            --  If we fall through that loop, then there was only one match

            return P1;
         end if;
      end loop;

      --  If we fall through outer loop, there was no match

      if not Quiet then
         Put (Standard_Error, "unrecognized ");
         Err;
         New_Line (Standard_Error);
      end if;

      return null;
   end Matching_Name;

   -----------------------
   -- OK_Alphanumerplus --
   -----------------------

   function OK_Alphanumerplus (S : String) return Boolean is
   begin
      if S'Length = 0 then
         return False;

      else
         for J in S'Range loop
            if not (Is_Alphanumeric (S (J)) or else
                    S (J) = '_' or else S (J) = '$')
            then
               return False;
            end if;
         end loop;

         return True;
      end if;
   end OK_Alphanumerplus;

   ----------------
   -- OK_Integer --
   ----------------

   function OK_Integer (S : String) return Boolean is
   begin
      if S'Length = 0 then
         return False;

      else
         for J in S'Range loop
            if not Is_Digit (S (J)) then
               return False;
            end if;
         end loop;

         return True;
      end if;
   end OK_Integer;

   --------------------
   -- Output_Version --
   --------------------

   procedure Output_Version is
   begin
      if AAMP_On_Target then
         Put ("GNAAMP ");
      else
         Put ("GNAT ");
      end if;

      Put_Line (Gnatvsn.Gnat_Version_String);
      Put_Line ("Copyright 1996-" &
                Current_Year &
                ", Free Software Foundation, Inc.");
   end Output_Version;

   -----------
   -- Place --
   -----------

   procedure Place (C : Character) is
   begin
      if Cargs then
         Cargs_Buffer.Append (C);
      else
         Buffer.Append (C);
      end if;
   end Place;

   procedure Place (S : String) is
   begin
      for J in S'Range loop
         Place (S (J));
      end loop;
   end Place;

   -----------------
   -- Place_Lower --
   -----------------

   procedure Place_Lower (S : String) is
   begin
      for J in S'Range loop
         Place (To_Lower (S (J)));
      end loop;
   end Place_Lower;

   -------------------------
   -- Place_Unix_Switches --
   -------------------------

   procedure Place_Unix_Switches (S : VMS_Data.String_Ptr) is
      P1, P2, P3 : Natural;
      Remove     : Boolean;
      Slen, Sln2 : Natural;
      Wild_Card  : Boolean := False;

   begin
      P1 := S'First;
      while P1 <= S'Last loop
         if S (P1) = '!' then
            P1 := P1 + 1;
            Remove := True;
         else
            Remove := False;
         end if;

         P2 := P1;
         pragma Assert (S (P1) = '-' or else S (P1) = '`');

         while P2 < S'Last and then S (P2 + 1) /= ',' loop
            P2 := P2 + 1;
         end loop;

         --  Switch is now in S (P1 .. P2)

         Slen := P2 - P1 + 1;

         if Remove then
            Wild_Card := S (P2) = '*';

            if Wild_Card then
               Slen := Slen - 1;
               P2   := P2 - 1;
            end if;

            P3 := 1;
            while P3 <= Buffer.Last - Slen loop
               if Buffer.Table (P3) = ' '
                 and then String (Buffer.Table (P3 + 1 .. P3 + Slen)) =
                                                             S (P1 .. P2)
                 and then (Wild_Card
                             or else
                           P3 + Slen = Buffer.Last
                             or else
                           Buffer.Table (P3 + Slen + 1) = ' ')
               then
                  Sln2 := Slen;

                  if Wild_Card then
                     while P3 + Sln2 /= Buffer.Last
                       and then Buffer.Table (P3 + Sln2 + 1) /= ' '
                     loop
                        Sln2 := Sln2 + 1;
                     end loop;
                  end if;

                  Buffer.Table (P3 .. Buffer.Last - Sln2 - 1) :=
                    Buffer.Table (P3 + Sln2 + 1 .. Buffer.Last);
                  Buffer.Set_Last (Buffer.Last - Sln2 - 1);

               else
                  P3 := P3 + 1;
               end if;
            end loop;

            if Wild_Card then
               P2 := P2 + 1;
            end if;

         else
            pragma Assert (S (P2) /= '*');
            Place (' ');

            if S (P1) = '`' then
               P1 := P1 + 1;
            end if;

            Place (S (P1 .. P2));
         end if;

         P1 := P2 + 2;
      end loop;
   end Place_Unix_Switches;

   -----------------------------
   -- Preprocess_Command_Data --
   -----------------------------

   procedure Preprocess_Command_Data is
   begin
      for C in Real_Command_Type loop
         declare
            Command : constant Item_Ptr := new Command_Item;

            Last_Switch : Item_Ptr;
            --  Last switch in list

         begin
            --  Link new command item into list of commands

            if Last_Command = null then
               Commands := Command;
            else
               Last_Command.Next := Command;
            end if;

            Last_Command := Command;

            --  Fill in fields of new command item

            Command.Name    := Command_List (C).Cname;
            Command.Usage   := Command_List (C).Usage;
            Command.Command := C;

            if Command_List (C).Unixsws = null then
               Command.Unix_String := Command_List (C).Unixcmd;
            else
               declare
                  Cmd  : String (1 .. 5_000);
                  Last : Natural := 0;
                  Sws  : constant Argument_List_Access :=
                           Command_List (C).Unixsws;

               begin
                  Cmd (1 .. Command_List (C).Unixcmd'Length) :=
                    Command_List (C).Unixcmd.all;
                  Last := Command_List (C).Unixcmd'Length;

                  for J in Sws'Range loop
                     Last := Last + 1;
                     Cmd (Last) := ' ';
                     Cmd (Last + 1 .. Last + Sws (J)'Length) :=
                       Sws (J).all;
                     Last := Last + Sws (J)'Length;
                  end loop;

                  Command.Unix_String := new String'(Cmd (1 .. Last));
               end;
            end if;

            Command.Params := Command_List (C).Params;
            Command.Defext := Command_List (C).Defext;

            Validate_Command_Or_Option (Command.Name);

            --  Process the switch list

            for S in Command_List (C).Switches'Range loop
               declare
                  SS : constant VMS_Data.String_Ptr :=
                         Command_List (C).Switches (S);
                  P  : Natural := SS'First;
                  Sw : Item_Ptr := new Switch_Item;

                  Last_Opt : Item_Ptr;
                  --  Pointer to last option

               begin
                  --  Link new switch item into list of switches

                  if Last_Switch = null then
                     Command.Switches := Sw;
                  else
                     Last_Switch.Next := Sw;
                  end if;

                  Last_Switch := Sw;

                  --  Process switch string, first get name

                  while SS (P) /= ' ' and then SS (P) /= '=' loop
                     P := P + 1;
                  end loop;

                  Sw.Name := new String'(SS (SS'First .. P - 1));

                  --  Direct translation case

                  if SS (P) = ' ' then
                     Sw.Translation := T_Direct;
                     Sw.Unix_String := new String'(SS (P + 1 .. SS'Last));
                     Validate_Unix_Switch (Sw.Unix_String);

                     if SS (P - 1) = '>' then
                        Sw.Translation := T_Other;

                     elsif SS (P + 1) = '`' then
                        null;

                        --  Create the inverted case (/NO ..)

                     elsif SS (SS'First + 1 .. SS'First + 2) /= "NO" then
                        Sw := new Switch_Item;
                        Last_Switch.Next := Sw;
                        Last_Switch := Sw;

                        Sw.Name :=
                          new String'("/NO" & SS (SS'First + 1 .. P - 1));
                        Sw.Translation := T_Direct;
                        Sw.Unix_String := Invert_Sense (SS (P + 1 .. SS'Last));
                        Validate_Unix_Switch (Sw.Unix_String);
                     end if;

                  --  Directories translation case

                  elsif SS (P + 1) = '*' then
                     pragma Assert (SS (SS'Last) = '*');
                     Sw.Translation := T_Directories;
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                     Validate_Unix_Switch (Sw.Unix_String);

                  --  Directory translation case

                  elsif SS (P + 1) = '%' then
                     pragma Assert (SS (SS'Last) = '%');
                     Sw.Translation := T_Directory;
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                     Validate_Unix_Switch (Sw.Unix_String);

                  --  File translation case

                  elsif SS (P + 1) = '@' then
                     pragma Assert (SS (SS'Last) = '@');
                     Sw.Translation := T_File;
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                     Validate_Unix_Switch (Sw.Unix_String);

                  --  No space file translation case

                  elsif SS (P + 1) = '<' then
                     pragma Assert (SS (SS'Last) = '>');
                     Sw.Translation := T_No_Space_File;
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                     Validate_Unix_Switch (Sw.Unix_String);

                  --  Numeric translation case

                  elsif SS (P + 1) = '#' then
                     pragma Assert (SS (SS'Last) = '#');
                     Sw.Translation := T_Numeric;
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                     Validate_Unix_Switch (Sw.Unix_String);

                  --  Alphanumerplus translation case

                  elsif SS (P + 1) = '|' then
                     pragma Assert (SS (SS'Last) = '|');
                     Sw.Translation := T_Alphanumplus;
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                     Validate_Unix_Switch (Sw.Unix_String);

                  --  String translation case

                  elsif SS (P + 1) = '"' then
                     pragma Assert (SS (SS'Last) = '"');
                     Sw.Translation := T_String;
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last - 1));
                     Validate_Unix_Switch (Sw.Unix_String);

                  --  Commands translation case

                  elsif SS (P + 1) = '?' then
                     Sw.Translation := T_Commands;
                     Sw.Unix_String := new String'(SS (P + 2 .. SS'Last));

                  --  Options translation case

                  else
                     Sw.Translation := T_Options;
                     Sw.Unix_String := new String'("");

                     P := P + 1; -- bump past =
                     while P <= SS'Last loop
                        declare
                           Opt : constant Item_Ptr := new Option_Item;
                           Q   : Natural;

                        begin
                           --  Link new option item into options list

                           if Last_Opt = null then
                              Sw.Options := Opt;
                           else
                              Last_Opt.Next := Opt;
                           end if;

                           Last_Opt := Opt;

                           --  Fill in fields of new option item

                           Q := P;
                           while SS (Q) /= ' ' loop
                              Q := Q + 1;
                           end loop;

                           Opt.Name := new String'(SS (P .. Q - 1));
                           Validate_Command_Or_Option (Opt.Name);

                           P := Q + 1;
                           Q := P;

                           while Q <= SS'Last and then SS (Q) /= ' ' loop
                              Q := Q + 1;
                           end loop;

                           Opt.Unix_String := new String'(SS (P .. Q - 1));
                           Validate_Unix_Switch (Opt.Unix_String);
                           P := Q + 1;
                        end;
                     end loop;
                  end if;
               end;
            end loop;
         end;
      end loop;
   end Preprocess_Command_Data;

   ----------------------
   -- Process_Argument --
   ----------------------

   procedure Process_Argument (The_Command : in out Command_Type) is
      Argv    : String_Access;
      Arg_Idx : Integer;

      function Get_Arg_End
        (Argv    : String;
         Arg_Idx : Integer) return Integer;
      --  Begins looking at Arg_Idx + 1 and returns the index of the
      --  last character before a slash or else the index of the last
      --  character in the string Argv.

      -----------------
      -- Get_Arg_End --
      -----------------

      function Get_Arg_End
        (Argv    : String;
         Arg_Idx : Integer) return Integer
      is
      begin
         for J in Arg_Idx + 1 .. Argv'Last loop
            if Argv (J) = '/' then
               return J - 1;
            end if;
         end loop;

         return Argv'Last;
      end Get_Arg_End;

      --  Start of processing for Process_Argument

   begin
      Cargs := False;

      --  If an argument file is open, read the next non empty line

      if Is_Open (Arg_File) then
         declare
            Line : String (1 .. 256);
            Last : Natural;
         begin
            loop
               Get_Line (Arg_File, Line, Last);
               exit when Last /= 0 or else End_Of_File (Arg_File);
            end loop;

            --  If the end of the argument file has been reached, close it

            if End_Of_File (Arg_File) then
               Close (Arg_File);

               --  If the last line was empty, return after increasing Arg_Num
               --  to go to the next argument on the comment line.

               if Last = 0 then
                  Arg_Num := Arg_Num + 1;
                  return;
               end if;
            end if;

            Argv := new String'(Line (1 .. Last));
            Arg_Idx := 1;

            if Argv (1) = '@' then
               Put_Line (Standard_Error, "argument file cannot contain @cmd");
               raise Error_Exit;
            end if;
         end;

      else
         --  No argument file is open, get the argument on the command line

         Argv := new String'(Argument (Arg_Num));
         Arg_Idx := Argv'First;

         --  Check if this is the specification of an argument file

         if Argv (Arg_Idx) = '@' then
            --  The first argument on the command line cannot be an argument
            --  file.

            if Arg_Num = 1 then
               Put_Line
                 (Standard_Error,
                  "Cannot specify argument line before command");
               raise Error_Exit;
            end if;

            --  Open the file, after conversion of the name to canonical form.
            --  Fail if file is not found.

            declare
               Canonical_File_Name : String_Access :=
                 To_Canonical_File_Spec (Argv (Arg_Idx + 1 .. Argv'Last));
            begin
               Open (Arg_File, In_File, Canonical_File_Name.all);
               Free (Canonical_File_Name);
               return;

            exception
               when others =>
                  Put (Standard_Error, "Cannot open argument file """);
                  Put (Standard_Error, Argv (Arg_Idx + 1 .. Argv'Last));
                  Put_Line (Standard_Error, """");
                  raise Error_Exit;
            end;
         end if;
      end if;

      <<Tryagain_After_Coalesce>>
      loop
         declare
            Next_Arg_Idx : Integer;
            Arg          : String_Access;

         begin
            Next_Arg_Idx := Get_Arg_End (Argv.all, Arg_Idx);
            Arg := new String'(Argv (Arg_Idx .. Next_Arg_Idx));

            --  The first one must be a command name

            if Arg_Num = 1 and then Arg_Idx = Argv'First then
               Command := Matching_Name (Arg.all, Commands);

               if Command = null then
                  raise Error_Exit;
               end if;

               The_Command := Command.Command;
               Output_File_Expected := False;

               --  Give usage information if only command given

               if Argument_Count = 1
                 and then Next_Arg_Idx = Argv'Last
               then
                  Output_Version;
                  New_Line;
                  Put_Line
                    ("List of available qualifiers and options");
                  New_Line;

                  Put (Command.Usage.all);
                  Set_Col (53);
                  Put_Line (Command.Unix_String.all);

                  declare
                     Sw : Item_Ptr := Command.Switches;

                  begin
                     while Sw /= null loop
                        Put ("   ");
                        Put (Sw.Name.all);

                        case Sw.Translation is

                           when T_Other =>
                              Set_Col (53);
                              Put_Line (Sw.Unix_String.all &
                                        "/<other>");

                           when T_Direct =>
                              Set_Col (53);
                              Put_Line (Sw.Unix_String.all);

                           when T_Directories =>
                              Put ("=(direc,direc,..direc)");
                              Set_Col (53);
                              Put (Sw.Unix_String.all);
                              Put (" direc ");
                              Put (Sw.Unix_String.all);
                              Put_Line (" direc ...");

                           when T_Directory =>
                              Put ("=directory");
                              Set_Col (53);
                              Put (Sw.Unix_String.all);

                              if Sw.Unix_String (Sw.Unix_String'Last)
                              /= '='
                              then
                                 Put (' ');
                              end if;

                              Put_Line ("directory ");

                           when T_File | T_No_Space_File =>
                              Put ("=file");
                              Set_Col (53);
                              Put (Sw.Unix_String.all);

                              if Sw.Translation = T_File
                                and then Sw.Unix_String
                                  (Sw.Unix_String'Last) /= '='
                              then
                                 Put (' ');
                              end if;

                              Put_Line ("file ");

                           when T_Numeric =>
                              Put ("=nnn");
                              Set_Col (53);

                              if Sw.Unix_String
                                (Sw.Unix_String'First) = '`'
                              then
                                 Put (Sw.Unix_String
                                        (Sw.Unix_String'First + 1
                                         .. Sw.Unix_String'Last));
                              else
                                 Put (Sw.Unix_String.all);
                              end if;

                              Put_Line ("nnn");

                           when T_Alphanumplus =>
                              Put ("=xyz");
                              Set_Col (53);

                              if Sw.Unix_String
                                (Sw.Unix_String'First) = '`'
                              then
                                 Put (Sw.Unix_String
                                        (Sw.Unix_String'First + 1
                                         .. Sw.Unix_String'Last));
                              else
                                 Put (Sw.Unix_String.all);
                              end if;

                              Put_Line ("xyz");

                           when T_String =>
                              Put ("=");
                              Put ('"');
                              Put ("<string>");
                              Put ('"');
                              Set_Col (53);

                              Put (Sw.Unix_String.all);

                              if Sw.Unix_String
                                (Sw.Unix_String'Last) /= '='
                              then
                                 Put (' ');
                              end if;

                              Put ("<string>");
                              New_Line;

                           when T_Commands =>
                              Put (" (switches for ");
                              Put (Sw.Unix_String
                                     (Sw.Unix_String'First + 7
                                      .. Sw.Unix_String'Last));
                              Put (')');
                              Set_Col (53);
                              Put (Sw.Unix_String
                                     (Sw.Unix_String'First
                                      .. Sw.Unix_String'First + 5));
                              Put_Line (" switches");

                           when T_Options =>
                              declare
                                 Opt : Item_Ptr := Sw.Options;

                              begin
                                 Put_Line ("=(option,option..)");

                                 while Opt /= null loop
                                    Put ("      ");
                                    Put (Opt.Name.all);

                                    if Opt = Sw.Options then
                                       Put (" (D)");
                                    end if;

                                    Set_Col (53);
                                    Put_Line (Opt.Unix_String.all);
                                    Opt := Opt.Next;
                                 end loop;
                              end;

                        end case;

                        Sw := Sw.Next;
                     end loop;
                  end;

                  raise Normal_Exit;
               end if;

            --  Special handling for internal debugging switch /?

            elsif Arg.all = "/?" then
               Display_Command := True;
               Output_File_Expected := False;

            --  Special handling of internal option /KEEP_TEMPORARY_FILES

            elsif Arg'Length >= 7
              and then Matching_Name
                         (Arg.all, Keep_Temps_Option, True) /= null
            then
               Opt.Keep_Temporary_Files := True;

            --  Copy -switch unchanged, as well as +rule

            elsif Arg (Arg'First) = '-' or else Arg (Arg'First) = '+' then
               Place (' ');
               Place (Arg.all);

               --  Set Output_File_Expected for the next argument

               Output_File_Expected :=
                 Arg.all = "-o" and then The_Command = Link;

               --  Copy quoted switch with quotes stripped

            elsif Arg (Arg'First) = '"' then
               if Arg (Arg'Last) /= '"' then
                  Put (Standard_Error, "misquoted argument: ");
                  Put_Line (Standard_Error, Arg.all);
                  Errors := Errors + 1;

               else
                  Place (' ');
                  Place (Arg (Arg'First + 1 .. Arg'Last - 1));
               end if;

               Output_File_Expected := False;

               --  Parameter Argument

            elsif Arg (Arg'First) /= '/'
              and then Make_Commands_Active = null
            then
               Param_Count := Param_Count + 1;

               if Param_Count <= Command.Params'Length then

                  case Command.Params (Param_Count) is

                     when File | Optional_File =>
                        declare
                           Normal_File : constant String_Access :=
                             To_Canonical_File_Spec
                               (Arg.all);

                        begin
                           Place (' ');
                           Place_Lower (Normal_File.all);

                           if Is_Extensionless (Normal_File.all)
                             and then Command.Defext /= "   "
                           then
                              Place ('.');
                              Place (Command.Defext);
                           end if;
                        end;

                     when Unlimited_Files =>
                        declare
                           Normal_File : constant String_Access :=
                             To_Canonical_File_Spec
                               (Arg.all);

                           File_Is_Wild : Boolean := False;
                           File_List    : String_Access_List_Access;

                        begin
                           for J in Arg'Range loop
                              if Arg (J) = '*'
                                or else Arg (J) = '%'
                              then
                                 File_Is_Wild := True;
                              end if;
                           end loop;

                           if File_Is_Wild then
                              File_List := To_Canonical_File_List
                                (Arg.all, False);

                              for J in File_List.all'Range loop
                                 Place (' ');
                                 Place_Lower (File_List.all (J).all);
                              end loop;

                           else
                              Place (' ');
                              Place_Lower (Normal_File.all);

                              --  Add extension if not present, except after
                              --  switch -o.

                              if Is_Extensionless (Normal_File.all)
                                and then Command.Defext /= "   "
                                and then not Output_File_Expected
                              then
                                 Place ('.');
                                 Place (Command.Defext);
                              end if;
                           end if;

                           Param_Count := Param_Count - 1;
                        end;

                     when Other_As_Is =>
                        Place (' ');
                        Place (Arg.all);

                     when Unlimited_As_Is =>
                        Place (' ');
                        Place (Arg.all);
                        Param_Count := Param_Count - 1;

                     when Files_Or_Wildcard =>

                        --  Remove spaces from a comma separated list
                        --  of file names and adjust control variables
                        --  accordingly.

                        while Arg_Num < Argument_Count and then
                          (Argv (Argv'Last) = ',' xor
                             Argument (Arg_Num + 1)
                             (Argument (Arg_Num + 1)'First) = ',')
                        loop
                           Argv := new String'
                             (Argv.all & Argument (Arg_Num + 1));
                           Arg_Num := Arg_Num + 1;
                           Arg_Idx := Argv'First;
                           Next_Arg_Idx :=
                             Get_Arg_End (Argv.all, Arg_Idx);
                           Arg := new String'
                             (Argv (Arg_Idx .. Next_Arg_Idx));
                        end loop;

                        --  Parse the comma separated list of VMS
                        --  filenames and place them on the command
                        --  line as space separated Unix style
                        --  filenames. Lower case and add default
                        --  extension as appropriate.

                        declare
                           Arg1_Idx : Integer := Arg'First;

                           function Get_Arg1_End
                             (Arg     : String;
                              Arg_Idx : Integer) return Integer;
                           --  Begins looking at Arg_Idx + 1 and
                           --  returns the index of the last character
                           --  before a comma or else the index of the
                           --  last character in the string Arg.

                           ------------------
                           -- Get_Arg1_End --
                           ------------------

                           function Get_Arg1_End
                             (Arg     : String;
                              Arg_Idx : Integer) return Integer
                           is
                           begin
                              for J in Arg_Idx + 1 .. Arg'Last loop
                                 if Arg (J) = ',' then
                                    return J - 1;
                                 end if;
                              end loop;

                              return Arg'Last;
                           end Get_Arg1_End;

                        begin
                           loop
                              declare
                                 Next_Arg1_Idx :
                                 constant Integer :=
                                   Get_Arg1_End (Arg.all, Arg1_Idx);

                                 Arg1 :
                                 constant String :=
                                   Arg (Arg1_Idx .. Next_Arg1_Idx);

                                 Normal_File :
                                 constant String_Access :=
                                   To_Canonical_File_Spec (Arg1);

                              begin
                                 Place (' ');
                                 Place_Lower (Normal_File.all);

                                 if Is_Extensionless (Normal_File.all)
                                   and then Command.Defext /= "   "
                                 then
                                    Place ('.');
                                    Place (Command.Defext);
                                 end if;

                                 Arg1_Idx := Next_Arg1_Idx + 1;
                              end;

                              exit when Arg1_Idx > Arg'Last;

                              --  Don't allow two or more commas in
                              --  a row

                              if Arg (Arg1_Idx) = ',' then
                                 Arg1_Idx := Arg1_Idx + 1;
                                 if Arg1_Idx > Arg'Last or else
                                   Arg (Arg1_Idx) = ','
                                 then
                                    Put_Line
                                      (Standard_Error,
                                       "Malformed Parameter: " &
                                       Arg.all);
                                    Put (Standard_Error, "usage: ");
                                    Put_Line (Standard_Error,
                                              Command.Usage.all);
                                    raise Error_Exit;
                                 end if;
                              end if;

                           end loop;
                        end;
                  end case;
               end if;

               --  Reset Output_File_Expected, in case it was True

               Output_File_Expected := False;

               --  Qualifier argument

            else
               Output_File_Expected := False;

               Cargs := Command.Name.all = "COMPILE";

               --  This code is too heavily nested, should be
               --  separated out as separate subprogram ???

               declare
                  Sw   : Item_Ptr;
                  SwP  : Natural;
                  P2   : Natural;
                  Endp : Natural := 0; -- avoid warning!
                  Opt  : Item_Ptr;

               begin
                  SwP := Arg'First;
                  while SwP < Arg'Last
                    and then Arg (SwP + 1) /= '='
                  loop
                     SwP := SwP + 1;
                  end loop;

                  --  At this point, the switch name is in
                  --  Arg (Arg'First..SwP) and if that is not the
                  --  whole switch, then there is an equal sign at
                  --  Arg (SwP + 1) and the rest of Arg is what comes
                  --  after the equal sign.

                  --  If make commands are active, see if we have
                  --  another COMMANDS_TRANSLATION switch belonging
                  --  to gnatmake.

                  if Make_Commands_Active /= null then
                     Sw :=
                       Matching_Name
                         (Arg (Arg'First .. SwP),
                          Command.Switches,
                          Quiet => True);

                     if Sw /= null
                       and then Sw.Translation = T_Commands
                     then
                        null;

                     else
                        Sw :=
                          Matching_Name
                            (Arg (Arg'First .. SwP),
                             Make_Commands_Active.Switches,
                             Quiet => False);
                     end if;

                     --  For case of GNAT MAKE or CHOP, if we cannot
                     --  find the switch, then see if it is a
                     --  recognized compiler switch instead, and if
                     --  so process the compiler switch.

                  elsif Command.Name.all = "MAKE"
                    or else Command.Name.all = "CHOP" then
                     Sw :=
                       Matching_Name
                         (Arg (Arg'First .. SwP),
                          Command.Switches,
                          Quiet => True);

                     if Sw = null then
                        Sw :=
                          Matching_Name
                            (Arg (Arg'First .. SwP),
                             Matching_Name
                               ("COMPILE", Commands).Switches,
                             Quiet => False);
                     end if;

                     --  For all other cases, just search the relevant
                     --  command.

                  else
                     Sw :=
                       Matching_Name
                         (Arg (Arg'First .. SwP),
                          Command.Switches,
                          Quiet => False);
                  end if;

                  if Sw /= null then
                     if Cargs
                       and then Sw.Name /= null
                       and then
                         (Sw.Name.all = "/PROJECT_FILE"          or else
                          Sw.Name.all = "/MESSAGES_PROJECT_FILE" or else
                          Sw.Name.all = "/EXTERNAL_REFERENCE")
                     then
                        Cargs := False;
                     end if;

                     case Sw.Translation is
                        when T_Direct =>
                           Place_Unix_Switches (Sw.Unix_String);
                           if SwP < Arg'Last
                             and then Arg (SwP + 1) = '='
                           then
                              Put (Standard_Error,
                                   "qualifier options ignored: ");
                              Put_Line (Standard_Error, Arg.all);
                           end if;

                        when T_Directories =>
                           if SwP + 1 > Arg'Last then
                              Put (Standard_Error,
                                   "missing directories for: ");
                              Put_Line (Standard_Error, Arg.all);
                              Errors := Errors + 1;

                           elsif Arg (SwP + 2) /= '(' then
                              SwP := SwP + 2;
                              Endp := Arg'Last;

                           elsif Arg (Arg'Last) /= ')' then

                              --  Remove spaces from a comma separated
                              --  list of file names and adjust
                              --  control variables accordingly.

                              if Arg_Num < Argument_Count and then
                                (Argv (Argv'Last) = ',' xor
                                   Argument (Arg_Num + 1)
                                   (Argument (Arg_Num + 1)'First) = ',')
                              then
                                 Argv :=
                                   new String'(Argv.all
                                               & Argument
                                                 (Arg_Num + 1));
                                 Arg_Num := Arg_Num + 1;
                                 Arg_Idx := Argv'First;
                                 Next_Arg_Idx :=
                                   Get_Arg_End (Argv.all, Arg_Idx);
                                 Arg := new String'
                                   (Argv (Arg_Idx .. Next_Arg_Idx));
                                 goto Tryagain_After_Coalesce;
                              end if;

                              Put (Standard_Error,
                                   "incorrectly parenthesized " &
                                   "or malformed argument: ");
                              Put_Line (Standard_Error, Arg.all);
                              Errors := Errors + 1;

                           else
                              SwP := SwP + 3;
                              Endp := Arg'Last - 1;
                           end if;

                           while SwP <= Endp loop
                              declare
                                 Dir_Is_Wild       : Boolean := False;
                                 Dir_Maybe_Is_Wild : Boolean := False;

                                 Dir_List : String_Access_List_Access;

                              begin
                                 P2 := SwP;

                                 while P2 < Endp
                                   and then Arg (P2 + 1) /= ','
                                 loop
                                    --  A wildcard directory spec on
                                    --  VMS will contain either * or
                                    --  % or ...

                                    if Arg (P2) = '*' then
                                       Dir_Is_Wild := True;

                                    elsif Arg (P2) = '%' then
                                       Dir_Is_Wild := True;

                                    elsif Dir_Maybe_Is_Wild
                                      and then Arg (P2) = '.'
                                      and then Arg (P2 + 1) = '.'
                                    then
                                       Dir_Is_Wild := True;
                                       Dir_Maybe_Is_Wild := False;

                                    elsif Dir_Maybe_Is_Wild then
                                       Dir_Maybe_Is_Wild := False;

                                    elsif Arg (P2) = '.'
                                      and then Arg (P2 + 1) = '.'
                                    then
                                       Dir_Maybe_Is_Wild := True;

                                    end if;

                                    P2 := P2 + 1;
                                 end loop;

                                 if Dir_Is_Wild then
                                    Dir_List :=
                                      To_Canonical_File_List
                                        (Arg (SwP .. P2), True);

                                    for J in Dir_List.all'Range loop
                                       Place_Unix_Switches
                                         (Sw.Unix_String);
                                       Place_Lower
                                         (Dir_List.all (J).all);
                                    end loop;

                                 else
                                    Place_Unix_Switches
                                      (Sw.Unix_String);
                                    Place_Lower
                                      (To_Canonical_Dir_Spec
                                         (Arg (SwP .. P2), False).all);
                                 end if;

                                 SwP := P2 + 2;
                              end;
                           end loop;

                        when T_Directory =>
                           if SwP + 1 > Arg'Last then
                              Put (Standard_Error,
                                   "missing directory for: ");
                              Put_Line (Standard_Error, Arg.all);
                              Errors := Errors + 1;

                           else
                              Place_Unix_Switches (Sw.Unix_String);

                              --  Some switches end in "=". No space
                              --  here

                              if Sw.Unix_String
                                (Sw.Unix_String'Last) /= '='
                              then
                                 Place (' ');
                              end if;

                              Place_Lower
                                (To_Canonical_Dir_Spec
                                   (Arg (SwP + 2 .. Arg'Last),
                                    False).all);
                           end if;

                        when T_File | T_No_Space_File =>
                           if SwP + 1 > Arg'Last then
                              Put (Standard_Error,
                                   "missing file for: ");
                              Put_Line (Standard_Error, Arg.all);
                              Errors := Errors + 1;

                           else
                              Place_Unix_Switches (Sw.Unix_String);

                              --  Some switches end in "=". No space
                              --  here.

                              if Sw.Translation = T_File
                                and then Sw.Unix_String
                                  (Sw.Unix_String'Last) /= '='
                              then
                                 Place (' ');
                              end if;

                              Place_Lower
                                (To_Canonical_File_Spec
                                   (Arg (SwP + 2 .. Arg'Last)).all);
                           end if;

                        when T_Numeric =>
                           if OK_Integer (Arg (SwP + 2 .. Arg'Last)) then
                              Place_Unix_Switches (Sw.Unix_String);
                              Place (Arg (SwP + 2 .. Arg'Last));

                           else
                              Put (Standard_Error, "argument for ");
                              Put (Standard_Error, Sw.Name.all);
                              Put_Line
                                (Standard_Error, " must be numeric");
                              Errors := Errors + 1;
                           end if;

                        when T_Alphanumplus =>
                           if OK_Alphanumerplus
                             (Arg (SwP + 2 .. Arg'Last))
                           then
                              Place_Unix_Switches (Sw.Unix_String);
                              Place (Arg (SwP + 2 .. Arg'Last));

                           else
                              Put (Standard_Error, "argument for ");
                              Put (Standard_Error, Sw.Name.all);
                              Put_Line (Standard_Error,
                                        " must be alphanumeric");
                              Errors := Errors + 1;
                           end if;

                        when T_String =>

                           --  A String value must be extended to the
                           --  end of the Argv, otherwise strings like
                           --  "foo/bar" get split at the slash.

                           --  The beginning and ending of the string
                           --  are flagged with embedded nulls which
                           --  are removed when building the Spawn
                           --  call. Nulls are use because they won't
                           --  show up in a /? output. Quotes aren't
                           --  used because that would make it
                           --  difficult to embed them.

                           Place_Unix_Switches (Sw.Unix_String);

                           if Next_Arg_Idx /= Argv'Last then
                              Next_Arg_Idx := Argv'Last;
                              Arg := new String'
                                (Argv (Arg_Idx .. Next_Arg_Idx));

                              SwP := Arg'First;
                              while SwP < Arg'Last and then
                              Arg (SwP + 1) /= '=' loop
                                 SwP := SwP + 1;
                              end loop;
                           end if;

                           Place (ASCII.NUL);
                           Place (Arg (SwP + 2 .. Arg'Last));
                           Place (ASCII.NUL);

                        when T_Commands =>

                           --  Output -largs/-bargs/-cargs

                           Place (' ');
                           Place (Sw.Unix_String
                                    (Sw.Unix_String'First ..
                                       Sw.Unix_String'First + 5));

                           if Sw.Unix_String
                             (Sw.Unix_String'First + 7 ..
                                Sw.Unix_String'Last) = "MAKE"
                           then
                              Make_Commands_Active := null;

                           else
                              --  Set source of new commands, also
                              --  setting this non-null indicates that
                              --  we are in the special commands mode
                              --  for processing the -xargs case.

                              Make_Commands_Active :=
                                Matching_Name
                                  (Sw.Unix_String
                                       (Sw.Unix_String'First + 7 ..
                                            Sw.Unix_String'Last),
                                   Commands);
                           end if;

                        when T_Options =>
                           if SwP + 1 > Arg'Last then
                              Place_Unix_Switches
                                (Sw.Options.Unix_String);
                              SwP := Endp + 1;

                           elsif Arg (SwP + 2) /= '(' then
                              SwP := SwP + 2;
                              Endp := Arg'Last;

                           elsif Arg (Arg'Last) /= ')' then
                              Put (Standard_Error,
                                   "incorrectly parenthesized argument: ");
                              Put_Line (Standard_Error, Arg.all);
                              Errors := Errors + 1;
                              SwP := Endp + 1;

                           else
                              SwP := SwP + 3;
                              Endp := Arg'Last - 1;
                           end if;

                           while SwP <= Endp loop
                              P2 := SwP;

                              while P2 < Endp
                                and then Arg (P2 + 1) /= ','
                              loop
                                 P2 := P2 + 1;
                              end loop;

                              --  Option name is in Arg (SwP .. P2)

                              Opt := Matching_Name (Arg (SwP .. P2),
                                                    Sw.Options);

                              if Opt /= null then
                                 Place_Unix_Switches
                                   (Opt.Unix_String);
                              end if;

                              SwP := P2 + 2;
                           end loop;

                        when T_Other =>
                           Place_Unix_Switches
                             (new String'(Sw.Unix_String.all &
                                          Arg.all));

                     end case;
                  end if;
               end;
            end if;

            Arg_Idx := Next_Arg_Idx + 1;
         end;

         exit when Arg_Idx > Argv'Last;

      end loop;

      if not Is_Open (Arg_File) then
         Arg_Num := Arg_Num + 1;
      end if;
   end Process_Argument;

   --------------------
   -- Process_Buffer --
   --------------------

   procedure Process_Buffer (S : String) is
      P1, P2     : Natural;
      Inside_Nul : Boolean := False;
      Arg        : String (1 .. 1024);
      Arg_Ctr    : Natural;

   begin
      P1 := 1;
      while P1 <= S'Last and then S (P1) = ' ' loop
         P1 := P1 + 1;
      end loop;

      Arg_Ctr := 1;
      Arg (Arg_Ctr) := S (P1);

      while P1 <= S'Last loop
         if S (P1) = ASCII.NUL then
            if Inside_Nul then
               Inside_Nul := False;
            else
               Inside_Nul := True;
            end if;
         end if;

         if S (P1) = ' ' and then not Inside_Nul then
            P1 := P1 + 1;
            Arg_Ctr := Arg_Ctr + 1;
            Arg (Arg_Ctr) := S (P1);

         else
            Last_Switches.Increment_Last;
            P2 := P1;

            while P2 < S'Last
              and then (S (P2 + 1) /= ' ' or else
                        Inside_Nul)
            loop
               P2 := P2 + 1;
               Arg_Ctr := Arg_Ctr + 1;
               Arg (Arg_Ctr) := S (P2);
               if S (P2) = ASCII.NUL then
                  Arg_Ctr := Arg_Ctr - 1;

                  if Inside_Nul then
                     Inside_Nul := False;
                  else
                     Inside_Nul := True;
                  end if;
               end if;
            end loop;

            Last_Switches.Table (Last_Switches.Last) :=
              new String'(String (Arg (1 .. Arg_Ctr)));
            P1 := P2 + 2;

            exit when P1 > S'Last;

            Arg_Ctr := 1;
            Arg (Arg_Ctr) := S (P1);
         end if;
      end loop;
   end Process_Buffer;

   --------------------------------
   -- Validate_Command_Or_Option --
   --------------------------------

   procedure Validate_Command_Or_Option (N : VMS_Data.String_Ptr) is
   begin
      pragma Assert (N'Length > 0);

      for J in N'Range loop
         if N (J) = '_' then
            pragma Assert (N (J - 1) /= '_');
            null;
         else
            pragma Assert (Is_Upper (N (J)) or else Is_Digit (N (J)));
            null;
         end if;
      end loop;
   end Validate_Command_Or_Option;

   --------------------------
   -- Validate_Unix_Switch --
   --------------------------

   procedure Validate_Unix_Switch (S : VMS_Data.String_Ptr) is
   begin
      if S (S'First) = '`' then
         return;
      end if;

      pragma Assert (S (S'First) = '-' or else S (S'First) = '!');

      for J in S'First + 1 .. S'Last loop
         pragma Assert (S (J) /= ' ');

         if S (J) = '!' then
            pragma Assert (S (J - 1) = ',' and then S (J + 1) = '-');
            null;
         end if;
      end loop;
   end Validate_Unix_Switch;

   --------------------
   -- VMS_Conversion --
   --------------------

   procedure VMS_Conversion (The_Command : out Command_Type) is
      Result     : Command_Type := Undefined;
      Result_Set : Boolean      := False;

   begin
      Buffer.Init;

      --  First we must preprocess the string form of the command and options
      --  list into the internal form that we use.

      Preprocess_Command_Data;

      --  If no parameters, give complete list of commands

      if Argument_Count = 0 then
         Output_Version;
         New_Line;
         Put_Line ("List of available commands");
         New_Line;

         while Commands /= null loop

            --  No usage for GNAT SYNC

            if Commands.Command /= Sync then
               Put (Commands.Usage.all);
               Set_Col (53);
               Put_Line (Commands.Unix_String.all);
            end if;

            Commands := Commands.Next;
         end loop;

         raise Normal_Exit;
      end if;

      --  Loop through arguments

      Arg_Num := 1;
      while Arg_Num <= Argument_Count loop
         Process_Argument (Result);

         if not Result_Set then
            The_Command := Result;
            Result_Set := True;
         end if;
      end loop;

      --  Gross error checking that the number of parameters is correct.
      --  Not applicable to Unlimited_Files parameters.

      if (Param_Count = Command.Params'Length - 1
            and then Command.Params (Param_Count + 1) = Unlimited_Files)
        or else Param_Count <= Command.Params'Length
      then
         null;

      else
         Put_Line (Standard_Error,
                   "Parameter count of "
                   & Integer'Image (Param_Count)
                   & " not equal to expected "
                   & Integer'Image (Command.Params'Length));
         Put (Standard_Error, "usage: ");
         Put_Line (Standard_Error, Command.Usage.all);
         Errors := Errors + 1;
      end if;

      if Errors > 0 then
         raise Error_Exit;
      else
         --  Prepare arguments for a call to spawn, filtering out
         --  embedded nulls place there to delineate strings.

         Process_Buffer (String (Buffer.Table (1 .. Buffer.Last)));

         if Cargs_Buffer.Last > 1 then
            Last_Switches.Append (new String'("-cargs"));
            Process_Buffer
              (String (Cargs_Buffer.Table (1 .. Cargs_Buffer.Last)));
         end if;
      end if;
   end VMS_Conversion;

end VMS_Conv;