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-2013, 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 26with Output; use Output; 27with Put_SPARK_Xrefs; 28 29package 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 function Write_Info_Col return Positive; 166 -- Return next column for writing 167 168 procedure Write_Info_Initiate (Key : Character) renames Write_Char; 169 -- Start new one and write one character; 170 171 procedure Write_Info_Nat (N : Nat); 172 -- Write value of N 173 174 procedure Write_Info_Terminate renames Write_Eol; 175 -- Terminate current line 176 177 -------------------- 178 -- Write_Info_Col -- 179 -------------------- 180 181 function Write_Info_Col return Positive is 182 begin 183 return Positive (Column); 184 end Write_Info_Col; 185 186 -------------------- 187 -- Write_Info_Nat -- 188 -------------------- 189 190 procedure Write_Info_Nat (N : Nat) is 191 begin 192 Write_Int (N); 193 end Write_Info_Nat; 194 195 procedure Debug_Put_SPARK_Xrefs is new Put_SPARK_Xrefs; 196 197 -- Start of processing for pspark 198 199 begin 200 Debug_Put_SPARK_Xrefs; 201 end pspark; 202 203end SPARK_Xrefs; 204