diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 19 | ||||
| -rw-r--r-- | gcc/ada/ali.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/ali.ads | 40 | ||||
| -rw-r--r-- | gcc/ada/alloc.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/lib-util.adb | 72 | ||||
| -rw-r--r-- | gcc/ada/lib-util.ads | 13 | ||||
| -rw-r--r-- | gcc/ada/lib-writ.adb | 94 | ||||
| -rw-r--r-- | gcc/ada/lib-writ.ads | 68 | ||||
| -rw-r--r-- | gcc/ada/lib.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/lib.ads | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 26 |
11 files changed, 327 insertions, 85 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index de2536a..8869f22 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index a004956..27144b9 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -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 diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 94f7647..9056ce5 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -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 -- ------------------------------------------- diff --git a/gcc/ada/alloc.ads b/gcc/ada/alloc.ads index fa6c9d1..c5cad72 100644 --- a/gcc/ada/alloc.ads +++ b/gcc/ada/alloc.ads @@ -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; diff --git a/gcc/ada/lib-util.adb b/gcc/ada/lib-util.adb index 77b0efc..e6af023 100644 --- a/gcc/ada/lib-util.adb +++ b/gcc/ada/lib-util.adb @@ -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; diff --git a/gcc/ada/lib-util.ads b/gcc/ada/lib-util.ads index a8326ac..b34bd27 100644 --- a/gcc/ada/lib-util.ads +++ b/gcc/ada/lib-util.ads @@ -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; diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 94d4b45..24cce92 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -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; + + -- Output notes + + 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; - for J in 1 .. String_Length (S.Option) loop - C := Get_Character (Get_String_Char (S.Option, J)); + 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))); - if C in Character'Val (16#20#) .. Character'Val (16#7E#) - and then C /= '{' - then - Write_Info_Char (C); + declare + A : Node_Id; - if C = '"' then - Write_Info_Char (C); + 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 ('}'); + 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; - end if; - end loop; - Write_Info_Char ('"'); + Next (A); + end loop; + end; + Write_Info_EOL; end if; end; diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index 593442c..b3207c1 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -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 -- --------------------------------- diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 63dd620..940527f 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -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 -- ------------------------------- diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index 9c36d91..4a956b5 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 4f2a8ec..065be11 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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; |