gcc/ada/get_scos.adb

   1 ------------------------------------------------------------------------------
   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 or instance table 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             Skip_Spaces;
 240
 241             case Nextc is
 242
 243                --  Instance table entry
 244
 245                when 'i' =>
 246                   declare
 247                      Inum : SCO_Instance_Index;
 248                   begin
 249                      Skipc;
 250                      Skip_Spaces;
 251
 252                      Inum := SCO_Instance_Index (Get_Int);
 253                      SCO_Instance_Table.Increment_Last;
 254                      pragma Assert (SCO_Instance_Table.Last = Inum);
 255
 256                      Skip_Spaces;
 257                      declare
 258                         SIE : SCO_Instance_Table_Entry
 259                                 renames SCO_Instance_Table.Table (Inum);
 260                      begin
 261                         SIE.Inst_Dep_Num := Get_Int;
 262                         C := Getc;
 263                         pragma Assert (C = '|');
 264                         Get_Source_Location (SIE.Inst_Loc);
 265
 266                         if not At_EOL then
 267                            Skip_Spaces;
 268                            SIE.Enclosing_Instance :=
 269                              SCO_Instance_Index (Get_Int);
 270                            pragma Assert (SIE.Enclosing_Instance in
 271                                             SCO_Instance_Table.First
 272                                          .. SCO_Instance_Table.Last);
 273                         end if;
 274                      end;
 275                   end;
 276
 277                --  Unit header
 278
 279                when '0' .. '9' =>
 280                   --  Scan out dependency number and file name
 281
 282                   Dnum := Get_Int;
 283
 284                   Skip_Spaces;
 285
 286                   N := 0;
 287                   while Nextc > ' ' loop
 288                      N := N + 1;
 289                      Buf (N) := Getc;
 290                   end loop;
 291
 292                   --  Make new unit table entry (will fill in To later)
 293
 294                   SCO_Unit_Table.Append (
 295                     (File_Name => new String'(Buf (1 .. N)),
 296                      Dep_Num   => Dnum,
 297                      From      => SCO_Table.Last + 1,
 298                      To        => 0));
 299
 300                      when others =>
 301                         raise Program_Error;
 302
 303             end case;
 304
 305          --  Statement entry
 306
 307          when 'S' | 's' =>
 308             declare
 309                Typ : Character;
 310                Key : Character;
 311                Pid : Pragma_Id;
 312
 313             begin
 314                Key := 'S';
 315
 316                --  If continuation, reset Last indication in last entry stored
 317                --  for previous CS or cs line.
 318
 319                if C = 's' then
 320                   SCO_Table.Table (SCO_Table.Last).Last := False;
 321                end if;
 322
 323                --  Initialize to scan items on one line
 324
 325                Skip_Spaces;
 326
 327                --  Loop through items on one line
 328
 329                loop
 330                   Pid := Unknown_Pragma;
 331                   Typ := Nextc;
 332
 333                   case Typ is
 334                      when '>' =>
 335
 336                         --  Dominance marker may be present only at entry point
 337
 338                         pragma Assert (Key = 'S');
 339
 340                         Skipc;
 341                         Key := '>';
 342                         Typ := Getc;
 343
 344                      when '1' .. '9' =>
 345                         Typ := ' ';
 346
 347                      when others =>
 348                         Skipc;
 349                         if Typ = 'P' or else Typ = 'p' then
 350                            if Nextc not in '1' .. '9' then
 351                               N := 1;
 352                               loop
 353                                  Buf (N) := Getc;
 354                                  exit when Nextc = ':';
 355                                  N := N + 1;
 356                               end loop;
 357
 358                               Skipc;
 359
 360                               begin
 361                                  Pid :=
 362                                    Pragma_Id'Value ("pragma_" & Buf (1 .. N));
 363                               exception
 364                                  when Constraint_Error =>
 365
 366                                     --  Pid remains set to Unknown_Pragma
 367
 368                                     null;
 369                               end;
 370                            end if;
 371                         end if;
 372                   end case;
 373
 374                   if Key = '>' and then Typ /= 'E' then
 375                      Get_Source_Location (Loc1);
 376                      Loc2 := No_Source_Location;
 377                   else
 378                      Get_Source_Location_Range (Loc1, Loc2);
 379                   end if;
 380
 381                   SCO_Table.Append
 382                     ((C1          => Key,
 383                       C2          => Typ,
 384                       From        => Loc1,
 385                       To          => Loc2,
 386                       Last        => At_EOL,
 387                       Pragma_Sloc => No_Location,
 388                       Pragma_Name => Pid));
 389
 390                   if Key = '>' then
 391                      Key := 'S';
 392                   end if;
 393
 394                   exit when At_EOL;
 395                end loop;
 396             end;
 397
 398          --  Decision entry
 399
 400          when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
 401             Dtyp := C;
 402             Skip_Spaces;
 403
 404             --  Output header
 405
 406             declare
 407                Loc : Source_Location;
 408
 409             begin
 410                --  Acquire location information
 411
 412                if Dtyp = 'X' then
 413                   Loc := No_Source_Location;
 414                else
 415                   Get_Source_Location (Loc);
 416                end if;
 417
 418                SCO_Table.Append
 419                  ((C1     => Dtyp,
 420                    C2     => ' ',
 421                    From   => Loc,
 422                    To     => No_Source_Location,
 423                    Last   => False,
 424                    others => <>));
 425             end;
 426
 427             --  Loop through terms in complex expression
 428
 429             C := Nextc;
 430             while C /= CR and then C /= LF loop
 431                if C = 'c' or else C = 't' or else C = 'f' then
 432                   Cond := C;
 433                   Skipc;
 434                   Get_Source_Location_Range (Loc1, Loc2);
 435                   SCO_Table.Append
 436                     ((C2     => Cond,
 437                       From   => Loc1,
 438                       To     => Loc2,
 439                       Last   => False,
 440                       others => <>));
 441
 442                elsif C = '!' or else
 443                      C = '&' or else
 444                      C = '|'
 445                then
 446                   Skipc;
 447
 448                   declare
 449                      Loc : Source_Location;
 450                   begin
 451                      Get_Source_Location (Loc);
 452                      SCO_Table.Append
 453                        ((C1     => C,
 454                          From   => Loc,
 455                          Last   => False,
 456                          others => <>));
 457                   end;
 458
 459                elsif C = ' ' then
 460                   Skip_Spaces;
 461
 462                elsif C = 'T' or else C = 'F' then
 463
 464                   --  Chaining indicator: skip for now???
 465
 466                   declare
 467                      Loc1, Loc2 : Source_Location;
 468                      pragma Unreferenced (Loc1, Loc2);
 469                   begin
 470                      Skipc;
 471                      Get_Source_Location_Range (Loc1, Loc2);
 472                   end;
 473
 474                else
 475                   raise Data_Error;
 476                end if;
 477
 478                C := Nextc;
 479             end loop;
 480
 481             --  Reset Last indication to True for last entry
 482
 483             SCO_Table.Table (SCO_Table.Last).Last := True;
 484
 485          --  No other SCO lines are possible
 486
 487          when others =>
 488             raise Data_Error;
 489       end case;
 490
 491       Skip_EOL;
 492    end loop;
 493
 494    --  Here with all SCO's stored, complete last SCO Unit table entry
 495
 496    SCO_Unit_Table.Table (SCO_Unit_Table.Last).To := SCO_Table.Last;
 497 end Get_SCOs;