[Ada] VxWorks inconsistent use of return type (BOOL)

Message ID 20210922151555.GA1907969@adacore.com
State Committed
Commit 27534649ab6bed76c2839f2874849a5ddd48251a
Headers
Series [Ada] VxWorks inconsistent use of return type (BOOL) |

Commit Message

Pierre-Marie de Rodat Sept. 22, 2021, 3:15 p.m. UTC
  Type BOOL is made a new int to be consistent with the typedef used in
the C header files.

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

gcc/ada/

	* libgnarl/s-vxwext.ads (BOOL): New int type.
	(Interrupt_Context): Change return type to BOOL.
	* libgnarl/s-vxwext__kernel.ads: Likewise.
	* libgnarl/s-vxwext__rtp-smp.adb: Likewise.
	* libgnarl/s-vxwext__rtp.adb: Likewise.
	* libgnarl/s-vxwext__rtp.ads: Likewise.
	* libgnarl/s-osinte__vxworks.adb (Interrupt_Context): Change
	return type to BOOL.
	* libgnarl/s-osinte__vxworks.ads (BOOL) New subtype.
	(taskIsSuspended): Change return type to BOOL.
	(Interrupt_Context): Change return type to BOOL. Adjust comments
	accordingly.
	* libgnarl/s-taprop__vxworks.adb (System.VxWorks.Ext.BOOL):
	use type.
	(Is_Task_Context): Test Interrupt_Context against 0.
	* libgnat/i-vxwork.ads (BOOL): New int.
	(intContext): Change return type to BOOL. Adjust comments.
	* libgnat/i-vxwork__x86.ads: Likewise.
  

Patch

diff --git a/gcc/ada/libgnarl/s-osinte__vxworks.adb b/gcc/ada/libgnarl/s-osinte__vxworks.adb
--- a/gcc/ada/libgnarl/s-osinte__vxworks.adb
+++ b/gcc/ada/libgnarl/s-osinte__vxworks.adb
@@ -203,7 +203,7 @@  package body System.OS_Interface is
    -- Interrupt_Context --
    -----------------------
 
-   function Interrupt_Context return int is
+   function Interrupt_Context return BOOL is
    begin
       return System.VxWorks.Ext.Interrupt_Context;
    end Interrupt_Context;


diff --git a/gcc/ada/libgnarl/s-osinte__vxworks.ads b/gcc/ada/libgnarl/s-osinte__vxworks.ads
--- a/gcc/ada/libgnarl/s-osinte__vxworks.ads
+++ b/gcc/ada/libgnarl/s-osinte__vxworks.ads
@@ -57,6 +57,7 @@  package System.OS_Interface is
    type unsigned_long_long is mod 2 ** long_long'Size;
    type size_t             is mod 2 ** Standard'Address_Size;
 
+   subtype BOOL            is System.VxWorks.Ext.BOOL;
    subtype vx_freq_t       is System.VxWorks.Ext.vx_freq_t;
 
    -----------
@@ -307,7 +308,7 @@  package System.OS_Interface is
    function taskResume (tid : t_id) return int;
    pragma Import (C, taskResume, "taskResume");
 
-   function taskIsSuspended (tid : t_id) return int;
+   function taskIsSuspended (tid : t_id) return BOOL;
    pragma Import (C, taskIsSuspended, "taskIsSuspended");
 
    function taskDelay (ticks : int) return int;
@@ -489,10 +490,10 @@  package System.OS_Interface is
    --  which is invoked after the OS has saved enough context for a high-level
    --  language routine to be safely invoked.
 
-   function Interrupt_Context return int;
+   function Interrupt_Context return BOOL;
    pragma Inline (Interrupt_Context);
-   --  Return 1 if executing in an interrupt context; return 0 if executing in
-   --  a task context.
+   --  Return 1 (TRUE) if executing in an interrupt context;
+   --  return 0 (FALSE) if executing in a task context.
 
    function Interrupt_Number_To_Vector (intNum : int) return Interrupt_Vector;
    pragma Inline (Interrupt_Number_To_Vector);


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
@@ -62,9 +62,10 @@  package body System.Task_Primitives.Operations is
    use System.Tasking;
    use System.OS_Interface;
    use System.Parameters;
-   use type System.VxWorks.Ext.t_id;
    use type Interfaces.C.int;
    use type System.OS_Interface.unsigned;
+   use type System.VxWorks.Ext.t_id;
+   use type System.VxWorks.Ext.BOOL;
 
    subtype int is System.OS_Interface.int;
    subtype unsigned is System.OS_Interface.unsigned;
@@ -1304,7 +1305,7 @@  package body System.Task_Primitives.Operations is
 
    function Is_Task_Context return Boolean is
    begin
-      return System.OS_Interface.Interrupt_Context /= 1;
+      return System.OS_Interface.Interrupt_Context = 0;
    end Is_Task_Context;
 
    ----------------


diff --git a/gcc/ada/libgnarl/s-vxwext.ads b/gcc/ada/libgnarl/s-vxwext.ads
--- a/gcc/ada/libgnarl/s-vxwext.ads
+++ b/gcc/ada/libgnarl/s-vxwext.ads
@@ -46,6 +46,9 @@  package System.VxWorks.Ext is
    subtype int is Interfaces.C.int;
    subtype unsigned is Interfaces.C.unsigned;
 
+   type BOOL is new int;
+   --  Equivalent of the C type BOOL
+
    type vx_freq_t is new unsigned;
    --  Equivalent of the C type _Vx_freq_t
 
@@ -66,7 +69,7 @@  package System.VxWorks.Ext is
       Parameter : System.Address := System.Null_Address) return int;
    pragma Import (C, Interrupt_Connect, "intConnect");
 
-   function Interrupt_Context return int;
+   function Interrupt_Context return BOOL;
    pragma Import (C, Interrupt_Context, "intContext");
 
    function Interrupt_Number_To_Vector


diff --git a/gcc/ada/libgnarl/s-vxwext__kernel.ads b/gcc/ada/libgnarl/s-vxwext__kernel.ads
--- a/gcc/ada/libgnarl/s-vxwext__kernel.ads
+++ b/gcc/ada/libgnarl/s-vxwext__kernel.ads
@@ -45,6 +45,9 @@  package System.VxWorks.Ext is
    subtype int is Interfaces.C.int;
    subtype unsigned is Interfaces.C.unsigned;
 
+   type BOOL is new int;
+   --  Equivalent of the C type BOOL
+
    type vx_freq_t is new unsigned;
    --  Equivalent of the C type _Vx_freq_t
 
@@ -65,7 +68,7 @@  package System.VxWorks.Ext is
       Parameter : System.Address := System.Null_Address) return int;
    pragma Import (C, Interrupt_Connect, "intConnect");
 
-   function Interrupt_Context return int;
+   function Interrupt_Context return BOOL;
    pragma Import (C, Interrupt_Context, "intContext");
 
    function Interrupt_Number_To_Vector


diff --git a/gcc/ada/libgnarl/s-vxwext__rtp-smp.adb b/gcc/ada/libgnarl/s-vxwext__rtp-smp.adb
--- a/gcc/ada/libgnarl/s-vxwext__rtp-smp.adb
+++ b/gcc/ada/libgnarl/s-vxwext__rtp-smp.adb
@@ -72,7 +72,7 @@  package body System.VxWorks.Ext is
    -- Interrupt_Context --
    -----------------------
 
-   function Interrupt_Context return int is
+   function Interrupt_Context return BOOL is
    begin
       --  For RTPs, never in an interrupt context
 


diff --git a/gcc/ada/libgnarl/s-vxwext__rtp.adb b/gcc/ada/libgnarl/s-vxwext__rtp.adb
--- a/gcc/ada/libgnarl/s-vxwext__rtp.adb
+++ b/gcc/ada/libgnarl/s-vxwext__rtp.adb
@@ -72,7 +72,7 @@  package body System.VxWorks.Ext is
    -- Interrupt_Context --
    -----------------------
 
-   function Interrupt_Context return int is
+   function Interrupt_Context return BOOL is
    begin
       --  For RTPs, never in an interrupt context
 


diff --git a/gcc/ada/libgnarl/s-vxwext__rtp.ads b/gcc/ada/libgnarl/s-vxwext__rtp.ads
--- a/gcc/ada/libgnarl/s-vxwext__rtp.ads
+++ b/gcc/ada/libgnarl/s-vxwext__rtp.ads
@@ -45,6 +45,9 @@  package System.VxWorks.Ext is
    subtype int is Interfaces.C.int;
    subtype unsigned is Interfaces.C.unsigned;
 
+   type BOOL is new int;
+   --  Equivalent of the C type BOOL
+
    type vx_freq_t is new unsigned;
    --  Equivalent of the C type _Vx_freq_t
 
@@ -65,7 +68,7 @@  package System.VxWorks.Ext is
       Parameter : System.Address := System.Null_Address) return int;
    pragma Convention (C, Interrupt_Connect);
 
-   function Interrupt_Context return int;
+   function Interrupt_Context return BOOL;
    pragma Convention (C, Interrupt_Context);
 
    function Interrupt_Number_To_Vector


diff --git a/gcc/ada/libgnat/i-vxwork.ads b/gcc/ada/libgnat/i-vxwork.ads
--- a/gcc/ada/libgnat/i-vxwork.ads
+++ b/gcc/ada/libgnat/i-vxwork.ads
@@ -133,6 +133,9 @@  package Interfaces.VxWorks is
    OK    : constant STATUS := 0;
    ERROR : constant STATUS := -1;
 
+   type BOOL is new int;
+   --  Equivalent of the C type BOOL
+
    type VOIDFUNCPTR is access procedure (parameter : System.Address);
    type Interrupt_Vector is new System.Address;
    type Exception_Vector is new System.Address;
@@ -145,9 +148,9 @@  package Interfaces.VxWorks is
    --  The routine generates a wrapper around the user handler to save and
    --  restore context
 
-   function intContext return int;
-   --  Binding to the C routine intContext. This function returns 1 only if the
-   --  current execution state is in interrupt context.
+   function intContext return BOOL;
+   --  Binding to the C routine intContext. This function returns 1 (TRUE)
+   --  only if the current execution state is in interrupt context.
 
    function intVecGet
      (Vector : Interrupt_Vector) return VOIDFUNCPTR;


diff --git a/gcc/ada/libgnat/i-vxwork__x86.ads b/gcc/ada/libgnat/i-vxwork__x86.ads
--- a/gcc/ada/libgnat/i-vxwork__x86.ads
+++ b/gcc/ada/libgnat/i-vxwork__x86.ads
@@ -128,6 +128,9 @@  package Interfaces.VxWorks is
    OK    : constant STATUS := 0;
    ERROR : constant STATUS := -1;
 
+   type BOOL is new int;
+   --  Equivalent of the C type BOOL
+
    type VOIDFUNCPTR is access procedure (parameter : System.Address);
    type Interrupt_Vector is new System.Address;
    type Exception_Vector is new System.Address;
@@ -140,9 +143,9 @@  package Interfaces.VxWorks is
    --  The routine generates a wrapper around the user handler to save and
    --  restore context
 
-   function intContext return int;
-   --  Binding to the C routine intContext. This function returns 1 only if the
-   --  current execution state is in interrupt context.
+   function intContext return BOOL;
+   --  Binding to the C routine intContext. This function returns 1 (TRUE)
+   --  only if the current execution state is in interrupt context.
 
    function intVecGet
      (Vector : Interrupt_Vector) return VOIDFUNCPTR;