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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [get_alfa.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 _ 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
with Types; use Types;
28
 
29
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
30
 
31
procedure Get_Alfa is
32
   C : Character;
33
 
34
   use ASCII;
35
   --  For CR/LF
36
 
37
   Cur_File : Nat;
38
   --  Dependency number for the current file
39
 
40
   Cur_Scope : Nat;
41
   --  Scope number for the current scope entity
42
 
43
   Cur_File_Idx : File_Index;
44
   --  Index in Alfa_File_Table of the current file
45
 
46
   Cur_Scope_Idx : Scope_Index;
47
   --  Index in Alfa_Scope_Table of the current scope
48
 
49
   Name_Str : String (1 .. 32768);
50
   Name_Len : Natural := 0;
51
   --  Local string used to store name of File/entity scanned as
52
   --  Name_Str (1 .. Name_Len).
53
 
54
   -----------------------
55
   -- Local Subprograms --
56
   -----------------------
57
 
58
   function At_EOL return Boolean;
59
   --  Skips any spaces, then checks if at the end of a line. If so, returns
60
   --  True (but does not skip the EOL sequence). If not, then returns False.
61
 
62
   procedure Check (C : Character);
63
   --  Checks that file is positioned at given character, and if so skips past
64
   --  it, If not, raises Data_Error.
65
 
66
   function Get_Nat return Nat;
67
   --  On entry the file is positioned to a digit. On return, the file is
68
   --  positioned past the last digit, and the returned result is the decimal
69
   --  value read. Data_Error is raised for overflow (value greater than
70
   --  Int'Last), or if the initial character is not a digit.
71
 
72
   procedure Get_Name;
73
   --  On entry the file is positioned to a name. On return, the file is
74
   --  positioned past the last character, and the name scanned is returned
75
   --  in Name_Str (1 .. Name_Len).
76
 
77
   procedure Skip_EOL;
78
   --  Called with the current character about to be read being LF or CR. Skips
79
   --  past CR/LF characters until either a non-CR/LF character is found, or
80
   --  the end of file is encountered.
81
 
82
   procedure Skip_Spaces;
83
   --  Skips zero or more spaces at the current position, leaving the file
84
   --  positioned at the first non-blank character (or Types.EOF).
85
 
86
   ------------
87
   -- At_EOL --
88
   ------------
89
 
90
   function At_EOL return Boolean is
91
   begin
92
      Skip_Spaces;
93
      return Nextc = CR or else Nextc = LF;
94
   end At_EOL;
95
 
96
   -----------
97
   -- Check --
98
   -----------
99
 
100
   procedure Check (C : Character) is
101
   begin
102
      if Nextc = C then
103
         Skipc;
104
      else
105
         raise Data_Error;
106
      end if;
107
   end Check;
108
 
109
   -------------
110
   -- Get_Nat --
111
   -------------
112
 
113
   function Get_Nat return Nat is
114
      Val : Nat;
115
      C   : Character;
116
 
117
   begin
118
      C := Nextc;
119
      Val := 0;
120
 
121
      if C not in '0' .. '9' then
122
         raise Data_Error;
123
      end if;
124
 
125
      --  Loop to read digits of integer value
126
 
127
      loop
128
         declare
129
            pragma Unsuppress (Overflow_Check);
130
         begin
131
            Val := Val * 10 + (Character'Pos (C) - Character'Pos ('0'));
132
         end;
133
 
134
         Skipc;
135
         C := Nextc;
136
 
137
         exit when C not in '0' .. '9';
138
      end loop;
139
 
140
      return Val;
141
 
142
   exception
143
      when Constraint_Error =>
144
         raise Data_Error;
145
   end Get_Nat;
146
 
147
   --------------
148
   -- Get_Name --
149
   --------------
150
 
151
   procedure Get_Name is
152
      N : Integer;
153
 
154
   begin
155
      N := 0;
156
      while Nextc > ' ' loop
157
         N := N + 1;
158
         Name_Str (N) := Getc;
159
      end loop;
160
 
161
      Name_Len := N;
162
   end Get_Name;
163
 
164
   --------------
165
   -- Skip_EOL --
166
   --------------
167
 
168
   procedure Skip_EOL is
169
      C : Character;
170
 
171
   begin
172
      loop
173
         Skipc;
174
         C := Nextc;
175
         exit when C /= LF and then C /= CR;
176
 
177
         if C = ' ' then
178
            Skip_Spaces;
179
            C := Nextc;
180
            exit when C /= LF and then C /= CR;
181
         end if;
182
      end loop;
183
   end Skip_EOL;
184
 
185
   -----------------
186
   -- Skip_Spaces --
187
   -----------------
188
 
189
   procedure Skip_Spaces is
190
   begin
191
      while Nextc = ' ' loop
192
         Skipc;
193
      end loop;
194
   end Skip_Spaces;
195
 
196
--  Start of processing for Get_Alfa
197
 
198
begin
199
   Initialize_Alfa_Tables;
200
 
201
   Cur_File      := 0;
202
   Cur_Scope     := 0;
203
   Cur_File_Idx  := 1;
204
   Cur_Scope_Idx := 0;
205
 
206
   --  Loop through lines of Alfa information
207
 
208
   while Nextc = 'F' loop
209
      Skipc;
210
 
211
      C := Getc;
212
 
213
      --  Make sure first line is a File line
214
 
215
      if Alfa_File_Table.Last = 0 and then C /= 'D' then
216
         raise Data_Error;
217
      end if;
218
 
219
      --  Otherwise dispatch on type of line
220
 
221
      case C is
222
 
223
         --  Header entry for scope section
224
 
225
         when 'D' =>
226
 
227
            --  Complete previous entry if any
228
 
229
            if Alfa_File_Table.Last /= 0 then
230
               Alfa_File_Table.Table (Alfa_File_Table.Last).To_Scope :=
231
                 Alfa_Scope_Table.Last;
232
            end if;
233
 
234
            --  Scan out dependency number and file name
235
 
236
            Skip_Spaces;
237
            Cur_File := Get_Nat;
238
            Skip_Spaces;
239
            Get_Name;
240
 
241
            --  Make new File table entry (will fill in To_Scope later)
242
 
243
            Alfa_File_Table.Append (
244
              (File_Name  => new String'(Name_Str (1 .. Name_Len)),
245
               File_Num   => Cur_File,
246
               From_Scope => Alfa_Scope_Table.Last + 1,
247
               To_Scope   => 0));
248
 
249
            --  Initialize counter for scopes
250
 
251
            Cur_Scope := 1;
252
 
253
         --  Scope entry
254
 
255
         when 'S' =>
256
            declare
257
               Spec_File  : Nat;
258
               Spec_Scope : Nat;
259
               Scope      : Nat;
260
               Line       : Nat;
261
               Col        : Nat;
262
               Typ        : Character;
263
 
264
            begin
265
               --  Scan out location
266
 
267
               Skip_Spaces;
268
               Check ('.');
269
               Scope := Get_Nat;
270
               Check (' ');
271
               Line  := Get_Nat;
272
               Typ   := Getc;
273
               Col   := Get_Nat;
274
 
275
               pragma Assert (Scope = Cur_Scope);
276
               pragma Assert         (Typ = 'K'
277
                              or else Typ = 'V'
278
                              or else Typ = 'U');
279
 
280
               --  Scan out scope entity name
281
 
282
               Skip_Spaces;
283
               Get_Name;
284
               Skip_Spaces;
285
 
286
               if Nextc = '-' then
287
                  Skipc;
288
                  Check ('>');
289
                  Skip_Spaces;
290
                  Spec_File := Get_Nat;
291
                  Check ('.');
292
                  Spec_Scope := Get_Nat;
293
 
294
               else
295
                  Spec_File  := 0;
296
                  Spec_Scope := 0;
297
               end if;
298
 
299
               --  Make new scope table entry (will fill in From_Xref and
300
               --  To_Xref later). Initial range (From_Xref .. To_Xref) is
301
               --  empty for scopes without entities.
302
 
303
               Alfa_Scope_Table.Append (
304
                 (Scope_Entity   => Empty,
305
                  Scope_Name     => new String'(Name_Str (1 .. Name_Len)),
306
                  File_Num       => Cur_File,
307
                  Scope_Num      => Cur_Scope,
308
                  Spec_File_Num  => Spec_File,
309
                  Spec_Scope_Num => Spec_Scope,
310
                  Line           => Line,
311
                  Stype          => Typ,
312
                  Col            => Col,
313
                  From_Xref      => 1,
314
                  To_Xref        => 0));
315
            end;
316
 
317
            --  Update counter for scopes
318
 
319
            Cur_Scope := Cur_Scope + 1;
320
 
321
         --  Header entry for cross-ref section
322
 
323
         when 'X' =>
324
 
325
            --  Scan out dependency number and file name (ignored)
326
 
327
            Skip_Spaces;
328
            Cur_File := Get_Nat;
329
            Skip_Spaces;
330
            Get_Name;
331
 
332
            --  Update component From_Xref of current file if first reference
333
            --  in this file.
334
 
335
            while Alfa_File_Table.Table (Cur_File_Idx).File_Num /= Cur_File
336
            loop
337
               Cur_File_Idx := Cur_File_Idx + 1;
338
            end loop;
339
 
340
            --  Scan out scope entity number and entity name (ignored)
341
 
342
            Skip_Spaces;
343
            Check ('.');
344
            Cur_Scope := Get_Nat;
345
            Skip_Spaces;
346
            Get_Name;
347
 
348
            --  Update component To_Xref of previous scope
349
 
350
            if Cur_Scope_Idx /= 0 then
351
               Alfa_Scope_Table.Table (Cur_Scope_Idx).To_Xref :=
352
                 Alfa_Xref_Table.Last;
353
            end if;
354
 
355
            --  Update component From_Xref of current scope
356
 
357
            Cur_Scope_Idx := Alfa_File_Table.Table (Cur_File_Idx).From_Scope;
358
 
359
            while Alfa_Scope_Table.Table (Cur_Scope_Idx).Scope_Num /= Cur_Scope
360
            loop
361
               Cur_Scope_Idx := Cur_Scope_Idx + 1;
362
            end loop;
363
 
364
            Alfa_Scope_Table.Table (Cur_Scope_Idx).From_Xref :=
365
              Alfa_Xref_Table.Last + 1;
366
 
367
         --  Cross reference entry
368
 
369
         when ' ' =>
370
            declare
371
               XR_Entity      : String_Ptr;
372
               XR_Entity_Line : Nat;
373
               XR_Entity_Col  : Nat;
374
               XR_Entity_Typ  : Character;
375
 
376
               XR_File : Nat;
377
               --  Keeps track of the current file (changed by nn|)
378
 
379
               XR_Scope : Nat;
380
               --  Keeps track of the current scope (changed by nn:)
381
 
382
            begin
383
               XR_File  := Cur_File;
384
               XR_Scope := Cur_Scope;
385
 
386
               XR_Entity_Line := Get_Nat;
387
               XR_Entity_Typ  := Getc;
388
               XR_Entity_Col  := Get_Nat;
389
 
390
               Skip_Spaces;
391
               Get_Name;
392
               XR_Entity := new String'(Name_Str (1 .. Name_Len));
393
 
394
               --  Initialize to scan items on one line
395
 
396
               Skip_Spaces;
397
 
398
               --  Loop through cross-references for this entity
399
 
400
               loop
401
 
402
                  declare
403
                     Line  : Nat;
404
                     Col   : Nat;
405
                     N     : Nat;
406
                     Rtype : Character;
407
 
408
                  begin
409
                     Skip_Spaces;
410
 
411
                     if At_EOL then
412
                        Skip_EOL;
413
                        exit when Nextc /= '.';
414
                        Skipc;
415
                        Skip_Spaces;
416
                     end if;
417
 
418
                     if Nextc = '.' then
419
                        Skipc;
420
                        XR_Scope := Get_Nat;
421
                        Check (':');
422
 
423
                     else
424
                        N := Get_Nat;
425
 
426
                        if Nextc = '|' then
427
                           XR_File := N;
428
                           Skipc;
429
 
430
                        else
431
                           Line  := N;
432
                           Rtype := Getc;
433
                           Col   := Get_Nat;
434
 
435
                           pragma Assert
436
                             (Rtype = 'r' or else
437
                              Rtype = 'm' or else
438
                              Rtype = 's');
439
 
440
                           Alfa_Xref_Table.Append (
441
                             (Entity_Name => XR_Entity,
442
                              Entity_Line => XR_Entity_Line,
443
                              Etype       => XR_Entity_Typ,
444
                              Entity_Col  => XR_Entity_Col,
445
                              File_Num    => XR_File,
446
                              Scope_Num   => XR_Scope,
447
                              Line        => Line,
448
                              Rtype       => Rtype,
449
                              Col         => Col));
450
                        end if;
451
                     end if;
452
                  end;
453
               end loop;
454
            end;
455
 
456
         --  No other Alfa lines are possible
457
 
458
         when others =>
459
            raise Data_Error;
460
      end case;
461
 
462
      --  For cross reference lines, the EOL character has been skipped already
463
 
464
      if C /= ' ' then
465
         Skip_EOL;
466
      end if;
467
   end loop;
468
 
469
   --  Here with all Xrefs stored, complete last entries in File/Scope tables
470
 
471
   if Alfa_File_Table.Last /= 0 then
472
      Alfa_File_Table.Table (Alfa_File_Table.Last).To_Scope :=
473
        Alfa_Scope_Table.Last;
474
   end if;
475
 
476
   if Cur_Scope_Idx /= 0 then
477
      Alfa_Scope_Table.Table (Cur_Scope_Idx).To_Xref := Alfa_Xref_Table.Last;
478
   end if;
479
end Get_Alfa;

powered by: WebSVN 2.1.0

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