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, 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;