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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [put_scos.adb] - Blame information for rev 318

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

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;

powered by: WebSVN 2.1.0

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