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