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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                             G E T _ S C O S                              --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2009-2012, 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
pragma Ada_2005;
27
--  This unit is not part of the compiler proper, it is used in tools that
28
--  read SCO information from ALI files (Xcov and sco_test). Ada 2005
29
--  constructs may therefore be used freely (and are indeed).
30
 
31
with SCOs;   use SCOs;
32
with Snames; use Snames;
33
with Types;  use Types;
34
 
35
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
36
 
37
procedure Get_SCOs is
38
   Dnum : Nat;
39
   C    : Character;
40
   Loc1 : Source_Location;
41
   Loc2 : Source_Location;
42
   Cond : Character;
43
   Dtyp : Character;
44
 
45
   use ASCII;
46
   --  For CR/LF
47
 
48
   function At_EOL return Boolean;
49
   --  Skips any spaces, then checks if we are the end of a line. If so,
50
   --  returns True (but does not skip over the EOL sequence). If not,
51
   --  then returns False.
52
 
53
   procedure Check (C : Character);
54
   --  Checks that file is positioned at given character, and if so skips past
55
   --  it, If not, raises Data_Error.
56
 
57
   function Get_Int return Int;
58
   --  On entry the file is positioned to a digit. On return, the file is
59
   --  positioned past the last digit, and the returned result is the decimal
60
   --  value read. Data_Error is raised for overflow (value greater than
61
   --  Int'Last), or if the initial character is not a digit.
62
 
63
   procedure Get_Source_Location (Loc : out Source_Location);
64
   --  Reads a source location in the form line:col and places the source
65
   --  location in Loc. Raises Data_Error if the format does not match this
66
   --  requirement. Note that initial spaces are not skipped.
67
 
68
   procedure Get_Source_Location_Range (Loc1, Loc2 : out Source_Location);
69
   --  Skips initial spaces, then reads a source location range in the form
70
   --  line:col-line:col and places the two source locations in Loc1 and Loc2.
71
   --  Raises Data_Error if format does not match this requirement.
72
 
73
   procedure Skip_EOL;
74
   --  Called with the current character about to be read being LF or CR. Skips
75
   --  past CR/LF characters until either a non-CR/LF character is found, or
76
   --  the end of file is encountered.
77
 
78
   procedure Skip_Spaces;
79
   --  Skips zero or more spaces at the current position, leaving the file
80
   --  positioned at the first non-blank character (or Types.EOF).
81
 
82
   ------------
83
   -- At_EOL --
84
   ------------
85
 
86
   function At_EOL return Boolean is
87
   begin
88
      Skip_Spaces;
89
      return Nextc = CR or else Nextc = LF;
90
   end At_EOL;
91
 
92
   -----------
93
   -- Check --
94
   -----------
95
 
96
   procedure Check (C : Character) is
97
   begin
98
      if Nextc = C then
99
         Skipc;
100
      else
101
         raise Data_Error;
102
      end if;
103
   end Check;
104
 
105
   -------------
106
   -- Get_Int --
107
   -------------
108
 
109
   function Get_Int return Int is
110
      Val : Int;
111
      C   : Character;
112
 
113
   begin
114
      C := Nextc;
115
      Val := 0;
116
 
117
      if C not in '0' .. '9' then
118
         raise Data_Error;
119
      end if;
120
 
121
      --  Loop to read digits of integer value
122
 
123
      loop
124
         declare
125
            pragma Unsuppress (Overflow_Check);
126
         begin
127
            Val := Val * 10 + (Character'Pos (C) - Character'Pos ('0'));
128
         end;
129
 
130
         Skipc;
131
         C := Nextc;
132
 
133
         exit when C not in '0' .. '9';
134
      end loop;
135
 
136
      return Val;
137
 
138
   exception
139
      when Constraint_Error =>
140
         raise Data_Error;
141
   end Get_Int;
142
 
143
   -------------------------
144
   -- Get_Source_Location --
145
   -------------------------
146
 
147
   procedure Get_Source_Location (Loc : out Source_Location) is
148
      pragma Unsuppress (Range_Check);
149
   begin
150
      Loc.Line := Logical_Line_Number (Get_Int);
151
      Check (':');
152
      Loc.Col := Column_Number (Get_Int);
153
   exception
154
      when Constraint_Error =>
155
         raise Data_Error;
156
   end Get_Source_Location;
157
 
158
   -------------------------------
159
   -- Get_Source_Location_Range --
160
   -------------------------------
161
 
162
   procedure Get_Source_Location_Range (Loc1, Loc2 : out Source_Location) is
163
   begin
164
      Skip_Spaces;
165
      Get_Source_Location (Loc1);
166
      Check ('-');
167
      Get_Source_Location (Loc2);
168
   end Get_Source_Location_Range;
169
 
170
   --------------
171
   -- Skip_EOL --
172
   --------------
173
 
174
   procedure Skip_EOL is
175
      C : Character;
176
 
177
   begin
178
      loop
179
         Skipc;
180
         C := Nextc;
181
         exit when C /= LF and then C /= CR;
182
 
183
         if C = ' ' then
184
            Skip_Spaces;
185
            C := Nextc;
186
            exit when C /= LF and then C /= CR;
187
         end if;
188
      end loop;
189
   end Skip_EOL;
190
 
191
   -----------------
192
   -- Skip_Spaces --
193
   -----------------
194
 
195
   procedure Skip_Spaces is
196
   begin
197
      while Nextc = ' ' loop
198
         Skipc;
199
      end loop;
200
   end Skip_Spaces;
201
 
202
   Buf : String (1 .. 32_768);
203
   N   : Natural;
204
   --  Scratch buffer, and index into it
205
 
206
--  Start of processing for Get_Scos
207
 
208
begin
209
   SCOs.Initialize;
210
 
211
   --  Loop through lines of SCO information
212
 
213
   while Nextc = 'C' loop
214
      Skipc;
215
 
216
      C := Getc;
217
 
218
      --  Make sure first line is a header line
219
 
220
      if SCO_Unit_Table.Last = 0 and then C /= ' ' then
221
         raise Data_Error;
222
      end if;
223
 
224
      --  Otherwise dispatch on type of line
225
 
226
      case C is
227
 
228
         --  Header entry
229
 
230
         when ' ' =>
231
 
232
            --  Complete previous entry if any
233
 
234
            if SCO_Unit_Table.Last /= 0 then
235
               SCO_Unit_Table.Table (SCO_Unit_Table.Last).To :=
236
                 SCO_Table.Last;
237
            end if;
238
 
239
            --  Scan out dependency number and file name
240
 
241
            Skip_Spaces;
242
            Dnum := Get_Int;
243
 
244
            Skip_Spaces;
245
 
246
            N := 0;
247
            while Nextc > ' ' loop
248
               N := N + 1;
249
               Buf (N) := Getc;
250
            end loop;
251
 
252
            --  Make new unit table entry (will fill in To later)
253
 
254
            SCO_Unit_Table.Append (
255
              (File_Name => new String'(Buf (1 .. N)),
256
               Dep_Num   => Dnum,
257
               From      => SCO_Table.Last + 1,
258
               To        => 0));
259
 
260
         --  Statement entry
261
 
262
         when 'S' | 's' =>
263
            declare
264
               Typ : Character;
265
               Key : Character;
266
               Pid : Pragma_Id;
267
 
268
            begin
269
               Key := 'S';
270
 
271
               --  If continuation, reset Last indication in last entry stored
272
               --  for previous CS or cs line.
273
 
274
               if C = 's' then
275
                  SCO_Table.Table (SCO_Table.Last).Last := False;
276
               end if;
277
 
278
               --  Initialize to scan items on one line
279
 
280
               Skip_Spaces;
281
 
282
               --  Loop through items on one line
283
 
284
               loop
285
                  Pid := Unknown_Pragma;
286
                  Typ := Nextc;
287
 
288
                  case Typ is
289
                     when '>' =>
290
 
291
                        --  Dominance marker may be present only at entry point
292
 
293
                        pragma Assert (Key = 'S');
294
 
295
                        Skipc;
296
                        Key := '>';
297
                        Typ := Getc;
298
 
299
                     when '1' .. '9' =>
300
                        Typ := ' ';
301
 
302
                     when others =>
303
                        Skipc;
304
                        if Typ = 'P' or else Typ = 'p' then
305
                           if Nextc not in '1' .. '9' then
306
                              N := 1;
307
                              loop
308
                                 Buf (N) := Getc;
309
                                 exit when Nextc = ':';
310
                                 N := N + 1;
311
                              end loop;
312
 
313
                              Skipc;
314
 
315
                              begin
316
                                 Pid :=
317
                                   Pragma_Id'Value ("pragma_" & Buf (1 .. N));
318
                              exception
319
                                 when Constraint_Error =>
320
 
321
                                    --  Pid remains set to Unknown_Pragma
322
 
323
                                    null;
324
                              end;
325
                           end if;
326
                        end if;
327
                  end case;
328
 
329
                  if Key = '>' and then Typ /= 'E' then
330
                     Get_Source_Location (Loc1);
331
                     Loc2 := No_Source_Location;
332
                  else
333
                     Get_Source_Location_Range (Loc1, Loc2);
334
                  end if;
335
 
336
                  SCO_Table.Append
337
                    ((C1          => Key,
338
                      C2          => Typ,
339
                      From        => Loc1,
340
                      To          => Loc2,
341
                      Last        => At_EOL,
342
                      Pragma_Sloc => No_Location,
343
                      Pragma_Name => Pid));
344
 
345
                  if Key = '>' then
346
                     Key := 'S';
347
                  end if;
348
 
349
                  exit when At_EOL;
350
               end loop;
351
            end;
352
 
353
         --  Decision entry
354
 
355
         when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
356
            Dtyp := C;
357
            Skip_Spaces;
358
 
359
            --  Output header
360
 
361
            declare
362
               Loc : Source_Location;
363
 
364
            begin
365
               --  Acquire location information
366
 
367
               if Dtyp = 'X' then
368
                  Loc := No_Source_Location;
369
               else
370
                  Get_Source_Location (Loc);
371
               end if;
372
 
373
               SCO_Table.Append
374
                 ((C1     => Dtyp,
375
                   C2     => ' ',
376
                   From   => Loc,
377
                   To     => No_Source_Location,
378
                   Last   => False,
379
                   others => <>));
380
            end;
381
 
382
            --  Loop through terms in complex expression
383
 
384
            C := Nextc;
385
            while C /= CR and then C /= LF loop
386
               if C = 'c' or else C = 't' or else C = 'f' then
387
                  Cond := C;
388
                  Skipc;
389
                  Get_Source_Location_Range (Loc1, Loc2);
390
                  SCO_Table.Append
391
                    ((C2     => Cond,
392
                      From   => Loc1,
393
                      To     => Loc2,
394
                      Last   => False,
395
                      others => <>));
396
 
397
               elsif C = '!' or else
398
                     C = '&' or else
399
                     C = '|'
400
               then
401
                  Skipc;
402
 
403
                  declare
404
                     Loc : Source_Location;
405
                  begin
406
                     Get_Source_Location (Loc);
407
                     SCO_Table.Append
408
                       ((C1     => C,
409
                         From   => Loc,
410
                         Last   => False,
411
                         others => <>));
412
                  end;
413
 
414
               elsif C = ' ' then
415
                  Skip_Spaces;
416
 
417
               elsif C = 'T' or else C = 'F' then
418
 
419
                  --  Chaining indicator: skip for now???
420
 
421
                  declare
422
                     Loc1, Loc2 : Source_Location;
423
                     pragma Unreferenced (Loc1, Loc2);
424
                  begin
425
                     Skipc;
426
                     Get_Source_Location_Range (Loc1, Loc2);
427
                  end;
428
 
429
               else
430
                  raise Data_Error;
431
               end if;
432
 
433
               C := Nextc;
434
            end loop;
435
 
436
            --  Reset Last indication to True for last entry
437
 
438
            SCO_Table.Table (SCO_Table.Last).Last := True;
439
 
440
         --  No other SCO lines are possible
441
 
442
         when others =>
443
            raise Data_Error;
444
      end case;
445
 
446
      Skip_EOL;
447
   end loop;
448
 
449
   --  Here with all SCO's stored, complete last SCO Unit table entry
450
 
451
   SCO_Unit_Table.Table (SCO_Unit_Table.Last).To := SCO_Table.Last;
452
end Get_SCOs;

powered by: WebSVN 2.1.0

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