URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc1/] [gcc/] [ada/] [put_scos.adb] - Blame information for rev 338

Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             P U T _ S C O S                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--             Copyright (C) 2009, 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 SCOs; use SCOs;
 
procedure Put_SCOs is
begin
   --  Loop through entries in SCO_Unit_Table
 
   for U in 1 .. SCO_Unit_Table.Last loop
      declare
         SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
 
         Start : Nat;
         Stop  : Nat;
 
      begin
         Start := SUT.From;
         Stop  := SUT.To;
 
         --  Write unit header (omitted if no SCOs are generated for this unit)
 
         if Start <= Stop then
            Write_Info_Initiate ('C');
            Write_Info_Char (' ');
            Write_Info_Nat (SUT.Dep_Num);
            Write_Info_Char (' ');
 
            for N in SUT.File_Name'Range loop
               Write_Info_Char (SUT.File_Name (N));
            end loop;
 
            Write_Info_Terminate;
         end if;
 
         --  Loop through SCO entries for this unit
 
         loop
            exit when Start = Stop + 1;
            pragma Assert (Start <= Stop);
 
            Output_SCO_Line : declare
               T : SCO_Table_Entry renames SCO_Table.Table (Start);
 
               procedure Output_Range (T : SCO_Table_Entry);
               --  Outputs T.From and T.To in line:col-line:col format
 
               ------------------
               -- Output_Range --
               ------------------
 
               procedure Output_Range (T : SCO_Table_Entry) is
               begin
                  Write_Info_Nat  (Nat (T.From.Line));
                  Write_Info_Char (':');
                  Write_Info_Nat  (Nat (T.From.Col));
                  Write_Info_Char ('-');
                  Write_Info_Nat  (Nat (T.To.Line));
                  Write_Info_Char (':');
                  Write_Info_Nat  (Nat (T.To.Col));
               end Output_Range;
 
            --  Start of processing for Output_SCO_Line
 
            begin
               Write_Info_Initiate ('C');
               Write_Info_Char (T.C1);
 
               case T.C1 is
 
                  --  Statements
 
                  when 'S' =>
                     loop
                        Write_Info_Char (' ');
 
                        if SCO_Table.Table (Start).C2 /= ' ' then
                           Write_Info_Char (SCO_Table.Table (Start).C2);
                        end if;
 
                        Output_Range (SCO_Table.Table (Start));
                        exit when SCO_Table.Table (Start).Last;
 
                        Start := Start + 1;
                        pragma Assert (SCO_Table.Table (Start).C1 = 's');
                     end loop;
 
                  --  Statement continuations should not occur since they
                  --  are supposed to have been handled in the loop above.
 
                  when 's' =>
                     raise Program_Error;
 
                  --  Decision
 
                  when 'I' | 'E' | 'P' | 'W' | 'X' =>
                     if T.C2 = ' ' then
                        Start := Start + 1;
                     end if;
 
                     --  Loop through table entries for this decision
 
                     loop
                        declare
                           T : SCO_Table_Entry renames SCO_Table.Table (Start);
 
                        begin
                           Write_Info_Char (' ');
 
                           if T.C1 = '!' or else
                              T.C1 = '^' or else
                              T.C1 = '&' or else
                              T.C1 = '|'
                           then
                              Write_Info_Char (T.C1);
 
                           else
                              Write_Info_Char (T.C2);
                              Output_Range (T);
                           end if;
 
                           exit when T.Last;
                           Start := Start + 1;
                        end;
                     end loop;
 
                  when others =>
                     raise Program_Error;
               end case;
 
               Write_Info_Terminate;
            end Output_SCO_Line;
 
            Start := Start + 1;
         end loop;
      end;
   end loop;
end Put_SCOs;

Line No.	Rev	Author	Line
1	281	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT COMPILER COMPONENTS --`
4			`-- --`
5			`-- P U T _ S C O S --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 2009, 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 SCOs; use SCOs;`
27
28			`procedure Put_SCOs is`
29			`begin`
30			`-- Loop through entries in SCO_Unit_Table`
31
32			`for U in 1 .. SCO_Unit_Table.Last loop`
33			`declare`
34			`SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);`
35
36			`Start : Nat;`
37			`Stop : Nat;`
38
39			`begin`
40			`Start := SUT.From;`
41			`Stop := SUT.To;`
42
43			`-- Write unit header (omitted if no SCOs are generated for this unit)`
44
45			`if Start <= Stop then`
46			`Write_Info_Initiate ('C');`
47			`Write_Info_Char (' ');`
48			`Write_Info_Nat (SUT.Dep_Num);`
49			`Write_Info_Char (' ');`
50
51			`for N in SUT.File_Name'Range loop`
52			`Write_Info_Char (SUT.File_Name (N));`
53			`end loop;`
54
55			`Write_Info_Terminate;`
56			`end if;`
57
58			`-- Loop through SCO entries for this unit`
59
60			`loop`
61			`exit when Start = Stop + 1;`
62			`pragma Assert (Start <= Stop);`
63
64			`Output_SCO_Line : declare`
65			`T : SCO_Table_Entry renames SCO_Table.Table (Start);`
66
67			`procedure Output_Range (T : SCO_Table_Entry);`
68			`-- Outputs T.From and T.To in line:col-line:col format`
69
70			`------------------`
71			`-- Output_Range --`
72			`------------------`
73
74			`procedure Output_Range (T : SCO_Table_Entry) is`
75			`begin`
76			`Write_Info_Nat (Nat (T.From.Line));`
77			`Write_Info_Char (':');`
78			`Write_Info_Nat (Nat (T.From.Col));`
79			`Write_Info_Char ('-');`
80			`Write_Info_Nat (Nat (T.To.Line));`
81			`Write_Info_Char (':');`
82			`Write_Info_Nat (Nat (T.To.Col));`
83			`end Output_Range;`
84
85			`-- Start of processing for Output_SCO_Line`
86
87			`begin`
88			`Write_Info_Initiate ('C');`
89			`Write_Info_Char (T.C1);`
90
91			`case T.C1 is`
92
93			`-- Statements`
94
95			`when 'S' =>`
96			`loop`
97			`Write_Info_Char (' ');`
98
99			`if SCO_Table.Table (Start).C2 /= ' ' then`
100			`Write_Info_Char (SCO_Table.Table (Start).C2);`
101			`end if;`
102
103			`Output_Range (SCO_Table.Table (Start));`
104			`exit when SCO_Table.Table (Start).Last;`
105
106			`Start := Start + 1;`
107			`pragma Assert (SCO_Table.Table (Start).C1 = 's');`
108			`end loop;`
109
110			`-- Statement continuations should not occur since they`
111			`-- are supposed to have been handled in the loop above.`
112
113			`when 's' =>`
114			`raise Program_Error;`
115
116			`-- Decision`
117
118			`when 'I' \| 'E' \| 'P' \| 'W' \| 'X' =>`
119			`if T.C2 = ' ' then`
120			`Start := Start + 1;`
121			`end if;`
122
123			`-- Loop through table entries for this decision`
124
125			`loop`
126			`declare`
127			`T : SCO_Table_Entry renames SCO_Table.Table (Start);`
128
129			`begin`
130			`Write_Info_Char (' ');`
131
132			`if T.C1 = '!' or else`
133			`T.C1 = '^' or else`
134			`T.C1 = '&' or else`
135			`T.C1 = '\|'`
136			`then`
137			`Write_Info_Char (T.C1);`
138
139			`else`
140			`Write_Info_Char (T.C2);`
141			`Output_Range (T);`
142			`end if;`
143
144			`exit when T.Last;`
145			`Start := Start + 1;`
146			`end;`
147			`end loop;`
148
149			`when others =>`
150			`raise Program_Error;`
151			`end case;`
152
153			`Write_Info_Terminate;`
154			`end Output_SCO_Line;`
155
156			`Start := Start + 1;`
157			`end loop;`
158			`end;`
159			`end loop;`
160			`end Put_SCOs;`

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc1/] [gcc/] [ada/] [put_scos.adb] - Blame information for rev 338