[Ada] Import binder globals as constant

Message ID 20211011133923.GA1518865@adacore.com
State New
Headers show
Series
  • [Ada] Import binder globals as constant
Related show

Commit Message

Jason Merrill via Gcc-patches Oct. 11, 2021, 1:39 p.m.
The various __gl_XYZ binder globals prevent some link-time optimizations
when imported as mutable. Work around this by turning them into
constants.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* libgnarl/s-intman__android.adb, libgnarl/s-intman__lynxos.adb,
	libgnarl/s-intman__posix.adb, libgnarl/s-intman__qnx.adb,
	libgnarl/s-intman__solaris.adb, libgnarl/s-intman__susv3.adb,
	libgnarl/s-taprob.adb, libgnarl/s-taprop__hpux-dce.adb,
	libgnarl/s-taprop__linux.adb, libgnarl/s-taprop__mingw.adb,
	libgnarl/s-taprop__posix.adb, libgnarl/s-taprop__qnx.adb,
	libgnarl/s-taprop__solaris.adb, libgnarl/s-taprop__vxworks.adb,
	libgnarl/s-taskin.adb, libgnarl/s-tasque.adb,
	libgnarl/s-tpoben.adb, libgnat/a-calend.adb,
	libgnat/a-excach.adb, libgnat/a-except.adb, libgnat/a-tags.adb,
	libgnat/a-textio.adb, libgnat/a-witeio.adb,
	libgnat/a-ztexio.adb, libgnat/g-binenv.adb,
	libgnat/s-parame.adb, libgnat/s-parame__vxworks.adb,
	libgnat/s-stratt.adb, libgnat/s-trasym__dwarf.adb: Mark imported
	binder globals as constant.

Patch

diff --git a/gcc/ada/libgnarl/s-intman__android.adb b/gcc/ada/libgnarl/s-intman__android.adb
--- a/gcc/ada/libgnarl/s-intman__android.adb
+++ b/gcc/ada/libgnarl/s-intman__android.adb
@@ -68,7 +68,7 @@  package body System.Interrupt_Management is
    Exception_Interrupts : constant Interrupt_List :=
      (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
 
-   Unreserve_All_Interrupts : Interfaces.C.int;
+   Unreserve_All_Interrupts : constant Interfaces.C.int;
    pragma Import
      (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
 


diff --git a/gcc/ada/libgnarl/s-intman__lynxos.adb b/gcc/ada/libgnarl/s-intman__lynxos.adb
--- a/gcc/ada/libgnarl/s-intman__lynxos.adb
+++ b/gcc/ada/libgnarl/s-intman__lynxos.adb
@@ -68,7 +68,7 @@  package body System.Interrupt_Management is
    Exception_Interrupts : constant Interrupt_List :=
      (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
 
-   Unreserve_All_Interrupts : Interfaces.C.int;
+   Unreserve_All_Interrupts : constant Interfaces.C.int;
    pragma Import
      (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
 


diff --git a/gcc/ada/libgnarl/s-intman__posix.adb b/gcc/ada/libgnarl/s-intman__posix.adb
--- a/gcc/ada/libgnarl/s-intman__posix.adb
+++ b/gcc/ada/libgnarl/s-intman__posix.adb
@@ -68,7 +68,7 @@  package body System.Interrupt_Management is
    Exception_Interrupts : constant Interrupt_List :=
      (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
 
-   Unreserve_All_Interrupts : Interfaces.C.int;
+   Unreserve_All_Interrupts : constant Interfaces.C.int;
    pragma Import
      (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
 


diff --git a/gcc/ada/libgnarl/s-intman__qnx.adb b/gcc/ada/libgnarl/s-intman__qnx.adb
--- a/gcc/ada/libgnarl/s-intman__qnx.adb
+++ b/gcc/ada/libgnarl/s-intman__qnx.adb
@@ -68,7 +68,7 @@  package body System.Interrupt_Management is
    Exception_Interrupts : constant Interrupt_List :=
      (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
 
-   Unreserve_All_Interrupts : Interfaces.C.int;
+   Unreserve_All_Interrupts : constant Interfaces.C.int;
    pragma Import
      (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
 


diff --git a/gcc/ada/libgnarl/s-intman__solaris.adb b/gcc/ada/libgnarl/s-intman__solaris.adb
--- a/gcc/ada/libgnarl/s-intman__solaris.adb
+++ b/gcc/ada/libgnarl/s-intman__solaris.adb
@@ -47,7 +47,7 @@  package body System.Interrupt_Management is
    Exception_Interrupts : constant Interrupt_List :=
      (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
 
-   Unreserve_All_Interrupts : Interfaces.C.int;
+   Unreserve_All_Interrupts : constant Interfaces.C.int;
    pragma Import
      (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
 


diff --git a/gcc/ada/libgnarl/s-intman__susv3.adb b/gcc/ada/libgnarl/s-intman__susv3.adb
--- a/gcc/ada/libgnarl/s-intman__susv3.adb
+++ b/gcc/ada/libgnarl/s-intman__susv3.adb
@@ -56,7 +56,7 @@  package body System.Interrupt_Management is
    use Interfaces.C;
    use System.OS_Interface;
 
-   Unreserve_All_Interrupts : Interfaces.C.int;
+   Unreserve_All_Interrupts : constant Interfaces.C.int;
    pragma Import
      (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
 


diff --git a/gcc/ada/libgnarl/s-taprob.adb b/gcc/ada/libgnarl/s-taprob.adb
--- a/gcc/ada/libgnarl/s-taprob.adb
+++ b/gcc/ada/libgnarl/s-taprob.adb
@@ -47,7 +47,7 @@  package body System.Tasking.Protected_Objects is
    -- Local Data --
    ----------------
 
-   Locking_Policy : Character;
+   Locking_Policy : constant Character;
    pragma Import (C, Locking_Policy, "__gl_locking_policy");
 
    -------------------------


diff --git a/gcc/ada/libgnarl/s-taprop__hpux-dce.adb b/gcc/ada/libgnarl/s-taprop__hpux-dce.adb
--- a/gcc/ada/libgnarl/s-taprop__hpux-dce.adb
+++ b/gcc/ada/libgnarl/s-taprop__hpux-dce.adb
@@ -87,10 +87,10 @@  package body System.Task_Primitives.Operations is
    Unblocked_Signal_Mask : aliased sigset_t;
    --  The set of signals that should unblocked in all tasks
 
-   Time_Slice_Val : Integer;
+   Time_Slice_Val : constant Integer;
    pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
 
-   Dispatching_Policy : Character;
+   Dispatching_Policy : constant Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
    --  Note: the reason that Locking_Policy is not needed is that this


diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb
--- a/gcc/ada/libgnarl/s-taprop__linux.adb
+++ b/gcc/ada/libgnarl/s-taprop__linux.adb
@@ -84,13 +84,13 @@  package body System.Task_Primitives.Operations is
    Next_Serial_Number : Task_Serial_Number := 100;
    --  We start at 100 (reserve some special values for using in error checks)
 
-   Time_Slice_Val : Integer;
+   Time_Slice_Val : constant Integer;
    pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
 
-   Dispatching_Policy : Character;
+   Dispatching_Policy : constant Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
-   Locking_Policy : Character;
+   Locking_Policy : constant Character;
    pragma Import (C, Locking_Policy, "__gl_locking_policy");
 
    Foreign_Task_Elaborated : aliased Boolean := True;


diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb
--- a/gcc/ada/libgnarl/s-taprop__mingw.adb
+++ b/gcc/ada/libgnarl/s-taprop__mingw.adb
@@ -109,10 +109,10 @@  package body System.Task_Primitives.Operations is
    --  a time; it is used to execute in mutual exclusion from all other tasks.
    --  Used to protect All_Tasks_List
 
-   Time_Slice_Val : Integer;
+   Time_Slice_Val : constant Integer;
    pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
 
-   Dispatching_Policy : Character;
+   Dispatching_Policy : constant Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
    function Get_Policy (Prio : System.Any_Priority) return Character;


diff --git a/gcc/ada/libgnarl/s-taprop__posix.adb b/gcc/ada/libgnarl/s-taprop__posix.adb
--- a/gcc/ada/libgnarl/s-taprop__posix.adb
+++ b/gcc/ada/libgnarl/s-taprop__posix.adb
@@ -83,7 +83,7 @@  package body System.Task_Primitives.Operations is
    Environment_Task_Id : Task_Id;
    --  A variable to hold Task_Id for the environment task
 
-   Locking_Policy : Character;
+   Locking_Policy : constant Character;
    pragma Import (C, Locking_Policy, "__gl_locking_policy");
    --  Value of the pragma Locking_Policy:
    --    'C' for Ceiling_Locking
@@ -99,10 +99,10 @@  package body System.Task_Primitives.Operations is
    --  We start at 100, to reserve some special values for
    --  using in error checking.
 
-   Time_Slice_Val : Integer;
+   Time_Slice_Val : constant Integer;
    pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
 
-   Dispatching_Policy : Character;
+   Dispatching_Policy : constant Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
    Foreign_Task_Elaborated : aliased Boolean := True;


diff --git a/gcc/ada/libgnarl/s-taprop__qnx.adb b/gcc/ada/libgnarl/s-taprop__qnx.adb
--- a/gcc/ada/libgnarl/s-taprop__qnx.adb
+++ b/gcc/ada/libgnarl/s-taprop__qnx.adb
@@ -83,7 +83,7 @@  package body System.Task_Primitives.Operations is
    Environment_Task_Id : Task_Id;
    --  A variable to hold Task_Id for the environment task
 
-   Locking_Policy : Character;
+   Locking_Policy : constant Character;
    pragma Import (C, Locking_Policy, "__gl_locking_policy");
    --  Value of the pragma Locking_Policy:
    --    'C' for Ceiling_Locking
@@ -99,10 +99,10 @@  package body System.Task_Primitives.Operations is
    --  We start at 100, to reserve some special values for
    --  using in error checking.
 
-   Time_Slice_Val : Integer;
+   Time_Slice_Val : constant Integer;
    pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
 
-   Dispatching_Policy : Character;
+   Dispatching_Policy : constant Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
    Foreign_Task_Elaborated : aliased Boolean := True;


diff --git a/gcc/ada/libgnarl/s-taprop__solaris.adb b/gcc/ada/libgnarl/s-taprop__solaris.adb
--- a/gcc/ada/libgnarl/s-taprop__solaris.adb
+++ b/gcc/ada/libgnarl/s-taprop__solaris.adb
@@ -128,13 +128,13 @@  package body System.Task_Primitives.Operations is
    -- External Configuration Values --
    -----------------------------------
 
-   Time_Slice_Val : Integer;
+   Time_Slice_Val : constant Integer;
    pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
 
-   Locking_Policy : Character;
+   Locking_Policy : constant Character;
    pragma Import (C, Locking_Policy, "__gl_locking_policy");
 
-   Dispatching_Policy : Character;
+   Dispatching_Policy : constant Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
    Foreign_Task_Elaborated : aliased Boolean := True;


diff --git a/gcc/ada/libgnarl/s-taprop__vxworks.adb b/gcc/ada/libgnarl/s-taprop__vxworks.adb
--- a/gcc/ada/libgnarl/s-taprop__vxworks.adb
+++ b/gcc/ada/libgnarl/s-taprop__vxworks.adb
@@ -88,13 +88,13 @@  package body System.Task_Primitives.Operations is
 
    --  The followings are internal configuration constants needed
 
-   Dispatching_Policy : Character;
+   Dispatching_Policy : constant Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
    Foreign_Task_Elaborated : aliased Boolean := True;
    --  Used to identified fake tasks (i.e., non-Ada Threads)
 
-   Locking_Policy : Character;
+   Locking_Policy : constant Character;
    pragma Import (C, Locking_Policy, "__gl_locking_policy");
 
    Mutex_Protocol : Priority_Type;
@@ -104,7 +104,7 @@  package body System.Task_Primitives.Operations is
    --  time; it is used to execute in mutual exclusion from all other tasks.
    --  Used to protect All_Tasks_List
 
-   Time_Slice_Val : Integer;
+   Time_Slice_Val : constant Integer;
    pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
 
    Null_Thread_Id : constant Thread_Id := 0;


diff --git a/gcc/ada/libgnarl/s-taskin.adb b/gcc/ada/libgnarl/s-taskin.adb
--- a/gcc/ada/libgnarl/s-taskin.adb
+++ b/gcc/ada/libgnarl/s-taskin.adb
@@ -173,13 +173,13 @@  package body System.Tasking is
    Main_Task_Image : constant String := "main_task";
    --  Image of environment task
 
-   Main_Priority : Integer;
+   Main_Priority : constant Integer;
    pragma Import (C, Main_Priority, "__gl_main_priority");
    --  Priority for main task. Note that this is of type Integer, not Priority,
    --  because we use the value -1 to indicate the default main priority, and
    --  that is of course not in Priority'range.
 
-   Main_CPU : Integer;
+   Main_CPU : constant Integer;
    pragma Import (C, Main_CPU, "__gl_main_cpu");
    --  Affinity for main task. Note that this is of type Integer, not
    --  CPU_Range, because we use the value -1 to indicate the unassigned


diff --git a/gcc/ada/libgnarl/s-tasque.adb b/gcc/ada/libgnarl/s-tasque.adb
--- a/gcc/ada/libgnarl/s-tasque.adb
+++ b/gcc/ada/libgnarl/s-tasque.adb
@@ -44,7 +44,7 @@  package body System.Tasking.Queuing is
 
    --  Entry Queues implemented as doubly linked list
 
-   Queuing_Policy : Character;
+   Queuing_Policy : constant Character;
    pragma Import (C, Queuing_Policy, "__gl_queuing_policy");
 
    Priority_Queuing : constant Boolean := Queuing_Policy = 'P';


diff --git a/gcc/ada/libgnarl/s-tpoben.adb b/gcc/ada/libgnarl/s-tpoben.adb
--- a/gcc/ada/libgnarl/s-tpoben.adb
+++ b/gcc/ada/libgnarl/s-tpoben.adb
@@ -58,7 +58,7 @@  package body System.Tasking.Protected_Objects.Entries is
    -- Local Data --
    ----------------
 
-   Locking_Policy : Character;
+   Locking_Policy : constant Character;
    pragma Import (C, Locking_Policy, "__gl_locking_policy");
 
    --------------


diff --git a/gcc/ada/libgnat/a-calend.adb b/gcc/ada/libgnat/a-calend.adb
--- a/gcc/ada/libgnat/a-calend.adb
+++ b/gcc/ada/libgnat/a-calend.adb
@@ -149,7 +149,7 @@  is
    -- Leap seconds control --
    --------------------------
 
-   Flag : Integer;
+   Flag : constant Integer;
    pragma Import (C, Flag, "__gl_leap_seconds_support");
    --  This imported value is used to determine whether the compilation had
    --  binder flag "-y" present which enables leap seconds. A value of zero


diff --git a/gcc/ada/libgnat/a-excach.adb b/gcc/ada/libgnat/a-excach.adb
--- a/gcc/ada/libgnat/a-excach.adb
+++ b/gcc/ada/libgnat/a-excach.adb
@@ -41,7 +41,7 @@  pragma Warnings (On);
 separate (Ada.Exceptions)
 procedure Call_Chain (Excep : EOA) is
 
-   Exception_Tracebacks : Integer;
+   Exception_Tracebacks : constant Integer;
    pragma Import (C, Exception_Tracebacks, "__gl_exception_tracebacks");
    --  Boolean indicating whether tracebacks should be stored in exception
    --  occurrences.


diff --git a/gcc/ada/libgnat/a-except.adb b/gcc/ada/libgnat/a-except.adb
--- a/gcc/ada/libgnat/a-except.adb
+++ b/gcc/ada/libgnat/a-except.adb
@@ -1760,7 +1760,7 @@  package body Ada.Exceptions is
    -- Wide_Exception_Name --
    -------------------------
 
-   WC_Encoding : Character;
+   WC_Encoding : constant Character;
    pragma Import (C, WC_Encoding, "__gl_wc_encoding");
    --  Encoding method for source, as exported by binder
 


diff --git a/gcc/ada/libgnat/a-tags.adb b/gcc/ada/libgnat/a-tags.adb
--- a/gcc/ada/libgnat/a-tags.adb
+++ b/gcc/ada/libgnat/a-tags.adb
@@ -1032,7 +1032,7 @@  package body Ada.Tags is
    -- Wide_Expanded_Name --
    ------------------------
 
-   WC_Encoding : Character;
+   WC_Encoding : constant Character;
    pragma Import (C, WC_Encoding, "__gl_wc_encoding");
    --  Encoding method for source, as exported by binder
 


diff --git a/gcc/ada/libgnat/a-textio.adb b/gcc/ada/libgnat/a-textio.adb
--- a/gcc/ada/libgnat/a-textio.adb
+++ b/gcc/ada/libgnat/a-textio.adb
@@ -67,7 +67,7 @@  is
 
    use type System.CRTL.size_t;
 
-   WC_Encoding : Character;
+   WC_Encoding : constant Character;
    pragma Import (C, WC_Encoding, "__gl_wc_encoding");
    --  Default wide character encoding
 


diff --git a/gcc/ada/libgnat/a-witeio.adb b/gcc/ada/libgnat/a-witeio.adb
--- a/gcc/ada/libgnat/a-witeio.adb
+++ b/gcc/ada/libgnat/a-witeio.adb
@@ -55,7 +55,7 @@  package body Ada.Wide_Text_IO is
 
    use type System.CRTL.size_t;
 
-   WC_Encoding : Character;
+   WC_Encoding : constant Character;
    pragma Import (C, WC_Encoding, "__gl_wc_encoding");
    --  Default wide character encoding
 


diff --git a/gcc/ada/libgnat/a-ztexio.adb b/gcc/ada/libgnat/a-ztexio.adb
--- a/gcc/ada/libgnat/a-ztexio.adb
+++ b/gcc/ada/libgnat/a-ztexio.adb
@@ -55,7 +55,7 @@  package body Ada.Wide_Wide_Text_IO is
 
    use type System.CRTL.size_t;
 
-   WC_Encoding : Character;
+   WC_Encoding : constant Character;
    pragma Import (C, WC_Encoding, "__gl_wc_encoding");
    --  Default wide character encoding
 


diff --git a/gcc/ada/libgnat/g-binenv.adb b/gcc/ada/libgnat/g-binenv.adb
--- a/gcc/ada/libgnat/g-binenv.adb
+++ b/gcc/ada/libgnat/g-binenv.adb
@@ -40,7 +40,7 @@  package body GNAT.Bind_Environment is
    function Get (Key : String) return String is
       use type System.Address;
 
-      Bind_Env_Addr : System.Address;
+      Bind_Env_Addr : constant 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.


diff --git a/gcc/ada/libgnat/s-parame.adb b/gcc/ada/libgnat/s-parame.adb
--- a/gcc/ada/libgnat/s-parame.adb
+++ b/gcc/ada/libgnat/s-parame.adb
@@ -55,7 +55,7 @@  package body System.Parameters is
    ------------------------
 
    function Default_Stack_Size return Size_Type is
-      Default_Stack_Size : Integer;
+      Default_Stack_Size : constant Integer;
       pragma Import (C, Default_Stack_Size, "__gl_default_stack_size");
    begin
       if Default_Stack_Size = -1 then


diff --git a/gcc/ada/libgnat/s-parame__vxworks.adb b/gcc/ada/libgnat/s-parame__vxworks.adb
--- a/gcc/ada/libgnat/s-parame__vxworks.adb
+++ b/gcc/ada/libgnat/s-parame__vxworks.adb
@@ -53,7 +53,7 @@  package body System.Parameters is
    ------------------------
 
    function Default_Stack_Size return Size_Type is
-      Default_Stack_Size : Integer;
+      Default_Stack_Size : constant Integer;
       pragma Import (C, Default_Stack_Size, "__gl_default_stack_size");
    begin
       if Default_Stack_Size = -1 then


diff --git a/gcc/ada/libgnat/s-stratt.adb b/gcc/ada/libgnat/s-stratt.adb
--- a/gcc/ada/libgnat/s-stratt.adb
+++ b/gcc/ada/libgnat/s-stratt.adb
@@ -36,13 +36,13 @@  with System.Stream_Attributes.XDR;
 
 package body System.Stream_Attributes is
 
-   XDR_Flag : Integer;
-   pragma Import (C, XDR_Flag, "__gl_xdr_stream");
+   XDR_Stream : constant Integer;
+   pragma Import (C, XDR_Stream, "__gl_xdr_stream");
    --  This imported value is used to determine whether the build had the
    --  binder switch "-xdr" present which enables XDR streaming and sets this
    --  flag to 1.
 
-   function XDR_Support return Boolean;
+   function XDR_Support return Boolean is (XDR_Stream = 1);
    pragma Inline (XDR_Support);
    --  Return True if XDR streaming should be used. Note that 128-bit integers
    --  are not supported by the XDR protocol and will raise Device_Error.
@@ -141,15 +141,6 @@  package body System.Stream_Attributes is
    function To_WC   is new UC (S_WC,   Wide_Character);
    function To_WWC  is new UC (S_WWC,  Wide_Wide_Character);
 
-   -----------------
-   -- XDR_Support --
-   -----------------
-
-   function XDR_Support return Boolean is
-   begin
-      return XDR_Flag = 1;
-   end XDR_Support;
-
    -----------------
    -- Block_IO_OK --
    -----------------


diff --git a/gcc/ada/libgnat/s-trasym__dwarf.adb b/gcc/ada/libgnat/s-trasym__dwarf.adb
--- a/gcc/ada/libgnat/s-trasym__dwarf.adb
+++ b/gcc/ada/libgnat/s-trasym__dwarf.adb
@@ -691,7 +691,7 @@  package body System.Traceback.Symbolic is
       return Symbolic_Traceback (E, Suppress_Hex => True);
    end Symbolic_Traceback_No_Hex;
 
-   Exception_Tracebacks_Symbolic : Integer;
+   Exception_Tracebacks_Symbolic : constant Integer;
    pragma Import
      (C,
       Exception_Tracebacks_Symbolic,