OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

ali.adb (Scan_ALI): Implement reading and storing of N lines

Browse Source 
2010-06-14  Robert Dewar  <dewar@adacore.com>

	* ali.adb (Scan_ALI): Implement reading and storing of N lines
	(Known_ALI_Lines): Add entry for 'N' (notes)
	* ali.ads (Notes): New table to store Notes information
	* alloc.ads: Add entries for Notes table
	* lib-util.adb (Write_Info_Int): New procedure
	(Write_Info_Slit): New procedure
	(Write_Info_Uint): New procedure
	* lib-util.ads (Write_Info_Int): New procedure
	(Write_Info_Slit): New procedure
	(Write_Info_Uint): New procedure
	* lib-writ.adb (Write_Unit_Information): Output N (notes) lines
	* lib-writ.ads: Update documentation for N (Notes) lines
	* lib.adb (Store_Note): New procedure
	* lib.ads (Notes): New table
	(Store_Note): New procedure
	* sem_prag.adb: Call Store_Note for affected pragmas

From-SVN: r160736
This commit is contained in:
Robert Dewar 2010-06-14 13:01:07 +00:00 committed by Arnaud Charlet
parent 3a13e78582
commit 7eaa7cdf7d
11 changed files with 328 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
2010-06-14 Robert Dewar <dewar@adacore.com>
* ali.adb (Scan_ALI): Implement reading and storing of N lines
(Known_ALI_Lines): Add entry for 'N' (notes)
* ali.ads (Notes): New table to store Notes information
* alloc.ads: Add entries for Notes table
* lib-util.adb (Write_Info_Int): New procedure
(Write_Info_Slit): New procedure
(Write_Info_Uint): New procedure
* lib-util.ads (Write_Info_Int): New procedure
(Write_Info_Slit): New procedure
(Write_Info_Uint): New procedure
* lib-writ.adb (Write_Unit_Information): Output N (notes) lines
* lib-writ.ads: Update documentation for N (Notes) lines
* lib.adb (Store_Note): New procedure
* lib.ads (Notes): New table
(Store_Note): New procedure
* sem_prag.adb: Call Store_Note for affected pragmas
2010-06-14 Thomas Quinot <quinot@adacore.com>
* socket.c: Fix wrong condition in #ifdef

44
gcc/ada/ali.adb
View File

@ -49,6 +49,7 @@ package body ALI is
'U' => True, -- unit
'W' => True, -- with
'L' => True, -- linker option
'N' => True, -- notes
'E' => True, -- external
'D' => True, -- dependency
'X' => True, -- xref
@ -89,14 +90,16 @@ package body ALI is
Withs.Init;
Sdep.Init;
Linker_Options.Init;
Notes.Init;
Xref_Section.Init;
Xref_Entity.Init;
Xref.Init;
Version_Ref.Reset;
-- Add dummy zero'th item in Linker_Options for the sort function
-- Add dummy zero'th item in Linker_Options and Notes for sort calls
Linker_Options.Increment_Last;
Notes.Increment_Last;
-- Initialize global variables recording cumulative options in all
-- ALI files that are read for a given processing run in gnatbind.
@ -1862,6 +1865,45 @@ package body ALI is
Linker_Options.Table (Linker_Options.Last).Original_Pos :=
Linker_Options.Last;
end if;
-- If there are notes present, scan them
Notes_Loop : loop
Check_Unknown_Line;
exit Notes_Loop when C /= 'N';
if Ignore ('N') then
Skip_Line;
else
Checkc (' ');
Notes.Increment_Last;
Notes.Table (Notes.Last).Pragma_Type := Getc;
Notes.Table (Notes.Last).Pragma_Line := Get_Nat;
Checkc (':');
Notes.Table (Notes.Last).Pragma_Col := Get_Nat;
Notes.Table (Notes.Last).Unit := Units.Last;
if At_Eol then
Notes.Table (Notes.Last).Pragma_Args := No_Name;
else
Checkc (' ');
Name_Len := 0;
while not At_Eol loop
Add_Char_To_Name_Buffer (Getc);
end loop;
Notes.Table (Notes.Last).Pragma_Args := Name_Enter;
end if;
Skip_Eol;
end if;
C := Getc;
end loop Notes_Loop;
end loop U_Loop;
-- End loop through units for one ALI file

40
gcc/ada/ali.ads
View File

@ -605,8 +605,6 @@ package ALI is
-- table.
end record;
-- Declare the Linker_Options Table
-- The indexes of active entries in this table range from 1 to the
-- value of Linker_Options.Last. The zero'th element is for sort call.
@ -618,6 +616,44 @@ package ALI is
Table_Increment => 400,
Table_Name => "Linker_Options");
-----------------
-- Notes Table --
-----------------
-- The notes table records entries from N lines
type Notes_Record is record
Pragma_Type : Character;
-- 'A', 'C', 'I', 'S', 'T' for Annotate/Comment/Ident/Subtitle/Title
Pragma_Line : Nat;
-- Line number of pragma
Pragma_Col : Nat;
-- Column number of pragma
Unit : Unit_Id;
-- Unit_Id for the entry
Pragma_Args : Name_Id;
-- Pragma arguments. No_Name if no arguments, otherwise a single
-- name table entry consisting of all the characters on the notes
-- line from the first non-blank character following the source
-- location to the last character on the line.
end record;
-- The indexes of active entries in this table range from 1 to the
-- value of Linker_Options.Last. The zero'th element is for convenience
-- if the table needs to be sorted.
package Notes is new Table.Table (
Table_Component_Type => Notes_Record,
Table_Index_Type => Integer,
Table_Low_Bound => 0,
Table_Initial => 200,
Table_Increment => 400,
Table_Name => "Notes");
-------------------------------------------
-- External Version Reference Hash Table --
-------------------------------------------

3
gcc/ada/alloc.ads
View File

@ -100,6 +100,9 @@ package Alloc is
Nodes_Initial : constant := 50_000; -- Atree
Nodes_Increment : constant := 100;
Notes_Initial : constant := 100; -- Lib
Notes_Increment : constant := 200;
Obsolescent_Warnings_Initial : constant := 50; -- Sem_Prag
Obsolescent_Warnings_Increment : constant := 200;

72
gcc/ada/lib-util.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -25,6 +25,7 @@
with Hostparm;
with Osint.C; use Osint.C;
with Stringt; use Stringt;
package body Lib.Util is
@ -39,7 +40,7 @@ package body Lib.Util is
Info_Buffer_Col : Natural := 1;
-- Column number of next character to be written.
-- Can be different from Info_Buffer_Len + 1
-- Can be different from Info_Buffer_Len + 1.
-- because of tab characters written by Write_Info_Tab.
---------------------
@ -133,6 +134,23 @@ package body Lib.Util is
procedure Write_Info_Initiate (Key : Character) renames Write_Info_Char;
--------------------
-- Write_Info_Int --
--------------------
procedure Write_Info_Int (N : Int) is
begin
if N >= 0 then
Write_Info_Nat (N);
-- Negative numbers, use Write_Info_Uint to avoid problems with largest
-- negative number.
else
Write_Info_Uint (UI_From_Int (N));
end if;
end Write_Info_Int;
---------------------
-- Write_Info_Name --
---------------------
@ -169,6 +187,45 @@ package body Lib.Util is
Write_Info_Char (Character'Val (N mod 10 + Character'Pos ('0')));
end Write_Info_Nat;
---------------------
-- Write_Info_Slit --
---------------------
procedure Write_Info_Slit (S : String_Id) is
C : Character;
begin
Write_Info_Str ("""");
for J in 1 .. String_Length (S) loop
C := Get_Character (Get_String_Char (S, J));
if C in Character'Val (16#20#) .. Character'Val (16#7E#)
and then C /= '{'
then
Write_Info_Char (C);
if C = '"' then
Write_Info_Char (C);
end if;
else
declare
Hex : constant array (0 .. 15) of Character :=
"0123456789ABCDEF";
begin
Write_Info_Char ('{');
Write_Info_Char (Hex (Character'Pos (C) / 16));
Write_Info_Char (Hex (Character'Pos (C) mod 16));
Write_Info_Char ('}');
end;
end if;
end loop;
Write_Info_Char ('"');
end Write_Info_Slit;
--------------------
-- Write_Info_Str --
--------------------
@ -225,7 +282,16 @@ package body Lib.Util is
Info_Buffer_Len := 0;
Info_Buffer_Col := 1;
end Write_Info_Terminate;
---------------------
-- Write_Info_Uint --
---------------------
procedure Write_Info_Uint (N : Uint) is
begin
UI_Image (N, Decimal);
Write_Info_Str (UI_Image_Buffer (1 .. UI_Image_Length));
end Write_Info_Uint;
end Lib.Util;

13
gcc/ada/lib-util.ads
View File

@ -23,6 +23,8 @@
-- --
------------------------------------------------------------------------------
with Uintp; use Uintp;
package Lib.Util is
-- This package implements a buffered write of library information
@ -52,6 +54,10 @@ package Lib.Util is
procedure Write_Info_Nat (N : Nat);
-- Adds image of N to Info_Buffer with no leading or trailing blanks
procedure Write_Info_Int (N : Int);
-- Adds image of N to Info_Buffer with no leading or trailing blanks. A
-- minus sign is prepended for negative values.
procedure Write_Info_Name (Name : Name_Id);
procedure Write_Info_Name (Name : File_Name_Type);
procedure Write_Info_Name (Name : Unit_Name_Type);
@ -59,6 +65,9 @@ package Lib.Util is
-- name is written literally from the names table entry without modifying
-- the case, using simply Get_Name_String.
procedure Write_Info_Slit (S : String_Id);
-- Write string literal value in format required for L/N lines in ali file
procedure Write_Info_Str (Val : String);
-- Adds characters of Val to Info_Buffer surrounded by quotes
@ -70,4 +79,8 @@ package Lib.Util is
procedure Write_Info_Terminate;
-- Terminate current info line and output lines built in Info_Buffer
procedure Write_Info_Uint (N : Uint);
-- Adds decimal image of N to Info_Buffer with no leading or trailing
-- blanks. A minus sign is prepended for negative values.
end Lib.Util;

96
gcc/ada/lib-writ.adb
View File

@ -592,42 +592,90 @@ package body Lib.Writ is
for J in 1 .. Linker_Option_Lines.Last loop
declare
S : constant Linker_Option_Entry :=
Linker_Option_Lines.Table (J);
C : Character;
S : Linker_Option_Entry renames Linker_Option_Lines.Table (J);
begin
if S.Unit = Unit_Num then
Write_Info_Initiate ('L');
Write_Info_Str (" """);
Write_Info_Char (' ');
Write_Info_Slit (S.Option);
Write_Info_EOL;
end if;
end;
end loop;
for J in 1 .. String_Length (S.Option) loop
C := Get_Character (Get_String_Char (S.Option, J));
-- Output notes
if C in Character'Val (16#20#) .. Character'Val (16#7E#)
and then C /= '{'
then
Write_Info_Char (C);
for J in 1 .. Notes.Last loop
declare
N : constant Node_Id := Notes.Table (J).Pragma_Node;
L : constant Source_Ptr := Sloc (N);
U : constant Unit_Number_Type := Notes.Table (J).Unit;
C : Character;
if C = '"' then
Write_Info_Char (C);
begin
if U = Unit_Num then
Write_Info_Initiate ('N');
Write_Info_Char (' ');
case Chars (Pragma_Identifier (N)) is
when Name_Annotate =>
C := 'A';
when Name_Comment =>
C := 'C';
when Name_Ident =>
C := 'I';
when Name_Title =>
C := 'T';
when Name_Subtitle =>
C := 'S';
when others =>
raise Program_Error;
end case;
Write_Info_Char (C);
Write_Info_Int (Int (Get_Logical_Line_Number (L)));
Write_Info_Char (':');
Write_Info_Int (Int (Get_Column_Number (L)));
declare
A : Node_Id;
begin
A := First (Pragma_Argument_Associations (N));
while Present (A) loop
Write_Info_Char (' ');
if Chars (A) /= No_Name then
Write_Info_Name (Chars (A));
Write_Info_Char (':');
end if;
else
declare
Hex : constant array (0 .. 15) of Character :=
"0123456789ABCDEF";
Expr : constant Node_Id := Expression (A);
begin
Write_Info_Char ('{');
Write_Info_Char (Hex (Character'Pos (C) / 16));
Write_Info_Char (Hex (Character'Pos (C) mod 16));
Write_Info_Char ('}');
end;
end if;
end loop;
if Nkind (Expr) = N_Identifier then
Write_Info_Name (Chars (Expr));
elsif Nkind (Expr) = N_Integer_Literal
and then Is_Static_Expression (Expr)
then
Write_Info_Uint (Intval (Expr));
elsif Nkind (Expr) = N_String_Literal
and then Is_Static_Expression (Expr)
then
Write_Info_Slit (Strval (Expr));
else
Write_Info_Str ("<expr>");
end if;
end;
Next (A);
end loop;
end;
Write_Info_Char ('"');
Write_Info_EOL;
end if;
end;

68
gcc/ada/lib-writ.ads
View File

@ -571,6 +571,40 @@ package Lib.Writ is
-- source file, so that this order is preserved by the binder in
-- constructing the set of linker arguments.
-- --------------
-- -- N Notes --
-- --------------
-- The final section of unit-specific lines contains notes which record
-- annotations inserted in source code for processing by external tools
-- using pragmas. For each occurrence of any of these pragmas, a line is
-- generated with the following syntax:
-- N x<sloc> [<arg_id>:]<arg> ...
-- x is one of:
-- A pragma Annotate
-- C pragma Comment
-- I pragma Ident
-- T pragma Title
-- S pragma Subtitle
-- <sloc> is the source location of the pragma in line:col format
-- Successive entries record the pragma_argument_associations.
-- If a pragma argument identifier is present, the entry is prefixed
-- with the pragma argument identifier <arg_id> followed by a colon.
-- <arg> represents the pragma argument, and has the following
-- conventions:
-- - identifiers are output verbatim
-- - static string expressions are output as literals encoded as
-- for L lines
-- - static integer expressions are output as decimal literals
-- - any other expression is replaced by the placeholder "<expr>"
---------------------
-- Reference Lines --
---------------------
@ -654,40 +688,6 @@ package Lib.Writ is
-- The cross-reference data follows the dependency lines. See the spec of
-- Lib.Xref for details on the format of this data.
-- --------------
-- -- N Notes --
-- --------------
-- The note lines record annotations inserted in source code for processing
-- by external tools using pragmas. For each occurrence of any of these
-- pragmas, a line is generated with the following syntax:
-- N <dep>x<sloc> [<arg_id>:]<arg> ...
-- x is one of:
-- A pragma Annotate
-- C pragma Comment
-- I pragma Ident
-- T pragma Title
-- S pragma Subtitle
-- <dep> is the source file containing the pragma by its dependency index
-- (first D line has index 1)
-- <sloc> is the source location of the pragma
-- Successive entries record the pragma_argument_associations.
-- For a named association, the entry is prefixed with the pragma argument
-- identifier <arg_id> followed by a colon.
-- <arg> represents the pragma argument, and has the following conventions:
-- - identifiers are output verbatim
-- - static string expressions are output as literals encoded as for
-- L lines
-- - static integer expressions are output as decimal literals
-- - any other expression is replaced by the placeholder "<expr>"
---------------------------------
-- Source Coverage Obligations --
---------------------------------

14
gcc/ada/lib.adb
View File

@ -858,6 +858,7 @@ package body Lib is
procedure Initialize is
begin
Linker_Option_Lines.Init;
Notes.Init;
Load_Stack.Init;
Units.Init;
Compilation_Switches.Init;
@ -984,11 +985,18 @@ package body Lib is
procedure Store_Linker_Option_String (S : String_Id) is
begin
Linker_Option_Lines.Increment_Last;
Linker_Option_Lines.Table (Linker_Option_Lines.Last) :=
(Option => S, Unit => Current_Sem_Unit);
Linker_Option_Lines.Append ((Option => S, Unit => Current_Sem_Unit));
end Store_Linker_Option_String;
----------------
-- Store_Note --
----------------
procedure Store_Note (N : Node_Id) is
begin
Notes.Append ((Pragma_Node => N, Unit => Current_Sem_Unit));
end Store_Note;
-------------------------------
-- Synchronize_Serial_Number --
-------------------------------

19
gcc/ada/lib.ads
View File

@ -574,6 +574,10 @@ package Lib is
-- This procedure is called to register the string from a pragma
-- Linker_Option. The argument is the Id of the string to register.
procedure Store_Note (N : Node_Id);
-- This procedure is called to register a pragma N for which a notes
-- entry is required.
procedure Initialize;
-- Initialize internal tables
@ -733,6 +737,21 @@ private
Table_Increment => Alloc.Linker_Option_Lines_Increment,
Table_Name => "Linker_Option_Lines");
-- The following table stores references to pragmas that generate Notes
type Notes_Entry is record
Pragma_Node : Node_Id;
Unit : Unit_Number_Type;
end record;
package Notes is new Table.Table (
Table_Component_Type => Notes_Entry,
Table_Index_Type => Integer,
Table_Low_Bound => 1,
Table_Initial => Alloc.Notes_Initial,
Table_Increment => Alloc.Notes_Increment,
Table_Name => "Notes");
-- The following table records the compilation switches used to compile
-- the main unit. The table includes only switches. It excludes -o
-- switches as well as artifacts of the gcc/gnat1 interface such as

26
gcc/ada/sem_prag.adb
View File

@ -376,10 +376,6 @@ package body Sem_Prag is
-- Any_Integer is OK). If not, given error and raise Pragma_Exit. If
-- Typ is left Empty, then any static expression is allowed.
procedure Check_Arg_Is_String_Literal (Arg : Node_Id);
-- Check the specified argument Arg to make sure that it is a string
-- literal. If not give error and raise Pragma_Exit
procedure Check_Arg_Is_Task_Dispatching_Policy (Arg : Node_Id);
-- Check the specified argument Arg to make sure that it is a valid task
-- dispatching policy name. If not give error and raise Pragma_Exit.
@ -1014,19 +1010,6 @@ package body Sem_Prag is
end if;
end Check_Arg_Is_Static_Expression;
---------------------------------
-- Check_Arg_Is_String_Literal --
---------------------------------
procedure Check_Arg_Is_String_Literal (Arg : Node_Id) is
Argx : constant Node_Id := Get_Pragma_Arg (Arg);
begin
if Nkind (Argx) /= N_String_Literal then
Error_Pragma_Arg
("argument for pragma% must be string literal", Argx);
end if;
end Check_Arg_Is_String_Literal;
------------------------------------------
-- Check_Arg_Is_Task_Dispatching_Policy --
------------------------------------------
@ -5244,6 +5227,8 @@ package body Sem_Prag is
GNAT_Pragma;
Check_At_Least_N_Arguments (1);
Check_Arg_Is_Identifier (Arg1);
Check_No_Identifiers;
Store_Note (N);
declare
Arg : Node_Id;
@ -7573,6 +7558,7 @@ package body Sem_Prag is
Check_Arg_Count (1);
Check_No_Identifiers;
Check_Arg_Is_Static_Expression (Arg1, Standard_String);
Store_Note (N);
-- For pragma Ident, preserve DEC compatibility by requiring the
-- pragma to appear in a declarative part or package spec.
@ -11184,7 +11170,8 @@ package body Sem_Prag is
GNAT_Pragma;
Check_Arg_Count (1);
Check_Optional_Identifier (Arg1, Name_Subtitle);
Check_Arg_Is_String_Literal (Arg1);
Check_Arg_Is_Static_Expression (Arg1, Standard_String);
Store_Note (N);
--------------
-- Suppress --
@ -11562,10 +11549,11 @@ package body Sem_Prag is
begin
GNAT_Pragma;
Gather_Associations (Names, Args);
Store_Note (N);
for J in 1 .. 2 loop
if Present (Args (J)) then
Check_Arg_Is_String_Literal (Args (J));
Check_Arg_Is_Static_Expression (Args (J), Standard_String);
end if;
end loop;
end Title;