[Ada] Fix type mismatch warnings during LTO bootstrap #2

Message ID 20210507093823.GA140739@adacore.com
State New
Headers show
Series
  • [Ada] Fix type mismatch warnings during LTO bootstrap #2
Related show

Commit Message

Pierre-Marie de Rodat May 7, 2021, 9:38 a.m.
This fixes the type of parameters and variables in the C code, changes
the convention of Raise_From_Signal_Handler to C and uses a compatible
boolean type for Is_Handled_By_Others.

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

gcc/ada/

	* init.c (__gnat_raise_program_error): Fix parameter type.
	(Raise_From_Signal_Handler): Likewise and mark as no-return.
	* raise-gcc.c (__gnat_others_value): Fix type.
	(__gnat_all_others_value): Likewise.
	(__gnat_unhandled_others_value): Likewise.
	* seh_init.c (Raise_From_Signal_Handler): Fix parameter type.
	* libgnat/a-except.ads (Raise_From_Signal_Handler): Use convention C
	and new symbol name, move declaration to...
	(Raise_From_Controlled_Operation): Minor tweak.
	* libgnat/a-except.adb (Raise_From_Signal_Handler): ...here.
	* libgnat/a-exexpr.adb (bool): New C compatible boolean type.
	(Is_Handled_By_Others): Use it as return type for the function.

Patch

diff --git a/gcc/ada/init.c b/gcc/ada/init.c
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -78,7 +78,7 @@ 
 extern "C" {
 #endif
 
-extern void __gnat_raise_program_error (const char *, int);
+extern void __gnat_raise_program_error (const void *, int);
 
 /* Addresses of exception data blocks for predefined exceptions.  Tasking_Error
    is not used in this unit, and the abort signal is only used on IRIX.
@@ -89,17 +89,16 @@  extern struct Exception_Data program_error;
 extern struct Exception_Data storage_error;
 
 /* For the Cert run time we use the regular raise exception routine because
-   Raise_From_Signal_Handler is not available.  */
+   __gnat_raise_from_signal_handler is not available.  */
 #ifdef CERT
-#define Raise_From_Signal_Handler \
-                      __gnat_raise_exception
-extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
+#define Raise_From_Signal_Handler __gnat_raise_exception
 #else
-#define Raise_From_Signal_Handler \
-                      ada__exceptions__raise_from_signal_handler
-extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
+#define Raise_From_Signal_Handler __gnat_raise_from_signal_handler
 #endif
 
+extern void Raise_From_Signal_Handler (struct Exception_Data *, const void *)
+  ATTRIBUTE_NORETURN;
+
 /* 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.  */


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
@@ -279,6 +279,23 @@  package body Ada.Exceptions is
    pragma No_Return (Raise_Exception_No_Defer);
    --  Similar to Raise_Exception, but with no abort deferral
 
+   procedure Raise_From_Signal_Handler
+     (E : Exception_Id;
+      M : System.Address);
+   pragma Export
+     (C, Raise_From_Signal_Handler, "__gnat_raise_from_signal_handler");
+   pragma No_Return (Raise_From_Signal_Handler);
+   --  This routine is used to raise an exception from a signal handler. The
+   --  signal handler has already stored the machine state (i.e. the state that
+   --  corresponds to the location at which the signal was raised). E is the
+   --  Exception_Id specifying what exception is being raised, and M is a
+   --  pointer to a null-terminated string which is the message to be raised.
+   --  Note that this routine never returns, so it is permissible to simply
+   --  jump to this routine, rather than call it. This may be appropriate for
+   --  systems where the right way to get out of signal handler is to alter the
+   --  PC value in the machine state or in some other way ask the operating
+   --  system to return here rather than to the original location.
+
    procedure Raise_With_Msg (E : Exception_Id);
    pragma No_Return (Raise_With_Msg);
    pragma Export (C, Raise_With_Msg, "__gnat_raise_with_msg");


diff --git a/gcc/ada/libgnat/a-except.ads b/gcc/ada/libgnat/a-except.ads
--- a/gcc/ada/libgnat/a-except.ads
+++ b/gcc/ada/libgnat/a-except.ads
@@ -184,26 +184,7 @@  private
    --  Raise_Exception_Always if it can determine this is the case. The Export
    --  allows this routine to be accessed from Pure units.
 
-   procedure Raise_From_Signal_Handler
-     (E : Exception_Id;
-      M : System.Address);
-   pragma Export
-     (Ada, Raise_From_Signal_Handler,
-           "ada__exceptions__raise_from_signal_handler");
-   pragma No_Return (Raise_From_Signal_Handler);
-   --  This routine is used to raise an exception from a signal handler. The
-   --  signal handler has already stored the machine state (i.e. the state that
-   --  corresponds to the location at which the signal was raised). E is the
-   --  Exception_Id specifying what exception is being raised, and M is a
-   --  pointer to a null-terminated string which is the message to be raised.
-   --  Note that this routine never returns, so it is permissible to simply
-   --  jump to this routine, rather than call it. This may be appropriate for
-   --  systems where the right way to get out of signal handler is to alter the
-   --  PC value in the machine state or in some other way ask the operating
-   --  system to return here rather than to the original location.
-
-   procedure Raise_From_Controlled_Operation
-     (X : Ada.Exceptions.Exception_Occurrence);
+   procedure Raise_From_Controlled_Operation (X : Exception_Occurrence);
    pragma No_Return (Raise_From_Controlled_Operation);
    pragma Export
      (Ada, Raise_From_Controlled_Operation,


diff --git a/gcc/ada/libgnat/a-exexpr.adb b/gcc/ada/libgnat/a-exexpr.adb
--- a/gcc/ada/libgnat/a-exexpr.adb
+++ b/gcc/ada/libgnat/a-exexpr.adb
@@ -91,6 +91,9 @@  package body Exception_Propagation is
 
    use Exception_Traces;
 
+   type bool is new Boolean;
+   pragma Convention (C, bool);
+
    Foreign_Exception : aliased System.Standard_Library.Exception_Data;
    pragma Import (Ada, Foreign_Exception,
                   "system__exceptions__foreign_exception");
@@ -277,7 +280,7 @@  package body Exception_Propagation is
    --  painful and error prone. These subprograms could be moved to a more
    --  widely visible location if need be.
 
-   function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
+   function Is_Handled_By_Others (E : Exception_Data_Ptr) return bool;
    pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
    pragma Warnings (Off, Is_Handled_By_Others);
 
@@ -685,9 +688,7 @@  package body Exception_Propagation is
    -- Foreign_Data_For --
    ----------------------
 
-   function Foreign_Data_For
-     (E : SSL.Exception_Data_Ptr) return Address
-   is
+   function Foreign_Data_For (E : SSL.Exception_Data_Ptr) return Address is
    begin
       return E.Foreign_Data;
    end Foreign_Data_For;
@@ -696,9 +697,9 @@  package body Exception_Propagation is
    -- Is_Handled_By_Others --
    --------------------------
 
-   function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return Boolean is
+   function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return bool is
    begin
-      return not E.all.Not_Handled_By_Others;
+      return not bool (E.all.Not_Handled_By_Others);
    end Is_Handled_By_Others;
 
    ------------------


diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -542,17 +542,17 @@  typedef struct
   /* ABI header, maximally aligned. */
 } _GNAT_Exception;
 
-/* The two constants below are specific ttype identifiers for special
+/* The three constants below are specific ttype identifiers for special
    exception ids.  Their type should match what a-exexpr exports.  */
 
-extern const int __gnat_others_value;
-#define GNAT_OTHERS      ((_Unwind_Ptr) &__gnat_others_value)
+extern const char __gnat_others_value;
+#define GNAT_OTHERS ((_Unwind_Ptr) &__gnat_others_value)
 
-extern const int __gnat_all_others_value;
-#define GNAT_ALL_OTHERS  ((_Unwind_Ptr) &__gnat_all_others_value)
+extern const char __gnat_all_others_value;
+#define GNAT_ALL_OTHERS ((_Unwind_Ptr) &__gnat_all_others_value)
 
-extern const int __gnat_unhandled_others_value;
-#define GNAT_UNHANDLED_OTHERS  ((_Unwind_Ptr) &__gnat_unhandled_others_value)
+extern const char __gnat_unhandled_others_value;
+#define GNAT_UNHANDLED_OTHERS ((_Unwind_Ptr) &__gnat_unhandled_others_value)
 
 /* Describe the useful region data associated with an unwind context.  */
 


diff --git a/gcc/ada/seh_init.c b/gcc/ada/seh_init.c
--- a/gcc/ada/seh_init.c
+++ b/gcc/ada/seh_init.c
@@ -64,8 +64,8 @@  extern struct Exception_Data storage_error;
 extern struct Exception_Data tasking_error;
 extern struct Exception_Data _abort_signal;
 
-#define Raise_From_Signal_Handler ada__exceptions__raise_from_signal_handler
-extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *)
+#define Raise_From_Signal_Handler __gnat_raise_from_signal_handler
+extern void Raise_From_Signal_Handler (struct Exception_Data *, const void *)
   ATTRIBUTE_NORETURN;