You've already forked ada_language_server
mirror of
https://github.com/AdaCore/ada_language_server.git
synced 2026-02-12 12:45:50 -08:00
45c4d79e8c
When PIE mode is used address reported doesn't fit in Long_Integer type used to handle conversions. Long_Integer replaced it by valid & portable System.Storage_Elements.Integer_Address for #1142
102 lines
4.0 KiB
Ada
102 lines
4.0 KiB
Ada
------------------------------------------------------------------------------
|
|
-- Language Server Protocol --
|
|
-- --
|
|
-- Copyright (C) 2020, AdaCore --
|
|
-- --
|
|
-- This 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. This software is distributed in the hope that it will be useful, --
|
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
|
|
-- TABILITY 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 this software; see file --
|
|
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
|
|
-- of the license. --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Ada.Characters.Latin_1;
|
|
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
|
|
with GNAT.Regpat; use GNAT.Regpat;
|
|
with GNAT.Traceback.Symbolic; use GNAT.Traceback.Symbolic;
|
|
with System.Address_Image;
|
|
with System.Storage_Elements; use System.Storage_Elements;
|
|
|
|
package body LSP.Memory_Statistics is
|
|
|
|
----------------------------
|
|
-- Dump_Memory_Statistics --
|
|
----------------------------
|
|
|
|
function Dump_Memory_Statistics
|
|
(Size : Positive;
|
|
Report : Report_Type := Memory_Usage)
|
|
return String
|
|
is
|
|
Buffer : Unbounded_String := To_Unbounded_String
|
|
("Dump_Memory_Statistics at 0x" &
|
|
System.Address_Image (Dump_Memory_Statistics'Address) &
|
|
Ada.Characters.Latin_1.LF);
|
|
|
|
Traceback_Regexp : constant Pattern_Matcher :=
|
|
Compile ("\s0x0+([0-9a-zA-Z]+)");
|
|
|
|
procedure Trace_Put (S : String);
|
|
|
|
procedure Trace_Put_Line (S : String);
|
|
|
|
---------------
|
|
-- Trace_Put --
|
|
---------------
|
|
|
|
procedure Trace_Put (S : String) is
|
|
Matched : Match_Array (0 .. 1);
|
|
begin
|
|
Match (Traceback_Regexp, S, Matched);
|
|
|
|
-- If we are dealing with traceback addresses, resolve it to the
|
|
-- actual source location using GNAT.Traceback.Symbolic.
|
|
-- This is needed since these addresses can point to relocatable
|
|
-- libraries, in which case addr2line won't be able to find the
|
|
-- corresponding source locations.
|
|
|
|
if Matched (0) = No_Match then
|
|
Append (Buffer, S);
|
|
else
|
|
declare
|
|
Traceback_Str : constant String :=
|
|
S (Matched (1).First .. Matched (1).Last);
|
|
Traceback_Long : constant Integer_Address :=
|
|
Integer_Address'Value
|
|
("16#" & Traceback_Str & "#");
|
|
Traceback_Addr : constant System.Address :=
|
|
To_Address (Traceback_Long);
|
|
New_S : constant String :=
|
|
Symbolic_Traceback_No_Hex
|
|
((1 => Traceback_Addr));
|
|
begin
|
|
Append (Buffer, New_S);
|
|
end;
|
|
end if;
|
|
end Trace_Put;
|
|
|
|
--------------------
|
|
-- Trace_Put_Line --
|
|
--------------------
|
|
|
|
procedure Trace_Put_Line (S : String) is
|
|
begin
|
|
Append (Buffer, S & Ada.Characters.Latin_1.LF);
|
|
end Trace_Put_Line;
|
|
|
|
procedure Internal is new GNATCOLL.Memory.Redirectable_Dump
|
|
(Put_Line => Trace_Put_Line,
|
|
Put => Trace_Put);
|
|
|
|
begin
|
|
Internal (Size, Report);
|
|
return To_String (Buffer);
|
|
end Dump_Memory_Statistics;
|
|
|
|
end LSP.Memory_Statistics;
|