diff options
Diffstat (limited to 'gcc-4.4.3/gcc/ada/gnatlbr.adb')
-rw-r--r-- | gcc-4.4.3/gcc/ada/gnatlbr.adb | 346 |
1 files changed, 346 insertions, 0 deletions
diff --git a/gcc-4.4.3/gcc/ada/gnatlbr.adb b/gcc-4.4.3/gcc/ada/gnatlbr.adb new file mode 100644 index 000000000..7be1d494b --- /dev/null +++ b/gcc-4.4.3/gcc/ada/gnatlbr.adb @@ -0,0 +1,346 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; |