|
111
|
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;
|
