Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/spark_xrefs.adb @ 131:84e7813d76e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
4 -- -- 4 -- --
5 -- S P A R K _ X R E F S -- 5 -- S P A R K _ X R E F S --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 2011-2016, Free Software Foundation, Inc. -- 9 -- Copyright (C) 2011-2018, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 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- -- 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- -- 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- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
21 -- GNAT was originally developed by the GNAT team at New York University. -- 21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. -- 22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- -- 23 -- --
24 ------------------------------------------------------------------------------ 24 ------------------------------------------------------------------------------
25 25
26 with Output; use Output; 26 with Lib.Xref;
27 with Put_SPARK_Xrefs; 27 with Output; use Output;
28 with Sem_Util; use Sem_Util;
28 29
29 package body SPARK_Xrefs is 30 package body SPARK_Xrefs is
30 31
31 ------------ 32 ------------
32 -- dspark -- 33 -- dspark --
33 ------------ 34 ------------
34 35
35 procedure dspark is 36 procedure dspark is
37
38 procedure Dump (Index : Nat; AXR : SPARK_Xref_Record);
39
40 procedure Dump_SPARK_Xrefs is new
41 Lib.Xref.SPARK_Specific.Iterate_SPARK_Xrefs (Dump);
42
43 ----------
44 -- Dump --
45 ----------
46
47 procedure Dump (Index : Nat; AXR : SPARK_Xref_Record) is
48 begin
49 Write_Str (" ");
50 Write_Int (Index);
51 Write_Char ('.');
52
53 Write_Str (" Entity = " & Unique_Name (AXR.Entity));
54 Write_Str (" (");
55 Write_Int (Nat (AXR.Entity));
56 Write_Str (")");
57
58 Write_Str (" Scope = " & Unique_Name (AXR.Ref_Scope));
59 Write_Str (" (");
60 Write_Int (Nat (AXR.Ref_Scope));
61 Write_Str (")");
62
63 Write_Str (" Ref_Type = '" & AXR.Rtype & "'");
64
65 Write_Eol;
66 end Dump;
67
68 -- Start of processing for dspark
69
36 begin 70 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 71 -- Dump SPARK cross-reference table
107 72
108 Write_Eol; 73 Write_Eol;
109 Write_Line ("SPARK Xref Table"); 74 Write_Line ("SPARK Xref Table");
110 Write_Line ("----------------"); 75 Write_Line ("----------------");
111 76
112 for Index in 1 .. SPARK_Xref_Table.Last loop 77 Dump_SPARK_Xrefs;
113 declare
114 AXR : SPARK_Xref_Record renames SPARK_Xref_Table.Table (Index);
115 78
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; 79 end dspark;
144 80
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; 81 end SPARK_Xrefs;