-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
with GNAT.IO; use GNAT.IO;
with System.Address_Image;
+with System.CRTL;
with System.Memory; use System.Memory;
with System.Soft_Links; use System.Soft_Links;
-- is high enough to make sure we still have enough frames to return to
-- the user after we have hidden the frames internal to this package.
+ Disable : Boolean := False;
+ -- This variable is used to avoid infinite loops, where this package would
+ -- itself allocate memory and then calls itself recursively, forever.
+ -- Useful when System_Memory_Debug_Pool_Enabled is True.
+
+ System_Memory_Debug_Pool_Enabled : Boolean := False;
+ -- If True System.Memory allocation are using Debug_Pool
+
+ Allow_Unhandled_Memory : Boolean := False;
+ -- If True protects Deallocate against releasing memory allocated before
+ -- System_Memory_Debug_Pool_Enabled was set.
+
---------------------------
-- Back Trace Hash Table --
---------------------------
is access Traceback_Htable_Elem;
type Traceback_Htable_Elem is record
- Traceback : Tracebacks_Array_Access;
- Kind : Traceback_Kind;
- Count : Natural;
- Total : Byte_Count;
- Next : Traceback_Htable_Elem_Ptr;
+ Traceback : Tracebacks_Array_Access;
+ Kind : Traceback_Kind;
+ Count : Natural;
+ -- size of the memory allocated/freed at Traceback since last Reset
+ -- call.
+
+ Total : Byte_Count;
+ -- number of chunk of memory allocated/freed at Traceback since last
+ -- Reset call.
+
+ Frees : Natural;
+ -- number of chunk of memory allocated at Traceback, currently freed
+ -- since last Reset call. (only for Alloc & Indirect_Alloc elements)
+
+ Total_Frees : Byte_Count;
+ -- size of the memory allocated at Traceback, currently freed since last
+ -- Reset call. (only for Alloc & Indirect_Alloc elements)
+
+ Next : Traceback_Htable_Elem_Ptr;
end record;
-- Subprograms used for the Backtrace_Htable instantiation
-- up to the first one in the range:
-- Ignored_Frame_Start .. Ignored_Frame_End
+ procedure Stdout_Put (S : String);
+ -- Wrapper for Put that ensure we always write to stdout
+ -- instead of the current output file defined in GNAT.IO.
+
+ procedure Stdout_Put_Line (S : String);
+ -- Wrapper for Put_Line that ensure we always write to stdout
+ -- instead of the current output file defined in GNAT.IO.
+
package Validity is
+ function Is_Handled (Storage : System.Address) return Boolean;
+ pragma Inline (Is_Handled);
+ -- Return True if Storage is the address of a block that the debug pool
+ -- had already under its control.
+ -- Used to allow System.Memory to use Debug_Pools
+
function Is_Valid (Storage : System.Address) return Boolean;
pragma Inline (Is_Valid);
-- Return True if Storage is the address of a block that the debug pool
end if;
declare
+ Disable_Exit_Value : constant Boolean := Disable;
Trace : aliased Tracebacks_Array
(1 .. Integer (Pool.Stack_Trace_Depth) + Max_Ignored_Levels);
Len, Start : Natural;
Elem : Traceback_Htable_Elem_Ptr;
begin
+ Disable := True;
Call_Chain (Trace, Len);
Skip_Levels (Pool.Stack_Trace_Depth, Trace, Start, Len,
Ignored_Frame_Start, Ignored_Frame_End);
if Elem = null then
Elem := new Traceback_Htable_Elem'
(Traceback => new Tracebacks_Array'(Trace (Start .. Len)),
- Count => 1,
- Kind => Kind,
- Total => Byte_Count (Size),
- Next => null);
+ Count => 1,
+ Kind => Kind,
+ Total => Byte_Count (Size),
+ Frees => 0,
+ Total_Frees => 0,
+ Next => null);
Backtrace_Htable.Set (Elem);
else
Elem.Total := Elem.Total + Byte_Count (Size);
end if;
+ Disable := Disable_Exit_Value;
return Elem;
+ exception
+ when others =>
+ Disable := Disable_Exit_Value;
+ raise;
end;
end Find_Or_Create_Traceback;
type Byte is mod 2 ** System.Storage_Unit;
- type Validity_Bits is array (Validity_Byte_Index) of Byte;
+ type Validity_Bits_Part is array (Validity_Byte_Index) of Byte;
+ type Validity_Bits_Part_Ref is access all Validity_Bits_Part;
+ No_Validity_Bits_Part : constant Validity_Bits_Part_Ref := null;
+
+ type Validity_Bits is record
+ Valid : Validity_Bits_Part_Ref := No_Validity_Bits_Part;
+ -- True if chunk of memory at this address currently allocated.
+
+ Handled : Validity_Bits_Part_Ref := No_Validity_Bits_Part;
+ -- True if chunk of memory at this address was allocated once after
+ -- Allow_Unhandled_Memory was set to True.
+ -- Used to know on Deallocate if chunk of memory should be handled
+ -- as a block allocated by this package.
+
+ end record;
type Validity_Bits_Ref is access all Validity_Bits;
No_Validity_Bits : constant Validity_Bits_Ref := null;
function Hash (F : Integer_Address) return Header_Num;
+ function Is_Valid_Or_Handled
+ (Storage : System.Address;
+ Valid : Boolean) return Boolean;
+ pragma Inline (Is_Valid_Or_Handled);
+ -- internal implementation of Is_Valid and Is_Handled.
+ -- Valid is used to select Valid or Handled arrays.
+
package Validy_Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Validity_Bits_Ref,
Key => Integer_Address,
Hash => Hash,
Equal => "=");
- -- Table to keep the validity bit blocks for the allocated data
+ -- Table to keep the validity and handled bit blocks for the allocated
+ -- data
function To_Pointer is new Ada.Unchecked_Conversion
- (System.Address, Validity_Bits_Ref);
+ (System.Address, Validity_Bits_Part_Ref);
procedure Memset (A : Address; C : Integer; N : size_t);
pragma Import (C, Memset, "memset");
return Header_Num (F mod Max_Header_Num);
end Hash;
- --------------
- -- Is_Valid --
- --------------
+ -------------------------
+ -- Is_Valid_Or_Handled --
+ -------------------------
- function Is_Valid (Storage : System.Address) return Boolean is
+ function Is_Valid_Or_Handled
+ (Storage : System.Address;
+ Valid : Boolean) return Boolean is
Int_Storage : constant Integer_Address := To_Integer (Storage);
begin
if Ptr = No_Validity_Bits then
return False;
else
- return (Ptr (Offset / System.Storage_Unit) and Bit) /= 0;
+ if Valid then
+ return (Ptr.Valid (Offset / System.Storage_Unit)
+ and Bit) /= 0;
+ else
+ if Ptr.Handled = No_Validity_Bits_Part then
+ return False;
+ else
+ return (Ptr.Handled (Offset / System.Storage_Unit)
+ and Bit) /= 0;
+ end if;
+ end if;
end if;
end;
+ end Is_Valid_Or_Handled;
+
+ --------------
+ -- Is_Valid --
+ --------------
+
+ function Is_Valid (Storage : System.Address) return Boolean is
+ begin
+ return Is_Valid_Or_Handled (Storage => Storage, Valid => True);
end Is_Valid;
+ -----------------
+ -- Is_Handled --
+ -----------------
+
+ function Is_Handled (Storage : System.Address) return Boolean is
+ begin
+ return Is_Valid_Or_Handled (Storage => Storage, Valid => False);
+ end Is_Handled;
+
---------------
-- Set_Valid --
---------------
Bit : constant Byte :=
2 ** Natural (Offset mod System.Storage_Unit);
+ procedure Set_Handled;
+ pragma Inline (Set_Handled);
+ -- if Allow_Unhandled_Memory set Handled bit in table.
+
+ -----------------
+ -- Set_Handled --
+ -----------------
+
+ procedure Set_Handled is
+ begin
+ if Allow_Unhandled_Memory then
+ if Ptr.Handled = No_Validity_Bits_Part then
+ Ptr.Handled :=
+ To_Pointer (Alloc (size_t (Max_Validity_Byte_Index)));
+ Memset (Ptr.Handled.all'Address, 0,
+ size_t (Max_Validity_Byte_Index));
+ end if;
+ Ptr.Handled (Offset / System.Storage_Unit) :=
+ Ptr.Handled (Offset / System.Storage_Unit) or Bit;
+ end if;
+ end Set_Handled;
+
begin
if Ptr = No_Validity_Bits then
-- it in the table.
if Value then
- Ptr := To_Pointer (Alloc (size_t (Max_Validity_Byte_Index)));
+ Ptr := new Validity_Bits;
+ Ptr.Valid :=
+ To_Pointer (Alloc (size_t (Max_Validity_Byte_Index)));
Validy_Htable.Set (Block_Number, Ptr);
- Memset (Ptr.all'Address, 0, size_t (Max_Validity_Byte_Index));
- Ptr (Offset / System.Storage_Unit) := Bit;
+ Memset (Ptr.Valid.all'Address, 0,
+ size_t (Max_Validity_Byte_Index));
+ Ptr.Valid (Offset / System.Storage_Unit) := Bit;
+ Set_Handled;
end if;
else
if Value then
- Ptr (Offset / System.Storage_Unit) :=
- Ptr (Offset / System.Storage_Unit) or Bit;
-
+ Ptr.Valid (Offset / System.Storage_Unit) :=
+ Ptr.Valid (Offset / System.Storage_Unit) or Bit;
+ Set_Handled;
else
- Ptr (Offset / System.Storage_Unit) :=
- Ptr (Offset / System.Storage_Unit) and (not Bit);
+ Ptr.Valid (Offset / System.Storage_Unit) :=
+ Ptr.Valid (Offset / System.Storage_Unit) and (not Bit);
end if;
end if;
end Set_Valid;
P : Ptr;
Trace : Traceback_Htable_Elem_Ptr;
+ Disable_Exit_Value : constant Boolean := Disable;
+
begin
<<Allocate_Label>>
Lock_Task.all;
+ if Disable then
+ Storage_Address :=
+ System.CRTL.malloc (System.CRTL.size_t (Size_In_Storage_Elements));
+ Unlock_Task.all;
+ return;
+ end if;
+
+ Disable := True;
+
+ Pool.Alloc_Count := Pool.Alloc_Count + 1;
+
-- If necessary, start physically releasing memory. The reason this is
-- done here, although Pool.Logically_Deallocated has not changed above,
-- is so that we do this only after a series of deallocations (e.g loop
Pool.Allocated :=
Pool.Allocated + Byte_Count (Size_In_Storage_Elements);
- Current := Pool.Allocated -
- Pool.Logically_Deallocated -
- Pool.Physically_Deallocated;
+ Current := Pool.Current_Water_Mark;
if Current > Pool.High_Water then
Pool.High_Water := Current;
end if;
+ Disable := Disable_Exit_Value;
+
Unlock_Task.all;
exception
when others =>
+ Disable := Disable_Exit_Value;
Unlock_Task.all;
raise;
end Allocate;
& Address_Image (Header.Allocation_Address));
end if;
- System.Memory.Free (Header.Allocation_Address);
+ if System_Memory_Debug_Pool_Enabled then
+ System.CRTL.free (Header.Allocation_Address);
+ else
+ System.Memory.Free (Header.Allocation_Address);
+ end if;
+
Set_Valid (Tmp, False);
-- Remove this block from the list
raise;
end Free_Physically;
+ --------------
+ -- Get_Size --
+ --------------
+
+ procedure Get_Size
+ (Storage_Address : Address;
+ Size_In_Storage_Elements : out Storage_Count;
+ Valid : out Boolean) is
+ begin
+ Lock_Task.all;
+
+ Valid := Is_Valid (Storage_Address);
+
+ if Is_Valid (Storage_Address) then
+ declare
+ Header : constant Allocation_Header_Access :=
+ Header_Of (Storage_Address);
+ begin
+ if Header.Block_Size >= 0 then
+ Valid := True;
+ Size_In_Storage_Elements := Header.Block_Size;
+ else
+ Valid := False;
+ end if;
+ end;
+ else
+ Valid := False;
+ end if;
+
+ Unlock_Task.all;
+
+ exception
+ when others =>
+ Unlock_Task.all;
+ raise;
+
+ end Get_Size;
+
----------------
-- Deallocate --
----------------
if not Valid then
Unlock_Task.all;
- if Pool.Raise_Exceptions then
+
+ if Storage_Address = System.Null_Address then
+ if Pool.Raise_Exceptions and then
+ Size_In_Storage_Elements /= Storage_Count'Last
+ then
+ raise Freeing_Not_Allocated_Storage;
+ else
+ Put (Output_File (Pool),
+ "error: Freeing Null_Address, at ");
+ Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
+ Deallocate_Label'Address,
+ Code_Address_For_Deallocate_End);
+ return;
+ end if;
+ end if;
+
+ if Allow_Unhandled_Memory and then not Is_Handled (Storage_Address)
+ then
+ System.CRTL.free (Storage_Address);
+ return;
+ end if;
+
+ if Pool.Raise_Exceptions and then
+ Size_In_Storage_Elements /= Storage_Count'Last
+ then
raise Freeing_Not_Allocated_Storage;
else
Put (Output_File (Pool),
-- The code below is all based on the assumption that Header.all
-- is not corrupted, such that the error is non-fatal.
- if Header.Block_Size /= Size_In_Storage_Elements then
+ if Header.Block_Size /= Size_In_Storage_Elements and then
+ Size_In_Storage_Elements /= Storage_Count'Last
+ then
Put_Line (Output_File (Pool),
"error: Deallocate size "
& Storage_Count'Image (Size_In_Storage_Elements)
if Pool.Low_Level_Traces then
Put (Output_File (Pool),
"info: Deallocated"
- & Storage_Count'Image (Size_In_Storage_Elements)
+ & Storage_Count'Image (Header.Block_Size)
& " bytes at 0x" & Address_Image (Storage_Address)
& " (physically"
& Storage_Count'Image (Header.Block_Size + Extra_Allocation)
end if;
end if;
+ -- Update the Alloc_Traceback Frees/Total_Frees members (if present)
+
+ if Header.Alloc_Traceback /= null then
+ Header.Alloc_Traceback.Frees := Header.Alloc_Traceback.Frees + 1;
+ Header.Alloc_Traceback.Total_Frees :=
+ Header.Alloc_Traceback.Total_Frees +
+ Byte_Count (Header.Block_Size);
+ end if;
+
+ Pool.Free_Count := Pool.Free_Count + 1;
+
-- Update the header
Header.all :=
Dealloc_Traceback => To_Traceback
(Find_Or_Create_Traceback
(Pool, Dealloc,
- Size_In_Storage_Elements,
+ Header.Block_Size,
Deallocate_Label'Address,
Code_Address_For_Deallocate_End)),
Next => System.Null_Address,
Put_Line
("Current Water Mark: " &
- Byte_Count'Image
- (Pool.Allocated - Pool.Logically_Deallocated
- - Pool.Physically_Deallocated));
+ Byte_Count'Image (Pool.Current_Water_Mark));
Put_Line
("High Water Mark: " &
Elem :=
new Traceback_Htable_Elem'
(Traceback => new Tracebacks_Array'(Data.Traceback.all),
- Count => Data.Count,
- Kind => Data.Kind,
- Total => Data.Total,
- Next => null);
+ Count => Data.Count,
+ Kind => Data.Kind,
+ Total => Data.Total,
+ Frees => Data.Frees,
+ Total_Frees => Data.Total_Frees,
+ Next => null);
Backtrace_Htable_Cumulate.Set (Elem);
if Cumulate then
Elem := new Traceback_Htable_Elem'
(Traceback => new Tracebacks_Array'
(Data.Traceback (T .. Data.Traceback'Last)),
- Count => Data.Count,
- Kind => K,
- Total => Data.Total,
- Next => null);
+ Count => Data.Count,
+ Kind => K,
+ Total => Data.Total,
+ Frees => Data.Frees,
+ Total_Frees => Data.Total_Frees,
+ Next => null);
Backtrace_Htable_Cumulate.Set (Elem);
-- Properly take into account that the subprograms
end if;
end Print_Info;
+ ----------
+ -- Dump --
+ ----------
+
+ procedure Dump
+ (Pool : Debug_Pool;
+ Size : Positive;
+ Report : Report_Type := All_Reports) is
+
+ Total_Freed : constant Byte_Count :=
+ Pool.Logically_Deallocated + Pool.Physically_Deallocated;
+
+ procedure Do_Report (Sort : Report_Type);
+ -- Do a specific type of report
+
+ procedure Do_Report (Sort : Report_Type) is
+ Elem : Traceback_Htable_Elem_Ptr;
+ Bigger : Boolean;
+ Grand_Total : Float;
+
+ Max : array (1 .. Size) of Traceback_Htable_Elem_Ptr :=
+ (others => null);
+ -- Sorted array for the biggest memory users
+
+ begin
+ New_Line;
+ case Sort is
+ when Memory_Usage | All_Reports =>
+ Put_Line (Size'Img & " biggest memory users at this time:");
+ Put_Line ("Results include bytes and chunks still allocated");
+ Grand_Total := Float (Pool.Current_Water_Mark);
+ when Allocations_Count =>
+ Put_Line (Size'Img & " biggest number of live allocations:");
+ Put_Line ("Results include bytes and chunks still allocated");
+ Grand_Total := Float (Pool.Current_Water_Mark);
+ when Sort_Total_Allocs =>
+ Put_Line (Size'Img & " biggest number of allocations:");
+ Put_Line ("Results include total bytes and chunks allocated,");
+ Put_Line ("even if no longer allocated - Deallocations are"
+ & " ignored");
+ Grand_Total := Float (Pool.Allocated);
+ when Marked_Blocks =>
+ Put_Line ("Special blocks marked by Mark_Traceback");
+ Grand_Total := 0.0;
+ end case;
+
+ Elem := Backtrace_Htable.Get_First;
+ while Elem /= null loop
+ -- Handle only alloc elememts
+ if Elem.Kind = Alloc then
+ -- Ignore small blocks (depending on the sorting criteria) to
+ -- gain speed
+
+ if (Sort = Memory_Usage
+ and then Elem.Total - Elem.Total_Frees >= 1_000)
+ or else (Sort = Allocations_Count
+ and then Elem.Count - Elem.Frees >= 1)
+ or else (Sort = Sort_Total_Allocs and then Elem.Count > 1)
+ or else (Sort = Marked_Blocks
+ and then Elem.Total = 0)
+ then
+ if Sort = Marked_Blocks then
+ Grand_Total := Grand_Total + Float (Elem.Count);
+ end if;
+
+ for M in Max'Range loop
+ Bigger := Max (M) = null;
+ if not Bigger then
+ case Sort is
+ when Memory_Usage | All_Reports =>
+ Bigger :=
+ Max (M).Total - Max (M).Total_Frees <
+ Elem.Total - Elem.Total_Frees;
+ when Allocations_Count =>
+ Bigger :=
+ Max (M).Count - Max (M).Frees
+ < Elem.Count - Elem.Frees;
+ when Sort_Total_Allocs | Marked_Blocks =>
+ Bigger := Max (M).Count < Elem.Count;
+ end case;
+ end if;
+
+ if Bigger then
+ Max (M + 1 .. Max'Last) := Max (M .. Max'Last - 1);
+ Max (M) := Elem;
+ exit;
+ end if;
+ end loop;
+ end if;
+ end if;
+
+ Elem := Backtrace_Htable.Get_Next;
+ end loop;
+
+ if Grand_Total = 0.0 then
+ Grand_Total := 1.0;
+ end if;
+
+ for M in Max'Range loop
+ exit when Max (M) = null;
+ declare
+ type Percent is delta 0.1 range 0.0 .. 100.0;
+ Total : Byte_Count;
+ P : Percent;
+ begin
+ case Sort is
+ when Memory_Usage | Allocations_Count | All_Reports =>
+ Total := Max (M).Total - Max (M).Total_Frees;
+ when Sort_Total_Allocs =>
+ Total := Max (M).Total;
+ when Marked_Blocks =>
+ Total := Byte_Count (Max (M).Count);
+ end case;
+
+ P := Percent (100.0 * Float (Total) / Grand_Total);
+
+ if Sort = Marked_Blocks then
+ Put (P'Img & "%:"
+ & Max (M).Count'Img & " chunks /"
+ & Integer (Grand_Total)'Img & " at");
+ else
+ Put (P'Img & "%:" & Total'Img & " bytes in"
+ & Max (M).Count'Img & " chunks at");
+ end if;
+ end;
+
+ for J in Max (M).Traceback'Range loop
+ Put (" 0x" & Address_Image (PC_For (Max (M).Traceback (J))));
+ end loop;
+
+ New_Line;
+ end loop;
+ end Do_Report;
+
+ begin
+
+ Put_Line ("Ada Allocs:" & Pool.Allocated'Img
+ & " bytes in" & Pool.Alloc_Count'Img & " chunks");
+ Put_Line ("Ada Free:" & Total_Freed'Img & " bytes in" &
+ Pool.Free_Count'Img
+ & " chunks");
+ Put_Line ("Ada Current watermark: "
+ & Byte_Count'Image (Pool.Current_Water_Mark)
+ & " in" & Byte_Count'Image (Pool.Alloc_Count -
+ Pool.Free_Count) & " chunks");
+ Put_Line ("Ada High watermark: " & Pool.High_Water_Mark'Img);
+
+ case Report is
+ when All_Reports =>
+ for Sort in Report_Type loop
+ if Sort /= All_Reports then
+ Do_Report (Sort);
+ end if;
+ end loop;
+
+ when others =>
+ Do_Report (Report);
+ end case;
+
+ end Dump;
+
+ -----------------
+ -- Dump_Stdout --
+ -----------------
+
+ procedure Dump_Stdout
+ (Pool : Debug_Pool;
+ Size : Positive;
+ Report : Report_Type := All_Reports)
+ is
+
+ procedure Internal is new Dump
+ (Put_Line => Stdout_Put_Line,
+ Put => Stdout_Put);
+
+ -- Start of processing for Dump_Stdout
+
+ begin
+ Internal (Pool, Size, Report);
+ end Dump_Stdout;
+
+ -----------
+ -- Reset --
+ -----------
+
+ procedure Reset is
+ Elem : Traceback_Htable_Elem_Ptr;
+ begin
+ Elem := Backtrace_Htable.Get_First;
+ while Elem /= null loop
+ Elem.Count := 0;
+ Elem.Frees := 0;
+ Elem.Total := 0;
+ Elem.Total_Frees := 0;
+ Elem := Backtrace_Htable.Get_Next;
+ end loop;
+ end Reset;
+
------------------
-- Storage_Size --
------------------
return Storage_Count'Last;
end Storage_Size;
+ ---------------------
+ -- High_Water_Mark --
+ ---------------------
+
+ function High_Water_Mark
+ (Pool : Debug_Pool) return Byte_Count is
+ begin
+ return Pool.High_Water;
+ end High_Water_Mark;
+
+ ------------------------
+ -- Current_Water_Mark --
+ ------------------------
+
+ function Current_Water_Mark
+ (Pool : Debug_Pool) return Byte_Count is
+ begin
+ return Pool.Allocated - Pool.Logically_Deallocated -
+ Pool.Physically_Deallocated;
+ end Current_Water_Mark;
+
+ ------------------------------
+ -- System_Memory_Debug_Pool --
+ ------------------------------
+
+ procedure System_Memory_Debug_Pool
+ (Has_Unhandled_Memory : Boolean := True) is
+ begin
+ System_Memory_Debug_Pool_Enabled := True;
+ Allow_Unhandled_Memory := Has_Unhandled_Memory;
+ end System_Memory_Debug_Pool;
+
---------------
-- Configure --
---------------
Display_Slots : Boolean := False;
Display_Leaks : Boolean := False)
is
- procedure Stdout_Put (S : String);
- procedure Stdout_Put_Line (S : String);
- -- Wrappers for Put and Put_Line that ensure we always write to stdout
- -- instead of the current output file defined in GNAT.IO.
procedure Internal is new Print_Info
(Put_Line => Stdout_Put_Line,
Put => Stdout_Put);
- ----------------
- -- Stdout_Put --
- ----------------
-
- procedure Stdout_Put (S : String) is
- begin
- Put_Line (Standard_Output, S);
- end Stdout_Put;
-
- ---------------------
- -- Stdout_Put_Line --
- ---------------------
-
- procedure Stdout_Put_Line (S : String) is
- begin
- Put_Line (Standard_Output, S);
- end Stdout_Put_Line;
-
-- Start of processing for Print_Info_Stdout
begin
fclose (File);
end Dump_Gnatmem;
+ ----------------
+ -- Stdout_Put --
+ ----------------
+
+ procedure Stdout_Put (S : String) is
+ begin
+ Put (Standard_Output, S);
+ end Stdout_Put;
+
+ ---------------------
+ -- Stdout_Put_Line --
+ ---------------------
+
+ procedure Stdout_Put_Line (S : String) is
+ begin
+ Put_Line (Standard_Output, S);
+ end Stdout_Put_Line;
+
-- Package initialization
begin
projects / gcc.git / commitdiff