Subversion Repositories openrisc_2011-10-31

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                              G N A T L B R                               --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1997-2008, 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.      --

--                                                                          --

------------------------------------------------------------------------------

--  Program to create, set, or delete an alternate runtime library

--  Works by calling an appropriate target specific Makefile residing

--  in the default library object (e.g. adalib) directory from the context

--  of the new library objects directory.

--  Command line arguments are:

--  1st:  --[create | set | delete]=<directory_spec>

--    --create : Build a library

--    --set    : Set environment variables to point to a library

--    --delete : Delete a library

--  2nd:  --config=<file_spec>

--  A -gnatg valid file containing desired configuration pragmas

--  This program is currently used only on Alpha/VMS

with Ada.Command_Line;     use Ada.Command_Line;

with Ada.Text_IO;          use Ada.Text_IO;

with GNAT.OS_Lib;          use GNAT.OS_Lib;

with Gnatvsn;              use Gnatvsn;

with Interfaces.C_Streams; use Interfaces.C_Streams;

with Osint;                use Osint;

with System;

procedure GnatLbr is

   pragma Ident (Gnat_Static_Version_String);

   type Lib_Mode is (None, Create, Set, Delete);

   Next_Arg  : Integer;

   Mode      : Lib_Mode := None;

   ADC_File  : String_Access := null;

   Lib_Dir   : String_Access := null;

   Make      : constant String := "make";

   Make_Path : String_Access;

   procedure Create_Directory (Name : System.Address; Mode : Integer);

   pragma Import (C, Create_Directory, "decc$mkdir");

begin

   if Argument_Count = 0 then

      Put ("Usage: ");

      Put_Line

        ("gnatlbr --[create|set|delete]=<directory> [--config=<file>]");

      Exit_Program (E_Fatal);

   end if;

   Next_Arg := 1;

   loop

      exit when Next_Arg > Argument_Count;

      Process_One_Arg : declare

         Arg : constant String := Argument (Next_Arg);

      begin

         if Arg'Length > 9 and then Arg (1 .. 9) = "--create=" then

            if Mode = None then

               Mode := Create;

               Lib_Dir := new String'(Arg (10 .. Arg'Last));

            else

               Put_Line (Standard_Error, "Error: Multiple modes specified");

               Exit_Program (E_Fatal);

            end if;

         elsif Arg'Length > 6 and then Arg (1 .. 6) = "--set=" then

            if Mode = None then

               Mode := Set;

               Lib_Dir := new String'(Arg (7 .. Arg'Last));

            else

               Put_Line (Standard_Error, "Error: Multiple modes specified");

               Exit_Program (E_Fatal);

            end if;

         elsif Arg'Length > 9 and then Arg (1 .. 9) = "--delete=" then

            if Mode = None then

               Mode := Delete;

               Lib_Dir := new String'(Arg (10 .. Arg'Last));

            else

               Put_Line (Standard_Error, "Error: Multiple modes specified");

               Exit_Program (E_Fatal);

            end if;

         elsif Arg'Length > 9 and then Arg (1 .. 9) = "--config=" then

            if ADC_File /= null then

               Put_Line (Standard_Error,

                         "Error: Multiple gnat.adc files specified");

               Exit_Program (E_Fatal);

            end if;

            ADC_File := new String'(Arg (10 .. Arg'Last));

         else

            Put_Line (Standard_Error, "Error: Unrecognized option: " & Arg);

            Exit_Program (E_Fatal);

         end if;

      end Process_One_Arg;

      Next_Arg := Next_Arg + 1;

   end loop;

   case Mode is

      when Create =>

         --  Validate arguments

         if Lib_Dir = null then

            Put_Line (Standard_Error, "Error: No library directory specified");

            Exit_Program (E_Fatal);

         end if;

         if Is_Directory (Lib_Dir.all) then

            Put_Line (Standard_Error,

                      "Error:" & Lib_Dir.all & " already exists");

            Exit_Program (E_Fatal);

         end if;

         if ADC_File = null then

            Put_Line (Standard_Error,

                      "Error: No configuration file specified");

            Exit_Program (E_Fatal);

         end if;

         if not Is_Regular_File (ADC_File.all) then

            Put_Line (Standard_Error,

                      "Error: " & ADC_File.all & " doesn't exist");

            Exit_Program (E_Fatal);

         end if;

         Create_Block : declare

            Success        : Boolean;

            Make_Args      : Argument_List (1 .. 9);

            C_Lib_Dir      : String := Lib_Dir.all & ASCII.NUL;

            C_ADC_File     : String := ADC_File.all & ASCII.NUL;

            F_ADC_File     : String (1 .. max_path_len);

            F_ADC_File_Len : Integer := max_path_len;

            Include_Dirs   : Integer;

            Object_Dirs    : Integer;

            Include_Dir    : array (Integer range 1 .. 256) of String_Access;

            Object_Dir     : array (Integer range 1 .. 256) of String_Access;

            Include_Dir_Name : String_Access;

            Object_Dir_Name  : String_Access;

         begin

            --  Create the new top level library directory

            if not Is_Directory (Lib_Dir.all) then

               Create_Directory (C_Lib_Dir'Address, 8#755#);

            end if;

            full_name (C_ADC_File'Address, F_ADC_File'Address);

            for I in 1 .. max_path_len loop

               if F_ADC_File (I) = ASCII.NUL then

                  F_ADC_File_Len := I - 1;

                  exit;

               end if;

            end loop;

            --

            --  Make a list of the default library source and object

            --  directories.  Usually only one, except on VMS where

            --  there are two.

            --

            Include_Dirs := 0;

            Include_Dir_Name := new String'(Include_Dir_Default_Prefix);

            Get_Next_Dir_In_Path_Init (Include_Dir_Name);

            loop

               declare

                  Dir : constant String_Access := String_Access

                    (Get_Next_Dir_In_Path (Include_Dir_Name));

               begin

                  exit when Dir = null;

                  Include_Dirs := Include_Dirs + 1;

                  Include_Dir (Include_Dirs) :=

                    String_Access (Normalize_Directory_Name (Dir.all));

               end;

            end loop;

            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 :=

                          String_Access

                            (Get_Next_Dir_In_Path (Object_Dir_Name));

               begin

                  exit when Dir = null;

                  Object_Dirs := Object_Dirs + 1;

                  Object_Dir (Object_Dirs)

                    := String_Access (Normalize_Directory_Name (Dir.all));

               end;

            end loop;

            --  "Make" an alternate sublibrary for each default sublibrary

            for Dirs in 1 .. Object_Dirs loop

               Make_Args (1) :=

                 new String'("-C");

               Make_Args (2) :=

                 new String'(Lib_Dir.all);

               --  Resolve /gnu on VMS by converting to host format and then

               --  convert resolved path back to canonical format for the

               --  make program. This fixes the problem that can occur when

               --  GNU: is a search path pointing to multiple versions of GNAT.

               Make_Args (3) :=

                 new String'("ADA_INCLUDE_PATH=" &

                   To_Canonical_Dir_Spec

                     (To_Host_Dir_Spec

                       (Include_Dir (Dirs).all, True).all, True).all);

               Make_Args (4) :=

                 new String'("ADA_OBJECTS_PATH=" &

                   To_Canonical_Dir_Spec

                     (To_Host_Dir_Spec

                       (Object_Dir (Dirs).all, True).all, True).all);

               Make_Args (5) :=

                 new String'("GNAT_ADC_FILE="

                             & F_ADC_File (1 .. F_ADC_File_Len));

               Make_Args (6) :=

                 new String'("LIBRARY_VERSION=" & '"' &

                             Verbose_Library_Version & '"');

               Make_Args (7) :=

                 new String'("-f");

               Make_Args (8) :=

                 new String'(Object_Dir (Dirs).all & "Makefile.lib");

               Make_Args (9) :=

                 new String'("create");

               Make_Path := Locate_Exec_On_Path (Make);

               Put (Make);

               for J in 1 .. Make_Args'Last loop

                  Put (" ");

                  Put (Make_Args (J).all);

               end loop;

               New_Line;

               Spawn (Make_Path.all, Make_Args, Success);

               if not Success then

                  Put_Line (Standard_Error, "Error: Make failed");

                  Exit_Program (E_Fatal);

               end if;

            end loop;

         end Create_Block;

      when Set =>

         --  Validate arguments

         if Lib_Dir = null then

            Put_Line (Standard_Error,

                      "Error: No library directory specified");

            Exit_Program (E_Fatal);

         end if;

         if not Is_Directory (Lib_Dir.all) then

            Put_Line (Standard_Error,

                      "Error: " & Lib_Dir.all & " doesn't exist");

            Exit_Program (E_Fatal);

         end if;

         if ADC_File = null then

            Put_Line (Standard_Error,

                      "Error: No configuration file specified");

            Exit_Program (E_Fatal);

         end if;

         if not Is_Regular_File (ADC_File.all) then

            Put_Line (Standard_Error,

                      "Error: " & ADC_File.all & " doesn't exist");

            Exit_Program (E_Fatal);

         end if;

         --  Give instructions

         Put_Line ("Copy the contents of "

           & ADC_File.all & " into your GNAT.ADC file");

         Put_Line ("and use GNAT Make qualifier /OBJECT_SEARCH=("

           & To_Host_Dir_Spec

               (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/declib", False).all

           & ","

           & To_Host_Dir_Spec

               (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/adalib", False).all

           & ")");

         Put_Line ("or else define ADA_OBJECTS_PATH as " & '"'

           & To_Host_Dir_Spec

               (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/declib", False).all

           & ','

           & To_Host_Dir_Spec

               (Lib_Dir (Lib_Dir'First .. Lib_Dir'Last) & "/adalib", False).all

           & '"');

      when Delete =>

         --  Give instructions

         Put_Line ("GNAT Librarian DELETE not yet implemented.");

         Put_Line ("Use appropriate system tools to remove library");

      when None =>

         Put_Line (Standard_Error,

                   "Error: No mode (create|set|delete) specified");

         Exit_Program (E_Fatal);

   end case;

end GnatLbr;