X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2Fgnatlbr.adb;fp=gcc%2Fada%2Fgnatlbr.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=a44e6c92c740e614ccb43721681f159cffaa8f4b;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/gnatlbr.adb b/gcc/ada/gnatlbr.adb deleted file mode 100644 index a44e6c92..00000000 --- a/gcc/ada/gnatlbr.adb +++ /dev/null @@ -1,349 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G N A T L B R -- --- -- --- B o d y -- --- -- --- $Revision: 1.1.16.1 $ --- -- --- Copyright (C) 1997-2000 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 2, 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 COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- 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]= --- --create : Build a library --- --set : Set environment variables to point to a library --- --delete : Delete a library - --- 2nd: --config= --- 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 Sdefault; use Sdefault; -with System; - -procedure GnatLbr is - pragma Ident (Gnat_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, "mkdir"); - -begin - if Argument_Count = 0 then - Put ("Usage: "); - Put_Line - ("gnatlbr --[create|set|delete]= [--config=]"); - Exit_Program (E_Fatal); - end if; - - Next_Arg := 1; - - loop - exit when Next_Arg > Argument_Count; - - Process_One_Arg : declare - Arg : 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 := String_Access (Include_Dir_Default_Name); - Get_Next_Dir_In_Path_Init (String_Access (Include_Dir_Name)); - - loop - declare - Dir : String_Access := String_Access - (Get_Next_Dir_In_Path (String_Access (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 := String_Access (Object_Dir_Default_Name); - Get_Next_Dir_In_Path_Init (String_Access (Object_Dir_Name)); - - loop - declare - Dir : String_Access := String_Access - (Get_Next_Dir_In_Path (String_Access (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=" & '"' & 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 I in 1 .. Make_Args'Last loop - Put (" "); - Put (Make_Args (I).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;