--| +=========================================================================+
--| |                                                                         |
--| | REFERENCE_SCAN.TRACE_SUPPORT (body)                                     |
--| |                                                                         |
--| | Greg Janee                                                              |
--| | General Research Corporation                                            |
--| |                                                                         |
--| +=========================================================================+

with Asis_Debug_Support;

separate (Reference_Scan)
package body Trace_Support is

    package Int_Io is new Text_Io.Integer_Io (Integer);

    Tracing_On : Boolean := False;

--| The numbers of remaining children at each level are stored in a
--| doubly-linked list headed by First_Level and "tailed" by Last_Level.
--| For convenience, there is always one dummy level at the head of
--| the list.

    type Level;
    type Level_Ptr is access Level;

    type Level is
	record
	    Previous : Level_Ptr;
	    Next : Level_Ptr;
	    Remaining_Children : Natural;
	end record;

    First_Level : Level_Ptr;
    Last_Level : Level_Ptr;

    procedure Free is new Unchecked_Deallocation (Level, Level_Ptr);

--| Local subprograms.

    procedure Adjust_Level;

    procedure Log_Element (File : in Text_Io.File_Type; 
			   The_Element : in Asis.Element; 
			   The_Context : in Context; 
			   Is_Reference : in Boolean);

    procedure Log_Unit (File : in Text_Io.File_Type; 
			The_Unit : in Asis.Compilation_Unit; 
			The_Context : in Context);

    procedure Put_Context_Image 
		 (File : in Text_Io.File_Type; The_Context : in Context);

    procedure Put_Indentation (File : in Text_Io.File_Type; 
			       Put_Blanks_At_End : in Boolean := False);

--| +-------------------------------------------------------------------------+
--| | ADD_CHILDREN (exported)                                                 |
--| +-------------------------------------------------------------------------+

    procedure Add_Children (Number_Children : in Natural) is
    begin

	Last_Level.Remaining_Children := 
	   Last_Level.Remaining_Children + Number_Children;

    end Add_Children;

--| +-------------------------------------------------------------------------+
--| | ADD_LEVEL (exported)                                                    |
--| +-------------------------------------------------------------------------+

    procedure Add_Level (Number_Children : in Natural) is

	New_Level : Level_Ptr;

    begin

	New_Level := new Level;
	New_Level.Previous := Last_Level;
	Last_Level.Next := New_Level;
	Last_Level := New_Level;

	New_Level.Remaining_Children := Number_Children;

    end Add_Level;

--| +-------------------------------------------------------------------------+
--| | ADJUST_LEVEL (local)                                                    |
--| +-------------------------------------------------------------------------+
--|
--| Finds the current level and decrements the number of children at that
--| level.

    procedure Adjust_Level is

	L : Level_Ptr;

    begin

	while Last_Level.Remaining_Children = 0 loop
	    L := Last_Level;
	    Last_Level := Last_Level.Previous;
	    Free (L);
	end loop;
	Last_Level.Next := null;

	if Last_Level /= First_Level then
	    Last_Level.Remaining_Children := Last_Level.Remaining_Children - 1;
	end if;

    end Adjust_Level;

--| +-------------------------------------------------------------------------+
--| | LOG/1 (exported)                                                        |
--| +-------------------------------------------------------------------------+

    procedure Log (The_Unit : in Asis.Compilation_Unit; 
		   The_Context : in Context) is
    begin

	if Text_Io.Is_Open (Reference_Scan.Trace_File) then
	    Log_Unit (Reference_Scan.Trace_File, The_Unit, The_Context);
	else
	    Log_Unit (Text_Io.Current_Output, The_Unit, The_Context);
	end if;

    end Log;

--| +-------------------------------------------------------------------------+
--| | LOG/2 (exported)                                                        |
--| +-------------------------------------------------------------------------+

    procedure Log (The_Element : in Asis.Element; 
		   The_Context : in Context; 
		   Is_Reference : in Boolean := False) is
    begin

	if Text_Io.Is_Open (Reference_Scan.Trace_File) then
	    Log_Element (Reference_Scan.Trace_File, The_Element, 
			 The_Context, Is_Reference);
	else
	    Log_Element (Text_Io.Current_Output, The_Element, 
			 The_Context, Is_Reference);
	end if;

    end Log;

--| +-------------------------------------------------------------------------+
--| | LOG_ELEMENT (local)                                                     |
--| +-------------------------------------------------------------------------+

    procedure Log_Element (File : in Text_Io.File_Type; 
			   The_Element : in Asis.Element; 
			   The_Context : in Context; 
			   Is_Reference : in Boolean) is
    begin

	Adjust_Level;

	Put_Indentation (File, Put_Blanks_At_End => True);
	Put_Context_Image (File, The_Context);
	Text_Io.New_Line (File);
	Put_Indentation (File);
	Text_Io.Put (File, Asis_Debug_Support.Element_Image (The_Element));
	if Is_Reference then
	    Text_Io.Put (File, " ***REFERENCE***");
	end if;
	Text_Io.New_Line (File);

    end Log_Element;

--| +-------------------------------------------------------------------------+
--| | LOG_UNIT (local)                                                        |
--| +-------------------------------------------------------------------------+

    procedure Log_Unit (File : in Text_Io.File_Type; 
			The_Unit : in Asis.Compilation_Unit; 
			The_Context : in Context) is
    begin

	Adjust_Level;

	Put_Indentation (File, Put_Blanks_At_End => True);
	Put_Context_Image (File, The_Context);
	Text_Io.New_Line (File);
	Put_Indentation (File);
	Text_Io.Put_Line (File, 
			  Asis_Debug_Support.Compilation_Unit_Image (The_Unit));

    end Log_Unit;

--| +-------------------------------------------------------------------------+
--| | ON (exported)                                                           |
--| +-------------------------------------------------------------------------+

    function On return Boolean is
    begin

	return Tracing_On;

    end On;

--| +-------------------------------------------------------------------------+
--| | PUT_CONTEXT_IMAGE (local)                                               |
--| +-------------------------------------------------------------------------+
--|
--| Writes out the current context.

    procedure Put_Context_Image (File : in Text_Io.File_Type; 
				 The_Context : in Context) is
    begin

	Text_Io.Put 
	   (File, 
	    Rvs.Reference_Kinds_Or_Unknown'Image (The_Context.Basic_Context) & 
	       " ");
	Int_Io.Put (File, The_Context.Weight, 0);
	Text_Io.Put (File, " (");
	if Rvs."/=" (The_Context.Data_Access_Context, null) then
	    for I in The_Context.Data_Access_Context'Range loop
		if I > The_Context.Data_Access_Context'First then
		    Text_Io.Put (File, " ");
		end if;
		Text_Io.Put (File, Rvs.Data_Access_Context_Kinds'Image 
				      (The_Context.Data_Access_Context (I)));
	    end loop;
	end if;
	Text_Io.Put (File, ") " & Rvs.Type_Mark_Context_Kinds_Or_Unknown'Image 
				     (The_Context.Type_Mark_Context));

    end Put_Context_Image;

--| +-------------------------------------------------------------------------+
--| | PUT_INDENTATION (local)                                                 |
--| +-------------------------------------------------------------------------+
--|
--| Writes out indentation appropriate for the current level.

    procedure Put_Indentation (File : in Text_Io.File_Type; 
			       Put_Blanks_At_End : in Boolean := False) is

	L : Level_Ptr;

    begin

	L := First_Level.Next;
	while L /= null and L /= Last_Level loop
	    if L.Remaining_Children = 0 then
		Text_Io.Put (File, "   ");
	    else
		Text_Io.Put (File, "|  ");
	    end if;
	    L := L.Next;
	end loop;

	if Last_Level /= First_Level then
	    if Put_Blanks_At_End then
		Text_Io.Put (File, "|  ");
	    else
		if Last_Level.Remaining_Children = 0 then
		    Text_Io.Put (File, "+--");
		else
		    Text_Io.Put (File, "|--");
		end if;
	    end if;
	end if;

    end Put_Indentation;

--| +-------------------------------------------------------------------------+
--| | START (exported)                                                        |
--| +-------------------------------------------------------------------------+

    procedure Start is
    begin

	Stop;
	First_Level := new Level;
	First_Level.Remaining_Children := 1;
	Last_Level := First_Level;

	Tracing_On := True;

    end Start;

--| +-------------------------------------------------------------------------+
--| | STOP (exported)                                                         |
--| +-------------------------------------------------------------------------+

    procedure Stop is

	L : Level_Ptr;

    begin

	while First_Level /= null loop
	    L := First_Level;
	    First_Level := First_Level.Next;
	    Free (L);
	end loop;
	Last_Level := null;

	Tracing_On := False;

    end Stop;

end Trace_Support;