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 708

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


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             P U T _ A L F A                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--             Copyright (C) 2011, Free Software Foundation, Inc.           --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Alfa; use Alfa;
 
procedure Put_Alfa is
begin
   --  Loop through entries in Alfa_File_Table
 
   for J in 1 .. Alfa_File_Table.Last loop
      declare
         F     : Alfa_File_Record renames Alfa_File_Table.Table (J);
         Start : Scope_Index;
         Stop  : Scope_Index;
 
      begin
         Start := F.From_Scope;
         Stop  := F.To_Scope;
 
         Write_Info_Initiate ('F');
         Write_Info_Char ('D');
         Write_Info_Char (' ');
         Write_Info_Nat (F.File_Num);
         Write_Info_Char (' ');
 
         for N in F.File_Name'Range loop
            Write_Info_Char (F.File_Name (N));
         end loop;
 
         Write_Info_Terminate;
 
         --  Loop through scope entries for this file
 
         loop
            exit when Start = Stop + 1;
            pragma Assert (Start <= Stop);
 
            declare
               S : Alfa_Scope_Record renames Alfa_Scope_Table.Table (Start);
 
            begin
               Write_Info_Initiate ('F');
               Write_Info_Char ('S');
               Write_Info_Char (' ');
               Write_Info_Char ('.');
               Write_Info_Nat (S.Scope_Num);
               Write_Info_Char (' ');
               Write_Info_Nat (S.Line);
               Write_Info_Char (S.Stype);
               Write_Info_Nat (S.Col);
               Write_Info_Char (' ');
 
               pragma Assert (S.Scope_Name.all /= "");
 
               for N in S.Scope_Name'Range loop
                  Write_Info_Char (S.Scope_Name (N));
               end loop;
 
               if S.Spec_File_Num /= 0 then
                  Write_Info_Char (' ');
                  Write_Info_Char ('-');
                  Write_Info_Char ('>');
                  Write_Info_Char (' ');
                  Write_Info_Nat (S.Spec_File_Num);
                  Write_Info_Char ('.');
                  Write_Info_Nat (S.Spec_Scope_Num);
               end if;
 
               Write_Info_Terminate;
            end;
 
            Start := Start + 1;
         end loop;
      end;
   end loop;
 
   --  Loop through entries in Alfa_File_Table
 
   for J in 1 .. Alfa_File_Table.Last loop
      declare
         F           : Alfa_File_Record renames Alfa_File_Table.Table (J);
         Start       : Scope_Index;
         Stop        : Scope_Index;
         File        : Nat;
         Scope       : Nat;
         Entity_Line : Nat;
         Entity_Col  : Nat;
 
      begin
         Start := F.From_Scope;
         Stop  := F.To_Scope;
 
         --  Loop through scope entries for this file
 
         loop
            exit when Start = Stop + 1;
            pragma Assert (Start <= Stop);
 
            Output_One_Scope : declare
               S : Alfa_Scope_Record renames Alfa_Scope_Table.Table (Start);
 
               XStart : Xref_Index;
               XStop  : Xref_Index;
 
            begin
               XStart := S.From_Xref;
               XStop  := S.To_Xref;
 
               if XStart > XStop then
                  goto Continue;
               end if;
 
               Write_Info_Initiate ('F');
               Write_Info_Char ('X');
               Write_Info_Char (' ');
               Write_Info_Nat (F.File_Num);
               Write_Info_Char (' ');
 
               for N in F.File_Name'Range loop
                  Write_Info_Char (F.File_Name (N));
               end loop;
 
               Write_Info_Char (' ');
               Write_Info_Char ('.');
               Write_Info_Nat (S.Scope_Num);
               Write_Info_Char (' ');
 
               for N in S.Scope_Name'Range loop
                  Write_Info_Char (S.Scope_Name (N));
               end loop;
 
               --  Default value of (0,0) is used for the special __HEAP
               --  variable so use another default value.
 
               Entity_Line := 0;
               Entity_Col  := 1;
 
               --  Loop through cross reference entries for this scope
 
               loop
                  exit when XStart = XStop + 1;
                  pragma Assert (XStart <= XStop);
 
                  Output_One_Xref : declare
                     R : Alfa_Xref_Record renames
                           Alfa_Xref_Table.Table (XStart);
 
                  begin
                     if R.Entity_Line /= Entity_Line
                       or else R.Entity_Col /= Entity_Col
                     then
                        Write_Info_Terminate;
 
                        Write_Info_Initiate ('F');
                        Write_Info_Char (' ');
                        Write_Info_Nat (R.Entity_Line);
                        Write_Info_Char (R.Etype);
                        Write_Info_Nat (R.Entity_Col);
                        Write_Info_Char (' ');
 
                        for N in R.Entity_Name'Range loop
                           Write_Info_Char (R.Entity_Name (N));
                        end loop;
 
                        Entity_Line := R.Entity_Line;
                        Entity_Col  := R.Entity_Col;
                        File        := F.File_Num;
                        Scope       := S.Scope_Num;
                     end if;
 
                     if Write_Info_Col > 72 then
                        Write_Info_Terminate;
                        Write_Info_Initiate ('.');
                     end if;
 
                     Write_Info_Char (' ');
 
                     if R.File_Num /= File then
                        Write_Info_Nat (R.File_Num);
                        Write_Info_Char ('|');
                        File  := R.File_Num;
                        Scope := 0;
                     end if;
 
                     if R.Scope_Num /= Scope then
                        Write_Info_Char ('.');
                        Write_Info_Nat (R.Scope_Num);
                        Write_Info_Char (':');
                        Scope := R.Scope_Num;
                     end if;
 
                     Write_Info_Nat (R.Line);
                     Write_Info_Char (R.Rtype);
                     Write_Info_Nat (R.Col);
                  end Output_One_Xref;
 
                  XStart := XStart + 1;
               end loop;
 
               Write_Info_Terminate;
            end Output_One_Scope;
 
         <<Continue>>
            Start := Start + 1;
         end loop;
      end;
   end loop;
end Put_Alfa;

Browse

Tools

Subversion Repositories openrisc

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

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