Commit f26d5cd3 by Arnaud Charlet

[multiple changes]

2009-06-19  Thomas Quinot  <quinot@adacore.com>

	* i-vxwoio.ads: Add comments

2009-06-19  Thomas Quinot  <quinot@adacore.com>

	* socket.c, g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
	g-socthi-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads,
	g-socthi.adb, g-socthi.ads, g-socket.adb, g-sothco.ads
	(GNAT.Sockets.Thin.C_Ioctl): Rename to Socket_Ioctl.
	(GNAT.Sockets.Thin.Socket_Ioctl): Use new function
	Thin_Common.Socket_Ioctl.
	(GNAT.Sockets.Thin_Common.Socket_Ioctl): Binding to new C wrapper
	__gnat_socket_ioctl.
	(__gnat_socket_ioctl): Wrapper for ioctl(2) called with a single int*
	argument after the file descriptor and request code.

2009-06-19  Robert Dewar  <dewar@adacore.com>

	* checks.adb: Minor reformatting

From-SVN: r148694
parent 1abad480
2009-06-19 Thomas Quinot <quinot@adacore.com>
* i-vxwoio.ads: Add comments
2009-06-19 Thomas Quinot <quinot@adacore.com>
* socket.c, g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
g-socthi-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads,
g-socthi.adb, g-socthi.ads, g-socket.adb, g-sothco.ads
(GNAT.Sockets.Thin.C_Ioctl): Rename to Socket_Ioctl.
(GNAT.Sockets.Thin.Socket_Ioctl): Use new function
Thin_Common.Socket_Ioctl.
(GNAT.Sockets.Thin_Common.Socket_Ioctl): Binding to new C wrapper
__gnat_socket_ioctl.
(__gnat_socket_ioctl): Wrapper for ioctl(2) called with a single int*
argument after the file descriptor and request code.
2009-06-19 Robert Dewar <dewar@adacore.com>
* checks.adb: Minor reformatting
2009-06-19 Jose Ruiz <ruiz@adacore.com> 2009-06-19 Jose Ruiz <ruiz@adacore.com>
* env.c (__gnat_environ): RTX does not support this functionality. * env.c (__gnat_environ): RTX does not support this functionality.
......
...@@ -3324,7 +3324,7 @@ package body Checks is ...@@ -3324,7 +3324,7 @@ package body Checks is
case Attribute_Name (N) is case Attribute_Name (N) is
-- For Pos/Val attributes, we can refine the range using the -- For Pos/Val attributes, we can refine the range using the
-- possible range of values of the attribute expression -- possible range of values of the attribute expression.
when Name_Pos | Name_Val => when Name_Pos | Name_Val =>
Determine_Range Determine_Range
......
...@@ -707,10 +707,8 @@ package body GNAT.Sockets is ...@@ -707,10 +707,8 @@ package body GNAT.Sockets is
null; null;
end case; end case;
Res := C_Ioctl Res := Socket_Ioctl
(C.int (Socket), (C.int (Socket), Requests (Request.Name), Arg'Unchecked_Access);
Requests (Request.Name),
Arg'Unchecked_Access);
if Res = Failure then if Res = Failure then
Raise_Socket_Error (Socket_Errno); Raise_Socket_Error (Socket_Errno);
......
...@@ -247,6 +247,19 @@ package body GNAT.Sockets.Thin is ...@@ -247,6 +247,19 @@ package body GNAT.Sockets.Thin is
return Res; return Res;
end C_Connect; end C_Connect;
------------------
-- Socket_Ioctl --
------------------
function Socket_Ioctl
(S : C.int;
Req : C.int;
Arg : access C.int) return C.int
is
begin
return C_Ioctl (S, Req, Arg);
end Socket_Ioctl;
--------------- ---------------
-- C_Recvmsg -- -- C_Recvmsg --
--------------- ---------------
......
...@@ -120,10 +120,10 @@ package GNAT.Sockets.Thin is ...@@ -120,10 +120,10 @@ package GNAT.Sockets.Thin is
Optval : System.Address; Optval : System.Address;
Optlen : not null access C.int) return C.int; Optlen : not null access C.int) return C.int;
function C_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : C.int;
Arg : access C.int) return C.int; Arg : access C.int) return C.int;
function C_Listen function C_Listen
(S : C.int; (S : C.int;
...@@ -234,7 +234,6 @@ private ...@@ -234,7 +234,6 @@ private
pragma Import (Stdcall, C_Getpeername, "getpeername"); pragma Import (Stdcall, C_Getpeername, "getpeername");
pragma Import (Stdcall, C_Getsockname, "getsockname"); pragma Import (Stdcall, C_Getsockname, "getsockname");
pragma Import (Stdcall, C_Getsockopt, "getsockopt"); pragma Import (Stdcall, C_Getsockopt, "getsockopt");
pragma Import (Stdcall, C_Ioctl, "ioctlsocket");
pragma Import (Stdcall, C_Listen, "listen"); pragma Import (Stdcall, C_Listen, "listen");
pragma Import (Stdcall, C_Recv, "recv"); pragma Import (Stdcall, C_Recv, "recv");
pragma Import (Stdcall, C_Recvfrom, "recvfrom"); pragma Import (Stdcall, C_Recvfrom, "recvfrom");
......
...@@ -74,12 +74,6 @@ package body GNAT.Sockets.Thin is ...@@ -74,12 +74,6 @@ package body GNAT.Sockets.Thin is
Namelen : C.int) return C.int; Namelen : C.int) return C.int;
pragma Import (C, Syscall_Connect, "connect"); pragma Import (C, Syscall_Connect, "connect");
function Syscall_Ioctl
(S : C.int;
Req : C.int;
Arg : access C.int) return C.int;
pragma Import (C, Syscall_Ioctl, "ioctl");
function Syscall_Recv function Syscall_Recv
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -153,11 +147,11 @@ package body GNAT.Sockets.Thin is ...@@ -153,11 +147,11 @@ package body GNAT.Sockets.Thin is
and then R /= Failure and then R /= Failure
then then
-- A socket inherits the properties of its server, especially -- A socket inherits the properties of its server, especially
-- the FIONBIO flag. Do not use C_Ioctl as this subprogram -- the FIONBIO flag. Do not use Socket_Ioctl as this subprogram
-- tracks sockets set in non-blocking mode by user. -- tracks sockets set in non-blocking mode by user.
Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S)); Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
end if; end if;
return R; return R;
...@@ -220,26 +214,24 @@ package body GNAT.Sockets.Thin is ...@@ -220,26 +214,24 @@ package body GNAT.Sockets.Thin is
end if; end if;
end C_Connect; end C_Connect;
------------- ------------------
-- C_Ioctl -- -- Socket_Ioctl --
------------- ------------------
function C_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : C.int;
Arg : access C.int) return C.int Arg : access C.int) return C.int
is is
begin begin
if not SOSC.Thread_Blocking_IO if not SOSC.Thread_Blocking_IO and then Req = SOSC.FIONBIO then
and then Req = SOSC.FIONBIO
then
if Arg.all /= 0 then if Arg.all /= 0 then
Set_Non_Blocking_Socket (S, True); Set_Non_Blocking_Socket (S, True);
end if; end if;
end if; end if;
return Syscall_Ioctl (S, Req, Arg); return C_Ioctl (S, Req, Arg);
end C_Ioctl; end Socket_Ioctl;
------------ ------------
-- C_Recv -- -- C_Recv --
...@@ -405,10 +397,10 @@ package body GNAT.Sockets.Thin is ...@@ -405,10 +397,10 @@ package body GNAT.Sockets.Thin is
if not SOSC.Thread_Blocking_IO if not SOSC.Thread_Blocking_IO
and then R /= Failure and then R /= Failure
then then
-- Do not use C_Ioctl as this subprogram tracks sockets set -- Do not use Socket_Ioctl as this subprogram tracks sockets set
-- in non-blocking mode by user. -- in non-blocking mode by user.
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
Set_Non_Blocking_Socket (R, False); Set_Non_Blocking_Socket (R, False);
end if; end if;
......
...@@ -123,10 +123,10 @@ package GNAT.Sockets.Thin is ...@@ -123,10 +123,10 @@ package GNAT.Sockets.Thin is
Optval : System.Address; Optval : System.Address;
Optlen : not null access C.int) return C.int; Optlen : not null access C.int) return C.int;
function C_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : C.int;
Arg : access C.int) return C.int; Arg : access C.int) return C.int;
function C_Listen function C_Listen
(S : C.int; (S : C.int;
......
...@@ -80,12 +80,6 @@ package body GNAT.Sockets.Thin is ...@@ -80,12 +80,6 @@ package body GNAT.Sockets.Thin is
Namelen : C.int) return C.int; Namelen : C.int) return C.int;
pragma Import (C, Syscall_Connect, "connect"); pragma Import (C, Syscall_Connect, "connect");
function Syscall_Ioctl
(S : C.int;
Req : C.int;
Arg : access C.int) return C.int;
pragma Import (C, Syscall_Ioctl, "ioctl");
function Syscall_Recv function Syscall_Recv
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -161,11 +155,11 @@ package body GNAT.Sockets.Thin is ...@@ -161,11 +155,11 @@ package body GNAT.Sockets.Thin is
and then R /= Failure and then R /= Failure
then then
-- A socket inherits the properties of its server especially -- A socket inherits the properties of its server especially
-- the FIONBIO flag. Do not use C_Ioctl as this subprogram -- the FIONBIO flag. Do not use Socket_Ioctl as this subprogram
-- tracks sockets set in non-blocking mode by user. -- tracks sockets set in non-blocking mode by user.
Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S)); Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); Res := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
-- Is it OK to ignore result ??? -- Is it OK to ignore result ???
end if; end if;
...@@ -230,26 +224,24 @@ package body GNAT.Sockets.Thin is ...@@ -230,26 +224,24 @@ package body GNAT.Sockets.Thin is
end if; end if;
end C_Connect; end C_Connect;
------------- ------------------
-- C_Ioctl -- -- Socket_Ioctl --
------------- ------------------
function C_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : C.int;
Arg : access C.int) return C.int Arg : access C.int) return C.int
is is
begin begin
if not SOSC.Thread_Blocking_IO if not SOSC.Thread_Blocking_IO and then Req = SOSC.FIONBIO then
and then Req = SOSC.FIONBIO
then
if Arg.all /= 0 then if Arg.all /= 0 then
Set_Non_Blocking_Socket (S, True); Set_Non_Blocking_Socket (S, True);
end if; end if;
end if; end if;
return Syscall_Ioctl (S, Req, Arg); return C_Ioctl (S, Req, Arg);
end C_Ioctl; end Socket_Ioctl;
------------ ------------
-- C_Recv -- -- C_Recv --
...@@ -399,10 +391,10 @@ package body GNAT.Sockets.Thin is ...@@ -399,10 +391,10 @@ package body GNAT.Sockets.Thin is
if not SOSC.Thread_Blocking_IO if not SOSC.Thread_Blocking_IO
and then R /= Failure and then R /= Failure
then then
-- Do not use C_Ioctl as this subprogram tracks sockets set -- Do not use Socket_Ioctl as this subprogram tracks sockets set
-- in non-blocking mode by user. -- in non-blocking mode by user.
Res := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); Res := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
-- Is it OK to ignore result ??? -- Is it OK to ignore result ???
Set_Non_Blocking_Socket (R, False); Set_Non_Blocking_Socket (R, False);
end if; end if;
......
...@@ -121,10 +121,10 @@ package GNAT.Sockets.Thin is ...@@ -121,10 +121,10 @@ package GNAT.Sockets.Thin is
Optval : System.Address; Optval : System.Address;
Optlen : not null access C.int) return C.int; Optlen : not null access C.int) return C.int;
function C_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : C.int;
Arg : access C.int) return C.int; Arg : access C.int) return C.int;
function C_Listen function C_Listen
(S : C.int; (S : C.int;
......
...@@ -76,12 +76,6 @@ package body GNAT.Sockets.Thin is ...@@ -76,12 +76,6 @@ package body GNAT.Sockets.Thin is
Namelen : C.int) return C.int; Namelen : C.int) return C.int;
pragma Import (C, Syscall_Connect, "connect"); pragma Import (C, Syscall_Connect, "connect");
function Syscall_Ioctl
(S : C.int;
Req : C.int;
Arg : access C.int) return C.int;
pragma Import (C, Syscall_Ioctl, "ioctl");
function Syscall_Recv function Syscall_Recv
(S : C.int; (S : C.int;
Msg : System.Address; Msg : System.Address;
...@@ -165,11 +159,11 @@ package body GNAT.Sockets.Thin is ...@@ -165,11 +159,11 @@ package body GNAT.Sockets.Thin is
and then R /= Failure and then R /= Failure
then then
-- A socket inherits the properties ot its server especially -- A socket inherits the properties ot its server especially
-- the FIONBIO flag. Do not use C_Ioctl as this subprogram -- the FIONBIO flag. Do not use Socket_Ioctl as this subprogram
-- tracks sockets set in non-blocking mode by user. -- tracks sockets set in non-blocking mode by user.
Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S)); Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
end if; end if;
Disable_SIGPIPE (R); Disable_SIGPIPE (R);
...@@ -235,26 +229,24 @@ package body GNAT.Sockets.Thin is ...@@ -235,26 +229,24 @@ package body GNAT.Sockets.Thin is
end if; end if;
end C_Connect; end C_Connect;
------------- ------------------
-- C_Ioctl -- -- Socket_Ioctl --
------------- ------------------
function C_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : C.int;
Arg : access C.int) return C.int Arg : access C.int) return C.int
is is
begin begin
if not SOSC.Thread_Blocking_IO if not SOSC.Thread_Blocking_IO and then Req = SOSC.FIONBIO then
and then Req = SOSC.FIONBIO
then
if Arg.all /= 0 then if Arg.all /= 0 then
Set_Non_Blocking_Socket (S, True); Set_Non_Blocking_Socket (S, True);
end if; end if;
end if; end if;
return Syscall_Ioctl (S, Req, Arg); return C_Ioctl (S, Req, Arg);
end C_Ioctl; end Socket_Ioctl;
------------ ------------
-- C_Recv -- -- C_Recv --
...@@ -404,10 +396,10 @@ package body GNAT.Sockets.Thin is ...@@ -404,10 +396,10 @@ package body GNAT.Sockets.Thin is
if not SOSC.Thread_Blocking_IO if not SOSC.Thread_Blocking_IO
and then R /= Failure and then R /= Failure
then then
-- Do not use C_Ioctl as this subprogram tracks sockets set -- Do not use Socket_Ioctl as this subprogram tracks sockets set
-- in non-blocking mode by user. -- in non-blocking mode by user.
Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access); Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
Set_Non_Blocking_Socket (R, False); Set_Non_Blocking_Socket (R, False);
end if; end if;
Disable_SIGPIPE (R); Disable_SIGPIPE (R);
......
...@@ -122,10 +122,10 @@ package GNAT.Sockets.Thin is ...@@ -122,10 +122,10 @@ package GNAT.Sockets.Thin is
Optval : System.Address; Optval : System.Address;
Optlen : not null access C.int) return C.int; Optlen : not null access C.int) return C.int;
function C_Ioctl function Socket_Ioctl
(S : C.int; (S : C.int;
Req : C.int; Req : C.int;
Arg : access C.int) return C.int; Arg : access C.int) return C.int;
function C_Listen function C_Listen
(S : C.int; (S : C.int;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2008, AdaCore -- -- Copyright (C) 2008-2009, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -321,6 +321,11 @@ package GNAT.Sockets.Thin_Common is ...@@ -321,6 +321,11 @@ package GNAT.Sockets.Thin_Common is
Cp : C.Strings.chars_ptr; Cp : C.Strings.chars_ptr;
Inp : System.Address) return C.int; Inp : System.Address) return C.int;
function C_Ioctl
(Fd : C.int;
Req : C.int;
Arg : access C.int) return C.int;
private private
pragma Import (C, Get_Socket_From_Set, "__gnat_get_socket_from_set"); pragma Import (C, Get_Socket_From_Set, "__gnat_get_socket_from_set");
pragma Import (C, Is_Socket_In_Set, "__gnat_is_socket_in_set"); pragma Import (C, Is_Socket_In_Set, "__gnat_is_socket_in_set");
...@@ -328,5 +333,6 @@ private ...@@ -328,5 +333,6 @@ private
pragma Import (C, Insert_Socket_In_Set, "__gnat_insert_socket_in_set"); pragma Import (C, Insert_Socket_In_Set, "__gnat_insert_socket_in_set");
pragma Import (C, Remove_Socket_From_Set, "__gnat_remove_socket_from_set"); pragma Import (C, Remove_Socket_From_Set, "__gnat_remove_socket_from_set");
pragma Import (C, Reset_Socket_Set, "__gnat_reset_socket_set"); pragma Import (C, Reset_Socket_Set, "__gnat_reset_socket_set");
pragma Import (C, C_Ioctl, "__gnat_socket_ioctl");
pragma Import (C, Inet_Pton, SOSC.Inet_Pton_Linkname); pragma Import (C, Inet_Pton, SOSC.Inet_Pton_Linkname);
end GNAT.Sockets.Thin_Common; end GNAT.Sockets.Thin_Common;
...@@ -53,8 +53,8 @@ package Interfaces.VxWorks.IO is ...@@ -53,8 +53,8 @@ package Interfaces.VxWorks.IO is
type IOOPT is mod 2 ** int'Size; type IOOPT is mod 2 ** int'Size;
-- Type of the option codes in ioctl -- Type of the option codes in ioctl
-- ioctl function codes -- ioctl function codes (for more information see ioLib.h)
-- For more information see ioLib.h -- These values could be generated automatically in System.OS_Constants???
FIONREAD : constant FUNCODE := 1; FIONREAD : constant FUNCODE := 1;
FIOFLUSH : constant FUNCODE := 2; FIOFLUSH : constant FUNCODE := 2;
...@@ -129,6 +129,9 @@ package Interfaces.VxWorks.IO is ...@@ -129,6 +129,9 @@ package Interfaces.VxWorks.IO is
function ioctl (Fd : int; Function_Code : FUNCODE; Arg : IOOPT) return int; function ioctl (Fd : int; Function_Code : FUNCODE; Arg : IOOPT) return int;
pragma Import (C, ioctl, "ioctl"); pragma Import (C, ioctl, "ioctl");
-- Binding to the C routine ioctl -- Binding to the C routine ioctl
--
-- Note: we are taking advantage of the fact that on currently supported
-- VxWorks targets, it is fine to directly bind to a variadic C function.
------------------------------ ------------------------------
-- Control of Get_Immediate -- -- Control of Get_Immediate --
......
...@@ -73,6 +73,7 @@ extern fd_set *__gnat_new_socket_set (fd_set *); ...@@ -73,6 +73,7 @@ extern fd_set *__gnat_new_socket_set (fd_set *);
extern void __gnat_remove_socket_from_set (fd_set *, int); extern void __gnat_remove_socket_from_set (fd_set *, int);
extern void __gnat_reset_socket_set (fd_set *); extern void __gnat_reset_socket_set (fd_set *);
extern int __gnat_get_h_errno (void); extern int __gnat_get_h_errno (void);
extern int __gnat_socket_ioctl (int, int, int *);
#if defined (__vxworks) || defined (_WIN32) #if defined (__vxworks) || defined (_WIN32)
extern int __gnat_inet_pton (int, const char *, void *); extern int __gnat_inet_pton (int, const char *, void *);
#endif #endif
...@@ -409,6 +410,17 @@ __gnat_get_h_errno (void) { ...@@ -409,6 +410,17 @@ __gnat_get_h_errno (void) {
#endif #endif
} }
/* Wrapper for ioctl(2), which is a variadic function */
int
__gnat_socket_ioctl (int fd, int req, int *arg) {
#if defined (_WIN32)
return ioctlsocket (fd, req, arg);
#else
return ioctl (fd, req, arg);
#endif
}
#ifndef HAVE_INET_PTON #ifndef HAVE_INET_PTON
#ifdef VMS #ifdef VMS
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment