procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

s-dwalin.ads, [...]: New.

Browse source 
2017-09-08  Arnaud Charlet <charlet@adacore.com>

	* s-dwalin.ads, s-dwalin.adb, s-trasym-dwarf.adb, s-objrea.ads,
	s-objrea.adb, s-tsmona-linux.adb, s-tsmona-mingw.adb: New.
	* gcc-interface/Makefile.in: Enable s-trasym-dwarf.adb on x86*linux.

From-SVN: r251887
This commit is contained in:
Arnaud Charlet 2017-09-08 13:00:52 +02:00
parent 6a237c4530
commit a2529c0aa7
8 changed files with 5512 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
gcc/ada/gcc-interface/Makefile.in
View file

@ -429,6 +429,25 @@ X86_64_TARGET_PAIRS = \
a-numaux.adb<a-numaux-x86.adb \
s-atocou.adb<s-atocou-builtin.adb
# Implementation of symbolic traceback based on dwarf
TRASYM_DWARF_UNIX_PAIRS = \
s-trasym.adb<s-trasym-dwarf.adb \
s-mmosin.ads<s-mmosin-unix.ads \
s-mmosin.adb<s-mmosin-unix.adb \
s-mmauni.ads<s-mmauni-long.ads
TRASYM_DWARF_MINGW_PAIRS = \
s-trasym.adb<s-trasym-dwarf.adb \
s-mmosin.ads<s-mmosin-mingw.ads \
s-mmosin.adb<s-mmosin-mingw.adb
TRASYM_DWARF_COMMON_OBJS = s-objrea$(objext) s-dwalin$(objext) s-mmap$(objext) \
s-mmosin$(objext)
TRASYM_DWARF_UNIX_OBJS = $(TRASYM_DWARF_COMMON_OBJS) s-mmauni$(objext)
TRASYM_DWARF_MINGW_OBJS = $(TRASYM_DWARF_COMMON_OBJS)
# Shared library version
LIB_VERSION = $(strip $(shell grep ' Library_Version :' $(fsrcpfx)ada/gnatvsn.ads | sed -e 's/.*"\(.*\)".*/\1/'))
@ -1085,7 +1104,9 @@ ifeq ($(strip $(filter-out %86 linux%,$(target_cpu) $(target_os))),)
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-tpopsp.adb<s-tpopsp-tls.adb \
$(TRASYM_DWARF_UNIX_PAIRS) \
g-sercom.adb<g-sercom-linux.adb \
s-tsmona.adb<s-tsmona-linux.adb \
a-exetim.adb<a-exetim-posix.adb \
a-exetim.ads<a-exetim-default.ads \
s-linux.ads<s-linux.ads \
@ -1111,6 +1132,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(target_cpu) $(target_os))),)
EH_MECHANISM=-gcc
THREADSLIB = -lpthread -lrt
EXTRA_GNATRTL_NONTASKING_OBJS += g-sse.o g-ssvety.o
EXTRA_GNATRTL_NONTASKING_OBJS += $(TRASYM_DWARF_UNIX_OBJS)
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
TOOLS_TARGET_PAIRS = indepsw.adb<indepsw-gnu.adb
@ -1907,6 +1929,8 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(target_cpu) $(target_os))),)
s-tpopsp.adb<s-tpopsp-tls.adb \
s-taspri.ads<s-taspri-posix.ads \
g-sercom.adb<g-sercom-linux.adb \
$(TRASYM_DWARF_UNIX_PAIRS) \
s-tsmona.adb<s-tsmona-linux.adb \
$(ATOMICS_TARGET_PAIRS) \
$(X86_64_TARGET_PAIRS) \
system.ads<system-linux-x86.ads
@ -1914,6 +1938,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(target_cpu) $(target_os))),)
TOOLS_TARGET_PAIRS = indepsw.adb<indepsw-gnu.adb
EXTRA_GNATRTL_NONTASKING_OBJS += g-sse.o g-ssvety.o
EXTRA_GNATRTL_NONTASKING_OBJS += $(TRASYM_DWARF_UNIX_OBJS)
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
EH_MECHANISM=-gcc

1627
gcc/ada/s-dwalin.adb Normal file
View file

File diff suppressed because it is too large Load diff

191
gcc/ada/s-dwalin.ads Normal file
View file

@ -0,0 +1,191 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . D W A R F _ L I N E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2009-2017, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package provides routines to read DWARF line number information from
-- a generic object file with as little overhead as possible. This allows
-- conversions from PC addresses to human readable source locations.
--
-- Objects must be built with debugging information, however only the
-- .debug_line section of the object file is referenced. In cases where object
-- size is a consideration it's possible to strip all other .debug sections,
-- which will decrease the size of the object significantly.
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we can get
-- elaboration circularities when polling is turned on
with Ada.Exceptions.Traceback;
with System.Object_Reader;
with System.Storage_Elements;
with System.Bounded_Strings;
package System.Dwarf_Lines is
package AET renames Ada.Exceptions.Traceback;
package SOR renames System.Object_Reader;
type Dwarf_Context (In_Exception : Boolean := False) is private;
-- Type encapsulation the state of the Dwarf reader. When In_Exception
-- is True we are parsing as part of a exception handler decorator, we do
-- not want an exception to be raised, the parsing is done safely skipping
-- DWARF file that cannot be read or with stripped debug section for
-- example.
procedure Open
(File_Name : String;
C : out Dwarf_Context;
Success : out Boolean);
procedure Close (C : in out Dwarf_Context);
-- Open and close files
procedure Set_Load_Address (C : in out Dwarf_Context; Addr : Address);
-- Set the load address of a file. This is used to rebase PIE (Position
-- Independant Executable) binaries.
function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean;
pragma Inline (Is_Inside);
-- Return true iff Addr is within the module
function Low (C : Dwarf_Context) return Address;
pragma Inline (Low);
-- Return the lowest address of C
procedure Dump (C : in out Dwarf_Context);
-- Dump each row found in the object's .debug_lines section to standard out
procedure Dump_Cache (C : Dwarf_Context);
-- Dump the cache (if present)
procedure Enable_Cache (C : in out Dwarf_Context);
-- Read symbols information to speed up Symbolic_Traceback.
procedure Symbolic_Traceback
(Cin : Dwarf_Context;
Traceback : AET.Tracebacks_Array;
Suppress_Hex : Boolean;
Symbol_Found : in out Boolean;
Res : in out System.Bounded_Strings.Bounded_String);
-- Generate a string for a traceback suitable for displaying to the user.
-- If one or more symbols are found, Symbol_Found is set to True. This
-- allows the caller to fall back to hexadecimal addresses.
Dwarf_Error : exception;
-- Raised if a problem is encountered parsing DWARF information. Can be a
-- result of a logic error or malformed DWARF information.
private
-- The following section numbers reference
-- "DWARF Debugging Information Format, Version 3"
-- published by the Standards Group, http://freestandards.org.
-- 6.2.2 State Machine Registers
type Line_Info_Registers is record
Address : SOR.uint64;
File : SOR.uint32;
Line : SOR.uint32;
Column : SOR.uint32;
Is_Stmt : Boolean;
Basic_Block : Boolean;
End_Sequence : Boolean;
Prologue_End : Boolean;
Epilogue_Begin : Boolean;
ISA : SOR.uint32;
Is_Row : Boolean;
end record;
-- 6.2.4 The Line Number Program Prologue
MAX_OPCODE_LENGTHS : constant := 256;
type Opcodes_Lengths_Array is
array (SOR.uint32 range 1 .. MAX_OPCODE_LENGTHS) of SOR.uint8;
type Line_Info_Prologue is record
Unit_Length : SOR.uint32;
Version : SOR.uint16;
Prologue_Length : SOR.uint32;
Min_Isn_Length : SOR.uint8;
Default_Is_Stmt : SOR.uint8;
Line_Base : SOR.int8;
Line_Range : SOR.uint8;
Opcode_Base : SOR.uint8;
Opcode_Lengths : Opcodes_Lengths_Array;
Includes_Offset : SOR.Offset;
File_Names_Offset : SOR.Offset;
end record;
type Search_Entry is record
First : SOR.uint32;
Size : SOR.uint32;
-- Function bounds as offset to the base address.
Sym : SOR.uint32;
-- Symbol offset to get the name.
Line : SOR.uint32;
-- Dwarf line offset.
end record;
type Search_Array is array (Natural range <>) of Search_Entry;
type Search_Array_Access is access Search_Array;
type Dwarf_Context (In_Exception : Boolean := False) is record
Load_Slide : System.Storage_Elements.Integer_Address := 0;
Low, High : Address;
-- Bounds of the module
Obj : SOR.Object_File_Access;
-- The object file containing dwarf sections
Has_Debug : Boolean;
-- True if all debug sections are available
Cache : Search_Array_Access;
-- Quick access to symbol and debug info (when present).
Lines : SOR.Mapped_Stream;
Aranges : SOR.Mapped_Stream;
Info : SOR.Mapped_Stream;
Abbrev : SOR.Mapped_Stream;
-- Dwarf line, aranges, info and abbrev sections
Prologue : Line_Info_Prologue;
Registers : Line_Info_Registers;
Next_Prologue : SOR.Offset;
-- State for lines
end record;
end System.Dwarf_Lines;

2246
gcc/ada/s-objrea.adb Normal file
View file

File diff suppressed because it is too large Load diff

451
gcc/ada/s-objrea.ads Normal file
View file

@ -0,0 +1,451 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . O B J E C T _ R E A D E R --
-- --
-- S p e c --
-- --
-- Copyright (C) 2009-2017, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package implements a simple, minimal overhead reader for object files
-- composed of sections of untyped heterogeneous binary data.
with Interfaces;
with System.Mmap;
package System.Object_Reader is
--------------
-- Limits --
--------------
BUFFER_SIZE : constant := 8 * 1024;
------------------
-- Object files --
------------------
type Object_File (<>) is private;
type Object_File_Access is access Object_File;
---------------------
-- Object sections --
----------------------
type Object_Section is private;
Null_Section : constant Object_Section;
--------------------
-- Object symbols --
--------------------
type Object_Symbol is private;
------------------------
-- Object format type --
------------------------
type Object_Format is
(ELF32,
-- Object format is 32-bit ELF
ELF64,
-- Object format is 64-bit ELF
PECOFF,
-- Object format is Microsoft PECOFF
PECOFF_PLUS,
-- Object format is Microsoft PECOFF+
XCOFF32);
-- Object format is AIX 32-bit XCOFF
-- PECOFF | PECOFF_PLUS appears so often as a case choice, would
-- seem a good idea to have a subtype name covering these two choices ???
------------------------------
-- Object architecture type --
------------------------------
type Object_Arch is
(Unknown,
-- The target architecture has not yet been determined
SPARC,
-- 32-bit SPARC
SPARC64,
-- 64-bit SPARC
i386,
-- Intel IA32
MIPS,
-- MIPS Technologies MIPS
x86_64,
-- x86-64 (64-bit AMD/Intel)
IA64,
-- Intel IA64
PPC,
-- 32-bit PowerPC
PPC64);
-- 64-bit PowerPC
------------------
-- Target types --
------------------
subtype Offset is Interfaces.Integer_64;
subtype uint8 is Interfaces.Unsigned_8;
subtype uint16 is Interfaces.Unsigned_16;
subtype uint32 is Interfaces.Unsigned_32;
subtype uint64 is Interfaces.Unsigned_64;
subtype int8 is Interfaces.Integer_8;
subtype int16 is Interfaces.Integer_16;
subtype int32 is Interfaces.Integer_32;
subtype int64 is Interfaces.Integer_64;
type Buffer is array (0 .. BUFFER_SIZE - 1) of uint8;
type String_Ptr_Len is record
Ptr : Mmap.Str_Access;
Len : Natural;
end record;
-- A string made from a pointer and a length. Not all strings for name
-- are C strings: COFF inlined symbol names have a max length of 8.
-------------------------------------------
-- Operations on buffers of untyped data --
-------------------------------------------
function To_String (Buf : Buffer) return String;
-- Construct string from C style null-terminated string stored in a buffer
function To_String_Ptr_Len
(Ptr : Mmap.Str_Access;
Max_Len : Natural := Natural'Last) return String_Ptr_Len;
-- Convert PTR to a String_Ptr_Len.
function Strlen (Buf : Buffer) return int32;
-- Return the length of a C style null-terminated string
-------------------------
-- Opening and closing --
-------------------------
function Open
(File_Name : String;
In_Exception : Boolean := False) return Object_File_Access;
-- Open the object file and initialize the reader. In_Exception is true
-- when the parsing is done as part of an exception handler decorator. In
-- this mode we do not want to raise an exception.
procedure Close (Obj : in out Object_File);
-- Close the object file
-----------------------
-- Sequential access --
-----------------------
type Mapped_Stream is private;
-- Provide an abstraction of a stream on a memory mapped file
function Create_Stream (Mf : System.Mmap.Mapped_File;
File_Offset : System.Mmap.File_Size;
File_Length : System.Mmap.File_Size)
return Mapped_Stream;
-- Create a stream from Mf
procedure Close (S : in out Mapped_Stream);
-- Close the stream (deallocate memory)
procedure Read_Raw
(S : in out Mapped_Stream;
Addr : Address;
Size : uint32);
pragma Inline (Read_Raw);
-- Read a number of fixed sized records
procedure Seek (S : in out Mapped_Stream; Off : Offset);
-- Seek to an absolute offset in bytes
procedure Tell (Obj : in out Mapped_Stream; Off : out Offset)
with Inline;
function Tell (Obj : Mapped_Stream) return Offset
with Inline;
-- Fetch the current offset
function Length (Obj : Mapped_Stream) return Offset
with Inline;
-- Length of the stream
function Read (S : in out Mapped_Stream) return Mmap.Str_Access;
-- Provide a pointer in memory at the current offset
function Read (S : in out Mapped_Stream) return String_Ptr_Len;
-- Provide a pointer in memory at the current offset
function Read (S : in out Mapped_Stream) return uint8;
function Read (S : in out Mapped_Stream) return uint16;
function Read (S : in out Mapped_Stream) return uint32;
function Read (S : in out Mapped_Stream) return uint64;
function Read (S : in out Mapped_Stream) return int8;
function Read (S : in out Mapped_Stream) return int16;
function Read (S : in out Mapped_Stream) return int32;
function Read (S : in out Mapped_Stream) return int64;
-- Read a scalar
function Read_Address
(Obj : Object_File; S : in out Mapped_Stream) return uint64;
-- Read either a 64 or 32 bit address from the file stream depending on the
-- address size of the target architecture and promote it to a 64 bit type.
function Read_LEB128 (S : in out Mapped_Stream) return uint32;
function Read_LEB128 (S : in out Mapped_Stream) return int32;
-- Read a value encoding in Little-Endian Base 128 format
procedure Read_C_String (S : in out Mapped_Stream; B : out Buffer);
function Read_C_String (S : in out Mapped_Stream) return Mmap.Str_Access;
-- Read a C style NULL terminated string
function Offset_To_String
(S : in out Mapped_Stream;
Off : Offset) return String;
-- Construct a string from a C style NULL terminated string located at an
-- offset into the object file.
------------------------
-- Object information --
------------------------
function Arch (Obj : Object_File) return Object_Arch;
-- Return the object architecture
function Format (Obj : Object_File) return Object_Format;
-- Return the object file format
function Get_Load_Address (Obj : Object_File) return uint64;
-- Return the load address defined in Obj. May raise Format_Error if not
-- implemented
function Num_Sections (Obj : Object_File) return uint32;
-- Return the number of sections composing the object file
function Get_Section
(Obj : in out Object_File;
Shnum : uint32) return Object_Section;
-- Return the Nth section (numbered from zero)
function Get_Section
(Obj : in out Object_File;
Sec_Name : String) return Object_Section;
-- Return a section by name
function Create_Stream
(Obj : Object_File;
Sec : Object_Section) return Mapped_Stream;
-- Create a stream for section Sec
procedure Get_Memory_Bounds
(Obj : in out Object_File;
Low, High : out uint64);
-- Return the low and high addresses of the code for the object file. Can
-- be used to check if an address in within this object file. This
-- procedure is not efficient and the result should be saved to avoid
-- recomputation.
-------------------------
-- Section information --
-------------------------
function Name
(Obj : in out Object_File;
Sec : Object_Section) return String;
-- Return the name of a section as a string
function Size (Sec : Object_Section) return uint64;
-- Return the size of a section in bytes
function Num (Sec : Object_Section) return uint32;
-- Return the index of a section from zero
function Off (Sec : Object_Section) return Offset;
-- Return the byte offset of the section within the object
------------------------------
-- Symbol table information --
------------------------------
Null_Symbol : constant Object_Symbol;
-- An empty symbol table entry.
function First_Symbol (Obj : in out Object_File) return Object_Symbol;
-- Return the first element in the symbol table or Null_Symbol if the
-- symbol table is empty.
function Next_Symbol
(Obj : in out Object_File;
Prev : Object_Symbol) return Object_Symbol;
-- Return the element following Prev in the symbol table, or Null_Symbol if
-- Prev is the last symbol in the table.
function Read_Symbol
(Obj : in out Object_File;
Off : Offset) return Object_Symbol;
-- Read symbol at Off
function Name
(Obj : in out Object_File;
Sym : Object_Symbol) return String_Ptr_Len;
-- Return the name of the symbol
function Decoded_Ada_Name
(Obj : in out Object_File;
Sym : String_Ptr_Len) return String;
-- Return the decoded name of a symbol encoded as per exp_dbug.ads
function Strip_Leading_Char
(Obj : in out Object_File;
Sym : String_Ptr_Len) return Positive;
-- Return the index of the first character to decode the name. This can
-- strip one character for ABI with a prefix (like x86 for PECOFF).
function Value (Sym : Object_Symbol) return uint64;
-- Return the name of the symbol
function Size (Sym : Object_Symbol) return uint64;
-- Return the size of the symbol in bytes
function Spans (Sym : Object_Symbol; Addr : uint64) return Boolean;
-- Determine whether a particular address corresponds to the range
-- referenced by this symbol.
function Off (Sym : Object_Symbol) return Offset;
-- Return the offset of the symbol.
----------------
-- Exceptions --
----------------
IO_Error : exception;
-- Input/Output error reading file
Format_Error : exception;
-- Encountered a problem parsing the object
private
type Mapped_Stream is record
Region : System.Mmap.Mapped_Region;
Off : Offset;
Len : Offset;
end record;
subtype ELF is Object_Format range ELF32 .. ELF64;
subtype Any_PECOFF is Object_Format range PECOFF .. PECOFF_PLUS;
type Object_File (Format : Object_Format) is record
Mf : System.Mmap.Mapped_File :=
System.Mmap.Invalid_Mapped_File;
Arch : Object_Arch := Unknown;
Num_Sections : uint32 := 0;
-- Number of sections
Symtab_Last : Offset; -- Last offset of symbol table
In_Exception : Boolean := False;
-- True if the parsing is done as part of an exception handler
Sectab_Stream : Mapped_Stream;
-- Section table
Symtab_Stream : Mapped_Stream;
-- Symbol table
Symstr_Stream : Mapped_Stream;
-- Symbol strings
case Format is
when ELF =>
Secstr_Stream : Mapped_Stream;
-- Section strings
when Any_PECOFF =>
ImageBase : uint64; -- ImageBase value from header
-- Cache for latest result of Get_Section_Virtual_Address
GSVA_Sec : uint32 := uint32'Last;
GSVA_Addr : uint64;
when XCOFF32 =>
null;
end case;
end record;
subtype ELF_Object_File is Object_File; -- with
-- Predicate => ELF_Object_File.Format in ELF;
subtype PECOFF_Object_File is Object_File; -- with
-- Predicate => PECOFF_Object_File.Format in Any_PECOFF;
subtype XCOFF32_Object_File is Object_File; -- with
-- Predicate => XCOFF32_Object_File.Format in XCOFF32;
-- ???Above predicates cause the compiler to crash when instantiating
-- ELF64_Ops (see package body).
type Object_Section is record
Num : uint32 := 0;
-- Section index in the section table
Off : Offset := 0;
-- First byte of the section in the object file
Addr : uint64 := 0;
-- Load address of the section. Valid only when Flag_Alloc is true.
Size : uint64 := 0;
-- Length of the section in bytes
Flag_Alloc : Boolean := False;
-- True if the section is mapped in memory by the OS loader
end record;
Null_Section : constant Object_Section := (0, 0, 0, 0, False);
type Object_Symbol is record
Off : Offset := 0; -- Offset of underlying symbol on disk
Next : Offset := 0; -- Offset of the following symbol
Value : uint64 := 0; -- Value associated with this symbol
Size : uint64 := 0; -- Size of the referenced entity
end record;
Null_Symbol : constant Object_Symbol := (0, 0, 0, 0);
end System.Object_Reader;

689
gcc/ada/s-trasym-dwarf.adb Normal file
View file

@ -0,0 +1,689 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . T R A C E B A C K . S Y M B O L I C --
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2017, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Run-time symbolic traceback support for targets using DWARF debug data
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we can get
-- elaboration circularities when polling is turned on.
with Ada.Unchecked_Deallocation;
with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
with Ada.Containers.Generic_Array_Sort;
with System.Address_To_Access_Conversions;
with System.Soft_Links;
with System.CRTL;
with System.Dwarf_Lines;
with System.Exception_Traces;
with System.Standard_Library;
with System.Traceback_Entries;
with System.Strings;
with System.Bounded_Strings;
package body System.Traceback.Symbolic is
use System.Bounded_Strings;
use System.Dwarf_Lines;
subtype Big_String is String (Positive);
-- To deal with C strings
package Big_String_Conv is new System.Address_To_Access_Conversions
(Big_String);
type Module_Cache;
type Module_Cache_Acc is access all Module_Cache;
type Module_Cache is record
Name : Strings.String_Access;
-- Name of the module
C : Dwarf_Context (In_Exception => True);
-- Context to symbolize an address within this module
Chain : Module_Cache_Acc;
end record;
procedure Free is new Ada.Unchecked_Deallocation
(Module_Cache,
Module_Cache_Acc);
Cache_Chain : Module_Cache_Acc;
-- Simply linked list of modules
type Module_Array is array (Natural range <>) of Module_Cache_Acc;
type Module_Array_Acc is access Module_Array;
Modules_Cache : Module_Array_Acc;
-- Sorted array of cached modules (if not null)
Exec_Module : aliased Module_Cache;
-- Context for the executable
type Init_State is (Uninitialized, Initialized, Failed);
Exec_Module_State : Init_State := Uninitialized;
-- How Exec_Module is initialized
procedure Init_Exec_Module;
-- Initialize Exec_Module if not already initialized
function Symbolic_Traceback
(Traceback : System.Traceback_Entries.Tracebacks_Array;
Suppress_Hex : Boolean) return String;
function Symbolic_Traceback
(E : Ada.Exceptions.Exception_Occurrence;
Suppress_Hex : Boolean) return String;
-- Suppress_Hex means do not print any hexadecimal addresses, even if the
-- symbol is not available.
function Lt (Left, Right : Module_Cache_Acc) return Boolean;
-- Sort function for Module_Cache
procedure Init_Module
(Module : out Module_Cache;
Success : out Boolean;
Module_Name : String;
Load_Address : Address := Null_Address);
-- Initialize Module
procedure Close_Module (Module : in out Module_Cache);
-- Finalize Module
function Value (Item : System.Address) return String;
-- Return the String contained in Item, up until the first NUL character
pragma Warnings (Off, "*Add_Module_To_Cache*");
procedure Add_Module_To_Cache (Module_Name : String);
-- To be called by Build_Cache_For_All_Modules to add a new module to the
-- list. May not be referenced.
package Module_Name is
procedure Build_Cache_For_All_Modules;
-- Create the cache for all current modules
function Get (Addr : access System.Address) return String;
-- Returns the module name for the given address, Addr may be updated
-- to be set relative to a shared library. This depends on the platform.
-- Returns an empty string for the main executable.
function Is_Supported return Boolean;
pragma Inline (Is_Supported);
-- Returns True if Module_Name is supported, so if the traceback is
-- supported for shared libraries.
end Module_Name;
package body Module_Name is separate;
function Executable_Name return String;
-- Returns the executable name as reported by argv[0]. If gnat_argv not
-- initialized or if argv[0] executable not found in path, function returns
-- an empty string.
function Get_Executable_Load_Address return System.Address;
pragma Import
(C,
Get_Executable_Load_Address,
"__gnat_get_executable_load_address");
-- Get the load address of the executable, or Null_Address if not known
procedure Hexa_Traceback
(Traceback : Tracebacks_Array;
Suppress_Hex : Boolean;
Res : in out Bounded_String);
-- Non-symbolic traceback (simply write addresses in hexa)
procedure Symbolic_Traceback_No_Lock
(Traceback : Tracebacks_Array;
Suppress_Hex : Boolean;
Res : in out Bounded_String);
-- Like the public Symbolic_Traceback_No_Lock except there is no provision
-- against concurrent accesses.
procedure Module_Symbolic_Traceback
(Traceback : Tracebacks_Array;
Module : Module_Cache;
Suppress_Hex : Boolean;
Res : in out Bounded_String);
-- Returns the Traceback for a given module
procedure Multi_Module_Symbolic_Traceback
(Traceback : Tracebacks_Array;
Suppress_Hex : Boolean;
Res : in out Bounded_String);
-- Build string containing symbolic traceback for the given call chain
procedure Multi_Module_Symbolic_Traceback
(Traceback : Tracebacks_Array;
Module : Module_Cache;
Suppress_Hex : Boolean;
Res : in out Bounded_String);
-- Likewise but using Module
Max_String_Length : constant := 4096;
-- Arbitrary limit on Bounded_Str length
-----------
-- Value --
-----------
function Value (Item : System.Address) return String is
begin
if Item /= Null_Address then
for J in Big_String'Range loop
if Big_String_Conv.To_Pointer (Item) (J) = ASCII.NUL then
return Big_String_Conv.To_Pointer (Item) (1 .. J - 1);
end if;
end loop;
end if;
return "";
end Value;
-------------------------
-- Add_Module_To_Cache --
-------------------------
procedure Add_Module_To_Cache (Module_Name : String) is
Module : Module_Cache_Acc;
Success : Boolean;
begin
Module := new Module_Cache;
Init_Module (Module.all, Success, Module_Name);
if not Success then
Free (Module);
return;
end if;
Module.Chain := Cache_Chain;
Cache_Chain := Module;
end Add_Module_To_Cache;
----------------------
-- Init_Exec_Module --
----------------------
procedure Init_Exec_Module is
begin
if Exec_Module_State = Uninitialized then
declare
Exec_Path : constant String := Executable_Name;
Exec_Load : constant Address := Get_Executable_Load_Address;
Success : Boolean;
begin
Init_Module (Exec_Module, Success, Exec_Path, Exec_Load);
if Success then
Exec_Module_State := Initialized;
else
Exec_Module_State := Failed;
end if;
end;
end if;
end Init_Exec_Module;
--------
-- Lt --
--------
function Lt (Left, Right : Module_Cache_Acc) return Boolean is
begin
return Low (Left.C) < Low (Right.C);
end Lt;
-----------------------------
-- Module_Cache_Array_Sort --
-----------------------------
procedure Module_Cache_Array_Sort is new Ada.Containers.Generic_Array_Sort
(Natural,
Module_Cache_Acc,
Module_Array,
Lt);
------------------
-- Enable_Cache --
------------------
procedure Enable_Cache (Include_Modules : Boolean := False) is
begin
-- Can be called at most once
if Cache_Chain /= null then
return;
end if;
-- Add all modules
Init_Exec_Module;
Cache_Chain := Exec_Module'Access;
if Include_Modules then
Module_Name.Build_Cache_For_All_Modules;
end if;
-- Build and fill the array of modules
declare
Count : Natural;
Module : Module_Cache_Acc;
begin
for Phase in 1 .. 2 loop
Count := 0;
Module := Cache_Chain;
while Module /= null loop
Count := Count + 1;
if Phase = 1 then
Enable_Cache (Module.C);
else
Modules_Cache (Count) := Module;
end if;
Module := Module.Chain;
end loop;
if Phase = 1 then
Modules_Cache := new Module_Array (1 .. Count);
end if;
end loop;
end;
-- Sort the array
Module_Cache_Array_Sort (Modules_Cache.all);
end Enable_Cache;
---------------------
-- Executable_Name --
---------------------
function Executable_Name return String is
-- We have to import gnat_argv as an Address to match the type of
-- gnat_argv in the binder generated file. Otherwise, we get spurious
-- warnings about type mismatch when LTO is turned on.
Gnat_Argv : System.Address;
pragma Import (C, Gnat_Argv, "gnat_argv");
type Argv_Array is array (0 .. 0) of System.Address;
package Conv is new System.Address_To_Access_Conversions (Argv_Array);
function locate_exec_on_path (A : System.Address) return System.Address;
pragma Import (C, locate_exec_on_path, "__gnat_locate_exec_on_path");
begin
if Gnat_Argv = Null_Address then
return "";
end if;
declare
Addr : constant System.Address :=
locate_exec_on_path (Conv.To_Pointer (Gnat_Argv) (0));
Result : constant String := Value (Addr);
begin
-- The buffer returned by locate_exec_on_path was allocated using
-- malloc, so we should use free to release the memory.
if Addr /= Null_Address then
System.CRTL.free (Addr);
end if;
return Result;
end;
end Executable_Name;
------------------
-- Close_Module --
------------------
procedure Close_Module (Module : in out Module_Cache) is
begin
Close (Module.C);
Strings.Free (Module.Name);
end Close_Module;
-----------------
-- Init_Module --
-----------------
procedure Init_Module
(Module : out Module_Cache;
Success : out Boolean;
Module_Name : String;
Load_Address : Address := Null_Address)
is
begin
-- Early return if the module is not known
if Module_Name = "" then
Success := False;
return;
end if;
Open (Module_Name, Module.C, Success);
-- If a module can't be opened just return now, we just cannot give more
-- information in this case.
if not Success then
return;
end if;
Set_Load_Address (Module.C, Load_Address);
Module.Name := new String'(Module_Name);
end Init_Module;
-------------------------------
-- Module_Symbolic_Traceback --
-------------------------------
procedure Module_Symbolic_Traceback
(Traceback : Tracebacks_Array;
Module : Module_Cache;
Suppress_Hex : Boolean;
Res : in out Bounded_String)
is
Success : Boolean := False;
begin
if Symbolic.Module_Name.Is_Supported then
Append (Res, '[');
Append (Res, Module.Name.all);
Append (Res, ']' & ASCII.LF);
end if;
Dwarf_Lines.Symbolic_Traceback
(Module.C,
Traceback,
Suppress_Hex,
Success,
Res);
if not Success then
Hexa_Traceback (Traceback, Suppress_Hex, Res);
end if;
-- We must not allow an unhandled exception here, since this function
-- may be installed as a decorator for all automatic exceptions.
exception
when others =>
return;
end Module_Symbolic_Traceback;
-------------------------------------
-- Multi_Module_Symbolic_Traceback --
-------------------------------------
procedure Multi_Module_Symbolic_Traceback
(Traceback : Tracebacks_Array;
Suppress_Hex : Boolean;
Res : in out Bounded_String)
is
F : constant Natural := Traceback'First;
begin
if Traceback'Length = 0 or else Is_Full (Res) then
return;
end if;
if Modules_Cache /= null then
-- Search in the cache
declare
Addr : constant Address := Traceback (F);
Hi, Lo, Mid : Natural;
begin
Lo := Modules_Cache'First;
Hi := Modules_Cache'Last;
while Lo <= Hi loop
Mid := (Lo + Hi) / 2;
if Addr < Low (Modules_Cache (Mid).C) then
Hi := Mid - 1;
elsif Is_Inside (Modules_Cache (Mid).C, Addr) then
Multi_Module_Symbolic_Traceback
(Traceback,
Modules_Cache (Mid).all,
Suppress_Hex,
Res);
return;
else
Lo := Mid + 1;
end if;
end loop;
-- Not found
Hexa_Traceback (Traceback (F .. F), Suppress_Hex, Res);
Multi_Module_Symbolic_Traceback
(Traceback (F + 1 .. Traceback'Last),
Suppress_Hex,
Res);
end;
else
-- First try the executable
if Is_Inside (Exec_Module.C, Traceback (F)) then
Multi_Module_Symbolic_Traceback
(Traceback,
Exec_Module,
Suppress_Hex,
Res);
return;
end if;
-- Otherwise, try a shared library
declare
Addr : aliased System.Address := Traceback (F);
M_Name : constant String := Module_Name.Get (Addr'Access);
Module : Module_Cache;
Success : Boolean;
begin
Init_Module (Module, Success, M_Name, System.Null_Address);
if Success then
Multi_Module_Symbolic_Traceback
(Traceback,
Module,
Suppress_Hex,
Res);
Close_Module (Module);
else
-- Module not found
Hexa_Traceback (Traceback (F .. F), Suppress_Hex, Res);
Multi_Module_Symbolic_Traceback
(Traceback (F + 1 .. Traceback'Last),
Suppress_Hex,
Res);
end if;
end;
end if;
end Multi_Module_Symbolic_Traceback;
procedure Multi_Module_Symbolic_Traceback
(Traceback : Tracebacks_Array;
Module : Module_Cache;
Suppress_Hex : Boolean;
Res : in out Bounded_String)
is
Pos : Positive;
begin
-- Will symbolize the first address...
Pos := Traceback'First + 1;
-- ... and all addresses in the same module
Same_Module :
loop
exit Same_Module when Pos > Traceback'Last;
-- Get address to check for corresponding module name
exit Same_Module when not Is_Inside (Module.C, Traceback (Pos));
Pos := Pos + 1;
end loop Same_Module;
Module_Symbolic_Traceback
(Traceback (Traceback'First .. Pos - 1),
Module,
Suppress_Hex,
Res);
Multi_Module_Symbolic_Traceback
(Traceback (Pos .. Traceback'Last),
Suppress_Hex,
Res);
end Multi_Module_Symbolic_Traceback;
--------------------
-- Hexa_Traceback --
--------------------
procedure Hexa_Traceback
(Traceback : Tracebacks_Array;
Suppress_Hex : Boolean;
Res : in out Bounded_String)
is
use System.Traceback_Entries;
begin
if Suppress_Hex then
Append (Res, "...");
Append (Res, ASCII.LF);
else
for J in Traceback'Range loop
Append_Address (Res, PC_For (Traceback (J)));
Append (Res, ASCII.LF);
end loop;
end if;
end Hexa_Traceback;
--------------------------------
-- Symbolic_Traceback_No_Lock --
--------------------------------
procedure Symbolic_Traceback_No_Lock
(Traceback : Tracebacks_Array;
Suppress_Hex : Boolean;
Res : in out Bounded_String)
is
begin
if Symbolic.Module_Name.Is_Supported then
Multi_Module_Symbolic_Traceback (Traceback, Suppress_Hex, Res);
else
if Exec_Module_State = Failed then
Append (Res, "Call stack traceback locations:" & ASCII.LF);
Hexa_Traceback (Traceback, Suppress_Hex, Res);
else
Module_Symbolic_Traceback
(Traceback,
Exec_Module,
Suppress_Hex,
Res);
end if;
end if;
end Symbolic_Traceback_No_Lock;
------------------------
-- Symbolic_Traceback --
------------------------
function Symbolic_Traceback
(Traceback : Tracebacks_Array;
Suppress_Hex : Boolean) return String
is
Res : Bounded_String (Max_Length => Max_String_Length);
begin
System.Soft_Links.Lock_Task.all;
Init_Exec_Module;
Symbolic_Traceback_No_Lock (Traceback, Suppress_Hex, Res);
System.Soft_Links.Unlock_Task.all;
return To_String (Res);
exception
when others =>
System.Soft_Links.Unlock_Task.all;
raise;
end Symbolic_Traceback;
function Symbolic_Traceback
(Traceback : System.Traceback_Entries.Tracebacks_Array) return String is
begin
return Symbolic_Traceback (Traceback, Suppress_Hex => False);
end Symbolic_Traceback;
function Symbolic_Traceback_No_Hex
(Traceback : System.Traceback_Entries.Tracebacks_Array) return String is
begin
return Symbolic_Traceback (Traceback, Suppress_Hex => True);
end Symbolic_Traceback_No_Hex;
function Symbolic_Traceback
(E : Ada.Exceptions.Exception_Occurrence;
Suppress_Hex : Boolean) return String
is
begin
return Symbolic_Traceback
(Ada.Exceptions.Traceback.Tracebacks (E),
Suppress_Hex);
end Symbolic_Traceback;
function Symbolic_Traceback
(E : Ada.Exceptions.Exception_Occurrence) return String
is
begin
return Symbolic_Traceback (E, Suppress_Hex => False);
end Symbolic_Traceback;
function Symbolic_Traceback_No_Hex
(E : Ada.Exceptions.Exception_Occurrence) return String is
begin
return Symbolic_Traceback (E, Suppress_Hex => True);
end Symbolic_Traceback_No_Hex;
Exception_Tracebacks_Symbolic : Integer;
pragma Import
(C,
Exception_Tracebacks_Symbolic,
"__gl_exception_tracebacks_symbolic");
-- Boolean indicating whether symbolic tracebacks should be generated.
use Standard_Library;
begin
-- If this version of this package is available, and the binder switch -Es
-- was given, then we want to use this as the decorator by default, and we
-- want to turn on tracing for Unhandled_Raise_In_Main. Note that the user
-- cannot have already set Exception_Trace, because the runtime library is
-- elaborated before user-defined code.
if Exception_Tracebacks_Symbolic /= 0 then
Exception_Traces.Set_Trace_Decorator (Symbolic_Traceback'Access);
pragma Assert (Exception_Trace = RM_Convention);
Exception_Trace := Unhandled_Raise_In_Main;
end if;
end System.Traceback.Symbolic;

190
gcc/ada/s-tsmona-linux.adb Normal file
View file

@ -0,0 +1,190 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . T R A C E B A C K . S Y M B O L I C . M O D U L E _ N A M E --
-- --
-- B o d y --
-- --
-- Copyright (C) 2012-2017, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the GNU/Linux specific version of this package
with Interfaces.C; use Interfaces.C;
with System.Address_Operations; use System.Address_Operations;
separate (System.Traceback.Symbolic)
package body Module_Name is
use System;
pragma Linker_Options ("-ldl");
function Is_Shared_Lib (Base : Address) return Boolean;
-- Returns True if a shared library
-- The principle is:
-- 1. We get information about the module containing the address.
-- 2. We check that the full pathname is pointing to a shared library.
-- 3. for shared libraries, we return the non relocated address (so
-- the absolute address in the shared library).
-- 4. we also return the full pathname of the module containing this
-- address.
-------------------
-- Is_Shared_Lib --
-------------------
function Is_Shared_Lib (Base : Address) return Boolean is
EI_NIDENT : constant := 16;
type u16 is mod 2 ** 16;
-- Just declare the needed header information, we just need to read the
-- type encoded in the second field.
type Elf32_Ehdr is record
e_ident : char_array (1 .. EI_NIDENT);
e_type : u16;
end record;
ET_DYN : constant := 3; -- A shared lib if e_type = ET_DYN
Header : Elf32_Ehdr;
pragma Import (Ada, Header);
-- Suppress initialization in Normalized_Scalars mode
for Header'Address use Base;
begin
return Header.e_type = ET_DYN;
exception
when others =>
return False;
end Is_Shared_Lib;
---------------------------------
-- Build_Cache_For_All_Modules --
---------------------------------
procedure Build_Cache_For_All_Modules is
type link_map;
type link_map_acc is access all link_map;
pragma Convention (C, link_map_acc);
type link_map is record
l_addr : Address;
-- Base address of the shared object
l_name : Address;
-- Null-terminated absolute file name
l_ld : Address;
-- Dynamic section
l_next, l_prev : link_map_acc;
-- Chain
end record;
pragma Convention (C, link_map);
type r_debug_type is record
r_version : Integer;
r_map : link_map_acc;
end record;
pragma Convention (C, r_debug_type);
r_debug : r_debug_type;
pragma Import (C, r_debug, "_r_debug");
lm : link_map_acc;
begin
lm := r_debug.r_map;
while lm /= null loop
if Big_String_Conv.To_Pointer (lm.l_name) (1) /= ASCII.NUL then
-- Discard non-file (like the executable itself or the gate).
Add_Module_To_Cache (Value (lm.l_name));
end if;
lm := lm.l_next;
end loop;
end Build_Cache_For_All_Modules;
---------
-- Get --
---------
function Get (Addr : access System.Address) return String is
-- Dl_info record for Linux, used to get sym reloc offset
type Dl_info is record
dli_fname : System.Address;
dli_fbase : System.Address;
dli_sname : System.Address;
dli_saddr : System.Address;
end record;
function dladdr
(addr : System.Address;
info : not null access Dl_info) return int;
pragma Import (C, dladdr, "dladdr");
-- This is a Linux extension and not POSIX
info : aliased Dl_info;
begin
if dladdr (Addr.all, info'Access) /= 0 then
-- If we have a shared library we need to adjust the address to
-- be relative to the base address of the library.
if Is_Shared_Lib (info.dli_fbase) then
Addr.all := SubA (Addr.all, info.dli_fbase);
end if;
return Value (info.dli_fname);
-- Not found, fallback to executable name
else
return "";
end if;
exception
when others =>
return "";
end Get;
------------------
-- Is_Supported --
------------------
function Is_Supported return Boolean is
begin
return True;
end Is_Supported;
end Module_Name;

93
gcc/ada/s-tsmona-mingw.adb Normal file
View file

@ -0,0 +1,93 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . T R A C E B A C K . S Y M B O L I C . M O D U L E _ N A M E --
-- --
-- B o d y --
-- --
-- Copyright (C) 2012-2017, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the Windows specific version of this package
with System.Win32; use System.Win32;
separate (System.Traceback.Symbolic)
package body Module_Name is
use System;
---------------------------------
-- Build_Cache_For_All_Modules --
---------------------------------
procedure Build_Cache_For_All_Modules is
begin
null;
end Build_Cache_For_All_Modules;
---------
-- Get --
---------
function Get (Addr : access System.Address) return String is
Res : DWORD;
hModule : aliased HANDLE;
Path : String (1 .. 1_024);
begin
if GetModuleHandleEx
(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
Addr.all,
hModule'Access) = Win32.TRUE
then
Res := GetModuleFileName (hModule, Path'Address, Path'Length);
if FreeLibrary (hModule) = Win32.FALSE then
null;
end if;
if Res > 0 then
return Path (1 .. Positive (Res));
end if;
end if;
return "";
exception
when others =>
return "";
end Get;
------------------
-- Is_Supported --
------------------
function Is_Supported return Boolean is
begin
return True;
end Is_Supported;
end Module_Name;