OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [put_alfa.adb] - Blame information for rev 729

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                             P U T _ 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
 
26
with Alfa; use Alfa;
27
 
28
procedure Put_Alfa is
29
begin
30
   --  Loop through entries in Alfa_File_Table
31
 
32
   for J in 1 .. Alfa_File_Table.Last loop
33
      declare
34
         F     : Alfa_File_Record renames Alfa_File_Table.Table (J);
35
         Start : Scope_Index;
36
         Stop  : Scope_Index;
37
 
38
      begin
39
         Start := F.From_Scope;
40
         Stop  := F.To_Scope;
41
 
42
         Write_Info_Initiate ('F');
43
         Write_Info_Char ('D');
44
         Write_Info_Char (' ');
45
         Write_Info_Nat (F.File_Num);
46
         Write_Info_Char (' ');
47
 
48
         for N in F.File_Name'Range loop
49
            Write_Info_Char (F.File_Name (N));
50
         end loop;
51
 
52
         Write_Info_Terminate;
53
 
54
         --  Loop through scope entries for this file
55
 
56
         loop
57
            exit when Start = Stop + 1;
58
            pragma Assert (Start <= Stop);
59
 
60
            declare
61
               S : Alfa_Scope_Record renames Alfa_Scope_Table.Table (Start);
62
 
63
            begin
64
               Write_Info_Initiate ('F');
65
               Write_Info_Char ('S');
66
               Write_Info_Char (' ');
67
               Write_Info_Char ('.');
68
               Write_Info_Nat (S.Scope_Num);
69
               Write_Info_Char (' ');
70
               Write_Info_Nat (S.Line);
71
               Write_Info_Char (S.Stype);
72
               Write_Info_Nat (S.Col);
73
               Write_Info_Char (' ');
74
 
75
               pragma Assert (S.Scope_Name.all /= "");
76
 
77
               for N in S.Scope_Name'Range loop
78
                  Write_Info_Char (S.Scope_Name (N));
79
               end loop;
80
 
81
               if S.Spec_File_Num /= 0 then
82
                  Write_Info_Char (' ');
83
                  Write_Info_Char ('-');
84
                  Write_Info_Char ('>');
85
                  Write_Info_Char (' ');
86
                  Write_Info_Nat (S.Spec_File_Num);
87
                  Write_Info_Char ('.');
88
                  Write_Info_Nat (S.Spec_Scope_Num);
89
               end if;
90
 
91
               Write_Info_Terminate;
92
            end;
93
 
94
            Start := Start + 1;
95
         end loop;
96
      end;
97
   end loop;
98
 
99
   --  Loop through entries in Alfa_File_Table
100
 
101
   for J in 1 .. Alfa_File_Table.Last loop
102
      declare
103
         F           : Alfa_File_Record renames Alfa_File_Table.Table (J);
104
         Start       : Scope_Index;
105
         Stop        : Scope_Index;
106
         File        : Nat;
107
         Scope       : Nat;
108
         Entity_Line : Nat;
109
         Entity_Col  : Nat;
110
 
111
      begin
112
         Start := F.From_Scope;
113
         Stop  := F.To_Scope;
114
 
115
         --  Loop through scope entries for this file
116
 
117
         loop
118
            exit when Start = Stop + 1;
119
            pragma Assert (Start <= Stop);
120
 
121
            Output_One_Scope : declare
122
               S : Alfa_Scope_Record renames Alfa_Scope_Table.Table (Start);
123
 
124
               XStart : Xref_Index;
125
               XStop  : Xref_Index;
126
 
127
            begin
128
               XStart := S.From_Xref;
129
               XStop  := S.To_Xref;
130
 
131
               if XStart > XStop then
132
                  goto Continue;
133
               end if;
134
 
135
               Write_Info_Initiate ('F');
136
               Write_Info_Char ('X');
137
               Write_Info_Char (' ');
138
               Write_Info_Nat (F.File_Num);
139
               Write_Info_Char (' ');
140
 
141
               for N in F.File_Name'Range loop
142
                  Write_Info_Char (F.File_Name (N));
143
               end loop;
144
 
145
               Write_Info_Char (' ');
146
               Write_Info_Char ('.');
147
               Write_Info_Nat (S.Scope_Num);
148
               Write_Info_Char (' ');
149
 
150
               for N in S.Scope_Name'Range loop
151
                  Write_Info_Char (S.Scope_Name (N));
152
               end loop;
153
 
154
               --  Default value of (0,0) is used for the special __HEAP
155
               --  variable so use another default value.
156
 
157
               Entity_Line := 0;
158
               Entity_Col  := 1;
159
 
160
               --  Loop through cross reference entries for this scope
161
 
162
               loop
163
                  exit when XStart = XStop + 1;
164
                  pragma Assert (XStart <= XStop);
165
 
166
                  Output_One_Xref : declare
167
                     R : Alfa_Xref_Record renames
168
                           Alfa_Xref_Table.Table (XStart);
169
 
170
                  begin
171
                     if R.Entity_Line /= Entity_Line
172
                       or else R.Entity_Col /= Entity_Col
173
                     then
174
                        Write_Info_Terminate;
175
 
176
                        Write_Info_Initiate ('F');
177
                        Write_Info_Char (' ');
178
                        Write_Info_Nat (R.Entity_Line);
179
                        Write_Info_Char (R.Etype);
180
                        Write_Info_Nat (R.Entity_Col);
181
                        Write_Info_Char (' ');
182
 
183
                        for N in R.Entity_Name'Range loop
184
                           Write_Info_Char (R.Entity_Name (N));
185
                        end loop;
186
 
187
                        Entity_Line := R.Entity_Line;
188
                        Entity_Col  := R.Entity_Col;
189
                        File        := F.File_Num;
190
                        Scope       := S.Scope_Num;
191
                     end if;
192
 
193
                     if Write_Info_Col > 72 then
194
                        Write_Info_Terminate;
195
                        Write_Info_Initiate ('.');
196
                     end if;
197
 
198
                     Write_Info_Char (' ');
199
 
200
                     if R.File_Num /= File then
201
                        Write_Info_Nat (R.File_Num);
202
                        Write_Info_Char ('|');
203
                        File  := R.File_Num;
204
                        Scope := 0;
205
                     end if;
206
 
207
                     if R.Scope_Num /= Scope then
208
                        Write_Info_Char ('.');
209
                        Write_Info_Nat (R.Scope_Num);
210
                        Write_Info_Char (':');
211
                        Scope := R.Scope_Num;
212
                     end if;
213
 
214
                     Write_Info_Nat (R.Line);
215
                     Write_Info_Char (R.Rtype);
216
                     Write_Info_Nat (R.Col);
217
                  end Output_One_Xref;
218
 
219
                  XStart := XStart + 1;
220
               end loop;
221
 
222
               Write_Info_Terminate;
223
            end Output_One_Scope;
224
 
225
         <<Continue>>
226
            Start := Start + 1;
227
         end loop;
228
      end;
229
   end loop;
230
end Put_Alfa;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.