Commit f983388f by Thomas Quinot Committed by Arnaud Charlet

Makefile.rtl (GNAT.Sockets.Thin_Common): New unit.

2008-05-20  Thomas Quinot  <quinot@adacore.com>

	* Makefile.rtl (GNAT.Sockets.Thin_Common): New unit.

	* g-sttsne-vxworks.adb: Add missing dependency on Sockets.Constants.
	Add missing "with" of Ada.Unchecked_Conversion

	* g-soccon-linux-ppc.ads, g-soccon-linux-64.ads, g-soccon-lynxos.ads, 
	g-soccon-linux-x86.ads, g-soccon-hpux-ia64.ads, 
	g-soccon-solaris-64.ads, g-soccon-tru64.ads, g-soccon-aix.ads, 
	g-soccon-irix.ads, g-soccon-hpux.ads, g-soccon-solaris.ads, 
	g-soccon-vms.ads, g-soccon-mingw.ads, g-soccon-vxworks.ads, 
	g-socthi-vxworks.adb, g-soccon-freebsd.ads, g-soccon.ads: 
	Move common code out of GNAT.Sockets.Thin implementations and into
	Thin_Common.
	New constant SIZEOF_fd_set
	New flag Has_Sockaddr_Len
	New constants SIZEOF_sockaddr_in, SIZEOF_sockaddr_in6

	* g-stsifd-sockets.adb
	(Create): Remove call to Set_Length; use Set_Family to set the family
	and (on appropriate platforms) length fields in struct sockaddr.

	* g-socthi.adb, g-socthi.ads, g-socthi-vms.ads, g-socthi-vms.adb, 
	g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi-vxworks.adb, 
	g-soccon-darwin.ads, g-soccon-darwin.ads: New constant SIZEOF_fd_set
	Move common code out of GNAT.Sockets.Thin implementations and into
	Thin_Common.

	* g-socket.ads, g-socket.adb: 
	Move common code out of GNAT.Sockets.Thin implementations and into
	Thin_Common.
	(Connect_Socket, Accept_Socket): Provide new versions of these two
	routines that operate with a user specified timeout.
	(Bind_Socket, Connect_Socket, Send_Socket): Remove calls to Set_Length,
	this is now handled automatically by Set_Family on platforms that
	require it.

	* gen-soccon.c: 
	Move common code out of GNAT.Sockets.Thin implementations and into
	Thin_Common.
	(SIZEOF_sockaddr_in6): On platforms where IPv6 is not supported, define
	this constant to 0 (not -1) because we use it to initialize an
	unsigned_char value.
	Align values for numeric constants only.
	Handle the case of systems that do not support AF_INET6.
	New constant SIZEOF_fd_set
	New flag Has_Sockaddr_Len
	New constants SIZEOF_sockaddr_in, SIZEOF_sockaddr_in6

	* gsocket.h: New flag Has_Sockaddr_Len
	New constants SIZEOF_sockaddr_in, SIZEOF_sockaddr_in6

From-SVN: r135612
parent 01902653
......@@ -368,6 +368,7 @@ GNATRTL_NONTASKING_OBJS= \
g-socket$(objext) \
g-socthi$(objext) \
g-soliop$(objext) \
g-sothco$(objext) \
g-souinf$(objext) \
g-speche$(objext) \
g-spchge$(objext) \
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2007, AdaCore --
-- Copyright (C) 2001-2008, AdaCore --
-- --
-- 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- --
......@@ -39,10 +39,12 @@
with Interfaces.C.Strings; use Interfaces.C.Strings;
with System; use System;
with GNAT.Sockets.Constants;
package body GNAT.Sockets.Thin is
use type C.unsigned;
use type C.int;
WSAData_Dummy : array (1 .. 512) of C.int;
......@@ -294,7 +296,7 @@ package body GNAT.Sockets.Thin is
RFS : constant Fd_Set_Access := Readfds;
WFS : constant Fd_Set_Access := Writefds;
WFSC : Fd_Set_Access := No_Fd_Set;
WFSC : Fd_Set_Access := No_Fd_Set_Access;
EFS : Fd_Set_Access := Exceptfds;
Res : C.int;
S : aliased C.int;
......@@ -310,10 +312,10 @@ package body GNAT.Sockets.Thin is
-- the initial write fd set, then move the socket from the
-- exception fd set to the write fd set.
if WFS /= No_Fd_Set then
if WFS /= No_Fd_Set_Access then
-- Add any socket present in write fd set into exception fd set
if EFS = No_Fd_Set then
if EFS = No_Fd_Set_Access then
EFS := New_Socket_Set (WFS);
else
......@@ -337,7 +339,7 @@ package body GNAT.Sockets.Thin is
Res := Standard_Select (Nfds, RFS, WFS, EFS, Timeout);
if EFS /= No_Fd_Set then
if EFS /= No_Fd_Set_Access then
declare
EFSC : constant Fd_Set_Access := New_Socket_Set (EFS);
Flag : constant C.int := Constants.MSG_PEEK + Constants.MSG_OOB;
......@@ -372,7 +374,7 @@ package body GNAT.Sockets.Thin is
-- set. Otherwise, ignore this event since the user
-- is not watching for it.
if WFSC /= No_Fd_Set
if WFSC /= No_Fd_Set_Access
and then (Is_Socket_In_Set (WFSC, S) /= 0)
then
Insert_Socket_In_Set (WFS, S);
......@@ -383,14 +385,14 @@ package body GNAT.Sockets.Thin is
Free_Socket_Set (EFSC);
end;
if Exceptfds = No_Fd_Set then
if Exceptfds = No_Fd_Set_Access then
Free_Socket_Set (EFS);
end if;
end if;
-- Free any copy of write fd set
if WFSC /= No_Fd_Set then
if WFSC /= No_Fd_Set_Access then
Free_Socket_Set (WFSC);
end if;
......@@ -473,57 +475,6 @@ package body GNAT.Sockets.Thin is
end if;
end Initialize;
-----------------
-- Set_Address --
-----------------
procedure Set_Address
(Sin : Sockaddr_In_Access;
Address : In_Addr)
is
begin
Sin.Sin_Addr := Address;
end Set_Address;
----------------
-- Set_Family --
----------------
procedure Set_Family
(Sin : Sockaddr_In_Access;
Family : C.int)
is
begin
Sin.Sin_Family := C.unsigned_short (Family);
end Set_Family;
----------------
-- Set_Length --
----------------
procedure Set_Length
(Sin : Sockaddr_In_Access;
Len : C.int)
is
pragma Unreferenced (Sin);
pragma Unreferenced (Len);
begin
null;
end Set_Length;
--------------
-- Set_Port --
--------------
procedure Set_Port
(Sin : Sockaddr_In_Access;
Port : C.unsigned_short)
is
begin
Sin.Sin_Port := Port;
end Set_Port;
--------------------
-- Signalling_Fds --
--------------------
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2007, AdaCore --
-- Copyright (C) 2001-2008, AdaCore --
-- --
-- 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- --
......@@ -37,22 +37,17 @@
-- This version is for NT
with Interfaces.C.Pointers;
with Interfaces.C.Strings;
with GNAT.Sockets.Constants;
with GNAT.Sockets.Thin_Common;
with System;
package GNAT.Sockets.Thin is
package C renames Interfaces.C;
use type C.int;
-- So that we can declare the Failure constant below
use Thin_Common;
Success : constant C.int := 0;
Failure : constant C.int := -1;
package C renames Interfaces.C;
function Socket_Errno return Integer;
-- Returns last socket error number
......@@ -77,158 +72,6 @@ package GNAT.Sockets.Thin is
end Host_Error_Messages;
subtype Fd_Set_Access is System.Address;
No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
type time_t is
range -2 ** (8 * Constants.SIZEOF_tv_sec - 1)
.. 2 ** (8 * Constants.SIZEOF_tv_sec - 1) - 1;
for time_t'Size use 8 * Constants.SIZEOF_tv_sec;
pragma Convention (C, time_t);
type suseconds_t is
range -2 ** (8 * Constants.SIZEOF_tv_usec - 1)
.. 2 ** (8 * Constants.SIZEOF_tv_usec - 1) - 1;
for suseconds_t'Size use 8 * Constants.SIZEOF_tv_usec;
pragma Convention (C, suseconds_t);
type Timeval is record
Tv_Sec : time_t;
Tv_Usec : suseconds_t;
end record;
pragma Convention (C, Timeval);
type Timeval_Access is access all Timeval;
pragma Convention (C, Timeval_Access);
Immediat : constant Timeval := (0, 0);
type Int_Access is access all C.int;
pragma Convention (C, Int_Access);
-- Access to C integers
type Chars_Ptr_Array is array (C.size_t range <>) of
aliased C.Strings.chars_ptr;
package Chars_Ptr_Pointers is
new C.Pointers (C.size_t, C.Strings.chars_ptr, Chars_Ptr_Array,
C.Strings.Null_Ptr);
-- Arrays of C (char *)
type In_Addr is record
S_B1, S_B2, S_B3, S_B4 : C.unsigned_char;
end record;
for In_Addr'Alignment use C.int'Alignment;
pragma Convention (C, In_Addr);
-- IPv4 address, represented as a network-order C.int. Note that the
-- underlying operating system may assume that values of this type have
-- C.int alignment, so we need to provide a suitable alignment clause here.
type In_Addr_Access is access all In_Addr;
pragma Convention (C, In_Addr_Access);
-- Access to internet address
Inaddr_Any : aliased constant In_Addr := (others => 0);
-- Any internet address (all the interfaces)
type In_Addr_Access_Array is array (C.size_t range <>)
of aliased In_Addr_Access;
pragma Convention (C, In_Addr_Access_Array);
package In_Addr_Access_Pointers is
new C.Pointers (C.size_t, In_Addr_Access, In_Addr_Access_Array, null);
-- Array of internet addresses
type Sockaddr is record
Sa_Family : C.unsigned_short;
Sa_Data : C.char_array (1 .. 14);
end record;
pragma Convention (C, Sockaddr);
-- Socket address
type Sockaddr_Access is access all Sockaddr;
pragma Convention (C, Sockaddr_Access);
-- Access to socket address
type Sockaddr_In is record
Sin_Family : C.unsigned_short := Constants.AF_INET;
Sin_Port : C.unsigned_short := 0;
Sin_Addr : In_Addr := Inaddr_Any;
Sin_Zero : C.char_array (1 .. 8) := (others => C.char'Val (0));
end record;
pragma Convention (C, Sockaddr_In);
-- Internet socket address
type Sockaddr_In_Access is access all Sockaddr_In;
pragma Convention (C, Sockaddr_In_Access);
-- Access to internet socket address
procedure Set_Length
(Sin : Sockaddr_In_Access;
Len : C.int);
pragma Inline (Set_Length);
-- Set Sin.Sin_Length to Len.
-- On this platform, nothing is done as there is no such field.
procedure Set_Family
(Sin : Sockaddr_In_Access;
Family : C.int);
pragma Inline (Set_Family);
-- Set Sin.Sin_Family to Family
procedure Set_Port
(Sin : Sockaddr_In_Access;
Port : C.unsigned_short);
pragma Inline (Set_Port);
-- Set Sin.Sin_Port to Port
procedure Set_Address
(Sin : Sockaddr_In_Access;
Address : In_Addr);
pragma Inline (Set_Address);
-- Set Sin.Sin_Addr to Address
type Hostent is record
H_Name : C.Strings.chars_ptr;
H_Aliases : Chars_Ptr_Pointers.Pointer;
H_Addrtype : C.short;
H_Length : C.short;
H_Addr_List : In_Addr_Access_Pointers.Pointer;
end record;
pragma Convention (C, Hostent);
-- Host entry
type Hostent_Access is access all Hostent;
pragma Convention (C, Hostent_Access);
-- Access to host entry
type Servent is record
S_Name : C.Strings.chars_ptr;
S_Aliases : Chars_Ptr_Pointers.Pointer;
S_Port : C.int;
S_Proto : C.Strings.chars_ptr;
end record;
pragma Convention (C, Servent);
-- Service entry
type Servent_Access is access all Servent;
pragma Convention (C, Servent_Access);
-- Access to service entry
type Two_Ints is array (0 .. 1) of C.int;
pragma Convention (C, Two_Ints);
-- Container for two int values
subtype Fd_Pair is Two_Ints;
-- Two_Ints as used for Create_Signalling_Fds: a pair of connected file
-- descriptors, one of which (the "read end" of the connection) being used
-- for reading, the other one (the "write end") being used for writing.
Read_End : constant := 0;
Write_End : constant := 1;
-- Indices into an Fd_Pair value providing access to each of the connected
-- file descriptors.
--------------------------------
-- Standard library functions --
--------------------------------
......@@ -382,55 +225,6 @@ package GNAT.Sockets.Thin is
end Signalling_Fds;
----------------------------
-- Socket sets management --
----------------------------
procedure Free_Socket_Set
(Set : Fd_Set_Access);
-- Free system-dependent socket set
procedure Get_Socket_From_Set
(Set : Fd_Set_Access;
Socket : Int_Access;
Last : Int_Access);
-- Get last socket in Socket and remove it from the socket set. The
-- parameter Last is a maximum value of the largest socket. This hint is
-- used to avoid scanning very large socket sets. After a call to
-- Get_Socket_From_Set, Last is set back to the real largest socket in the
-- socket set.
procedure Insert_Socket_In_Set
(Set : Fd_Set_Access;
Socket : C.int);
-- Insert socket in the socket set
function Is_Socket_In_Set
(Set : Fd_Set_Access;
Socket : C.int) return C.int;
-- Check whether Socket is in the socket set, return a non-zero
-- value if it is, zero if it is not.
procedure Last_Socket_In_Set
(Set : Fd_Set_Access;
Last : Int_Access);
-- Find the largest socket in the socket set. This is needed for select().
-- When Last_Socket_In_Set is called, parameter Last is a maximum value of
-- the largest socket. This hint is used to avoid scanning very large
-- socket sets. After the call, Last is set back to the real largest socket
-- in the socket set.
function New_Socket_Set
(Set : Fd_Set_Access) return Fd_Set_Access;
-- Allocate a new socket set which is a system-dependent structure and
-- initialize by copying Set if it is non-null, by making it empty
-- otherwise.
procedure Remove_Socket_From_Set
(Set : Fd_Set_Access;
Socket : C.int);
-- Remove socket from the socket set
procedure WSACleanup;
procedure Initialize;
......@@ -461,12 +255,4 @@ private
pragma Import (Stdcall, WSAStartup, "WSAStartup");
pragma Import (Stdcall, WSACleanup, "WSACleanup");
pragma Import (C, Free_Socket_Set, "__gnat_free_socket_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, Last_Socket_In_Set, "__gnat_last_socket_in_set");
pragma Import (C, New_Socket_Set, "__gnat_new_socket_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");
end GNAT.Sockets.Thin;
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2007, AdaCore --
-- Copyright (C) 2001-2008, AdaCore --
-- --
-- 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- --
......@@ -34,6 +34,7 @@
-- Temporary version for Alpha/VMS
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Sockets.Constants;
with GNAT.Task_Lock;
with Interfaces.C; use Interfaces.C;
......@@ -41,7 +42,7 @@ with Interfaces.C; use Interfaces.C;
package body GNAT.Sockets.Thin is
Non_Blocking_Sockets : constant Fd_Set_Access :=
New_Socket_Set (No_Socket_Set);
New_Socket_Set (No_Fd_Set_Access);
-- When this package is initialized with Process_Blocking_IO set
-- to True, sockets are set in non-blocking mode to avoid blocking
-- the whole process when a thread wants to perform a blocking IO
......@@ -182,15 +183,15 @@ package body GNAT.Sockets.Thin is
Now : aliased Timeval;
begin
WSet := New_Socket_Set (No_Socket_Set);
WSet := New_Socket_Set (No_Fd_Set_Access);
loop
Insert_Socket_In_Set (WSet, S);
Now := Immediat;
Res := C_Select
(S + 1,
No_Fd_Set,
No_Fd_Set_Access,
WSet,
No_Fd_Set,
No_Fd_Set_Access,
Now'Unchecked_Access);
exit when Res > 0;
......@@ -208,10 +209,9 @@ package body GNAT.Sockets.Thin is
Res := Syscall_Connect (S, Name, Namelen);
if Res = Failure
and then Errno = Constants.EISCONN
then
return Thin.Success;
if Res = Failure and then Errno = Constants.EISCONN then
return Thin_Common.Success;
else
return Res;
end if;
......@@ -410,35 +410,6 @@ package body GNAT.Sockets.Thin is
return R;
end Non_Blocking_Socket;
-----------------
-- Set_Address --
-----------------
procedure Set_Address (Sin : Sockaddr_In_Access; Address : In_Addr) is
begin
Sin.Sin_Addr := Address;
end Set_Address;
----------------
-- Set_Family --
----------------
procedure Set_Family (Sin : Sockaddr_In_Access; Family : C.int) is
begin
Sin.Sin_Family := C.unsigned_short (Family);
end Set_Family;
----------------
-- Set_Length --
----------------
procedure Set_Length (Sin : Sockaddr_In_Access; Len : C.int) is
pragma Unreferenced (Sin);
pragma Unreferenced (Len);
begin
null;
end Set_Length;
-----------------------------
-- Set_Non_Blocking_Socket --
-----------------------------
......@@ -456,15 +427,6 @@ package body GNAT.Sockets.Thin is
Task_Lock.Unlock;
end Set_Non_Blocking_Socket;
--------------
-- Set_Port --
--------------
procedure Set_Port (Sin : Sockaddr_In_Access; Port : C.unsigned_short) is
begin
Sin.Sin_Port := Port;
end Set_Port;
--------------------
-- Signalling_Fds --
--------------------
......
......@@ -37,26 +37,20 @@
-- This is the Alpha/VMS version
with Interfaces.C.Pointers;
with Interfaces.C.Strings;
with GNAT.OS_Lib;
with GNAT.Sockets.Constants;
with GNAT.Sockets.Thin_Common;
with System;
with System.Aux_DEC;
package GNAT.Sockets.Thin is
-- ??? more comments needed ???
package C renames Interfaces.C;
use type C.int;
-- This is so we can declare the Failure constant below
use Thin_Common;
Success : constant C.int := 0;
Failure : constant C.int := -1;
package C renames Interfaces.C;
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number
......@@ -81,162 +75,6 @@ package GNAT.Sockets.Thin is
end Host_Error_Messages;
subtype Fd_Set_Access is System.Aux_DEC.Short_Address;
No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
type time_t is
range -2 ** (8 * Constants.SIZEOF_tv_sec - 1)
.. 2 ** (8 * Constants.SIZEOF_tv_sec - 1) - 1;
for time_t'Size use 8 * Constants.SIZEOF_tv_sec;
pragma Convention (C, time_t);
type suseconds_t is
range -2 ** (8 * Constants.SIZEOF_tv_usec - 1)
.. 2 ** (8 * Constants.SIZEOF_tv_usec - 1) - 1;
for suseconds_t'Size use 8 * Constants.SIZEOF_tv_usec;
pragma Convention (C, suseconds_t);
type Timeval is record
Tv_Sec : time_t;
Tv_Usec : suseconds_t;
end record;
pragma Convention (C, Timeval);
type Timeval_Access is access all Timeval;
pragma Convention (C, Timeval_Access);
Immediat : constant Timeval := (0, 0);
type Int_Access is access all C.int;
pragma Convention (C, Int_Access);
-- Access to C integers
type Chars_Ptr_Array is array (C.size_t range <>) of
aliased C.Strings.chars_ptr;
package Chars_Ptr_Pointers is
new C.Pointers (C.size_t, C.Strings.chars_ptr, Chars_Ptr_Array,
C.Strings.Null_Ptr);
-- Arrays of C (char *)
type In_Addr is record
S_B1, S_B2, S_B3, S_B4 : C.unsigned_char;
end record;
for In_Addr'Alignment use C.int'Alignment;
pragma Convention (C, In_Addr);
-- IPv4 address, represented as a network-order C.int. Note that the
-- underlying operating system may assume that values of this type have
-- C.int alignment, so we need to provide a suitable alignment clause here.
type In_Addr_Access is access all In_Addr;
pragma Convention (C, In_Addr_Access);
-- Access to internet address
Inaddr_Any : aliased constant In_Addr := (others => 0);
-- Any internet address (all the interfaces)
type In_Addr_Access_Array is array (C.size_t range <>)
of aliased In_Addr_Access;
pragma Convention (C, In_Addr_Access_Array);
package In_Addr_Access_Pointers is
new C.Pointers (C.size_t, In_Addr_Access, In_Addr_Access_Array, null);
-- Array of internet addresses
type Sockaddr is record
Sa_Family : C.unsigned_short;
Sa_Data : C.char_array (1 .. 14);
end record;
pragma Convention (C, Sockaddr);
-- Socket address
type Sockaddr_Access is access all Sockaddr;
for Sockaddr_Access'Size use 32;
pragma Convention (C, Sockaddr_Access);
-- Access to socket address
type Sockaddr_In is record
Sin_Family : C.unsigned_short := Constants.AF_INET;
Sin_Port : C.unsigned_short := 0;
Sin_Addr : In_Addr := Inaddr_Any;
Sin_Zero : C.char_array (1 .. 8) := (others => C.char'Val (0));
end record;
pragma Convention (C, Sockaddr_In);
-- Internet socket address
type Sockaddr_In_Access is access all Sockaddr_In;
for Sockaddr_In_Access'Size use 32;
pragma Convention (C, Sockaddr_In_Access);
-- Access to internet socket address
procedure Set_Length
(Sin : Sockaddr_In_Access;
Len : C.int);
pragma Inline (Set_Length);
-- Set Sin.Sin_Length to Len.
-- On this platform, nothing is done as there is no such field.
procedure Set_Family
(Sin : Sockaddr_In_Access;
Family : C.int);
pragma Inline (Set_Family);
-- Set Sin.Sin_Family to Family
procedure Set_Port
(Sin : Sockaddr_In_Access;
Port : C.unsigned_short);
pragma Inline (Set_Port);
-- Set Sin.Sin_Port to Port
procedure Set_Address
(Sin : Sockaddr_In_Access;
Address : In_Addr);
pragma Inline (Set_Address);
-- Set Sin.Sin_Addr to Address
type Hostent is record
H_Name : C.Strings.chars_ptr;
H_Aliases : Chars_Ptr_Pointers.Pointer;
H_Addrtype : C.int;
H_Length : C.int;
H_Addr_List : In_Addr_Access_Pointers.Pointer;
end record;
pragma Convention (C, Hostent);
-- Host entry
type Hostent_Access is access all Hostent;
for Hostent_Access'Size use 32;
pragma Convention (C, Hostent_Access);
-- Access to host entry
type Servent is record
S_Name : C.Strings.chars_ptr;
S_Aliases : Chars_Ptr_Pointers.Pointer;
S_Port : C.int;
S_Proto : C.Strings.chars_ptr;
end record;
pragma Convention (C, Servent);
-- Service entry
type Servent_Access is access all Servent;
for Servent_Access'Size use 32;
pragma Convention (C, Servent_Access);
-- Access to service entry
type Two_Ints is array (0 .. 1) of C.int;
pragma Convention (C, Two_Ints);
-- Container for two int values
subtype Fd_Pair is Two_Ints;
-- Two_Ints as used for Create_Signalling_Fds: a pair of connected file
-- descriptors, one of which (the "read end" of the connection) being used
-- for reading, the other one (the "write end") being used for writing.
Read_End : constant := 0;
Write_End : constant := 1;
-- Indices into an Fd_Pair value providing access to each of the connected
-- file descriptors.
--------------------------------
-- Standard library functions --
--------------------------------
......@@ -386,55 +224,6 @@ package GNAT.Sockets.Thin is
end Signalling_Fds;
----------------------------
-- Socket sets management --
----------------------------
procedure Free_Socket_Set
(Set : Fd_Set_Access);
-- Free system-dependent socket set
procedure Get_Socket_From_Set
(Set : Fd_Set_Access;
Socket : Int_Access;
Last : Int_Access);
-- Get last socket in Socket and remove it from the socket set. The
-- parameter Last is a maximum value of the largest socket. This hint is
-- used to avoid scanning very large socket sets. After a call to
-- Get_Socket_From_Set, Last is set back to the real largest socket in the
-- socket set.
procedure Insert_Socket_In_Set
(Set : Fd_Set_Access;
Socket : C.int);
-- Insert socket in the socket set
function Is_Socket_In_Set
(Set : Fd_Set_Access;
Socket : C.int) return C.int;
-- Check whether Socket is in the socket set, return a non-zero
-- value if it is, zero if it is not.
procedure Last_Socket_In_Set
(Set : Fd_Set_Access;
Last : Int_Access);
-- Find the largest socket in the socket set. This is needed for select().
-- When Last_Socket_In_Set is called, parameter Last is a maximum value of
-- the largest socket. This hint is used to avoid scanning very large
-- socket sets. After the call, Last is set back to the real largest socket
-- in the socket set.
function New_Socket_Set
(Set : Fd_Set_Access) return Fd_Set_Access;
-- Allocate a new socket set which is a system-dependent structure and
-- initialize by copying Set if it is non-null, by making it empty
-- otherwise.
procedure Remove_Socket_From_Set
(Set : Fd_Set_Access;
Socket : C.int);
-- Remove socket from the socket set
-------------------------------------------
-- Nonreentrant network databases access --
-------------------------------------------
......@@ -474,14 +263,6 @@ private
pragma Import (C, C_Strerror, "DECC$STRERROR");
pragma Import (C, C_System, "DECC$SYSTEM");
pragma Import (C, Free_Socket_Set, "__gnat_free_socket_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, Last_Socket_In_Set, "__gnat_last_socket_in_set");
pragma Import (C, New_Socket_Set, "__gnat_new_socket_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, Nonreentrant_Gethostbyname, "DECC$GETHOSTBYNAME");
pragma Import (C, Nonreentrant_Gethostbyaddr, "DECC$GETHOSTBYADDR");
pragma Import (C, Nonreentrant_Getservbyname, "DECC$GETSERVBYNAME");
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2007, AdaCore --
-- Copyright (C) 2002-2008, AdaCore --
-- --
-- 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- --
......@@ -38,6 +38,7 @@
-- This version is for VxWorks
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Sockets.Constants;
with GNAT.Task_Lock;
with Interfaces.C; use Interfaces.C;
......@@ -45,7 +46,7 @@ with Interfaces.C; use Interfaces.C;
package body GNAT.Sockets.Thin is
Non_Blocking_Sockets : constant Fd_Set_Access :=
New_Socket_Set (No_Socket_Set);
New_Socket_Set (No_Fd_Set_Access);
-- When this package is initialized with Process_Blocking_IO set
-- to True, sockets are set in non-blocking mode to avoid blocking
-- the whole process when a thread wants to perform a blocking IO
......@@ -195,16 +196,16 @@ package body GNAT.Sockets.Thin is
Now : aliased Timeval;
begin
WSet := New_Socket_Set (No_Socket_Set);
WSet := New_Socket_Set (No_Fd_Set_Access);
loop
Insert_Socket_In_Set (WSet, S);
Now := Immediat;
Res := C_Select
(S + 1,
No_Fd_Set,
No_Fd_Set_Access,
WSet,
No_Fd_Set,
No_Fd_Set_Access,
Now'Unchecked_Access);
exit when Res > 0;
......@@ -225,7 +226,7 @@ package body GNAT.Sockets.Thin is
if Res = Failure
and then Errno = Constants.EISCONN
then
return Thin.Success;
return Thin_Common.Success;
else
return Res;
end if;
......@@ -425,42 +426,6 @@ package body GNAT.Sockets.Thin is
return R;
end Non_Blocking_Socket;
-----------------
-- Set_Address --
-----------------
procedure Set_Address
(Sin : Sockaddr_In_Access;
Address : In_Addr)
is
begin
Sin.Sin_Addr := Address;
end Set_Address;
----------------
-- Set_Family --
----------------
procedure Set_Family
(Sin : Sockaddr_In_Access;
Family : C.int)
is
begin
Sin.Sin_Family := C.unsigned_char (Family);
end Set_Family;
----------------
-- Set_Length --
----------------
procedure Set_Length
(Sin : Sockaddr_In_Access;
Len : C.int)
is
begin
Sin.Sin_Length := C.unsigned_char (Len);
end Set_Length;
-----------------------------
-- Set_Non_Blocking_Socket --
-----------------------------
......@@ -477,18 +442,6 @@ package body GNAT.Sockets.Thin is
Task_Lock.Unlock;
end Set_Non_Blocking_Socket;
--------------
-- Set_Port --
--------------
procedure Set_Port
(Sin : Sockaddr_In_Access;
Port : C.unsigned_short)
is
begin
Sin.Sin_Port := Port;
end Set_Port;
--------------------
-- Signalling_Fds --
--------------------
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2007, AdaCore --
-- Copyright (C) 2001-2008, AdaCore --
-- --
-- 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- --
......@@ -38,6 +38,7 @@
-- This is the default version
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Sockets.Constants;
with GNAT.Task_Lock;
with Interfaces.C; use Interfaces.C;
......@@ -45,7 +46,7 @@ with Interfaces.C; use Interfaces.C;
package body GNAT.Sockets.Thin is
Non_Blocking_Sockets : constant Fd_Set_Access :=
New_Socket_Set (No_Socket_Set);
New_Socket_Set (No_Fd_Set_Access);
-- When this package is initialized with Process_Blocking_IO set
-- to True, sockets are set in non-blocking mode to avoid blocking
-- the whole process when a thread wants to perform a blocking IO
......@@ -199,15 +200,15 @@ package body GNAT.Sockets.Thin is
Now : aliased Timeval;
begin
WSet := New_Socket_Set (No_Socket_Set);
WSet := New_Socket_Set (No_Fd_Set_Access);
loop
Insert_Socket_In_Set (WSet, S);
Now := Immediat;
Res := C_Select
(S + 1,
No_Fd_Set,
No_Fd_Set_Access,
WSet,
No_Fd_Set,
No_Fd_Set_Access,
Now'Unchecked_Access);
exit when Res > 0;
......@@ -228,7 +229,7 @@ package body GNAT.Sockets.Thin is
if Res = Failure
and then Errno = Constants.EISCONN
then
return Thin.Success;
return Thin_Common.Success;
else
return Res;
end if;
......@@ -427,45 +428,6 @@ package body GNAT.Sockets.Thin is
return R;
end Non_Blocking_Socket;
-----------------
-- Set_Address --
-----------------
procedure Set_Address
(Sin : Sockaddr_In_Access;
Address : In_Addr)
is
begin
Sin.Sin_Addr := Address;
end Set_Address;
----------------
-- Set_Family --
----------------
procedure Set_Family
(Sin : Sockaddr_In_Access;
Family : C.int)
is
begin
Sin.Sin_Family := C.unsigned_short (Family);
end Set_Family;
----------------
-- Set_Length --
----------------
procedure Set_Length
(Sin : Sockaddr_In_Access;
Len : C.int)
is
pragma Unreferenced (Sin);
pragma Unreferenced (Len);
begin
null;
end Set_Length;
-----------------------------
-- Set_Non_Blocking_Socket --
-----------------------------
......@@ -483,18 +445,6 @@ package body GNAT.Sockets.Thin is
Task_Lock.Unlock;
end Set_Non_Blocking_Socket;
--------------
-- Set_Port --
--------------
procedure Set_Port
(Sin : Sockaddr_In_Access;
Port : C.unsigned_short)
is
begin
Sin.Sin_Port := Port;
end Set_Port;
--------------------
-- Signalling_Fds --
--------------------
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2007, AdaCore --
-- Copyright (C) 2001-2008, AdaCore --
-- --
-- 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- --
......@@ -37,11 +37,10 @@
-- This is the default version
with Interfaces.C.Pointers;
with Interfaces.C.Strings;
with GNAT.OS_Lib;
with GNAT.Sockets.Constants;
with GNAT.Sockets.Thin_Common;
with System;
......@@ -51,13 +50,9 @@ package GNAT.Sockets.Thin is
-- standard interface. It will be used as a default for all the platforms
-- that do not have a specific version of this file.
package C renames Interfaces.C;
use type C.int;
-- This is so we can declare the Failure constant below
use Thin_Common;
Success : constant C.int := 0;
Failure : constant C.int := -1;
package C renames Interfaces.C;
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number
......@@ -79,158 +74,6 @@ package GNAT.Sockets.Thin is
end Host_Error_Messages;
subtype Fd_Set_Access is System.Address;
No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
type time_t is
range -2 ** (8 * Constants.SIZEOF_tv_sec - 1)
.. 2 ** (8 * Constants.SIZEOF_tv_sec - 1) - 1;
for time_t'Size use 8 * Constants.SIZEOF_tv_sec;
pragma Convention (C, time_t);
type suseconds_t is
range -2 ** (8 * Constants.SIZEOF_tv_usec - 1)
.. 2 ** (8 * Constants.SIZEOF_tv_usec - 1) - 1;
for suseconds_t'Size use 8 * Constants.SIZEOF_tv_usec;
pragma Convention (C, suseconds_t);
type Timeval is record
Tv_Sec : time_t;
Tv_Usec : suseconds_t;
end record;
pragma Convention (C, Timeval);
type Timeval_Access is access all Timeval;
pragma Convention (C, Timeval_Access);
Immediat : constant Timeval := (0, 0);
type Int_Access is access all C.int;
pragma Convention (C, Int_Access);
-- Access to C integers
type Chars_Ptr_Array is array (C.size_t range <>) of
aliased C.Strings.chars_ptr;
package Chars_Ptr_Pointers is
new C.Pointers (C.size_t, C.Strings.chars_ptr, Chars_Ptr_Array,
C.Strings.Null_Ptr);
-- Arrays of C (char *)
type In_Addr is record
S_B1, S_B2, S_B3, S_B4 : C.unsigned_char;
end record;
for In_Addr'Alignment use C.int'Alignment;
pragma Convention (C, In_Addr);
-- IPv4 address, represented as a network-order C.int. Note that the
-- underlying operating system may assume that values of this type have
-- C.int alignment, so we need to provide a suitable alignment clause here.
type In_Addr_Access is access all In_Addr;
pragma Convention (C, In_Addr_Access);
-- Access to internet address
Inaddr_Any : aliased constant In_Addr := (others => 0);
-- Any internet address (all the interfaces)
type In_Addr_Access_Array is array (C.size_t range <>)
of aliased In_Addr_Access;
pragma Convention (C, In_Addr_Access_Array);
package In_Addr_Access_Pointers is
new C.Pointers (C.size_t, In_Addr_Access, In_Addr_Access_Array, null);
-- Array of internet addresses
type Sockaddr is record
Sa_Family : C.unsigned_short;
Sa_Data : C.char_array (1 .. 14);
end record;
pragma Convention (C, Sockaddr);
-- Socket address
type Sockaddr_Access is access all Sockaddr;
pragma Convention (C, Sockaddr_Access);
-- Access to socket address
type Sockaddr_In is record
Sin_Family : C.unsigned_short := Constants.AF_INET;
Sin_Port : C.unsigned_short := 0;
Sin_Addr : In_Addr := Inaddr_Any;
Sin_Zero : C.char_array (1 .. 8) := (others => C.char'Val (0));
end record;
pragma Convention (C, Sockaddr_In);
-- Internet socket address
type Sockaddr_In_Access is access all Sockaddr_In;
pragma Convention (C, Sockaddr_In_Access);
-- Access to internet socket address
procedure Set_Length
(Sin : Sockaddr_In_Access;
Len : C.int);
pragma Inline (Set_Length);
-- Set Sin.Sin_Length to Len.
-- On this platform, nothing is done as there is no such field.
procedure Set_Family
(Sin : Sockaddr_In_Access;
Family : C.int);
pragma Inline (Set_Family);
-- Set Sin.Sin_Family to Family
procedure Set_Port
(Sin : Sockaddr_In_Access;
Port : C.unsigned_short);
pragma Inline (Set_Port);
-- Set Sin.Sin_Port to Port
procedure Set_Address
(Sin : Sockaddr_In_Access;
Address : In_Addr);
pragma Inline (Set_Address);
-- Set Sin.Sin_Addr to Address
type Hostent is record
H_Name : C.Strings.chars_ptr;
H_Aliases : Chars_Ptr_Pointers.Pointer;
H_Addrtype : C.int;
H_Length : C.int;
H_Addr_List : In_Addr_Access_Pointers.Pointer;
end record;
pragma Convention (C, Hostent);
-- Host entry
type Hostent_Access is access all Hostent;
pragma Convention (C, Hostent_Access);
-- Access to host entry
type Servent is record
S_Name : C.Strings.chars_ptr;
S_Aliases : Chars_Ptr_Pointers.Pointer;
S_Port : C.int;
S_Proto : C.Strings.chars_ptr;
end record;
pragma Convention (C, Servent);
-- Service entry
type Servent_Access is access all Servent;
pragma Convention (C, Servent_Access);
-- Access to service entry
type Two_Ints is array (0 .. 1) of C.int;
pragma Convention (C, Two_Ints);
-- Container for two int values
subtype Fd_Pair is Two_Ints;
-- Two_Ints as used for Create_Signalling_Fds: a pair of connected file
-- descriptors, one of which (the "read end" of the connection) being used
-- for reading, the other one (the "write end") being used for writing.
Read_End : constant := 0;
Write_End : constant := 1;
-- Indices into an Fd_Pair value providing access to each of the connected
-- file descriptors.
--------------------------------
-- Standard library functions --
--------------------------------
......@@ -380,55 +223,6 @@ package GNAT.Sockets.Thin is
end Signalling_Fds;
----------------------------
-- Socket sets management --
----------------------------
procedure Free_Socket_Set
(Set : Fd_Set_Access);
-- Free system-dependent socket set
procedure Get_Socket_From_Set
(Set : Fd_Set_Access;
Socket : Int_Access;
Last : Int_Access);
-- Get last socket in Socket and remove it from the socket set. The
-- parameter Last is a maximum value of the largest socket. This hint is
-- used to avoid scanning very large socket sets. After a call to
-- Get_Socket_From_Set, Last is set back to the real largest socket in the
-- socket set.
procedure Insert_Socket_In_Set
(Set : Fd_Set_Access;
Socket : C.int);
-- Insert socket in the socket set
function Is_Socket_In_Set
(Set : Fd_Set_Access;
Socket : C.int) return C.int;
-- Check whether Socket is in the socket set, return a non-zero
-- value if it is, zero if it is not.
procedure Last_Socket_In_Set
(Set : Fd_Set_Access;
Last : Int_Access);
-- Find the largest socket in the socket set. This is needed for select().
-- When Last_Socket_In_Set is called, parameter Last is a maximum value of
-- the largest socket. This hint is used to avoid scanning very large
-- socket sets. After the call, Last is set back to the real largest socket
-- in the socket set.
function New_Socket_Set
(Set : Fd_Set_Access) return Fd_Set_Access;
-- Allocate a new socket set which is a system-dependent structure and
-- initialize by copying Set if it is non-null, by making it empty
-- otherwise.
procedure Remove_Socket_From_Set
(Set : Fd_Set_Access;
Socket : C.int);
-- Remove socket from the socket set
-------------------------------------------
-- Nonreentrant network databases access --
-------------------------------------------
......@@ -473,14 +267,6 @@ private
pragma Import (C, C_System, "system");
pragma Import (C, C_Writev, "writev");
pragma Import (C, Free_Socket_Set, "__gnat_free_socket_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, Last_Socket_In_Set, "__gnat_last_socket_in_set");
pragma Import (C, New_Socket_Set, "__gnat_new_socket_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, Nonreentrant_Gethostbyname, "gethostbyname");
pragma Import (C, Nonreentrant_Gethostbyaddr, "gethostbyaddr");
pragma Import (C, Nonreentrant_Getservbyname, "getservbyname");
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2007, AdaCore --
-- Copyright (C) 2001-2008, AdaCore --
-- --
-- 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- --
......@@ -90,15 +90,14 @@ package body Signalling_Fds is
-- Bind the socket to an available port on localhost
Len := Sin'Size / 8;
Set_Length (Sin'Unchecked_Access, Len);
Sin.Sin_Family := Constants.AF_INET;
Set_Family (Sin.Sin_Family, Family_Inet);
Sin.Sin_Addr.S_B1 := 127;
Sin.Sin_Addr.S_B2 := 0;
Sin.Sin_Addr.S_B3 := 0;
Sin.Sin_Addr.S_B4 := 1;
Sin.Sin_Port := 0;
Len := C.int (Lengths (Family_Inet));
Res := C_Bind (L_Sock, Sin'Address, Len);
if Res = Failure then
......@@ -143,7 +142,7 @@ package body Signalling_Fds is
-- marked "in use", even though it has been closed (perhaps by some
-- other process that has already exited). This causes the above
-- C_Connect to fail with EADDRINUSE. In this case, we close the
-- ports, and loop back to try again. This mysterious windows
-- ports, and loop back to try again. This mysterious Windows
-- behavior is documented. See, for example:
-- http://msdn2.microsoft.com/en-us/library/ms737625.aspx
-- In an experiment with 2000 calls, 21 required exactly one retry, 7
......@@ -186,7 +185,7 @@ package body Signalling_Fds is
Fds.all := (Read_End => R_Sock, Write_End => W_Sock);
return Success;
return Thin_Common.Success;
<<Fail>>
declare
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007, AdaCore --
-- Copyright (C) 2007-2008, AdaCore --
-- --
-- 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- --
......@@ -34,7 +34,9 @@
-- This version is used on VxWorks. Note that the corresponding spec is in
-- g-sttsne-locking.ads.
with Ada.Unchecked_Conversion;
with Interfaces.C; use Interfaces.C;
with GNAT.Sockets.Constants;
package body GNAT.Sockets.Thin.Task_Safe_NetDB is
......
......@@ -51,16 +51,19 @@
#include "gsocket.h"
typedef enum { NUM, TXT } kind_t;
struct line {
char *text;
char *value;
char *comment;
kind_t kind;
struct line *next;
};
struct line *first = NULL, *last = NULL;
#define TXT(_text) add_line(_text, NULL, NULL);
#define TXT(_text) add_line(_text, NULL, NULL, TXT);
/* Plain text */
#define _NL TXT("")
......@@ -69,13 +72,13 @@ struct line *first = NULL, *last = NULL;
#define itoad(n) f_itoa ("%d", (n))
#define itoax(n) f_itoa ("16#%08x#", (n))
#define CND(name,comment) add_line(#name, itoad (name), comment);
#define CND(name,comment) add_line(#name, itoad (name), comment, NUM);
/* Constant (decimal) */
#define CNX(name,comment) add_line(#name, itoax (name), comment);
#define CNX(name,comment) add_line(#name, itoax (name), comment, NUM);
/* Constant (hexadecimal) */
#define CN_(name,comment) add_line(#name, name, comment);
#define CN_(name,comment) add_line(#name, name, comment, TXT);
/* Constant (generic) */
#define STR(p) STR1(p)
......@@ -87,7 +90,7 @@ void output (void);
char *f_itoa (char *, int);
/* int to string */
void add_line (char *, char*, char*);
void add_line (char *, char*, char*, kind_t);
#ifdef __MINGW32__
unsigned int _CRT_fmode = _O_BINARY;
......@@ -137,6 +140,7 @@ TXT("-- This is the version for " TARGET)
TXT("-- This file is generated automatically, do not modify it by hand! Instead,")
TXT("-- make changes to gen-soccon.c and re-run it on each target.")
_NL
TXT("with Interfaces.C;")
TXT("package GNAT.Sockets.Constants is")
_NL
TXT(" --------------")
......@@ -145,12 +149,14 @@ TXT(" --------------")
_NL
#ifndef AF_INET
#define AF_INET -1
# define AF_INET -1
#endif
CND(AF_INET, "IPv4 address family")
#ifndef AF_INET6
#define AF_INET6 -1
# define AF_INET6 -1
#else
# define HAVE_AF_INET6 1
#endif
CND(AF_INET6, "IPv6 address family")
_NL
......@@ -604,7 +610,34 @@ CND(SIZEOF_tv_sec, "tv_sec")
#define SIZEOF_tv_usec (sizeof tv.tv_usec)
CND(SIZEOF_tv_usec, "tv_usec")
}
_NL
TXT(" -- Sizes of protocol specific address types (for sockaddr.sa_len)")
_NL
#define SIZEOF_sockaddr_in (sizeof (struct sockaddr_in))
CND(SIZEOF_sockaddr_in, "struct sockaddr_in")
#ifdef HAVE_AF_INET6
# define SIZEOF_sockaddr_in6 (sizeof (struct sockaddr_in6))
#else
# define SIZEOF_sockaddr_in6 0
#endif
CND(SIZEOF_sockaddr_in6, "struct sockaddr_in6")
_NL
TXT(" -- Size of file descriptor sets")
_NL
#define SIZEOF_fd_set (sizeof (fd_set))
CND(SIZEOF_fd_set, "fd_set");
_NL
TXT(" -- Fields of struct hostent")
_NL
#ifdef __MINGW32__
# define h_addrtype_t "short"
# define h_length_t "short"
#else
# define h_addrtype_t "int"
# define h_length_t "int"
#endif
TXT(" subtype H_Addrtype_T is Interfaces.C." h_addrtype_t ";")
TXT(" subtype H_Length_T is Interfaces.C." h_length_t ";")
_NL
TXT(" ----------------------------------------")
TXT(" -- Properties of supported interfaces --")
......@@ -612,6 +645,10 @@ TXT(" ----------------------------------------")
_NL
CND(Need_Netdb_Buffer, "Need buffer for Netdb ops")
CND(Has_Sockaddr_Len, "Sockaddr has sa_len field")
_NL
TXT(" Thread_Blocking_IO : constant Boolean := True;")
TXT(" -- Set False for contexts where socket i/o are process blocking")
#ifdef __vxworks
_NL
......@@ -641,18 +678,9 @@ CND(WSASYSNOTREADY, "System not ready")
CND(WSAVERNOTSUPPORTED, "Version not supported")
CND(WSANOTINITIALISED, "Winsock not initialized")
CND(WSAEDISCON, "Disconnected")
#endif
_NL
TXT(" ----------------------")
TXT(" -- Additional flags --")
TXT(" ----------------------")
_NL
TXT(" Thread_Blocking_IO : constant Boolean := True;")
TXT(" -- Set False for contexts where socket i/o are process blocking")
_NL
TXT("end GNAT.Sockets.Constants;")
output ();
......@@ -672,7 +700,8 @@ output (void) {
for (p = first; p != NULL; p = p->next) {
if (p->value != NULL) {
UPD_MAX(text);
UPD_MAX(value);
if (p->kind == NUM)
UPD_MAX(value);
}
}
sprintf (fmt, " %%-%ds : constant := %%%ds;%%s%%s\n",
......@@ -700,13 +729,15 @@ f_itoa (char *fmt, int n) {
}
void
add_line (char *_text, char *_value, char *_comment) {
add_line (char *_text, char *_value, char *_comment, kind_t _kind) {
struct line *l = (struct line *) malloc (sizeof (struct line));
l->text = _text;
l->value = _value;
l->text = _text;
l->value = _value;
l->comment = _comment;
l->next = NULL;
l->kind = _kind;
l->next = NULL;
if (last == NULL)
first = last = l;
else {
......
......@@ -184,3 +184,9 @@
#else
# define Need_Netdb_Buffer 0
#endif
#if defined (__FreeBSD__) || defined (__vxworks)
# define Has_Sockaddr_Len 1
#else
# define Has_Sockaddr_Len 0
#endif
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