+2015-10-20 Thomas Quinot <quinot@adacore.com>
+
+ * 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 <celier@adacore.com>
+
+ * 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 <duff@adacore.com>
* output.adb (Write_Int): Work with negative numbers in order to avoid
directio$(objext) \
g-arrspl$(objext) \
g-awk$(objext) \
+ g-binenv$(objext) \
g-bubsor$(objext) \
g-busora$(objext) \
g-busorg$(objext) \
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;
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
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.
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 --
----------------------
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
-- 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 --
------------------
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.
& """__gnat_freeze_dispatching_domains"");");
end if;
+ -- Start of processing for Adainit
+
WBI (" begin");
WBI (" if Is_Elaborated then");
WBI (" return;");
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 ("");
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 --
--------------------------
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 ("");
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 --
----------------------
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 --
-----------------
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 --
----------------------------
-- --
-- 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- --
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;
-- --
-- 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- --
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 " &
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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 --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- 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;
-- --
-- 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- --
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
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;
("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
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;
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;
-- 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;
-------------------
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
+with Bindgen;
with Debug; use Debug;
with Osint; use Osint;
with Opt; use Opt;
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' =>
projects / gcc.git / commitdiff