[gcc(refs/users/guojiufu/heads/personal-branch)] [Ada] Profile mismatch between C and Ada functions
Jiu Fu Guo
guojiufu@gcc.gnu.org
Mon Aug 10 06:09:33 GMT 2020
https://gcc.gnu.org/g:c9a56fd316d254f3155e6eb37b4f662c5fbf6960
commit c9a56fd316d254f3155e6eb37b4f662c5fbf6960
Author: Arnaud Charlet <charlet@adacore.com>
Date: Wed Apr 22 06:11:48 2020 -0400
[Ada] Profile mismatch between C and Ada functions
2020-06-18 Arnaud Charlet <charlet@adacore.com>
gcc/ada/
* libgnarl/s-osinte__linux.ads, libgnat/g-io.adb,
libgnat/g-socket.adb, libgnat/g-socthi.adb,
libgnat/g-socthi.ads, libgnat/g-socthi__vxworks.adb,
libgnat/g-socthi__vxworks.ads, libgnat/g-sothco.ads,
libgnat/s-io.adb, libgnat/a-except.adb: Fix function profile
mismatch with imported C functions.
Diff:
---
gcc/ada/libgnarl/s-osinte__linux.ads | 18 +++++++++---------
gcc/ada/libgnat/a-except.adb | 4 ++--
gcc/ada/libgnat/g-io.adb | 12 ++++++------
gcc/ada/libgnat/g-socket.adb | 8 ++++----
gcc/ada/libgnat/g-socthi.adb | 24 ++++++++++++------------
gcc/ada/libgnat/g-socthi.ads | 8 ++++----
gcc/ada/libgnat/g-socthi__vxworks.adb | 22 +++++++++++-----------
gcc/ada/libgnat/g-socthi__vxworks.ads | 8 ++++----
gcc/ada/libgnat/g-sothco.ads | 8 ++++----
gcc/ada/libgnat/s-io.adb | 8 ++++----
10 files changed, 60 insertions(+), 60 deletions(-)
diff --git a/gcc/ada/libgnarl/s-osinte__linux.ads b/gcc/ada/libgnarl/s-osinte__linux.ads
index e95925b42c6..f7af00bf5e2 100644
--- a/gcc/ada/libgnarl/s-osinte__linux.ads
+++ b/gcc/ada/libgnarl/s-osinte__linux.ads
@@ -278,9 +278,9 @@ package System.OS_Interface is
PR_GET_NAME : constant := 16;
function prctl
- (option : int;
- arg2, arg3, arg4, arg5 : unsigned_long := 0) return int;
- pragma Import (C, prctl);
+ (option : int;
+ arg : unsigned_long) return int;
+ pragma Import (C_Variadic_1, prctl, "prctl");
-------------
-- Threads --
@@ -314,6 +314,8 @@ package System.OS_Interface is
-- Stack --
-----------
+ subtype char_array is Interfaces.C.char_array;
+
type stack_t is record
ss_sp : System.Address;
ss_flags : int;
@@ -326,13 +328,13 @@ package System.OS_Interface is
oss : access stack_t) return int;
pragma Import (C, sigaltstack, "sigaltstack");
- Alternate_Stack : aliased System.Address;
- pragma Import (C, Alternate_Stack, "__gnat_alternate_stack");
- -- The alternate signal stack for stack overflows
-
Alternate_Stack_Size : constant := 16 * 1024;
-- This must be in keeping with init.c:__gnat_alternate_stack
+ Alternate_Stack : aliased char_array (1 .. Alternate_Stack_Size);
+ pragma Import (C, Alternate_Stack, "__gnat_alternate_stack");
+ -- The alternate signal stack for stack overflows
+
function Get_Stack_Base (thread : pthread_t) return Address;
pragma Inline (Get_Stack_Base);
-- This is a dummy procedure to share some GNULLI files
@@ -634,8 +636,6 @@ private
type pid_t is new int;
- subtype char_array is Interfaces.C.char_array;
-
type pthread_attr_t is record
Data : char_array (1 .. OS_Constants.PTHREAD_ATTR_SIZE);
end record;
diff --git a/gcc/ada/libgnat/a-except.adb b/gcc/ada/libgnat/a-except.adb
index 6dcc6c21694..17f3db6e8bc 100644
--- a/gcc/ada/libgnat/a-except.adb
+++ b/gcc/ada/libgnat/a-except.adb
@@ -1660,10 +1660,10 @@ package body Ada.Exceptions is
---------------
procedure To_Stderr (C : Character) is
- procedure Put_Char_Stderr (C : Character);
+ procedure Put_Char_Stderr (C : Integer);
pragma Import (C, Put_Char_Stderr, "put_char_stderr");
begin
- Put_Char_Stderr (C);
+ Put_Char_Stderr (Character'Pos (C));
end To_Stderr;
procedure To_Stderr (S : String) is
diff --git a/gcc/ada/libgnat/g-io.adb b/gcc/ada/libgnat/g-io.adb
index 9c5c17c6486..c2c1ffa14b0 100644
--- a/gcc/ada/libgnat/g-io.adb
+++ b/gcc/ada/libgnat/g-io.adb
@@ -47,10 +47,10 @@ package body GNAT.IO is
end Get;
procedure Get (C : out Character) is
- function Get_Char return Character;
+ function Get_Char return Integer;
pragma Import (C, Get_Char, "get_char");
begin
- C := Get_Char;
+ C := Character'Val (Get_Char);
end Get;
--------------
@@ -121,16 +121,16 @@ package body GNAT.IO is
end Put;
procedure Put (File : File_Type; C : Character) is
- procedure Put_Char (C : Character);
+ procedure Put_Char (C : Integer);
pragma Import (C, Put_Char, "put_char");
- procedure Put_Char_Stderr (C : Character);
+ procedure Put_Char_Stderr (C : Integer);
pragma Import (C, Put_Char_Stderr, "put_char_stderr");
begin
case File is
- when Stdout => Put_Char (C);
- when Stderr => Put_Char_Stderr (C);
+ when Stdout => Put_Char (Character'Pos (C));
+ when Stderr => Put_Char_Stderr (Character'Pos (C));
end case;
end Put;
diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb
index 4c6566b5133..1b8032c9547 100644
--- a/gcc/ada/libgnat/g-socket.adb
+++ b/gcc/ada/libgnat/g-socket.adb
@@ -1222,7 +1222,7 @@ package body GNAT.Sockets is
pragma Unreferenced (Family);
HA : aliased In_Addr_Union (Address.Family);
- Buflen : constant C.int := Netdb_Buffer_Size;
+ Buflen : constant C.size_t := Netdb_Buffer_Size;
Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
Res : aliased Hostent;
Err : aliased C.int;
@@ -1277,7 +1277,7 @@ package body GNAT.Sockets is
declare
HN : constant C.char_array := C.To_C (Name);
- Buflen : constant C.int := Netdb_Buffer_Size;
+ Buflen : constant C.size_t := Netdb_Buffer_Size;
Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
Res : aliased Hostent;
Err : aliased C.int;
@@ -1325,7 +1325,7 @@ package body GNAT.Sockets is
is
SN : constant C.char_array := C.To_C (Name);
SP : constant C.char_array := C.To_C (Protocol);
- Buflen : constant C.int := Netdb_Buffer_Size;
+ Buflen : constant C.size_t := Netdb_Buffer_Size;
Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
Res : aliased Servent;
@@ -1355,7 +1355,7 @@ package body GNAT.Sockets is
Protocol : String) return Service_Entry_Type
is
SP : constant C.char_array := C.To_C (Protocol);
- Buflen : constant C.int := Netdb_Buffer_Size;
+ Buflen : constant C.size_t := Netdb_Buffer_Size;
Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
Res : aliased Servent;
diff --git a/gcc/ada/libgnat/g-socthi.adb b/gcc/ada/libgnat/g-socthi.adb
index 68c82e2f5de..5d86993eef1 100644
--- a/gcc/ada/libgnat/g-socthi.adb
+++ b/gcc/ada/libgnat/g-socthi.adb
@@ -74,17 +74,17 @@ package body GNAT.Sockets.Thin is
function Syscall_Recv
(S : C.int;
Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int;
+ Len : C.size_t;
+ Flags : C.int) return System.CRTL.ssize_t;
pragma Import (C, Syscall_Recv, "recv");
function Syscall_Recvfrom
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
From : System.Address;
- Fromlen : not null access C.int) return C.int;
+ Fromlen : not null access C.int) return System.CRTL.ssize_t;
pragma Import (C, Syscall_Recvfrom, "recvfrom");
function Syscall_Recvmsg
@@ -102,10 +102,10 @@ package body GNAT.Sockets.Thin is
function Syscall_Sendto
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
To : System.Address;
- Tolen : C.int) return C.int;
+ Tolen : C.int) return System.CRTL.ssize_t;
pragma Import (C, Syscall_Sendto, "sendto");
function Syscall_Socket
@@ -250,14 +250,14 @@ package body GNAT.Sockets.Thin is
function C_Recv
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int) return C.int
is
Res : C.int;
begin
loop
- Res := Syscall_Recv (S, Msg, Len, Flags);
+ Res := C.int (Syscall_Recv (S, Msg, Len, Flags));
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
@@ -275,7 +275,7 @@ package body GNAT.Sockets.Thin is
function C_Recvfrom
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
From : System.Address;
Fromlen : not null access C.int) return C.int
@@ -284,7 +284,7 @@ package body GNAT.Sockets.Thin is
begin
loop
- Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
+ Res := C.int (Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen));
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
@@ -350,7 +350,7 @@ package body GNAT.Sockets.Thin is
function C_Sendto
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
To : System.Address;
Tolen : C.int) return C.int
@@ -359,7 +359,7 @@ package body GNAT.Sockets.Thin is
begin
loop
- Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
+ Res := C.int (Syscall_Sendto (S, Msg, Len, Flags, To, Tolen));
exit when SOSC.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
diff --git a/gcc/ada/libgnat/g-socthi.ads b/gcc/ada/libgnat/g-socthi.ads
index 30d6c76250c..c6a07ba6908 100644
--- a/gcc/ada/libgnat/g-socthi.ads
+++ b/gcc/ada/libgnat/g-socthi.ads
@@ -98,7 +98,7 @@ package GNAT.Sockets.Thin is
function C_Gethostname
(Name : System.Address;
- Namelen : C.int) return C.int;
+ Namelen : C.size_t) return C.int;
function C_Getpeername
(S : C.int;
@@ -129,13 +129,13 @@ package GNAT.Sockets.Thin is
function C_Recv
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int) return C.int;
function C_Recvfrom
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
From : System.Address;
Fromlen : not null access C.int) return C.int;
@@ -160,7 +160,7 @@ package GNAT.Sockets.Thin is
function C_Sendto
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
To : System.Address;
Tolen : C.int) return C.int;
diff --git a/gcc/ada/libgnat/g-socthi__vxworks.adb b/gcc/ada/libgnat/g-socthi__vxworks.adb
index 19a7c6fb821..548b9d3f623 100644
--- a/gcc/ada/libgnat/g-socthi__vxworks.adb
+++ b/gcc/ada/libgnat/g-socthi__vxworks.adb
@@ -78,14 +78,14 @@ package body GNAT.Sockets.Thin is
function Syscall_Recv
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int) return C.int;
pragma Import (C, Syscall_Recv, "recv");
function Syscall_Recvfrom
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
From : System.Address;
Fromlen : not null access C.int) return C.int;
@@ -106,17 +106,17 @@ package body GNAT.Sockets.Thin is
function Syscall_Send
(S : C.int;
Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int;
+ Len : C.size_t;
+ Flags : C.int) return System.CRTL.ssize_t;
pragma Import (C, Syscall_Send, "send");
function Syscall_Sendto
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
To : System.Address;
- Tolen : C.int) return C.int;
+ Tolen : C.int) return System.CRTL.ssize_t;
pragma Import (C, Syscall_Sendto, "sendto");
function Syscall_Socket
@@ -252,7 +252,7 @@ package body GNAT.Sockets.Thin is
function C_Recv
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int) return C.int
is
Res : C.int;
@@ -277,7 +277,7 @@ package body GNAT.Sockets.Thin is
function C_Recvfrom
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
From : System.Address;
Fromlen : not null access C.int) return C.int
@@ -352,7 +352,7 @@ package body GNAT.Sockets.Thin is
function C_Sendto
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
To : System.Address;
Tolen : C.int) return C.int
@@ -369,12 +369,12 @@ package body GNAT.Sockets.Thin is
-- support sendto(2) calls on connected sockets with a null
-- destination address, so use send(2) instead in that case.
- Res := Syscall_Send (S, Msg, Len, Flags);
+ Res := C.int (Syscall_Send (S, Msg, Len, Flags));
-- Normal case where destination address is non-null
else
- Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
+ Res := C.int (Syscall_Sendto (S, Msg, Len, Flags, To, Tolen));
end if;
exit when SOSC.Thread_Blocking_IO
diff --git a/gcc/ada/libgnat/g-socthi__vxworks.ads b/gcc/ada/libgnat/g-socthi__vxworks.ads
index b49cc76efff..704ec0ade53 100644
--- a/gcc/ada/libgnat/g-socthi__vxworks.ads
+++ b/gcc/ada/libgnat/g-socthi__vxworks.ads
@@ -95,7 +95,7 @@ package GNAT.Sockets.Thin is
function C_Gethostname
(Name : System.Address;
- Namelen : C.int) return C.int;
+ Namelen : C.size_t) return C.int;
function C_Getpeername
(S : C.int;
@@ -126,13 +126,13 @@ package GNAT.Sockets.Thin is
function C_Recv
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int) return C.int;
function C_Recvfrom
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
From : System.Address;
Fromlen : not null access C.int) return C.int;
@@ -157,7 +157,7 @@ package GNAT.Sockets.Thin is
function C_Sendto
(S : C.int;
Msg : System.Address;
- Len : C.int;
+ Len : C.size_t;
Flags : C.int;
To : System.Address;
Tolen : C.int) return C.int;
diff --git a/gcc/ada/libgnat/g-sothco.ads b/gcc/ada/libgnat/g-sothco.ads
index cc7bccdcb45..e30af189d3a 100644
--- a/gcc/ada/libgnat/g-sothco.ads
+++ b/gcc/ada/libgnat/g-sothco.ads
@@ -281,7 +281,7 @@ package GNAT.Sockets.Thin_Common is
(Name : C.char_array;
Ret : not null access Hostent;
Buf : System.Address;
- Buflen : C.int;
+ Buflen : C.size_t;
H_Errnop : not null access C.int) return C.int;
function C_Gethostbyaddr
@@ -290,7 +290,7 @@ package GNAT.Sockets.Thin_Common is
Addr_Type : C.int;
Ret : not null access Hostent;
Buf : System.Address;
- Buflen : C.int;
+ Buflen : C.size_t;
H_Errnop : not null access C.int) return C.int;
function C_Getservbyname
@@ -298,14 +298,14 @@ package GNAT.Sockets.Thin_Common is
Proto : C.char_array;
Ret : not null access Servent;
Buf : System.Address;
- Buflen : C.int) return C.int;
+ Buflen : C.size_t) return C.int;
function C_Getservbyport
(Port : C.int;
Proto : C.char_array;
Ret : not null access Servent;
Buf : System.Address;
- Buflen : C.int) return C.int;
+ Buflen : C.size_t) return C.int;
Address_Size : constant := Standard'Address_Size;
diff --git a/gcc/ada/libgnat/s-io.adb b/gcc/ada/libgnat/s-io.adb
index 608bbe3c992..23301e9c883 100644
--- a/gcc/ada/libgnat/s-io.adb
+++ b/gcc/ada/libgnat/s-io.adb
@@ -65,16 +65,16 @@ package body System.IO is
end Put;
procedure Put (C : Character) is
- procedure Put_Char (C : Character);
+ procedure Put_Char (C : Integer);
pragma Import (C, Put_Char, "put_char");
- procedure Put_Char_Stderr (C : Character);
+ procedure Put_Char_Stderr (C : Integer);
pragma Import (C, Put_Char_Stderr, "put_char_stderr");
begin
case Current_Out is
- when Stdout => Put_Char (C);
- when Stderr => Put_Char_Stderr (C);
+ when Stdout => Put_Char (Character'Pos (C));
+ when Stderr => Put_Char_Stderr (Character'Pos (C));
end case;
end Put;
More information about the Gcc-cvs
mailing list