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