gcc/ada/put_alfa.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P U 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
  28 procedure Put_ALFA is
  29 begin
  30    --  Loop through entries in ALFA_File_Table
  31
  32    for J in 1 .. ALFA_File_Table.Last loop
  33       declare
  34          F     : ALFA_File_Record renames ALFA_File_Table.Table (J);
  35          Start : Scope_Index;
  36          Stop  : Scope_Index;
  37
  38       begin
  39          Start := F.From_Scope;
  40          Stop  := F.To_Scope;
  41
  42          if Start <= Stop then
  43             Write_Info_Initiate ('F');
  44             Write_Info_Char ('D');
  45             Write_Info_Char (' ');
  46             Write_Info_Nat (F.File_Num);
  47             Write_Info_Char (' ');
  48
  49             for N in F.File_Name'Range loop
  50                Write_Info_Char (F.File_Name (N));
  51             end loop;
  52
  53             Write_Info_Terminate;
  54          end if;
  55
  56          --  Loop through scope entries for this file
  57
  58          loop
  59             exit when Start = Stop + 1;
  60             pragma Assert (Start <= Stop);
  61
  62             declare
  63                S : ALFA_Scope_Record renames ALFA_Scope_Table.Table (Start);
  64
  65             begin
  66                Write_Info_Initiate ('F');
  67                Write_Info_Char ('S');
  68                Write_Info_Char (' ');
  69                Write_Info_Char ('.');
  70                Write_Info_Nat (S.Scope_Num);
  71                Write_Info_Char (' ');
  72                Write_Info_Nat (S.Line);
  73                Write_Info_Char (S.Stype);
  74                Write_Info_Nat (S.Col);
  75                Write_Info_Char (' ');
  76
  77                pragma Assert (S.Scope_Name.all /= "");
  78
  79                for N in S.Scope_Name'Range loop
  80                   Write_Info_Char (S.Scope_Name (N));
  81                end loop;
  82
  83                if S.Spec_File_Num /= 0 then
  84                   Write_Info_Char (' ');
  85                   Write_Info_Char ('-');
  86                   Write_Info_Char ('>');
  87                   Write_Info_Char (' ');
  88                   Write_Info_Nat (S.Spec_File_Num);
  89                   Write_Info_Char ('.');
  90                   Write_Info_Nat (S.Spec_Scope_Num);
  91                end if;
  92
  93                Write_Info_Terminate;
  94             end;
  95
  96             Start := Start + 1;
  97          end loop;
  98       end;
  99    end loop;
 100
 101    --  Loop through entries in ALFA_File_Table
 102
 103    for J in 1 .. ALFA_File_Table.Last loop
 104       declare
 105          F           : ALFA_File_Record renames ALFA_File_Table.Table (J);
 106          Start       : Scope_Index;
 107          Stop        : Scope_Index;
 108          File        : Nat;
 109          Scope       : Nat;
 110          Entity_Line : Nat;
 111          Entity_Col  : Nat;
 112
 113       begin
 114          Start := F.From_Scope;
 115          Stop  := F.To_Scope;
 116
 117          --  Loop through scope entries for this file
 118
 119          loop
 120             exit when Start = Stop + 1;
 121             pragma Assert (Start <= Stop);
 122
 123             Output_One_Scope : declare
 124                S : ALFA_Scope_Record renames ALFA_Scope_Table.Table (Start);
 125
 126                XStart : Xref_Index;
 127                XStop  : Xref_Index;
 128
 129             begin
 130                XStart := S.From_Xref;
 131                XStop  := S.To_Xref;
 132
 133                if XStart > XStop then
 134                   goto Continue;
 135                end if;
 136
 137                Write_Info_Initiate ('F');
 138                Write_Info_Char ('X');
 139                Write_Info_Char (' ');
 140                Write_Info_Nat (F.File_Num);
 141                Write_Info_Char (' ');
 142
 143                for N in F.File_Name'Range loop
 144                   Write_Info_Char (F.File_Name (N));
 145                end loop;
 146
 147                Write_Info_Char (' ');
 148                Write_Info_Char ('.');
 149                Write_Info_Nat (S.Scope_Num);
 150                Write_Info_Char (' ');
 151
 152                for N in S.Scope_Name'Range loop
 153                   Write_Info_Char (S.Scope_Name (N));
 154                end loop;
 155
 156                Entity_Line := 0;
 157                Entity_Col  := 0;
 158
 159                --  Loop through cross reference entries for this scope
 160
 161                loop
 162                   exit when XStart = XStop + 1;
 163                   pragma Assert (XStart <= XStop);
 164
 165                   Output_One_Xref : declare
 166                      R : ALFA_Xref_Record renames
 167                            ALFA_Xref_Table.Table (XStart);
 168
 169                   begin
 170                      if R.Entity_Line /= Entity_Line
 171                        or else R.Entity_Col /= Entity_Col
 172                      then
 173                         Write_Info_Terminate;
 174
 175                         Write_Info_Initiate ('F');
 176                         Write_Info_Char (' ');
 177                         Write_Info_Nat (R.Entity_Line);
 178                         Write_Info_Char (R.Etype);
 179                         Write_Info_Nat (R.Entity_Col);
 180                         Write_Info_Char (' ');
 181
 182                         for N in R.Entity_Name'Range loop
 183                            Write_Info_Char (R.Entity_Name (N));
 184                         end loop;
 185
 186                         Entity_Line := R.Entity_Line;
 187                         Entity_Col  := R.Entity_Col;
 188                         File        := F.File_Num;
 189                         Scope       := S.Scope_Num;
 190                      end if;
 191
 192                      if Write_Info_Col > 72 then
 193                         Write_Info_Terminate;
 194                         Write_Info_Initiate ('.');
 195                      end if;
 196
 197                      Write_Info_Char (' ');
 198
 199                      if R.File_Num /= File then
 200                         Write_Info_Nat (R.File_Num);
 201                         Write_Info_Char ('|');
 202                         File  := R.File_Num;
 203                         Scope := 0;
 204                      end if;
 205
 206                      if R.Scope_Num /= Scope then
 207                         Write_Info_Char ('.');
 208                         Write_Info_Nat (R.Scope_Num);
 209                         Write_Info_Char (':');
 210                         Scope := R.Scope_Num;
 211                      end if;
 212
 213                      Write_Info_Nat (R.Line);
 214                      Write_Info_Char (R.Rtype);
 215                      Write_Info_Nat (R.Col);
 216                   end Output_One_Xref;
 217
 218                   XStart := XStart + 1;
 219                end loop;
 220
 221                Write_Info_Terminate;
 222             end Output_One_Scope;
 223
 224          <<Continue>>
 225             Start := Start + 1;
 226          end loop;
 227       end;
 228    end loop;
 229 end Put_ALFA;