1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                                 A L F A                                  --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--             Copyright (C) 2011, 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_Alfa;
28
29package body Alfa is
30
31   -----------
32   -- dalfa --
33   -----------
34
35   procedure dalfa is
36   begin
37      --  Dump Alfa file table
38
39      Write_Line ("Alfa File Table");
40      Write_Line ("---------------");
41
42      for Index in 1 .. Alfa_File_Table.Last loop
43         declare
44            AFR : Alfa_File_Record renames Alfa_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 Alfa scope table
67
68      Write_Eol;
69      Write_Line ("Alfa Scope Table");
70      Write_Line ("----------------");
71
72      for Index in 1 .. Alfa_Scope_Table.Last loop
73         declare
74            ASR : Alfa_Scope_Record renames Alfa_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 Alfa cross-reference table
107
108      Write_Eol;
109      Write_Line ("Alfa Xref Table");
110      Write_Line ("---------------");
111
112      for Index in 1 .. Alfa_Xref_Table.Last loop
113         declare
114            AXR : Alfa_Xref_Record renames Alfa_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 dalfa;
144
145   ----------------
146   -- Initialize --
147   ----------------
148
149   procedure Initialize_Alfa_Tables is
150   begin
151      Alfa_File_Table.Init;
152      Alfa_Scope_Table.Init;
153      Alfa_Xref_Table.Init;
154   end Initialize_Alfa_Tables;
155
156   -----------
157   -- palfa --
158   -----------
159
160   procedure palfa 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_Alfa is new Put_Alfa;
196
197   --  Start of processing for palfa
198
199   begin
200      Debug_Put_Alfa;
201   end palfa;
202
203end Alfa;
204