From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 76179 invoked by alias); 11 Dec 2018 11:33:16 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 76047 invoked by uid 89); 11 Dec 2018 11:33:15 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-6.9 required=5.0 tests=BAYES_00,GIT_PATCH_3,RCVD_IN_DNSWL_NONE,SPF_PASS,TIME_LIMIT_EXCEEDED,WEIRD_QUOTING autolearn=unavailable version=3.3.2 spammy=association, UD:Free, understood, Configuration X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 11 Dec 2018 11:33:04 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id D900F56088; Tue, 11 Dec 2018 06:33:02 -0500 (EST) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id qV3wAxR1yU7h; Tue, 11 Dec 2018 06:33:02 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id E606D5608B; Tue, 11 Dec 2018 06:33:00 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id E4FBB3573; Tue, 11 Dec 2018 06:33:00 -0500 (EST) Date: Tue, 11 Dec 2018 11:33:00 -0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Jerome Lambourg Subject: [Ada] Remove vxlink and vxaddr2line from this repository Message-ID: <20181211113300.GA105140@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="4Ckj6UjgE2iN1+kY" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes X-SW-Source: 2018-12/txt/msg00671.txt.bz2 --4Ckj6UjgE2iN1+kY Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 449 Those tools need a dedicated repository as they're VxWorks specific and not related with the Ada front-end. Tested on x86_64-pc-linux-gnu, committed on trunk 2018-12-11 Jerome Lambourg gcc/ada/ * vxaddr2line.adb, vxlink-bind.adb, vxlink-bind.ads, vxlink-link.adb, vxlink-link.ads, vxlink-main.adb, vxlink.adb, vxlink.ads: Remove. * gcc-interface/Make-lang.in, gcc-interface/Makefile.in: Remove bits for vxaddr2line. --4Ckj6UjgE2iN1+kY Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" Content-length: 62044 --- gcc/ada/gcc-interface/Make-lang.in +++ gcc/ada/gcc-interface/Make-lang.in @@ -675,12 +675,10 @@ regnattools: cross-gnattools: force $(MAKE) -C ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools1-re $(MAKE) -C ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools2 - $(MAKE) -C ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools4 canadian-gnattools: force $(MAKE) -C ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools1-re $(MAKE) -C ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools2 - $(MAKE) -C ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools4 gnatlib gnatlib-sjlj gnatlib-zcx gnatlib-shared: force $(MAKE) -C ada $(COMMON_FLAGS_TO_PASS) \ @@ -811,8 +809,6 @@ doc/gnat-style.pdf: ada/gnat-style.texi $(gcc_docdir)/include/fdl.texi # gnatlink, gnatls, gnatmake, gnatname, gnatprep, gnatxref, gnatfind, # gnatclean). # gnatdll is only used on Windows. -# vxaddr2line is only used for cross VxWorks ports (it calls the underlying -# cross addr2line). ada.install-common: $(MKDIR) $(DESTDIR)$(bindir) -if [ -f gnat1$(exeext) ] ; \ @@ -829,11 +825,6 @@ ada.install-common: done; \ $(RM) $(DESTDIR)$(bindir)/gnatdll$(exeext); \ $(INSTALL_PROGRAM) gnatdll$(exeext) $(DESTDIR)$(bindir)/gnatdll$(exeext); \ - if [ -f vxaddr2line$(exeext) ] ; \ - then \ - $(RM) $(DESTDIR)$(bindir)/vxaddr2line$(exeext); \ - $(INSTALL_PROGRAM) vxaddr2line$(exeext) $(DESTDIR)$(bindir)/vxaddr2line$(exeext); \ - fi ; \ fi # @@ -859,7 +850,6 @@ ada.uninstall: -$(RM) $(DESTDIR)$(bindir)/$$install_name; \ done -$(RM) $(DESTDIR)$(tooldir)/bin/gnatdll$(exeext) - -$(RM) $(DESTDIR)$(tooldir)/bin/vxaddr2line$(exeext) # Clean hooks: # A lot of the ancillary files are deleted by the main makefile. --- gcc/ada/gcc-interface/Makefile.in +++ gcc/ada/gcc-interface/Makefile.in @@ -434,19 +434,6 @@ gnattools2: ../stamp-tools $(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \ TOOLSCASE=native common-tools $(EXTRA_GNATTOOLS) -# those tools are only built for the cross version -gnattools4: ../stamp-tools -ifeq ($(ENABLE_VXADDR2LINE),true) - $(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \ - TOOLSCASE=cross top_buildir=../../.. \ - ../../vxaddr2line$(exeext) -endif -ifeq ($(ENABLE_VXLINK),true) - $(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \ - TOOLSCASE=cross top_build=../../.. \ - ../../vxlink$(exeext) -endif - common-tools: ../stamp-tools $(GNATMAKE) -j0 -c -b $(ADA_INCLUDES) \ --GNATBIND="$(GNATBIND)" --GCC="$(CC) $(ALL_ADAFLAGS)" \ @@ -477,18 +464,6 @@ common-tools: ../stamp-tools $(GNATLINK) -v gnatdll -o $@ \ --GCC="$(CC) $(ADA_INCLUDES)" --LINK="$(GCC_LINK)" $(TOOLS_LIBS) -../../vxaddr2line$(exeext): ../stamp-tools - $(GNATMAKE) -c $(ADA_INCLUDES) vxaddr2line --GCC="$(CC) $(ALL_ADAFLAGS)" - $(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) vxaddr2line - $(GNATLINK) -v vxaddr2line -o $@ \ - --GCC="$(CC) $(ADA_INCLUDES)" --LINK="$(GCC_LINK)" ../targext.o $(CLIB) - -../../vxlink$(exeext): ../stamp-tools - $(GNATMAKE) -c $(ADA_INCLUDES) vxlink-main --GCC="$(CC) $(ALL_ADAFLAGS)" - $(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) vxlink-main - $(GNATLINK) -v vxlink-main -o $@ \ - --GCC="$(CC) $(ADA_INCLUDES)" --LINK="$(GCC_LINK)" - gnatmake-re: ../stamp-tools $(GNATMAKE) -j0 $(ADA_INCLUDES) -u sdefault --GCC="$(CC) $(MOST_ADA_FLAGS)" $(GNATMAKE) -j0 -c $(ADA_INCLUDES) gnatmake --GCC="$(CC) $(ALL_ADAFLAGS)" --- gcc/ada/vxaddr2line.adb deleted file mode 100644 +++ /dev/null @@ -1,525 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- V X A D D R 2 L I N E -- --- -- --- B o d y -- --- -- --- Copyright (C) 2002-2018, AdaCore -- --- -- --- 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. -- --- -- ------------------------------------------------------------------------------- - --- This program is meant to be used with vxworks to compute symbolic --- backtraces on the host from non-symbolic backtraces obtained on the target. - --- The basic idea is to automate the computation of the necessary address --- adjustments prior to calling addr2line when the application has only been --- partially linked on the host. - --- Variants for various targets are supported, and the command line should --- be like : - --- -addr2line [-a ] --- - --- Where: --- : --- selects the target architecture. In the absence of this parameter the --- default variant is chosen based on the Detect_Arch result. Generally, --- this parameter will only be used if vxaddr2line is recompiled manually. --- Otherwise, the command name will always be of the form: --- -vxaddr2line --- where there is no ambiguity on the target's architecture. - --- : --- The name of the partially linked binary file for the application. - --- : --- Runtime address (on the target) of a reference symbol you choose. This --- name must match the value of the Ref_Symbol variable declared below. --- A symbol with a small offset from the beginning of the text segment is --- better, so "adainit" is a good choice. - --- : --- The call chain addresses you obtained at run time on the target and --- for which you want a symbolic association. - --- TO ADD A NEW ARCHITECTURE add an appropriate value to Architecture type --- (in a format _), and then an appropriate value to Config_List --- array - -with Ada.Text_IO; use Ada.Text_IO; -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Fixed; use Ada.Strings.Fixed; -with Interfaces; use Interfaces; - -with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.Expect; use GNAT.Expect; -with GNAT.Regpat; use GNAT.Regpat; - -procedure VxAddr2Line is - - package Unsigned_64_IO is new Modular_IO (Unsigned_64); - -- Instantiate Modular_IO to have Put - - Ref_Symbol : constant String := "adainit"; - -- This is the name of the reference symbol whose runtime address must - -- be provided as the argument. - - -- All supported architectures - type Architecture is - (LINUX_AARCH64, - LINUX_ARM, - LINUX_E500V2, - LINUX_I586, - LINUX_POWERPC, - LINUX_POWERPC64, - LINUX_X86_64, - WINDOWS_AARCH64, - WINDOWS_ARM, - WINDOWS_E500V2, - WINDOWS_I586, - WINDOWS_POWERPC, - WINDOWS_POWERPC64, - WINDOWS_X86_64); - - type Arch_Record is record - Addr2line_Binary : String_Access; - -- Name of the addr2line utility to use - - Nm_Binary : String_Access; - -- Name of the host nm utility, which will be used to find out the - -- offset of the reference symbol in the text segment of the partially - -- linked executable. - - Addr_Digits_To_Skip : Integer; - -- When addresses such as 0xfffffc0001dfed50 are provided, for instance - -- on ALPHA, indicate the number of leading digits that can be ignored, - -- which will avoid computational overflows. Typically only useful when - -- 64bit addresses are provided. - - Bt_Offset_From_Call : Unsigned_64; - -- Offset from a backtrace address to the address of the corresponding - -- call instruction. This should always be 0, except on platforms where - -- the backtrace addresses actually correspond to return and not call - -- points. In such cases, a negative value is most likely. - end record; - - -- Configuration for each of the architectures - Arch_List : array (Architecture'Range) of Arch_Record := - (LINUX_AARCH64 => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -2), - LINUX_ARM => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -2), - LINUX_E500V2 => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -4), - LINUX_I586 => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -2), - LINUX_POWERPC => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -4), - LINUX_POWERPC64 => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -4), - LINUX_X86_64 => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -2), - WINDOWS_AARCH64 => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -2), - WINDOWS_ARM => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -2), - WINDOWS_E500V2 => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -4), - WINDOWS_I586 => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -2), - WINDOWS_POWERPC => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -4), - WINDOWS_POWERPC64 => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -4), - WINDOWS_X86_64 => - (Addr2line_Binary => null, - Nm_Binary => null, - Addr_Digits_To_Skip => 0, - Bt_Offset_From_Call => -2) - ); - - -- Current architecture - Cur_Arch : Architecture; - - -- State of architecture detection - Detect_Success : Boolean := False; - - ----------------------- - -- Local subprograms -- - ----------------------- - - procedure Error (Msg : String); - pragma No_Return (Error); - -- Prints the message and then terminates the program - - procedure Usage; - pragma No_Return (Usage); - -- Displays the short help message and then terminates the program - - function Get_Reference_Offset return Unsigned_64; - -- Computes the static offset of the reference symbol by calling nm - - function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_64; - -- Threats the argument number Arg as a C-style hexadecimal literal - -- and returns its integer value - - function Hex_Image (Value : Unsigned_64) return String_Access; - -- Returns access to a string that contains hexadecimal image of Value - - -- Separate functions that provide build-time customization: - - procedure Detect_Arch; - -- Saves in Cur_Arch the current architecture, based on the name of - -- vxaddr2line instance and properties of the host. Detect_Success is False - -- if detection fails - - ----------------- - -- Detect_Arch -- - ----------------- - - procedure Detect_Arch is - Name : constant String := Base_Name (Command_Name); - Proc : constant String := - Name (Name'First .. Index (Name, "-") - 1); - Target : constant String := - Name (Name'First .. Index (Name, "vxaddr2line") - 1); - - begin - Detect_Success := False; - - if Proc = "" then - return; - end if; - - -- Let's detect a Linux or Windows host. - if Directory_Separator = '/' then - Cur_Arch := Architecture'Value ("linux_" & Proc); - else - Cur_Arch := Architecture'Value ("windows_" & Proc); - end if; - - if Arch_List (Cur_Arch).Addr2line_Binary = null then - Arch_List (Cur_Arch).Addr2line_Binary := new String' - (Target & "addr2line"); - end if; - if Arch_List (Cur_Arch).Nm_Binary = null then - Arch_List (Cur_Arch).Nm_Binary := new String' - (Target & "nm"); - end if; - - Detect_Success := True; - - exception - when others => - return; - end Detect_Arch; - - ----------- - -- Error -- - ----------- - - procedure Error (Msg : String) is - begin - Put_Line (Msg); - OS_Exit (1); - raise Program_Error; - end Error; - - -------------------------- - -- Get_Reference_Offset -- - -------------------------- - - function Get_Reference_Offset return Unsigned_64 is - Nm_Cmd : constant String_Access := - Locate_Exec_On_Path (Arch_List (Cur_Arch).Nm_Binary.all); - - Nm_Args : constant Argument_List := - (new String'("-P"), - new String'(Argument (1))); - - Forever : aliased String := "^@@@@"; - Reference : aliased String := Ref_Symbol & "\s+\S\s+([\da-fA-F]+)"; - - Pd : Process_Descriptor; - Result : Expect_Match; - - begin - -- If Nm is not found, abort - - if Nm_Cmd = null then - Error ("Couldn't find " & Arch_List (Cur_Arch).Nm_Binary.all); - end if; - - Non_Blocking_Spawn - (Pd, Nm_Cmd.all, Nm_Args, Buffer_Size => 0, Err_To_Out => True); - - -- Expect a string containing the reference symbol - - Expect (Pd, Result, - Regexp_Array'(1 => Reference'Unchecked_Access), - Timeout => -1); - - -- If we are here, the pattern was matched successfully - - declare - Match_String : constant String := Expect_Out_Match (Pd); - Matches : Match_Array (0 .. 1); - Value : Unsigned_64 := 0; - - begin - Match (Reference, Match_String, Matches); - Value := Unsigned_64'Value - ("16#" - & Match_String (Matches (1).First .. Matches (1).Last) & "#"); - - -- Expect a string that will never be emitted, so that the - -- process can be correctly terminated (with Process_Died) - - Expect (Pd, Result, - Regexp_Array'(1 => Forever'Unchecked_Access), - Timeout => -1); - - exception - when Process_Died => - return Value; - end; - - -- We cannot get here - - raise Program_Error; - - exception - when Invalid_Process => - Error ("Could not spawn a process " & Nm_Cmd.all); - - when others => - - -- The process died without matching the reference symbol or the - -- format wasn't recognized. - - Error ("Unexpected output from " & Nm_Cmd.all); - end Get_Reference_Offset; - - ---------------------------- - -- Get_Value_From_Hex_Arg -- - ---------------------------- - - function Get_Value_From_Hex_Arg (Arg : Natural) return Unsigned_64 is - Cur_Arg : constant String := Argument (Arg); - Offset : Natural; - - begin - -- Skip "0x" prefix if present - - if Cur_Arg'Length > 2 and then Cur_Arg (1 .. 2) = "0x" then - Offset := 3; - else - Offset := 1; - end if; - - -- Add architecture-specific offset - - Offset := Offset + Arch_List (Cur_Arch).Addr_Digits_To_Skip; - - -- Convert to value - - return Unsigned_64'Value - ("16#" & Cur_Arg (Offset .. Cur_Arg'Last) & "#"); - - exception - when Constraint_Error => - - Error ("Can't parse backtrace address '" & Cur_Arg & "'"); - raise; - end Get_Value_From_Hex_Arg; - - --------------- - -- Hex_Image -- - --------------- - - function Hex_Image (Value : Unsigned_64) return String_Access is - Result : String (1 .. 20); - Start_Pos : Natural; - - begin - Unsigned_64_IO.Put (Result, Value, 16); - Start_Pos := Index (Result, "16#") + 3; - return new String'(Result (Start_Pos .. Result'Last - 1)); - end Hex_Image; - - ----------- - -- Usage -- - ----------- - - procedure Usage is - begin - Put_Line ("Usage : " & Base_Name (Command_Name) - & " <" - & Ref_Symbol & " offset on target> ..."); - - OS_Exit (1); - end Usage; - - Ref_Static_Offset, Ref_Runtime_Address, Bt_Address : Unsigned_64; - - Addr2line_Cmd : String_Access; - - Addr2line_Args : Argument_List (1 .. 501); - -- We expect that there won't be more than 500 backtrace frames - - Addr2line_Args_Count : Natural; - - Success : Boolean; - --- Start of processing for VxAddr2Line - -begin - - Detect_Arch; - - -- There should be at least two arguments - - if Argument_Count < 2 then - Usage; - end if; - - -- Enforce HARD LIMIT There should be at most 501 arguments. Why 501??? - - if Argument_Count > 501 then - Error ("Too many backtrace frames"); - end if; - - -- Do we have a valid architecture? - - if not Detect_Success then - Put_Line ("Couldn't detect the architecture"); - return; - end if; - - Addr2line_Cmd := - Locate_Exec_On_Path (Arch_List (Cur_Arch).Addr2line_Binary.all); - - -- If Addr2line is not found, abort - - if Addr2line_Cmd = null then - Error ("Couldn't find " & Arch_List (Cur_Arch).Addr2line_Binary.all); - end if; - - -- The first argument specifies the image file. Check if it exists - - if not Is_Regular_File (Argument (1)) then - Error ("Couldn't find the executable " & Argument (1)); - end if; - - -- The second argument specifies the reference symbol runtime address. - -- Let's parse and store it - - Ref_Runtime_Address := Get_Value_From_Hex_Arg (2); - - -- Run nm command to get the reference symbol static offset - - Ref_Static_Offset := Get_Reference_Offset; - - -- Build addr2line parameters. First, the standard part - - Addr2line_Args (1) := new String'("--exe=" & Argument (1)); - Addr2line_Args_Count := 1; - - -- Now, append to this the adjusted backtraces in arguments 4 and further - - for J in 3 .. Argument_Count loop - - -- Basically, for each address in the runtime backtrace ... - - -- o We compute its offset relatively to the runtime address of the - -- reference symbol, - - -- and then ... - - -- o We add this offset to the static one for the reference symbol in - -- the executable to find the executable offset corresponding to the - -- backtrace address. - - Bt_Address := Get_Value_From_Hex_Arg (J); - - Bt_Address := - Bt_Address - Ref_Runtime_Address - + Ref_Static_Offset - + Arch_List (Cur_Arch).Bt_Offset_From_Call; - - Addr2line_Args_Count := Addr2line_Args_Count + 1; - Addr2line_Args (Addr2line_Args_Count) := Hex_Image (Bt_Address); - end loop; - - -- Run the resulting command - - Spawn (Addr2line_Cmd.all, - Addr2line_Args (1 .. Addr2line_Args_Count), Success); - - if not Success then - Error ("Couldn't spawn " & Addr2line_Cmd.all); - end if; - -exception - when others => - - -- Mask all exceptions - - return; -end VxAddr2Line; --- gcc/ada/vxlink-bind.adb deleted file mode 100644 +++ /dev/null @@ -1,390 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- V X L I N K . B I N D -- --- -- --- B o d y -- --- -- --- Copyright (C) 2018, AdaCore -- --- -- --- 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. -- --- -- ------------------------------------------------------------------------------- - -pragma Ada_2012; - -with Ada.Text_IO; use Ada.Text_IO; -with Ada.IO_Exceptions; -with Ada.Strings.Fixed; - -with GNAT.Regpat; use GNAT.Regpat; - -package body VxLink.Bind is - - function Split_Lines (S : String) return Strings_List.Vector; - - function Split (S : String; C : Character) return Strings_List.Vector; - - function Parse_Nm_Output (S : String) return Symbol_Sets.Set; - - procedure Emit_Module_Dtor - (FP : File_Type); - - procedure Emit_CDtor - (FP : File_Type; - Var : String; - Set : Symbol_Sets.Set); - - ----------------- - -- Split_Lines -- - ----------------- - - function Split_Lines (S : String) return Strings_List.Vector - is - Last : Natural := S'First; - Ret : Strings_List.Vector; - begin - for J in S'Range loop - if S (J) = ASCII.CR - and then J < S'Last - and then S (J + 1) = ASCII.LF - then - Ret.Append (S (Last .. J - 1)); - Last := J + 2; - elsif S (J) = ASCII.LF then - Ret.Append (S (Last .. J - 1)); - Last := J + 1; - end if; - end loop; - - if Last <= S'Last then - Ret.Append (S (Last .. S'Last)); - end if; - - return Ret; - end Split_Lines; - - ----------- - -- Split -- - ----------- - - function Split (S : String; C : Character) return Strings_List.Vector - is - Last : Natural := S'First; - Ret : Strings_List.Vector; - begin - for J in S'Range loop - if S (J) = C then - if J > Last then - Ret.Append (S (Last .. J - 1)); - end if; - - Last := J + 1; - end if; - end loop; - - if Last <= S'Last then - Ret.Append (S (Last .. S'Last)); - end if; - - return Ret; - end Split; - - --------------------- - -- Parse_Nm_Output -- - --------------------- - - function Parse_Nm_Output (S : String) return Symbol_Sets.Set - is - Nm_Regexp : constant Pattern_Matcher := - Compile ("^[0-9A-Za-z]* ([a-zA-Z]) (.*)$"); - type CDTor_Type is - (CTOR_Diab, - CTOR_Gcc, - DTOR_Diab, - DTOR_Gcc); - subtype CTOR_Type is CDTor_Type range CTOR_Diab .. CTOR_Gcc; - CTOR_DIAB_Regexp : aliased constant Pattern_Matcher := - Compile ("^__?STI__*([0-9]+)_"); - CTOR_GCC_Regexp : aliased constant Pattern_Matcher := - Compile ("^__?GLOBAL_.I._*([0-9]+)_"); - DTOR_DIAB_Regexp : aliased constant Pattern_Matcher := - Compile ("^__?STD__*([0-9]+)_"); - DTOR_GCC_Regexp : aliased constant Pattern_Matcher := - Compile ("^__?GLOBAL_.D._*([0-9]+)_"); - type Regexp_Access is access constant Pattern_Matcher; - CDTor_Regexps : constant array (CDTor_Type) of Regexp_Access := - (CTOR_Diab => CTOR_DIAB_Regexp'Access, - CTOR_Gcc => CTOR_GCC_Regexp'Access, - DTOR_Diab => DTOR_DIAB_Regexp'Access, - DTOR_Gcc => DTOR_GCC_Regexp'Access); - Result : Symbol_Sets.Set; - - begin - for Line of Split_Lines (S) loop - declare - Sym : Symbol; - Nm_Grps : Match_Array (0 .. 2); - Ctor_Grps : Match_Array (0 .. 1); - begin - Match (Nm_Regexp, Line, Nm_Grps); - - if Nm_Grps (0) /= No_Match then - declare - Sym_Type : constant Character := - Line (Nm_Grps (1).First); - Sym_Name : constant String := - Line (Nm_Grps (2).First .. Nm_Grps (2).Last); - begin - Sym := - (Name => To_Unbounded_String (Sym_Name), - Cat => Sym_Type, - Internal => False, - Kind => Sym_Other, - Priority => -1); - - for J in CDTor_Regexps'Range loop - Match (CDTor_Regexps (J).all, Sym_Name, Ctor_Grps); - - if Ctor_Grps (0) /= No_Match then - if J in CTOR_Type then - Sym.Kind := Sym_Ctor; - else - Sym.Kind := Sym_Dtor; - end if; - - Sym.Priority := Integer'Value - (Line (Ctor_Grps (1).First .. Ctor_Grps (1).Last)); - - exit; - end if; - end loop; - - Result.Include (Sym); - end; - end if; - end; - end loop; - - return Result; - end Parse_Nm_Output; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize - (Binder : out VxLink_Binder; - Object_File : String) - is - Args : Arguments_List; - Module_Dtor_Not_Needed : Boolean := False; - Module_Dtor_Needed : Boolean := False; - - begin - Args.Append (Nm); - Args.Append (Object_File); - - declare - Output : constant String := Run (Args); - Symbols : Symbol_Sets.Set; - begin - if Is_Error_State then - return; - end if; - - Symbols := Parse_Nm_Output (Output); - - for Sym of Symbols loop - if Sym.Kind = Sym_Ctor then - Binder.Constructors.Insert (Sym); - elsif Sym.Kind = Sym_Dtor then - Binder.Destructors.Insert (Sym); - elsif Match ("_?__.*_atexit$", To_String (Sym.Name)) then - if Sym.Cat = 'T' then - Module_Dtor_Not_Needed := True; - elsif Sym.Cat = 'U' then - Module_Dtor_Needed := True; - end if; - end if; - end loop; - - Binder.Module_Dtor_Needed := - not Module_Dtor_Not_Needed and then Module_Dtor_Needed; - end; - end Initialize; - - -------------------- - -- Parse_Tag_File -- - -------------------- - - procedure Parse_Tag_File - (Binder : in out VxLink_Binder; - File : String) - is - FP : Ada.Text_IO.File_Type; - - begin - Open - (FP, - Mode => In_File, - Name => File); - loop - declare - Line : constant String := - Ada.Strings.Fixed.Trim - (Get_Line (FP), Ada.Strings.Both); - Tokens : Strings_List.Vector; - - begin - if Line'Length = 0 then - -- Skip empty lines - null; - - elsif Line (Line'First) = '#' then - -- Skip comment - null; - - else - Tokens := Split (Line, ' '); - if Tokens.First_Element = "section" then - -- Sections are not used for tags, only when building - -- kernels. So skip for now - null; - else - Binder.Tags_List.Append (Line); - end if; - end if; - end; - end loop; - - exception - when Ada.IO_Exceptions.End_Error => - Close (FP); - when others => - Log_Error ("Cannot open file " & File & - ". DKM tags won't be generated"); - end Parse_Tag_File; - - ---------------------- - -- Emit_Module_Dtor -- - ---------------------- - - procedure Emit_Module_Dtor - (FP : File_Type) - is - Dtor_Name : constant String := "_GLOBAL__D_65536_0_cxa_finalize"; - begin - Put_Line (FP, "extern void __cxa_finalize(void *);"); - Put_Line (FP, "static void " & Dtor_Name & "()"); - Put_Line (FP, "{"); - Put_Line (FP, " __cxa_finalize(&__dso_handle);"); - Put_Line (FP, "}"); - Put_Line (FP, ""); - end Emit_Module_Dtor; - - ---------------- - -- Emit_CDtor -- - ---------------- - - procedure Emit_CDtor - (FP : File_Type; - Var : String; - Set : Symbol_Sets.Set) - is - begin - for Sym of Set loop - if not Sym.Internal then - Put_Line (FP, "extern void " & To_String (Sym.Name) & "();"); - end if; - end loop; - - New_Line (FP); - - Put_Line (FP, "extern void (*" & Var & "[])();"); - Put_Line (FP, "void (*" & Var & "[])() ="); - Put_Line (FP, " {"); - for Sym of Set loop - Put_Line (FP, " " & To_String (Sym.Name) & ","); - end loop; - Put_Line (FP, " 0};"); - New_Line (FP); - end Emit_CDtor; - - --------------- - -- Emit_CTDT -- - --------------- - - procedure Emit_CTDT - (Binder : in out VxLink_Binder; - Namespace : String) - is - FP : Ada.Text_IO.File_Type; - CDtor_File : constant String := Namespace & "-cdtor.c"; - begin - Binder.CTDT_File := To_Unbounded_String (CDtor_File); - Create - (File => FP, - Name => CDtor_File); - Put_Line (FP, "#if defined(_HAVE_TOOL_XTORS)"); - Put_Line (FP, "#include "); - if Binder.Module_Dtor_Needed then - Put_Line (FP, "#define _WRS_NEED_CALL_CXA_FINALIZE"); - end if; - Put_Line (FP, "#include TOOL_HEADER (toolXtors.h)"); - Put_Line (FP, "#else"); - Put_Line (FP, ""); - - if Binder.Module_Dtor_Needed then - Emit_Module_Dtor (FP); - end if; - - Emit_CDtor (FP, "_ctors", Binder.Constructors); - Emit_CDtor (FP, "_dtors", Binder.Destructors); - - Put_Line (FP, "#endif"); - - if not Binder.Tags_List.Is_Empty then - New_Line (FP); - Put_Line (FP, "/* build variables */"); - Put_Line (FP, "__asm("" .section \"".wrs_build_vars\"",\""a\"""");"); - for Tag of Binder.Tags_List loop - Put_Line (FP, "__asm("" .ascii \""" & Tag & "\"""");"); - Put_Line (FP, "__asm("" .byte 0"");"); - end loop; - Put_Line (FP, "__asm("" .ascii \""end\"""");"); - Put_Line (FP, "__asm("" .byte 0"");"); - end if; - - Close (FP); - - exception - when others => - Close (FP); - Set_Error_State ("Internal error"); - raise; - end Emit_CTDT; - - --------------- - -- CTDT_File -- - --------------- - - function CTDT_File (Binder : VxLink_Binder) return String - is - begin - return To_String (Binder.CTDT_File); - end CTDT_File; - -end VxLink.Bind; --- gcc/ada/vxlink-bind.ads deleted file mode 100644 +++ /dev/null @@ -1,87 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- V X L I N K . B I N D -- --- -- --- S p e c -- --- -- --- Copyright (C) 2018, AdaCore -- --- -- --- 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. -- --- -- ------------------------------------------------------------------------------- - -pragma Ada_2012; - -private with Ada.Containers.Ordered_Sets; -private with Ada.Strings.Unbounded; - -package VxLink.Bind is - - type VxLink_Binder is private; - - procedure Initialize - (Binder : out VxLink_Binder; - Object_File : String); - - procedure Parse_Tag_File - (Binder : in out VxLink_Binder; - File : String); - - procedure Emit_CTDT - (Binder : in out VxLink_Binder; - Namespace : String); - - function CTDT_File (Binder : VxLink_Binder) return String; - -private - - use Ada.Strings.Unbounded; - - type Symbol_Kind is (Sym_Ctor, Sym_Dtor, Sym_Other); - - type Symbol is record - Name : Unbounded_String; - Cat : Character; - Internal : Boolean; - Kind : Symbol_Kind; - Priority : Integer; - end record; - - function "=" (S1, S2 : Symbol) return Boolean - is (S1.Name = S2.Name and then S1.Cat = S2.Cat); - - function "<" (S1, S2 : Symbol) return Boolean - is (if S1.Priority /= S2.Priority - then S1.Priority < S2.Priority - elsif S1.Name /= S2.Name - then S1.Name < S2.Name - else S1.Cat < S2.Cat); - - package Symbol_Sets is new Ada.Containers.Ordered_Sets - (Symbol, - "<" => "<", - "=" => "="); - - type VxLink_Binder is record - CTDT_File : Unbounded_String; - Constructors : Symbol_Sets.Set; - Destructors : Symbol_Sets.Set; - Module_Dtor_Needed : Boolean; - EH_Frame_Needed : Boolean; - Tags_List : Strings_List.Vector; - end record; - -end VxLink.Bind; --- gcc/ada/vxlink-link.adb deleted file mode 100644 +++ /dev/null @@ -1,194 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- V X L I N K . L I N K -- --- -- --- B o d y -- --- -- --- Copyright (C) 2018, AdaCore -- --- -- --- 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. -- --- -- ------------------------------------------------------------------------------- - -pragma Ada_2012; - -with Ada.Command_Line; use Ada.Command_Line; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; - -package body VxLink.Link is - - Gcc : constant String := VxLink.Gcc; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize - (Linker : out VxLink_Linker) - is - Leading : Boolean := True; - Next_Is_Object : Boolean := False; - - begin - for J in 1 .. Ada.Command_Line.Argument_Count loop - declare - Arg : String renames Argument (J); - begin - if Next_Is_Object then - Next_Is_Object := False; - Linker.Dest_Object := To_Unbounded_String (Arg); - Leading := False; - - elsif Argument (J) = "-o" then - Next_Is_Object := True; - - elsif Argument (J) = "-noauto-register" then - -- Filter out this argument, and do not generate _ctors/_dtors - Linker.Add_CDtors := False; - elsif Arg = "-v" and then not Is_Verbose then - -- first -v means VxLink should be verbose, two -v passes -v to - -- the linker. - Set_Verbose (True); - else - if Arg = "-nostdlib" or Arg = "-nostartfiles" then - Linker.Add_CDtors := False; - end if; - - if Leading then - Linker.Args_Leading.Append (Arg); - else - Linker.Args_Trailing.Append (Arg); - end if; - end if; - end; - end loop; - - if Linker.Dest_Object = Null_Unbounded_String then - Set_Error_State ("no output object is defined"); - elsif Linker.Add_CDtors then - -- We'll need to create intermediate artefacts, so we'll use the - -- destination object as base namespace just in case we have - -- several link operations in the same directory - declare - Obj : constant String := - Base_Name (To_String (Linker.Dest_Object)); - - begin - for J in reverse Obj'Range loop - if Obj (J) = '.' then - Linker.Dest_Base := - To_Unbounded_String (Obj (Obj'First .. J - 1)); - exit; - end if; - end loop; - - Linker.Partial_Obj := Linker.Dest_Base & "-partial.o"; - end; - end if; - end Initialize; - - ----------------- - -- Needs_CDtor -- - ----------------- - - function Needs_CDtor (Linker : VxLink_Linker) return Boolean is - begin - return Linker.Add_CDtors; - end Needs_CDtor; - - -------------------- - -- Partial_Object -- - -------------------- - - function Partial_Object (Linker : VxLink_Linker) return String is - begin - return To_String (Linker.Partial_Obj); - end Partial_Object; - - --------------- - -- Namespace -- - --------------- - - function Namespace (Linker : VxLink_Linker) return String is - begin - return To_String (Linker.Dest_Base); - end Namespace; - - --------------------- - -- Do_Initial_Link -- - --------------------- - - procedure Do_Initial_Link (Linker : VxLink_Linker) - is - Args : Arguments_List; - Gxx_Path : constant String := Gxx; - begin - if Is_Error_State then - return; - end if; - - if Gxx_Path'Length /= 0 then - Args.Append (Gxx); - else - Args.Append (Gcc); - end if; - Args.Append (Linker.Args_Leading); - Args.Append ("-o"); - - if Linker.Add_CDtors then - Args.Append (To_String (Linker.Partial_Obj)); - else - Args.Append (To_String (Linker.Dest_Object)); - end if; - - Args.Append (Linker.Args_Trailing); - - if not Linker.Add_CDtors then - Args.Append ("-nostartfiles"); - end if; - - Run (Args); - end Do_Initial_Link; - - ------------------- - -- Do_Final_Link -- - ------------------- - - procedure Do_Final_Link - (Linker : VxLink_Linker; - Ctdt_Obj : String) - is - Args : Arguments_List; - begin - if not Linker.Add_CDtors then - return; - end if; - - if Is_Error_State then - return; - end if; - - Args.Append (Gcc); - Args.Append ("-nostdlib"); - Args.Append (Ctdt_Obj); - Args.Append (To_String (Linker.Partial_Obj)); - Args.Append ("-o"); - Args.Append (To_String (Linker.Dest_Object)); - - Run (Args); - end Do_Final_Link; - -end VxLink.Link; --- gcc/ada/vxlink-link.ads deleted file mode 100644 +++ /dev/null @@ -1,63 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- V X L I N K . L I N K -- --- -- --- S p e c -- --- -- --- Copyright (C) 2018, AdaCore -- --- -- --- 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. -- --- -- ------------------------------------------------------------------------------- - -pragma Ada_2012; - -private with Ada.Strings.Unbounded; - -package VxLink.Link is - - type VxLink_Linker is private; - - procedure Initialize - (Linker : out VxLink_Linker); - - function Needs_CDtor (Linker : VxLink_Linker) return Boolean; - - function Partial_Object (Linker : VxLink_Linker) return String; - - function Namespace (Linker : VxLink_Linker) return String; - - procedure Do_Initial_Link - (Linker : VxLink_Linker); - - procedure Do_Final_Link - (Linker : VxLink_Linker; - Ctdt_Obj : String); - -private - - use Ada.Strings.Unbounded; - - type VxLink_Linker is record - Args_Leading : Arguments_List; - Args_Trailing : Arguments_List; - Add_CDtors : Boolean := True; - Dest_Object : Unbounded_String; - Dest_Base : Unbounded_String; - Partial_Obj : Unbounded_String; - end record; - -end VxLink.Link; --- gcc/ada/vxlink-main.adb deleted file mode 100644 +++ /dev/null @@ -1,81 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- V X L I N K . M A I N -- --- -- --- B o d y -- --- -- --- Copyright (C) 2018, AdaCore -- --- -- --- 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. -- --- -- ------------------------------------------------------------------------------- - --- VxLink is a helper tool used as a wrapper around g++/gcc to build VxWorks --- DKM (Downloadable Kernel Modules). --- Such DKM is a partially linked object that contains entry points for --- constructors and destructors. This tool thus uses g++ to generate an --- intermediate partially linked object, retrieves the list of constructors --- and destructors in it and produces a C file that lists those ctors/dtors --- in a way that is understood be VxWorks kernel. It then links this file --- with the intermediate object to produce a valid DKM. - -pragma Ada_2012; - -with GNAT.OS_Lib; use GNAT.OS_Lib; - -with VxLink.Link; use VxLink.Link; -with VxLink.Bind; use VxLink.Bind; - -procedure VxLink.Main is - Linker : VxLink_Linker; - Binder : VxLink_Binder; - VSB_Dir : String_Access := Getenv ("VSB_DIR"); -begin - Initialize (Linker); - - if Is_Error_State then - return; - end if; - - Do_Initial_Link (Linker); - - if Is_Error_State then - return; - end if; - - if not Needs_CDtor (Linker) then - -- Initial link is enough, let's return - return; - end if; - - if VSB_Dir /= null and then VSB_Dir'Length > 0 then - declare - DKM_Tag_File : constant String := - Normalize_Pathname - ("krnl/tags/dkm.tags", VSB_Dir.all); - begin - if Is_Regular_File (DKM_Tag_File) then - Parse_Tag_File (Binder, DKM_Tag_File); - end if; - end; - end if; - - Initialize (Binder, Object_File => Partial_Object (Linker)); - Emit_CTDT (Binder, Namespace => Namespace (Linker)); - - Do_Final_Link (Linker, CTDT_File (Binder)); - Free (VSB_Dir); -end VxLink.Main; --- gcc/ada/vxlink.adb deleted file mode 100644 +++ /dev/null @@ -1,280 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- V X L I N K -- --- -- --- B o d y -- --- -- --- Copyright (C) 2018, AdaCore -- --- -- --- 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. -- --- -- ------------------------------------------------------------------------------- - -pragma Ada_2012; - -with Ada.Command_Line; -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Text_IO; - -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.Expect; use GNAT.Expect; -with GNAT.OS_Lib; use GNAT.OS_Lib; - -package body VxLink is - - Target_Triplet : Unbounded_String := Null_Unbounded_String; - Verbose : Boolean := False; - Error_State : Boolean := False; - - function Triplet return String; - -- ??? missing spec - - function Which (Exe : String) return String; - -- ??? missing spec - - ------------- - -- Triplet -- - ------------- - - function Triplet return String is - begin - if Target_Triplet = Null_Unbounded_String then - declare - Exe : constant String := File_Name (Ada.Command_Line.Command_Name); - begin - for J in reverse Exe'Range loop - if Exe (J) = '-' then - Target_Triplet := To_Unbounded_String (Exe (Exe'First .. J)); - exit; - end if; - end loop; - end; - end if; - - return To_String (Target_Triplet); - end Triplet; - - ----------- - -- Which -- - ----------- - - function Which (Exe : String) return String is - Suffix : GNAT.OS_Lib.String_Access := Get_Executable_Suffix; - Basename : constant String := Exe & Suffix.all; - Path : GNAT.OS_Lib.String_Access := Getenv ("PATH"); - Last : Natural := Path'First; - - begin - Free (Suffix); - - for J in Path'Range loop - if Path (J) = Path_Separator then - declare - Full : constant String := Normalize_Pathname - (Name => Basename, - Directory => Path (Last .. J - 1), - Resolve_Links => False, - Case_Sensitive => True); - begin - if Is_Executable_File (Full) then - Free (Path); - - return Full; - end if; - end; - - Last := J + 1; - end if; - end loop; - - Free (Path); - - return ""; - end Which; - - ----------------- - -- Set_Verbose -- - ----------------- - - procedure Set_Verbose (Value : Boolean) is - begin - Verbose := Value; - end Set_Verbose; - - ---------------- - -- Is_Verbose -- - ---------------- - - function Is_Verbose return Boolean is - begin - return Verbose; - end Is_Verbose; - - --------------------- - -- Set_Error_State -- - --------------------- - - procedure Set_Error_State (Message : String) is - begin - Log_Error ("Error: " & Message); - Error_State := True; - Ada.Command_Line.Set_Exit_Status (1); - end Set_Error_State; - - -------------------- - -- Is_Error_State -- - -------------------- - - function Is_Error_State return Boolean is - begin - return Error_State; - end Is_Error_State; - - -------------- - -- Log_Info -- - -------------- - - procedure Log_Info (S : String) is - begin - if Verbose then - Ada.Text_IO.Put_Line (S); - end if; - end Log_Info; - - --------------- - -- Log_Error -- - --------------- - - procedure Log_Error (S : String) is - begin - Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, S); - end Log_Error; - - --------- - -- Run -- - --------- - - procedure Run (Arguments : Arguments_List) is - Output : constant String := Run (Arguments); - begin - if not Is_Error_State then - -- In case of erroneous execution, the function version of run will - -- have already displayed the output - Ada.Text_IO.Put (Output); - end if; - end Run; - - --------- - -- Run -- - --------- - - function Run (Arguments : Arguments_List) return String is - Args : GNAT.OS_Lib.Argument_List_Access := - new GNAT.OS_Lib.Argument_List - (1 .. Natural (Arguments.Length) - 1); - Base : constant String := Base_Name (Arguments.First_Element); - - Debug_Line : Unbounded_String; - Add_Quotes : Boolean; - - begin - if Verbose then - Append (Debug_Line, Base); - end if; - - for J in Arguments.First_Index + 1 .. Arguments.Last_Index loop - declare - Arg : String renames Arguments.Element (J); - begin - Args (J - 1) := new String'(Arg); - - if Verbose then - Add_Quotes := False; - - for K in Arg'Range loop - if Arg (K) = ' ' then - Add_Quotes := True; - exit; - end if; - end loop; - - Append (Debug_Line, ' '); - - if Add_Quotes then - Append (Debug_Line, '"' & Arg & '"'); - else - Append (Debug_Line, Arg); - end if; - end if; - end; - end loop; - - if Verbose then - Ada.Text_IO.Put_Line (To_String (Debug_Line)); - end if; - - declare - Status : aliased Integer := 0; - Ret : constant String := - Get_Command_Output - (Command => Arguments.First_Element, - Arguments => Args.all, - Input => "", - Status => Status'Access, - Err_To_Out => True); - - begin - GNAT.OS_Lib.Free (Args); - - if Status /= 0 then - Ada.Text_IO.Put_Line (Ret); - Set_Error_State - (Base_Name (Arguments.First_Element) & - " returned" & Status'Image); - end if; - - return Ret; - end; - end Run; - - --------- - -- Gcc -- - --------- - - function Gcc return String is - begin - return Which (Triplet & "gcc"); - end Gcc; - - --------- - -- Gxx -- - --------- - - function Gxx return String is - begin - return Which (Triplet & "g++"); - end Gxx; - - -------- - -- Nm -- - -------- - - function Nm return String is - begin - return Which (Triplet & "nm"); - end Nm; - -end VxLink; --- gcc/ada/vxlink.ads deleted file mode 100644 +++ /dev/null @@ -1,68 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- V X L I N K -- --- -- --- S p e c -- --- -- --- Copyright (C) 2018, AdaCore -- --- -- --- 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. -- --- -- ------------------------------------------------------------------------------- - --- See vxlink-main.adb for a description of the tool. --- --- This package contains only common utility functions used by the other --- child packages. - -pragma Ada_2012; - -with Ada.Containers.Indefinite_Vectors; - -package VxLink is - - package Strings_List is new Ada.Containers.Indefinite_Vectors - (Positive, String); - - subtype Arguments_List is Strings_List.Vector; - - procedure Set_Verbose (Value : Boolean); - function Is_Verbose return Boolean; - - procedure Set_Error_State (Message : String); - function Is_Error_State return Boolean; - - procedure Log_Info (S : String); - procedure Log_Error (S : String); - - procedure Run (Arguments : Arguments_List); - - function Run (Arguments : Arguments_List) return String; - - function Gcc return String; - -- Current toolchain's gcc command - - function Gxx return String; - -- Current toolchain's g++ command - - function Nm return String; - -- Current toolchain's nm command - - function Ends_With (Str, Suffix : String) return Boolean - is (Str'Length >= Suffix'Length - and then Str (Str'Last - Suffix'Length + 1 .. Str'Last) = Suffix); - -end VxLink; --4Ckj6UjgE2iN1+kY--