From 3c777b50a71002d3b0cb8c62a9bbdb846e286e96 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 20 Oct 2015 11:53:11 +0200 Subject: [PATCH] [multiple changes] 2015-10-20 Thomas Quinot * Makefile.rtl: add the following... * g-binenv.ads, g-binenv.adb: New unit providing runtime access to bind time captured values ("bind environment") * init.c: declare new global variable __gl_bind_env_addr. * bindgen.ads, bindgen.adb (Set_Bind_Env): record a bind environment key=value pair. (Gen_Bind_Env_String): helper to produce the bind environment data called in the binder generated file. (Gen_Output_File_Ada): Call the above (Gen_Adainit): Set __gl_bind_env_addr accordingly. * switch-b.adb: Support for command line switch -V (user interface to set a build environment key=value pair) * bindusg.adb: Document the above 2015-10-20 Vincent Celier * sem_prag.adb (Analyse_Pragma: Pragma Pure): Do not set the entity as Pure if Debug_Flag_U is set. From-SVN: r229031 --- gcc/ada/ChangeLog | 21 +++++++ gcc/ada/Makefile.rtl | 1 + gcc/ada/bindgen.adb | 147 +++++++++++++++++++++++++++++++++++++++++-- gcc/ada/bindgen.ads | 6 +- gcc/ada/bindusg.adb | 8 ++- gcc/ada/g-binenv.adb | 83 ++++++++++++++++++++++++ gcc/ada/g-binenv.ads | 40 ++++++++++++ gcc/ada/gnatbind.adb | 21 ++++--- gcc/ada/impunit.adb | 1 + gcc/ada/init.c | 5 +- gcc/ada/sem_prag.adb | 9 ++- gcc/ada/switch-b.adb | 23 ++++++- 12 files changed, 342 insertions(+), 23 deletions(-) create mode 100644 gcc/ada/g-binenv.adb create mode 100644 gcc/ada/g-binenv.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 612864835bc..f3e3d66344b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2015-10-20 Thomas Quinot + + * Makefile.rtl: add the following... + * g-binenv.ads, g-binenv.adb: New unit providing runtime access + to bind time captured values ("bind environment") + * init.c: declare new global variable __gl_bind_env_addr. + * bindgen.ads, bindgen.adb (Set_Bind_Env): record a bind + environment key=value pair. + (Gen_Bind_Env_String): helper to produce the bind environment data + called in the binder generated file. + (Gen_Output_File_Ada): Call the above (Gen_Adainit): Set + __gl_bind_env_addr accordingly. + * switch-b.adb: Support for command line switch -V (user interface + to set a build environment key=value pair) + * bindusg.adb: Document the above + +2015-10-20 Vincent Celier + + * sem_prag.adb (Analyse_Pragma: Pragma Pure): Do not set the + entity as Pure if Debug_Flag_U is set. + 2015-10-20 Bob Duff * output.adb (Write_Int): Work with negative numbers in order to avoid diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index ce59a64cfc2..5b71295dfa5 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -380,6 +380,7 @@ GNATRTL_NONTASKING_OBJS= \ directio$(objext) \ g-arrspl$(objext) \ g-awk$(objext) \ + g-binenv$(objext) \ g-bubsor$(objext) \ g-busora$(objext) \ g-busorg$(objext) \ diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 7c8aff2d120..eb853b506f2 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -35,6 +35,7 @@ with Osint; use Osint; with Osint.B; use Osint.B; with Output; use Output; with Rident; use Rident; +with Stringt; use Stringt; with Table; use Table; with Targparm; use Targparm; with Types; use Types; @@ -43,6 +44,7 @@ with System.OS_Lib; use System.OS_Lib; with System.WCh_Con; use System.WCh_Con; with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A; +with GNAT.HTable; package body Bindgen is @@ -89,6 +91,9 @@ package body Bindgen is Lib_Final_Built : Boolean := False; -- Flag indicating whether the finalize_library rountine has been built + Bind_Env_String_Built : Boolean := False; + -- Flag indicating whether a bind environment string has been built + CodePeer_Wrapper_Name : constant String := "call_main_subprogram"; -- For CodePeer, introduce a wrapper subprogram which calls the -- user-defined main subprogram. @@ -124,6 +129,22 @@ package body Bindgen is Table_Increment => 200, Table_Name => "PSD_Pragma_Settings"); + ---------------------------- + -- Bind_Environment Table -- + ---------------------------- + + subtype Header_Num is Int range 0 .. 36; + + function Hash (Nam : Name_Id) return Header_Num; + + package Bind_Environment is new GNAT.HTable.Simple_HTable + (Header_Num => Header_Num, + Element => Name_Id, + No_Element => No_Name, + Key => Name_Id, + Hash => Hash, + Equal => "="); + ---------------------- -- Run-Time Globals -- ---------------------- @@ -246,6 +267,9 @@ package body Bindgen is procedure Gen_Adafinal; -- Generate the Adafinal procedure + procedure Gen_Bind_Env_String; + -- Generate the bind environment buffer + procedure Gen_CodePeer_Wrapper; -- For CodePeer, generate wrapper which calls user-defined main subprogram @@ -369,6 +393,10 @@ package body Bindgen is -- First writes its argument (using Set_String (S)), then writes out the -- contents of statement buffer up to Last, and reset Last to 0 + procedure Write_Bind_Line (S : String); + -- Write S (an LF-terminated string) to the binder file (for use with + -- Set_Special_Output). + ------------------ -- Gen_Adafinal -- ------------------ @@ -594,6 +622,9 @@ package body Bindgen is WBI (" Leap_Seconds_Support : Integer;"); WBI (" pragma Import (C, Leap_Seconds_Support, " & """__gl_leap_seconds_support"");"); + WBI (" Bind_Env_Addr : System.Address;"); + WBI (" pragma Import (C, Bind_Env_Addr, " & + """__gl_bind_env_addr"");"); -- Import entry point for elaboration time signal handler -- installation, and indication of if it's been called previously. @@ -663,6 +694,8 @@ package body Bindgen is & """__gnat_freeze_dispatching_domains"");"); end if; + -- Start of processing for Adainit + WBI (" begin"); WBI (" if Is_Elaborated then"); WBI (" return;"); @@ -793,6 +826,10 @@ package body Bindgen is Set_String (";"); Write_Statement_Buffer; + if Bind_Env_String_Built then + WBI (" Bind_Env_Addr := Bind_Env'Address;"); + end if; + -- Generate call to Install_Handler WBI (""); @@ -897,6 +934,62 @@ package body Bindgen is WBI (""); end Gen_Adainit; + ------------------------- + -- Gen_Bind_Env_String -- + ------------------------- + + procedure Gen_Bind_Env_String is + KN, VN : Name_Id := No_Name; + Amp : Character; + + procedure Write_Name_With_Len (Nam : Name_Id); + -- Write Nam as a string literal, prefixed with one + -- character encoding Nam's length. + + ------------------------- + -- Write_Name_With_Len -- + ------------------------- + + procedure Write_Name_With_Len (Nam : Name_Id) is + begin + Get_Name_String (Nam); + + Start_String; + Store_String_Char (Character'Val (Name_Len)); + Store_String_Chars (Name_Buffer (1 .. Name_Len)); + + Write_String_Table_Entry (End_String); + end Write_Name_With_Len; + + -- Start of processing for Gen_Bind_Env_String + + begin + Bind_Environment.Get_First (KN, VN); + if VN = No_Name then + return; + end if; + + Set_Special_Output (Write_Bind_Line'Access); + + WBI (" Bind_Env : aliased constant String :="); + Amp := ' '; + while VN /= No_Name loop + Write_Str (" " & Amp & ' '); + Write_Name_With_Len (KN); + Write_Str (" & "); + Write_Name_With_Len (VN); + Write_Eol; + + Bind_Environment.Get_Next (KN, VN); + Amp := '&'; + end loop; + WBI (" & ASCII.NUL;"); + + Set_Special_Output (null); + + Bind_Env_String_Built := True; + end Gen_Bind_Env_String; + -------------------------- -- Gen_CodePeer_Wrapper -- -------------------------- @@ -2279,13 +2372,18 @@ package body Bindgen is WBI (""); end if; - -- The B.1 (39) implementation advice says that the adainit/adafinal - -- routines should be idempotent. Generate a flag to ensure that. - -- This is not needed if we are suppressing the standard library - -- since it would never be referenced. - if not Suppress_Standard_Library_On_Target then + + -- The B.1(39) implementation advice says that the adainit + -- and adafinal routines should be idempotent. Generate a flag to + -- ensure that. This is not needed if we are suppressing the + -- standard library since it would never be referenced. + WBI (" Is_Elaborated : Boolean := False;"); + + -- Generate bind environment string + + Gen_Bind_Env_String; end if; WBI (""); @@ -2656,6 +2754,15 @@ package body Bindgen is return False; end Has_Finalizer; + ---------- + -- Hash -- + ---------- + + function Hash (Nam : Name_Id) return Header_Num is + begin + return Int (Nam - Names_Low_Bound) rem Header_Num'Last; + end Hash; + ---------------------- -- Lt_Linker_Option -- ---------------------- @@ -2754,6 +2861,25 @@ package body Bindgen is end loop; end Resolve_Binder_Options; + ------------------ + -- Set_Bind_Env -- + ------------------ + + procedure Set_Bind_Env (Key, Value : String) is + begin + -- The lengths of Key and Value are stored as single bytes + + if Key'Length > 255 then + Osint.Fail ("bind environment key """ & Key & """ too long"); + end if; + + if Value'Length > 255 then + Osint.Fail ("bind environment value """ & Value & """ too long"); + end if; + + Bind_Environment.Set (Name_Find_Str (Key), Name_Find_Str (Value)); + end Set_Bind_Env; + ----------------- -- Set_Boolean -- ----------------- @@ -2945,6 +3071,17 @@ package body Bindgen is Set_Int (Unum); end Set_Unit_Number; + --------------------- + -- Write_Bind_Line -- + --------------------- + + procedure Write_Bind_Line (S : String) is + begin + -- Need to strip trailing LF from S + + WBI (S (S'First .. S'Last - 1)); + end Write_Bind_Line; + ---------------------------- -- Write_Statement_Buffer -- ---------------------------- diff --git a/gcc/ada/bindgen.ads b/gcc/ada/bindgen.ads index 71596284963..2f4cc78c483 100644 --- a/gcc/ada/bindgen.ads +++ b/gcc/ada/bindgen.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -37,4 +37,8 @@ package Bindgen is procedure Gen_Output_File (Filename : String); -- Filename is the full path name of the binder output file + procedure Set_Bind_Env (Key, Value : String); + -- Add (Key, Value) pair to bind environment. These associations + -- are made available at run time using System.Bind_Environment. + end Bindgen; diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index b1029487dfa..e5c0e362faa 100644 --- a/gcc/ada/bindusg.adb +++ b/gcc/ada/bindusg.adb @@ -4,9 +4,9 @@ -- -- -- B I N D U S G -- -- -- --- B o d y -- +-- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -228,6 +228,10 @@ package body Bindusg is Write_Line (" -v Verbose mode. Error messages, " & "header, summary output to stdout"); + -- Line for -V switch + + Write_Line (" -Vkey=val Record bind-time variable key " & + "with value val"); -- Line for -w switch Write_Line (" -wx Warning mode. (x=s/e for " & diff --git a/gcc/ada/g-binenv.adb b/gcc/ada/g-binenv.adb new file mode 100644 index 00000000000..13e414d46fa --- /dev/null +++ b/gcc/ada/g-binenv.adb @@ -0,0 +1,83 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- G N A T . B I N D _ E N V I R O N M E N T -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2015, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by AdaCore. -- +-- -- +------------------------------------------------------------------------------ + +with System; + +package body GNAT.Bind_Environment is + + --------- + -- Get -- + --------- + + function Get (Key : String) return String is + use type System.Address; + + Bind_Env_Addr : System.Address; + pragma Import (C, Bind_Env_Addr, "__gl_bind_env_addr"); + -- Variable provided by init.c/s-init.ads, and initialized by + -- the binder generated file. + + Bind_Env : String (Positive); + for Bind_Env'Address use Bind_Env_Addr; + pragma Import (Ada, Bind_Env); + -- Import Bind_Env string from binder file. Note that we import + -- it here as a string with maximum boundaries. The "real" end + -- of the string is indicated by a NUL byte. + + Index, KLen, VLen : Integer; + + begin + if Bind_Env_Addr = System.Null_Address then + return ""; + end if; + + Index := Bind_Env'First; + loop + -- Index points to key length + + VLen := 0; + KLen := Character'Pos (Bind_Env (Index)); + exit when KLen = 0; + + Index := Index + KLen + 1; + + -- Index points to value length + + VLen := Character'Pos (Bind_Env (Index)); + exit when Bind_Env (Index - KLen .. Index - 1) = Key; + + Index := Index + VLen + 1; + end loop; + + return Bind_Env (Index + 1 .. Index + VLen); + end Get; + +end GNAT.Bind_Environment; diff --git a/gcc/ada/g-binenv.ads b/gcc/ada/g-binenv.ads new file mode 100644 index 00000000000..e3c181fafa2 --- /dev/null +++ b/gcc/ada/g-binenv.ads @@ -0,0 +1,40 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- G N A T . B I N D _ E N V I R O N M E N T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2015, 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by AdaCore. -- +-- -- +------------------------------------------------------------------------------ + +package GNAT.Bind_Environment is + + pragma Pure; + + function Get (Key : String) return String; + -- Return the value associated with Key at bind time, + -- or an empty string if not found. + +end GNAT.Bind_Environment; diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 0d99ccf155c..3a4ec5318e0 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -560,7 +560,16 @@ begin Shared_Libgnat := (Shared_Libgnat_Default = SHARED); end; - -- Scan the switches and arguments + -- Carry out package initializations. These are initializations which + -- might logically be performed at elaboration time, and we decide to be + -- consistent. Like elaboration, the order in which these calls are made + -- is in some cases important. + + Csets.Initialize; + Snames.Initialize; + + -- Scan the switches and arguments. Note that Snames must already be + -- initialized (for processing of the -V switch). -- First, scan to detect --version and/or --help @@ -616,14 +625,6 @@ begin Osint.Add_Default_Search_Dirs; - -- Carry out package initializations. These are initializations which - -- might logically be performed at elaboration time, and we decide to be - -- consistent. Like elaboration, the order in which these calls are made - -- is in some cases important. - - Csets.Initialize; - Snames.Initialize; - -- Acquire target parameters Targparm.Get_Target_Parameters; diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index bd32e818549..6f6c9baee71 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -238,6 +238,7 @@ package body Impunit is ("g-alvevi", F), -- GNAT.Altivec.Vector_Views ("g-arrspl", F), -- GNAT.Array_Split ("g-awk ", F), -- GNAT.AWK + ("g-binenv", F), -- GNAT.Bind_Environment ("g-boubuf", F), -- GNAT.Bounded_Buffers ("g-boumai", F), -- GNAT.Bounded_Mailboxes ("g-bubsor", F), -- GNAT.Bubble_Sort diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 5754fae3619..e40487f04b1 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -93,7 +93,9 @@ extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *); extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *); #endif -/* Global values computed by the binder. */ +/* Global values computed by the binder. Note that these variables are + declared here, not in the binder file, to avoid having unresolved + references in the shared libgnat. */ int __gl_main_priority = -1; int __gl_main_cpu = -1; int __gl_time_slice_val = -1; @@ -111,6 +113,7 @@ int __gl_detect_blocking = 0; int __gl_default_stack_size = -1; int __gl_leap_seconds_support = 0; int __gl_canonical_streams = 0; +char *__gl_bind_env_addr = NULL; /* This value is not used anymore, but kept for bootstrapping purpose. */ int __gl_zero_cost_exceptions = 0; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index b2e0f113bfc..41763de72ec 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -18580,9 +18580,12 @@ package body Sem_Prag is -- purposes of legality checks and removal of ignored Ghost code. Mark_Pragma_As_Ghost (N, Ent); - Set_Is_Pure (Ent); - Set_Has_Pragma_Pure (Ent); - Set_Suppress_Elaboration_Warnings (Ent); + + if not Debug_Flag_U then + Set_Is_Pure (Ent); + Set_Has_Pragma_Pure (Ent); + Set_Suppress_Elaboration_Warnings (Ent); + end if; end Pure; ------------------- diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index 880540eca3e..2e58fbc5c29 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2015, 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- -- @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Bindgen; with Debug; use Debug; with Osint; use Osint; with Opt; use Opt; @@ -417,6 +418,26 @@ package body Switch.B is Ptr := Ptr + 1; Verbose_Mode := True; + -- Processing for V switch + + when 'V' => + declare + Eq : Integer; + begin + Ptr := Ptr + 1; + Eq := Ptr; + while Eq <= Max and then Switch_Chars (Eq) /= '=' loop + Eq := Eq + 1; + end loop; + if Eq = Ptr or else Eq = Max then + Bad_Switch (Switch_Chars); + end if; + Bindgen.Set_Bind_Env + (Key => Switch_Chars (Ptr .. Eq - 1), + Value => Switch_Chars (Eq + 1 .. Max)); + Ptr := Max + 1; + end; + -- Processing for w switch when 'w' => -- 2.30.2