From: Arnaud Charlet Date: Wed, 22 Apr 2020 10:11:48 +0000 (-0400) Subject: [Ada] Profile mismatch between C and Ada functions X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c9a56fd316d254f3155e6eb37b4f662c5fbf6960;p=gcc.git [Ada] Profile mismatch between C and Ada functions 2020-06-18 Arnaud Charlet 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 --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;