aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.4.3/gcc/ada/debug_a.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.4.3/gcc/ada/debug_a.adb')
-rw-r--r--gcc-4.4.3/gcc/ada/debug_a.adb144
1 files changed, 0 insertions, 144 deletions
diff --git a/gcc-4.4.3/gcc/ada/debug_a.adb b/gcc-4.4.3/gcc/ada/debug_a.adb
deleted file mode 100644
index 35b7f0025..000000000
--- a/gcc-4.4.3/gcc/ada/debug_a.adb
+++ /dev/null
@@ -1,144 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- D E B U G _ A --
--- --
--- B o d y --
--- --
--- Copyright (C) 1992-2007, 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. 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. --
--- --
-------------------------------------------------------------------------------
-
-with Atree; use Atree;
-with Debug; use Debug;
-with Sinfo; use Sinfo;
-with Sinput; use Sinput;
-with Output; use Output;
-
-package body Debug_A is
-
- Debug_A_Depth : Natural := 0;
- -- Output for the debug A flag is preceded by a sequence of vertical bar
- -- characters corresponding to the recursion depth of the actions being
- -- recorded (analysis, expansion, resolution and evaluation of nodes)
- -- This variable records the depth.
-
- Max_Node_Ids : constant := 200;
- -- Maximum number of Node_Id values that get stacked
-
- Node_Ids : array (1 .. Max_Node_Ids) of Node_Id;
- -- A stack used to keep track of Node_Id values for setting the value of
- -- Current_Error_Node correctly. Note that if we have more than 200
- -- recursion levels, we just don't reset the right value on exit, which
- -- is not crucial, since this is only for debugging!
-
- -----------------------
- -- Local Subprograms --
- -----------------------
-
- procedure Debug_Output_Astring;
- -- Outputs Debug_A_Depth number of vertical bars, used to preface messages
-
- -------------------
- -- Debug_A_Entry --
- -------------------
-
- procedure Debug_A_Entry (S : String; N : Node_Id) is
- begin
- -- Output debugging information if -gnatda flag set
-
- if Debug_Flag_A then
- Debug_Output_Astring;
- Write_Str (S);
- Write_Str ("Node_Id = ");
- Write_Int (Int (N));
- Write_Str (" ");
- Write_Location (Sloc (N));
- Write_Str (" ");
- Write_Str (Node_Kind'Image (Nkind (N)));
- Write_Eol;
- end if;
-
- -- Now push the new element
-
- Debug_A_Depth := Debug_A_Depth + 1;
-
- if Debug_A_Depth <= Max_Node_Ids then
- Node_Ids (Debug_A_Depth) := N;
- end if;
-
- -- Set Current_Error_Node only if the new node has a decent Sloc
- -- value, since it is for the Sloc value that we set this anyway.
- -- If we don't have a decent Sloc value, we leave it unchanged.
-
- if Sloc (N) > No_Location then
- Current_Error_Node := N;
- end if;
- end Debug_A_Entry;
-
- ------------------
- -- Debug_A_Exit --
- ------------------
-
- procedure Debug_A_Exit (S : String; N : Node_Id; Comment : String) is
- begin
- Debug_A_Depth := Debug_A_Depth - 1;
-
- -- We look down the stack to find something with a decent Sloc. (If
- -- we find nothing, just leave it unchanged which is not so terrible)
-
- for J in reverse 1 .. Integer'Min (Max_Node_Ids, Debug_A_Depth) loop
- if Sloc (Node_Ids (J)) > No_Location then
- Current_Error_Node := Node_Ids (J);
- exit;
- end if;
- end loop;
-
- -- Output debugging information if -gnatda flag set
-
- if Debug_Flag_A then
- Debug_Output_Astring;
- Write_Str (S);
- Write_Str ("Node_Id = ");
- Write_Int (Int (N));
- Write_Str (Comment);
- Write_Eol;
- end if;
- end Debug_A_Exit;
-
- --------------------------
- -- Debug_Output_Astring --
- --------------------------
-
- procedure Debug_Output_Astring is
- Vbars : constant String := "|||||||||||||||||||||||||";
- -- Should be constant, removed because of GNAT 1.78 bug ???
-
- begin
- if Debug_A_Depth > Vbars'Length then
- for I in Vbars'Length .. Debug_A_Depth loop
- Write_Char ('|');
- end loop;
-
- Write_Str (Vbars);
-
- else
- Write_Str (Vbars (1 .. Debug_A_Depth));
- end if;
- end Debug_Output_Astring;
-
-end Debug_A;