File : spark_xrefs.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S P A R K _ X R E F S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2011-2016, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 with Output; use Output;
27 with Put_SPARK_Xrefs;
28
29 package body SPARK_Xrefs is
30
31 ------------
32 -- dspark --
33 ------------
34
35 procedure dspark is
36 begin
37 -- Dump SPARK cross-reference file table
38
39 Write_Line ("SPARK Xrefs File Table");
40 Write_Line ("----------------------");
41
42 for Index in 1 .. SPARK_File_Table.Last loop
43 declare
44 AFR : SPARK_File_Record renames SPARK_File_Table.Table (Index);
45
46 begin
47 Write_Str (" ");
48 Write_Int (Int (Index));
49 Write_Str (". File_Num = ");
50 Write_Int (Int (AFR.File_Num));
51 Write_Str (" File_Name = """);
52
53 if AFR.File_Name /= null then
54 Write_Str (AFR.File_Name.all);
55 end if;
56
57 Write_Char ('"');
58 Write_Str (" From = ");
59 Write_Int (Int (AFR.From_Scope));
60 Write_Str (" To = ");
61 Write_Int (Int (AFR.To_Scope));
62 Write_Eol;
63 end;
64 end loop;
65
66 -- Dump SPARK cross-reference scope table
67
68 Write_Eol;
69 Write_Line ("SPARK Xrefs Scope Table");
70 Write_Line ("-----------------------");
71
72 for Index in 1 .. SPARK_Scope_Table.Last loop
73 declare
74 ASR : SPARK_Scope_Record renames SPARK_Scope_Table.Table (Index);
75
76 begin
77 Write_Str (" ");
78 Write_Int (Int (Index));
79 Write_Str (". File_Num = ");
80 Write_Int (Int (ASR.File_Num));
81 Write_Str (" Scope_Num = ");
82 Write_Int (Int (ASR.Scope_Num));
83 Write_Str (" Scope_Name = """);
84
85 if ASR.Scope_Name /= null then
86 Write_Str (ASR.Scope_Name.all);
87 end if;
88
89 Write_Char ('"');
90 Write_Str (" Line = ");
91 Write_Int (Int (ASR.Line));
92 Write_Str (" Col = ");
93 Write_Int (Int (ASR.Col));
94 Write_Str (" Type = ");
95 Write_Char (ASR.Stype);
96 Write_Str (" From = ");
97 Write_Int (Int (ASR.From_Xref));
98 Write_Str (" To = ");
99 Write_Int (Int (ASR.To_Xref));
100 Write_Str (" Scope_Entity = ");
101 Write_Int (Int (ASR.Scope_Entity));
102 Write_Eol;
103 end;
104 end loop;
105
106 -- Dump SPARK cross-reference table
107
108 Write_Eol;
109 Write_Line ("SPARK Xref Table");
110 Write_Line ("----------------");
111
112 for Index in 1 .. SPARK_Xref_Table.Last loop
113 declare
114 AXR : SPARK_Xref_Record renames SPARK_Xref_Table.Table (Index);
115
116 begin
117 Write_Str (" ");
118 Write_Int (Int (Index));
119 Write_Str (". Entity_Name = """);
120
121 if AXR.Entity_Name /= null then
122 Write_Str (AXR.Entity_Name.all);
123 end if;
124
125 Write_Char ('"');
126 Write_Str (" Entity_Line = ");
127 Write_Int (Int (AXR.Entity_Line));
128 Write_Str (" Entity_Col = ");
129 Write_Int (Int (AXR.Entity_Col));
130 Write_Str (" File_Num = ");
131 Write_Int (Int (AXR.File_Num));
132 Write_Str (" Scope_Num = ");
133 Write_Int (Int (AXR.Scope_Num));
134 Write_Str (" Line = ");
135 Write_Int (Int (AXR.Line));
136 Write_Str (" Col = ");
137 Write_Int (Int (AXR.Col));
138 Write_Str (" Type = ");
139 Write_Char (AXR.Rtype);
140 Write_Eol;
141 end;
142 end loop;
143 end dspark;
144
145 ----------------
146 -- Initialize --
147 ----------------
148
149 procedure Initialize_SPARK_Tables is
150 begin
151 SPARK_File_Table.Init;
152 SPARK_Scope_Table.Init;
153 SPARK_Xref_Table.Init;
154 end Initialize_SPARK_Tables;
155
156 ------------
157 -- pspark --
158 ------------
159
160 procedure pspark is
161
162 procedure Write_Info_Char (C : Character) renames Write_Char;
163 -- Write one character
164
165 procedure Write_Info_Str (Val : String) renames Write_Str;
166 -- Write string
167
168 function Write_Info_Col return Positive;
169 -- Return next column for writing
170
171 procedure Write_Info_Initiate (Key : Character) renames Write_Char;
172 -- Start new one and write one character;
173
174 procedure Write_Info_Nat (N : Nat);
175 -- Write value of N
176
177 procedure Write_Info_Terminate renames Write_Eol;
178 -- Terminate current line
179
180 --------------------
181 -- Write_Info_Col --
182 --------------------
183
184 function Write_Info_Col return Positive is
185 begin
186 return Positive (Column);
187 end Write_Info_Col;
188
189 --------------------
190 -- Write_Info_Nat --
191 --------------------
192
193 procedure Write_Info_Nat (N : Nat) is
194 begin
195 Write_Int (N);
196 end Write_Info_Nat;
197
198 procedure Debug_Put_SPARK_Xrefs is new Put_SPARK_Xrefs;
199
200 -- Start of processing for pspark
201
202 begin
203 Debug_Put_SPARK_Xrefs;
204 end pspark;
205
206 end SPARK_Xrefs;