gcc/ada/get_alfa.adb

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