mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-25 09:40:36 +08:00
g-soccon-freebsd.ads, [...]: Add new constant Thread_Blocking_IO...
2007-04-20 Thomas Quinot <quinot@adacore.com>
Bob Duff <duff@adacore.com>
* g-soccon-freebsd.ads, g-soccon-vxworks.ads:,
g-soccon-aix.ads, g-soccon-irix.ads, g-soccon-hpux.ads,
g-soccon-solaris.ads, g-soccon-vms.ads, g-soccon-tru64.ads: Add new
constant Thread_Blocking_IO, always True by default, set False
on a per-runtime basis.
(Need_Netdb_Buffer): New constant.
* g-stheme.adb, g-sttsne.ads, g-sttsne-locking.ads,
g-sttsne-locking.adb, g-sttsne-vxworks.ads, g-sttsne-vxworks.adb: New
files.
* g-socthi-vxworks.ads, g-socthi-vxworks.adb,
g-socthi-vms.ads, g-socthi-vms.adb (Safe_Gethostbyname,
Safe_Gethostbyaddr, Safe_Getservbyname, Safe_Getservbyport): Use new
child package Task_Safe_NetDB
(Host_Error_Messages): Add stub body.
(GNAT.Sockets.Thin.Signalling_Fds): New procedure Close.
* g-soccon-mingw.ads: Add Windows-specific constants.
(Need_Netdb_Buffer): New constant.
(GNAT.Sockets.Thin.C_Inet_Addr, Windows version): Remove useless Ada
wrapper and import inet_addr(3) from the standard sockets library
directly instead.
(In_Addr): Add alignment clause.
(GNAT.Sockets.Thin.Signalling_Fds): New procedure Close.
From-SVN: r125358
This commit is contained in:
Thomas Quinot
Arnaud Charlet
parent
9415ab7da8
commit
47a5501df9
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -178,4 +178,17 @@ package GNAT.Sockets.Constants is
|
||||
SIZEOF_tv_sec : constant := 4; -- tv_sec
|
||||
SIZEOF_tv_usec : constant := 4; -- tv_usec
|
||||
|
||||
----------------------------------------
|
||||
-- Properties of supported interfaces --
|
||||
----------------------------------------
|
||||
|
||||
Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops
|
||||
|
||||
----------------------
|
||||
-- Additional flags --
|
||||
----------------------
|
||||
|
||||
Thread_Blocking_IO : constant Boolean := True;
|
||||
-- Set False for contexts where socket i/o are process blocking
|
||||
|
||||
end GNAT.Sockets.Constants;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -35,7 +35,7 @@
|
||||
-- by the GNAT.Sockets package (g-socket.ads). This package should not be
|
||||
-- directly with'ed by an applications program.
|
||||
|
||||
-- This is the version for i386-unknown-freebsd5.2.1
|
||||
-- This is the version for i386-unknown-freebsd6.1
|
||||
-- This file is generated automatically, do not modify it by hand! Instead,
|
||||
-- make changes to gen-soccon.c and re-run it on each target.
|
||||
|
||||
@ -139,7 +139,7 @@ package GNAT.Sockets.Constants is
|
||||
MSG_PEEK : constant := 2; -- Peek at incoming data
|
||||
MSG_EOR : constant := 8; -- Send end of record
|
||||
MSG_WAITALL : constant := 64; -- Wait for full reception
|
||||
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
|
||||
MSG_NOSIGNAL : constant := 131072; -- No SIGPIPE on send
|
||||
MSG_Forced_Flags : constant := 0;
|
||||
-- Flags set on all send(2) calls
|
||||
|
||||
@ -178,4 +178,17 @@ package GNAT.Sockets.Constants is
|
||||
SIZEOF_tv_sec : constant := 4; -- tv_sec
|
||||
SIZEOF_tv_usec : constant := 4; -- tv_usec
|
||||
|
||||
----------------------------------------
|
||||
-- Properties of supported interfaces --
|
||||
----------------------------------------
|
||||
|
||||
Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops
|
||||
|
||||
----------------------
|
||||
-- Additional flags --
|
||||
----------------------
|
||||
|
||||
Thread_Blocking_IO : constant Boolean := True;
|
||||
-- Set False for contexts where socket i/o are process blocking
|
||||
|
||||
end GNAT.Sockets.Constants;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -178,4 +178,17 @@ package GNAT.Sockets.Constants is
|
||||
SIZEOF_tv_sec : constant := 4; -- tv_sec
|
||||
SIZEOF_tv_usec : constant := 4; -- tv_usec
|
||||
|
||||
----------------------------------------
|
||||
-- Properties of supported interfaces --
|
||||
----------------------------------------
|
||||
|
||||
Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops
|
||||
|
||||
----------------------
|
||||
-- Additional flags --
|
||||
----------------------
|
||||
|
||||
Thread_Blocking_IO : constant Boolean := True;
|
||||
-- Set False for contexts where socket i/o are process blocking
|
||||
|
||||
end GNAT.Sockets.Constants;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -178,4 +178,17 @@ package GNAT.Sockets.Constants is
|
||||
SIZEOF_tv_sec : constant := 4; -- tv_sec
|
||||
SIZEOF_tv_usec : constant := 4; -- tv_usec
|
||||
|
||||
----------------------------------------
|
||||
-- Properties of supported interfaces --
|
||||
----------------------------------------
|
||||
|
||||
Need_Netdb_Buffer : constant := 1; -- Need buffer for Netdb ops
|
||||
|
||||
----------------------
|
||||
-- Additional flags --
|
||||
----------------------
|
||||
|
||||
Thread_Blocking_IO : constant Boolean := True;
|
||||
-- Set False for contexts where socket i/o are process blocking
|
||||
|
||||
end GNAT.Sockets.Constants;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -178,4 +178,29 @@ package GNAT.Sockets.Constants is
|
||||
SIZEOF_tv_sec : constant := 4; -- tv_sec
|
||||
SIZEOF_tv_usec : constant := 4; -- tv_usec
|
||||
|
||||
----------------------------------------
|
||||
-- Properties of supported interfaces --
|
||||
----------------------------------------
|
||||
|
||||
Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops
|
||||
|
||||
----------------------
|
||||
-- Additional flags --
|
||||
----------------------
|
||||
|
||||
Thread_Blocking_IO : constant Boolean := True;
|
||||
-- Set False for contexts where socket i/o are process blocking
|
||||
|
||||
------------------------------
|
||||
-- MinGW-specific constants --
|
||||
------------------------------
|
||||
|
||||
-- These constants may be used only within the MinGW version of
|
||||
-- GNAT.Sockets.Thin.
|
||||
|
||||
WSASYSNOTREADY : constant := 10091; -- System not ready
|
||||
WSAVERNOTSUPPORTED : constant := 10092; -- Version not supported
|
||||
WSANOTINITIALISED : constant := 10093; -- Winsock not intialized
|
||||
WSAEDISCON : constant := 10101; -- Disconnected
|
||||
|
||||
end GNAT.Sockets.Constants;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -178,4 +178,17 @@ package GNAT.Sockets.Constants is
|
||||
SIZEOF_tv_sec : constant := 4; -- tv_sec
|
||||
SIZEOF_tv_usec : constant := 4; -- tv_usec
|
||||
|
||||
----------------------------------------
|
||||
-- Properties of supported interfaces --
|
||||
----------------------------------------
|
||||
|
||||
Need_Netdb_Buffer : constant := 1; -- Need buffer for Netdb ops
|
||||
|
||||
----------------------
|
||||
-- Additional flags --
|
||||
----------------------
|
||||
|
||||
Thread_Blocking_IO : constant Boolean := True;
|
||||
-- Set False for contexts where socket i/o are process blocking
|
||||
|
||||
end GNAT.Sockets.Constants;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -178,4 +178,17 @@ package GNAT.Sockets.Constants is
|
||||
SIZEOF_tv_sec : constant := 4; -- tv_sec
|
||||
SIZEOF_tv_usec : constant := 4; -- tv_usec
|
||||
|
||||
----------------------------------------
|
||||
-- Properties of supported interfaces --
|
||||
----------------------------------------
|
||||
|
||||
Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops
|
||||
|
||||
----------------------
|
||||
-- Additional flags --
|
||||
----------------------
|
||||
|
||||
Thread_Blocking_IO : constant Boolean := True;
|
||||
-- Set False for contexts where socket i/o are process blocking
|
||||
|
||||
end GNAT.Sockets.Constants;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -178,4 +178,17 @@ package GNAT.Sockets.Constants is
|
||||
SIZEOF_tv_sec : constant := 4; -- tv_sec
|
||||
SIZEOF_tv_usec : constant := 4; -- tv_usec
|
||||
|
||||
----------------------------------------
|
||||
-- Properties of supported interfaces --
|
||||
----------------------------------------
|
||||
|
||||
Need_Netdb_Buffer : constant := 1; -- Need buffer for Netdb ops
|
||||
|
||||
----------------------
|
||||
-- Additional flags --
|
||||
----------------------
|
||||
|
||||
Thread_Blocking_IO : constant Boolean := True;
|
||||
-- Set False for contexts where socket i/o are process blocking
|
||||
|
||||
end GNAT.Sockets.Constants;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -178,6 +178,19 @@ package GNAT.Sockets.Constants is
|
||||
SIZEOF_tv_sec : constant := 4; -- tv_sec
|
||||
SIZEOF_tv_usec : constant := 4; -- tv_usec
|
||||
|
||||
----------------------------------------
|
||||
-- Properties of supported interfaces --
|
||||
----------------------------------------
|
||||
|
||||
Need_Netdb_Buffer : constant := 1; -- Need buffer for Netdb ops
|
||||
|
||||
----------------------
|
||||
-- Additional flags --
|
||||
----------------------
|
||||
|
||||
Thread_Blocking_IO : constant Boolean := True;
|
||||
-- Set False for contexts where socket i/o are process blocking
|
||||
|
||||
--------------------------------
|
||||
-- VxWorks-specific constants --
|
||||
--------------------------------
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2006, AdaCore --
|
||||
-- Copyright (C) 2001-2007, 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- --
|
||||
@ -52,12 +52,10 @@ package body GNAT.Sockets.Thin is
|
||||
-- been set in non-blocking mode by the user.
|
||||
|
||||
Quantum : constant Duration := 0.2;
|
||||
-- When Thread_Blocking_IO is False, we set sockets in
|
||||
-- When Constants.Thread_Blocking_IO is False, we set sockets in
|
||||
-- non-blocking mode and we spend a period of time Quantum between
|
||||
-- two attempts on a blocking operation.
|
||||
|
||||
Thread_Blocking_IO : Boolean := True;
|
||||
|
||||
Unknown_System_Error : constant C.Strings.chars_ptr :=
|
||||
C.Strings.New_String ("Unknown system error");
|
||||
|
||||
@ -136,14 +134,14 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
loop
|
||||
R := Syscall_Accept (S, Addr, Addrlen);
|
||||
exit when Thread_Blocking_IO
|
||||
exit when Constants.Thread_Blocking_IO
|
||||
or else R /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EWOULDBLOCK;
|
||||
delay Quantum;
|
||||
end loop;
|
||||
|
||||
if not Thread_Blocking_IO
|
||||
if not Constants.Thread_Blocking_IO
|
||||
and then R /= Failure
|
||||
then
|
||||
-- A socket inherits the properties ot its server especially
|
||||
@ -171,7 +169,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
Res := Syscall_Connect (S, Name, Namelen);
|
||||
|
||||
if Thread_Blocking_IO
|
||||
if Constants.Thread_Blocking_IO
|
||||
or else Res /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EINPROGRESS
|
||||
@ -229,7 +227,7 @@ package body GNAT.Sockets.Thin is
|
||||
Arg : Int_Access) return C.int
|
||||
is
|
||||
begin
|
||||
if not Thread_Blocking_IO
|
||||
if not Constants.Thread_Blocking_IO
|
||||
and then Req = Constants.FIONBIO
|
||||
then
|
||||
if Arg.all /= 0 then
|
||||
@ -255,7 +253,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
loop
|
||||
Res := Syscall_Recv (S, Msg, Len, Flags);
|
||||
exit when Thread_Blocking_IO
|
||||
exit when Constants.Thread_Blocking_IO
|
||||
or else Res /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EWOULDBLOCK;
|
||||
@ -282,7 +280,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
loop
|
||||
Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
|
||||
exit when Thread_Blocking_IO
|
||||
exit when Constants.Thread_Blocking_IO
|
||||
or else Res /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EWOULDBLOCK;
|
||||
@ -307,7 +305,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
loop
|
||||
Res := Syscall_Send (S, Msg, Len, Flags);
|
||||
exit when Thread_Blocking_IO
|
||||
exit when Constants.Thread_Blocking_IO
|
||||
or else Res /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EWOULDBLOCK;
|
||||
@ -334,7 +332,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
loop
|
||||
Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
|
||||
exit when Thread_Blocking_IO
|
||||
exit when Constants.Thread_Blocking_IO
|
||||
or else Res /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EWOULDBLOCK;
|
||||
@ -362,7 +360,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
R := Syscall_Socket (Domain, Typ, Protocol);
|
||||
|
||||
if not Thread_Blocking_IO
|
||||
if not Constants.Thread_Blocking_IO
|
||||
and then R /= Failure
|
||||
then
|
||||
-- Do not use C_Ioctl as this subprogram tracks sockets set
|
||||
@ -384,13 +382,19 @@ package body GNAT.Sockets.Thin is
|
||||
null;
|
||||
end Finalize;
|
||||
|
||||
-------------------------
|
||||
-- Host_Error_Messages --
|
||||
-------------------------
|
||||
|
||||
package body Host_Error_Messages is separate;
|
||||
|
||||
----------------
|
||||
-- Initialize --
|
||||
----------------
|
||||
|
||||
procedure Initialize (Process_Blocking_IO : Boolean) is
|
||||
procedure Initialize is
|
||||
begin
|
||||
Thread_Blocking_IO := not Process_Blocking_IO;
|
||||
null;
|
||||
end Initialize;
|
||||
|
||||
-------------------------
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2006, AdaCore --
|
||||
-- Copyright (C) 2002-2007, 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- --
|
||||
@ -40,8 +40,8 @@
|
||||
with Interfaces.C.Pointers;
|
||||
with Interfaces.C.Strings;
|
||||
|
||||
with GNAT.Sockets.Constants;
|
||||
with GNAT.OS_Lib;
|
||||
with GNAT.Sockets.Constants;
|
||||
|
||||
with System;
|
||||
|
||||
@ -65,12 +65,21 @@ package GNAT.Sockets.Thin is
|
||||
|
||||
function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
|
||||
-- Returns the error message string for the error number Errno. If Errno is
|
||||
-- not known it returns "Unknown system error".
|
||||
-- not known, returns "Unknown system error".
|
||||
|
||||
function Host_Errno return Integer;
|
||||
pragma Import (C, Host_Errno, "__gnat_get_h_errno");
|
||||
-- Returns last host error number
|
||||
|
||||
package Host_Error_Messages is
|
||||
|
||||
function Host_Error_Message
|
||||
(H_Errno : Integer) return C.Strings.chars_ptr;
|
||||
-- Returns the error message string for the host error number H_Errno.
|
||||
-- If H_Errno is not known, returns "Unknown system error".
|
||||
|
||||
end Host_Error_Messages;
|
||||
|
||||
subtype Fd_Set_Access is System.Address;
|
||||
No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
|
||||
|
||||
@ -112,8 +121,11 @@ package GNAT.Sockets.Thin is
|
||||
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);
|
||||
-- Internet address
|
||||
-- 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);
|
||||
@ -220,6 +232,10 @@ package GNAT.Sockets.Thin is
|
||||
-- Indices into an Fd_Pair value providing access to each of the connected
|
||||
-- file descriptors.
|
||||
|
||||
--------------------------------
|
||||
-- Standard library functions --
|
||||
--------------------------------
|
||||
|
||||
function C_Accept
|
||||
(S : C.int;
|
||||
Addr : System.Address;
|
||||
@ -238,14 +254,6 @@ package GNAT.Sockets.Thin is
|
||||
Name : System.Address;
|
||||
Namelen : C.int) return C.int;
|
||||
|
||||
function C_Gethostbyaddr
|
||||
(Addr : System.Address;
|
||||
Len : C.int;
|
||||
Typ : C.int) return Hostent_Access;
|
||||
|
||||
function C_Gethostbyname
|
||||
(Name : C.char_array) return Hostent_Access;
|
||||
|
||||
function C_Gethostname
|
||||
(Name : System.Address;
|
||||
Namelen : C.int) return C.int;
|
||||
@ -255,14 +263,6 @@ package GNAT.Sockets.Thin is
|
||||
Name : System.Address;
|
||||
Namelen : not null access C.int) return C.int;
|
||||
|
||||
function C_Getservbyname
|
||||
(Name : C.char_array;
|
||||
Proto : C.char_array) return Servent_Access;
|
||||
|
||||
function C_Getservbyport
|
||||
(Port : C.int;
|
||||
Proto : C.char_array) return Servent_Access;
|
||||
|
||||
function C_Getsockname
|
||||
(S : C.int;
|
||||
Name : System.Address;
|
||||
@ -354,6 +354,10 @@ package GNAT.Sockets.Thin is
|
||||
Iov : System.Address;
|
||||
Iovcnt : C.int) return C.int;
|
||||
|
||||
-------------------------------------------------------
|
||||
-- Signalling file descriptors for selector abortion --
|
||||
-------------------------------------------------------
|
||||
|
||||
package Signalling_Fds is
|
||||
|
||||
function Create (Fds : not null access Fd_Pair) return C.int;
|
||||
@ -371,8 +375,16 @@ package GNAT.Sockets.Thin is
|
||||
-- Write one byte of data to wsig, the write end of a pair of signalling
|
||||
-- fds created by Create_Signalling_Fds.
|
||||
|
||||
procedure Close (Sig : C.int);
|
||||
pragma Convention (C, Close);
|
||||
-- Close one end of a pair of signalling fds (ignoring any error)
|
||||
|
||||
end Signalling_Fds;
|
||||
|
||||
----------------------------
|
||||
-- Socket sets management --
|
||||
----------------------------
|
||||
|
||||
procedure Free_Socket_Set
|
||||
(Set : Fd_Set_Access);
|
||||
-- Free system-dependent socket set
|
||||
@ -381,11 +393,11 @@ package GNAT.Sockets.Thin is
|
||||
(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.
|
||||
-- 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;
|
||||
@ -418,19 +430,35 @@ package GNAT.Sockets.Thin is
|
||||
Socket : C.int);
|
||||
-- Remove socket from the socket set
|
||||
|
||||
-------------------------------------------
|
||||
-- Nonreentrant network databases access --
|
||||
-------------------------------------------
|
||||
|
||||
function Nonreentrant_Gethostbyname
|
||||
(Name : C.char_array) return Hostent_Access;
|
||||
|
||||
function Nonreentrant_Gethostbyaddr
|
||||
(Addr : System.Address;
|
||||
Addr_Len : C.int;
|
||||
Addr_Type : C.int) return Hostent_Access;
|
||||
|
||||
function Nonreentrant_Getservbyname
|
||||
(Name : C.char_array;
|
||||
Proto : C.char_array) return Servent_Access;
|
||||
|
||||
function Nonreentrant_Getservbyport
|
||||
(Port : C.int;
|
||||
Proto : C.char_array) return Servent_Access;
|
||||
|
||||
procedure Initialize;
|
||||
procedure Finalize;
|
||||
procedure Initialize (Process_Blocking_IO : Boolean);
|
||||
|
||||
private
|
||||
|
||||
pragma Import (C, C_Bind, "DECC$BIND");
|
||||
pragma Import (C, C_Close, "DECC$CLOSE");
|
||||
pragma Import (C, C_Gethostbyaddr, "DECC$GETHOSTBYADDR");
|
||||
pragma Import (C, C_Gethostbyname, "DECC$GETHOSTBYNAME");
|
||||
pragma Import (C, C_Gethostname, "DECC$GETHOSTNAME");
|
||||
pragma Import (C, C_Getpeername, "DECC$GETPEERNAME");
|
||||
pragma Import (C, C_Getservbyname, "DECC$GETSERVBYNAME");
|
||||
pragma Import (C, C_Getservbyport, "DECC$GETSERVBYPORT");
|
||||
pragma Import (C, C_Getsockname, "DECC$GETSOCKNAME");
|
||||
pragma Import (C, C_Getsockopt, "DECC$GETSOCKOPT");
|
||||
pragma Import (C, C_Inet_Addr, "DECC$INET_ADDR");
|
||||
@ -449,4 +477,9 @@ private
|
||||
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");
|
||||
pragma Import (C, Nonreentrant_Getservbyport, "DECC$GETSERVBYPORT");
|
||||
|
||||
end GNAT.Sockets.Thin;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2006, AdaCore --
|
||||
-- Copyright (C) 2002-2007, 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- --
|
||||
@ -41,7 +41,6 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
with GNAT.Task_Lock;
|
||||
|
||||
with Interfaces.C; use Interfaces.C;
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body GNAT.Sockets.Thin is
|
||||
|
||||
@ -57,32 +56,13 @@ package body GNAT.Sockets.Thin is
|
||||
-- been set in non-blocking mode by the user.
|
||||
|
||||
Quantum : constant Duration := 0.2;
|
||||
-- When Thread_Blocking_IO is False, we set sockets in
|
||||
-- When Constants.Thread_Blocking_IO is False, we set sockets in
|
||||
-- non-blocking mode and we spend a period of time Quantum between
|
||||
-- two attempts on a blocking operation.
|
||||
|
||||
Thread_Blocking_IO : Boolean := True;
|
||||
|
||||
Unknown_System_Error : constant C.Strings.chars_ptr :=
|
||||
C.Strings.New_String ("Unknown system error");
|
||||
|
||||
-- The following types and variables are required to create a Hostent
|
||||
-- record "by hand".
|
||||
|
||||
type In_Addr_Access_Array_Access is access In_Addr_Access_Array;
|
||||
|
||||
Alias_Access : constant Chars_Ptr_Pointers.Pointer :=
|
||||
new C.Strings.chars_ptr'(C.Strings.Null_Ptr);
|
||||
|
||||
In_Addr_Access_Array_A : constant In_Addr_Access_Array_Access :=
|
||||
new In_Addr_Access_Array'(new In_Addr, null);
|
||||
|
||||
In_Addr_Access_Ptr : constant In_Addr_Access_Pointers.Pointer :=
|
||||
In_Addr_Access_Array_A
|
||||
(In_Addr_Access_Array_A'First)'Access;
|
||||
|
||||
Local_Hostent : constant Hostent_Access := new Hostent;
|
||||
|
||||
-----------------------
|
||||
-- Local Subprograms --
|
||||
-----------------------
|
||||
@ -166,14 +146,14 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
loop
|
||||
R := Syscall_Accept (S, Addr, Addrlen);
|
||||
exit when Thread_Blocking_IO
|
||||
exit when Constants.Thread_Blocking_IO
|
||||
or else R /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EWOULDBLOCK;
|
||||
delay Quantum;
|
||||
end loop;
|
||||
|
||||
if not Thread_Blocking_IO
|
||||
if not Constants.Thread_Blocking_IO
|
||||
and then R /= Failure
|
||||
then
|
||||
-- A socket inherits the properties ot its server especially
|
||||
@ -202,7 +182,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
Res := Syscall_Connect (S, Name, Namelen);
|
||||
|
||||
if Thread_Blocking_IO
|
||||
if Constants.Thread_Blocking_IO
|
||||
or else Res /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EINPROGRESS
|
||||
@ -251,97 +231,6 @@ package body GNAT.Sockets.Thin is
|
||||
end if;
|
||||
end C_Connect;
|
||||
|
||||
---------------------
|
||||
-- C_Gethostbyaddr --
|
||||
---------------------
|
||||
|
||||
function C_Gethostbyaddr
|
||||
(Addr : System.Address;
|
||||
Len : C.int;
|
||||
Typ : C.int) return Hostent_Access
|
||||
is
|
||||
pragma Warnings (Off, Len);
|
||||
pragma Warnings (Off, Typ);
|
||||
|
||||
type int_Access is access int;
|
||||
function To_Pointer is
|
||||
new Unchecked_Conversion (System.Address, int_Access);
|
||||
|
||||
function VxWorks_hostGetByAddr
|
||||
(Addr : C.int; Buf : System.Address) return C.int;
|
||||
pragma Import (C, VxWorks_hostGetByAddr, "hostGetByAddr");
|
||||
|
||||
Host_Name : aliased C.char_array (1 .. Max_Name_Length);
|
||||
|
||||
begin
|
||||
if VxWorks_hostGetByAddr (To_Pointer (Addr).all,
|
||||
Host_Name (Host_Name'First)'Address)
|
||||
/= Constants.OK
|
||||
then
|
||||
return null;
|
||||
end if;
|
||||
|
||||
In_Addr_Access_Ptr.all.all := To_In_Addr (To_Pointer (Addr).all);
|
||||
Local_Hostent.all.H_Name := C.Strings.New_Char_Array (Host_Name);
|
||||
|
||||
return Local_Hostent;
|
||||
end C_Gethostbyaddr;
|
||||
|
||||
---------------------
|
||||
-- C_Gethostbyname --
|
||||
---------------------
|
||||
|
||||
function C_Gethostbyname
|
||||
(Name : C.char_array) return Hostent_Access
|
||||
is
|
||||
function VxWorks_hostGetByName
|
||||
(Name : C.char_array) return C.int;
|
||||
pragma Import (C, VxWorks_hostGetByName, "hostGetByName");
|
||||
|
||||
Addr : C.int;
|
||||
|
||||
begin
|
||||
Addr := VxWorks_hostGetByName (Name);
|
||||
if Addr = Constants.ERROR then
|
||||
return null;
|
||||
end if;
|
||||
|
||||
In_Addr_Access_Ptr.all.all := To_In_Addr (Addr);
|
||||
Local_Hostent.all.H_Name := C.Strings.New_Char_Array (To_C (Host_Name));
|
||||
|
||||
return Local_Hostent;
|
||||
end C_Gethostbyname;
|
||||
|
||||
---------------------
|
||||
-- C_Getservbyname --
|
||||
---------------------
|
||||
|
||||
function C_Getservbyname
|
||||
(Name : C.char_array;
|
||||
Proto : C.char_array) return Servent_Access
|
||||
is
|
||||
pragma Warnings (Off, Name);
|
||||
pragma Warnings (Off, Proto);
|
||||
|
||||
begin
|
||||
return null;
|
||||
end C_Getservbyname;
|
||||
|
||||
---------------------
|
||||
-- C_Getservbyport --
|
||||
---------------------
|
||||
|
||||
function C_Getservbyport
|
||||
(Port : C.int;
|
||||
Proto : C.char_array) return Servent_Access
|
||||
is
|
||||
pragma Warnings (Off, Port);
|
||||
pragma Warnings (Off, Proto);
|
||||
|
||||
begin
|
||||
return null;
|
||||
end C_Getservbyport;
|
||||
|
||||
-------------
|
||||
-- C_Ioctl --
|
||||
-------------
|
||||
@ -352,7 +241,7 @@ package body GNAT.Sockets.Thin is
|
||||
Arg : Int_Access) return C.int
|
||||
is
|
||||
begin
|
||||
if not Thread_Blocking_IO
|
||||
if not Constants.Thread_Blocking_IO
|
||||
and then Req = Constants.FIONBIO
|
||||
then
|
||||
if Arg.all /= 0 then
|
||||
@ -378,7 +267,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
loop
|
||||
Res := Syscall_Recv (S, Msg, Len, Flags);
|
||||
exit when Thread_Blocking_IO
|
||||
exit when Constants.Thread_Blocking_IO
|
||||
or else Res /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EWOULDBLOCK;
|
||||
@ -405,7 +294,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
loop
|
||||
Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
|
||||
exit when Thread_Blocking_IO
|
||||
exit when Constants.Thread_Blocking_IO
|
||||
or else Res /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EWOULDBLOCK;
|
||||
@ -430,7 +319,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
loop
|
||||
Res := Syscall_Send (S, Msg, Len, Flags);
|
||||
exit when Thread_Blocking_IO
|
||||
exit when Constants.Thread_Blocking_IO
|
||||
or else Res /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EWOULDBLOCK;
|
||||
@ -457,7 +346,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
loop
|
||||
Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
|
||||
exit when Thread_Blocking_IO
|
||||
exit when Constants.Thread_Blocking_IO
|
||||
or else Res /= Failure
|
||||
or else Non_Blocking_Socket (S)
|
||||
or else Errno /= Constants.EWOULDBLOCK;
|
||||
@ -485,7 +374,7 @@ package body GNAT.Sockets.Thin is
|
||||
begin
|
||||
R := Syscall_Socket (Domain, Typ, Protocol);
|
||||
|
||||
if not Thread_Blocking_IO
|
||||
if not Constants.Thread_Blocking_IO
|
||||
and then R /= Failure
|
||||
then
|
||||
-- Do not use C_Ioctl as this subprogram tracks sockets set
|
||||
@ -508,13 +397,19 @@ package body GNAT.Sockets.Thin is
|
||||
null;
|
||||
end Finalize;
|
||||
|
||||
-------------------------
|
||||
-- Host_Error_Messages --
|
||||
-------------------------
|
||||
|
||||
package body Host_Error_Messages is separate;
|
||||
|
||||
----------------
|
||||
-- Initialize --
|
||||
----------------
|
||||
|
||||
procedure Initialize (Process_Blocking_IO : Boolean) is
|
||||
procedure Initialize is
|
||||
begin
|
||||
Thread_Blocking_IO := not Process_Blocking_IO;
|
||||
null;
|
||||
end Initialize;
|
||||
|
||||
-------------------------
|
||||
@ -539,7 +434,7 @@ package body GNAT.Sockets.Thin is
|
||||
Address : In_Addr)
|
||||
is
|
||||
begin
|
||||
Sin.Sin_Addr := Address;
|
||||
Sin.Sin_Addr := Address;
|
||||
end Set_Address;
|
||||
|
||||
----------------
|
||||
@ -622,16 +517,4 @@ package body GNAT.Sockets.Thin is
|
||||
end if;
|
||||
end Socket_Error_Message;
|
||||
|
||||
-- Package elaboration
|
||||
|
||||
begin
|
||||
Local_Hostent.all.H_Aliases := Alias_Access;
|
||||
|
||||
-- VxWorks currently only supports AF_INET
|
||||
|
||||
Local_Hostent.all.H_Addrtype := Constants.AF_INET;
|
||||
|
||||
Local_Hostent.all.H_Length := 1;
|
||||
Local_Hostent.all.H_Addr_List := In_Addr_Access_Ptr;
|
||||
|
||||
end GNAT.Sockets.Thin;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2006, AdaCore --
|
||||
-- Copyright (C) 2002-2007, 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- --
|
||||
@ -42,8 +42,8 @@ with Interfaces.C.Strings;
|
||||
|
||||
with Ada.Unchecked_Conversion;
|
||||
|
||||
with GNAT.Sockets.Constants;
|
||||
with GNAT.OS_Lib;
|
||||
with GNAT.Sockets.Constants;
|
||||
|
||||
with System;
|
||||
|
||||
@ -65,12 +65,21 @@ package GNAT.Sockets.Thin is
|
||||
|
||||
function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
|
||||
-- Returns the error message string for the error number Errno. If Errno is
|
||||
-- not known it returns "Unknown system error".
|
||||
-- not known, returns "Unknown system error".
|
||||
|
||||
function Host_Errno return Integer;
|
||||
pragma Import (C, Host_Errno, "__gnat_get_h_errno");
|
||||
-- Returns last host error number
|
||||
|
||||
package Host_Error_Messages is
|
||||
|
||||
function Host_Error_Message
|
||||
(H_Errno : Integer) return C.Strings.chars_ptr;
|
||||
-- Returns the error message string for the host error number H_Errno.
|
||||
-- If H_Errno is not known, returns "Unknown system error".
|
||||
|
||||
end Host_Error_Messages;
|
||||
|
||||
subtype Fd_Set_Access is System.Address;
|
||||
No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
|
||||
|
||||
@ -112,8 +121,11 @@ package GNAT.Sockets.Thin is
|
||||
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);
|
||||
-- Internet address
|
||||
-- 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.
|
||||
|
||||
function To_In_Addr is new Ada.Unchecked_Conversion (C.int, In_Addr);
|
||||
|
||||
@ -223,6 +235,10 @@ package GNAT.Sockets.Thin is
|
||||
-- Indices into an Fd_Pair value providing access to each of the connected
|
||||
-- file descriptors.
|
||||
|
||||
--------------------------------
|
||||
-- Standard library functions --
|
||||
--------------------------------
|
||||
|
||||
function C_Accept
|
||||
(S : C.int;
|
||||
Addr : System.Address;
|
||||
@ -241,14 +257,6 @@ package GNAT.Sockets.Thin is
|
||||
Name : System.Address;
|
||||
Namelen : C.int) return C.int;
|
||||
|
||||
function C_Gethostbyaddr
|
||||
(Addr : System.Address;
|
||||
Len : C.int;
|
||||
Typ : C.int) return Hostent_Access;
|
||||
|
||||
function C_Gethostbyname
|
||||
(Name : C.char_array) return Hostent_Access;
|
||||
|
||||
function C_Gethostname
|
||||
(Name : System.Address;
|
||||
Namelen : C.int) return C.int;
|
||||
@ -258,14 +266,6 @@ package GNAT.Sockets.Thin is
|
||||
Name : System.Address;
|
||||
Namelen : not null access C.int) return C.int;
|
||||
|
||||
function C_Getservbyname
|
||||
(Name : C.char_array;
|
||||
Proto : C.char_array) return Servent_Access;
|
||||
|
||||
function C_Getservbyport
|
||||
(Port : C.int;
|
||||
Proto : C.char_array) return Servent_Access;
|
||||
|
||||
function C_Getsockname
|
||||
(S : C.int;
|
||||
Name : System.Address;
|
||||
@ -357,6 +357,10 @@ package GNAT.Sockets.Thin is
|
||||
Iov : System.Address;
|
||||
Iovcnt : C.int) return C.int;
|
||||
|
||||
-------------------------------------------------------
|
||||
-- Signalling file descriptors for selector abortion --
|
||||
-------------------------------------------------------
|
||||
|
||||
package Signalling_Fds is
|
||||
|
||||
function Create (Fds : not null access Fd_Pair) return C.int;
|
||||
@ -374,8 +378,16 @@ package GNAT.Sockets.Thin is
|
||||
-- Write one byte of data to wsig, the write end of a pair of signalling
|
||||
-- fds created by Create_Signalling_Fds.
|
||||
|
||||
procedure Close (Sig : C.int);
|
||||
pragma Convention (C, Close);
|
||||
-- Close one end of a pair of signalling fds (ignoring any error)
|
||||
|
||||
end Signalling_Fds;
|
||||
|
||||
----------------------------
|
||||
-- Socket sets management --
|
||||
----------------------------
|
||||
|
||||
procedure Free_Socket_Set
|
||||
(Set : Fd_Set_Access);
|
||||
-- Free system-dependent socket set
|
||||
@ -384,11 +396,11 @@ package GNAT.Sockets.Thin is
|
||||
(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.
|
||||
-- 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;
|
||||
@ -421,8 +433,8 @@ package GNAT.Sockets.Thin is
|
||||
Socket : C.int);
|
||||
-- Remove socket from the socket set
|
||||
|
||||
procedure Initialize;
|
||||
procedure Finalize;
|
||||
procedure Initialize (Process_Blocking_IO : Boolean);
|
||||
|
||||
private
|
||||
pragma Import (C, C_Bind, "bind");
|
||||
|
||||
75
gcc/ada/g-stheme.adb
Normal file
75
gcc/ada/g-stheme.adb
Normal file
@ -0,0 +1,75 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- GNAT.SOCKETS.THIN.HOST_ERROR_MESSAGES --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2007, 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- --
|
||||
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
||||
-- for more details. You should have received a copy of the GNU General --
|
||||
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
||||
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
|
||||
-- Boston, MA 02110-1301, USA. --
|
||||
-- --
|
||||
-- As a special exception, if other files instantiate generics from this --
|
||||
-- unit, or you link this unit with other files to produce an executable, --
|
||||
-- this unit does not by itself cause the resulting executable to be --
|
||||
-- covered by the GNU General Public License. This exception does not --
|
||||
-- however invalidate any other reasons why the executable file might be --
|
||||
-- covered by the GNU Public License. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This is the default implementation of this unit, providing explicit
|
||||
-- literal messages (we do not use hstrerror from the standard C library,
|
||||
-- as this function is obsolete).
|
||||
|
||||
separate (GNAT.Sockets.Thin)
|
||||
package body Host_Error_Messages is
|
||||
|
||||
package Messages is
|
||||
HOST_NOT_FOUND : aliased char_array := "Host not found" & nul;
|
||||
TRY_AGAIN : aliased char_array := "Try again" & nul;
|
||||
NO_RECOVERY : aliased char_array := "No recovery" & nul;
|
||||
NO_DATA : aliased char_array := "No address" & nul;
|
||||
Unknown_Error : aliased char_array := "Unknown error" & nul;
|
||||
end Messages;
|
||||
|
||||
function Host_Error_Message (H_Errno : Integer) return C.Strings.chars_ptr
|
||||
is
|
||||
use Interfaces.C.Strings;
|
||||
function TCP
|
||||
(P : char_array_access; Nul_Check : Boolean := False) return chars_ptr
|
||||
renames To_Chars_Ptr;
|
||||
begin
|
||||
case H_Errno is
|
||||
when Constants.HOST_NOT_FOUND =>
|
||||
return TCP (Messages.HOST_NOT_FOUND'Access);
|
||||
|
||||
when Constants.TRY_AGAIN =>
|
||||
return TCP (Messages.TRY_AGAIN'Access);
|
||||
|
||||
when Constants.NO_RECOVERY =>
|
||||
return TCP (Messages.NO_RECOVERY'Access);
|
||||
|
||||
when Constants.NO_DATA =>
|
||||
return TCP (Messages.NO_DATA'Access);
|
||||
|
||||
when others =>
|
||||
return TCP (Messages.Unknown_Error'Access);
|
||||
|
||||
end case;
|
||||
end Host_Error_Message;
|
||||
|
||||
end Host_Error_Messages;
|
||||
442
gcc/ada/g-sttsne-locking.adb
Normal file
442
gcc/ada/g-sttsne-locking.adb
Normal file
@ -0,0 +1,442 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2007, 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- --
|
||||
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
||||
-- for more details. You should have received a copy of the GNU General --
|
||||
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
||||
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
|
||||
-- Boston, MA 02110-1301, USA. --
|
||||
-- --
|
||||
-- As a special exception, if other files instantiate generics from this --
|
||||
-- unit, or you link this unit with other files to produce an executable, --
|
||||
-- this unit does not by itself cause the resulting executable to be --
|
||||
-- covered by the GNU General Public License. This exception does not --
|
||||
-- however invalidate any other reasons why the executable file might be --
|
||||
-- covered by the GNU Public License. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with GNAT.Task_Lock;
|
||||
|
||||
with Interfaces.C; use Interfaces.C;
|
||||
|
||||
package body GNAT.Sockets.Thin.Task_Safe_NetDB is
|
||||
|
||||
procedure Copy_Host_Entry
|
||||
(Source_Hostent : Hostent;
|
||||
Target_Hostent : out Hostent;
|
||||
Target_Buffer : System.Address;
|
||||
Target_Buffer_Length : C.int;
|
||||
Result : out C.int);
|
||||
-- Copy all the information from Source_Hostent into Target_Hostent,
|
||||
-- using Target_Buffer to store associated data.
|
||||
-- 0 is returned on success, -1 on failure (in case the provided buffer
|
||||
-- is too small for the associated data).
|
||||
|
||||
procedure Copy_Service_Entry
|
||||
(Source_Servent : Servent;
|
||||
Target_Servent : out Servent;
|
||||
Target_Buffer : System.Address;
|
||||
Target_Buffer_Length : C.int;
|
||||
Result : out C.int);
|
||||
-- Copy all the information from Source_Servent into Target_Servent,
|
||||
-- using Target_Buffer to store associated data.
|
||||
-- 0 is returned on success, -1 on failure (in case the provided buffer
|
||||
-- is too small for the associated data).
|
||||
|
||||
procedure Store_Name
|
||||
(Name : char_array;
|
||||
Storage : in out char_array;
|
||||
Storage_Index : in out size_t;
|
||||
Stored_Name : out C.Strings.chars_ptr);
|
||||
-- Store the given Name at the first available location in Storage
|
||||
-- (indicated by Storage_Index, which is updated afterwards), and return
|
||||
-- the address of that location in Stored_Name.
|
||||
-- (Supporting routine for the two below).
|
||||
|
||||
---------------------
|
||||
-- Copy_Host_Entry --
|
||||
---------------------
|
||||
|
||||
procedure Copy_Host_Entry
|
||||
(Source_Hostent : Hostent;
|
||||
Target_Hostent : out Hostent;
|
||||
Target_Buffer : System.Address;
|
||||
Target_Buffer_Length : C.int;
|
||||
Result : out C.int)
|
||||
is
|
||||
use type C.Strings.chars_ptr;
|
||||
|
||||
Names_Length : size_t;
|
||||
|
||||
Source_Aliases : Chars_Ptr_Array
|
||||
renames Chars_Ptr_Pointers.Value
|
||||
(Source_Hostent.H_Aliases, Terminator => C.Strings.Null_Ptr);
|
||||
-- Null-terminated list of aliases (last element of this array is
|
||||
-- Null_Ptr).
|
||||
|
||||
Source_Addresses : In_Addr_Access_Array
|
||||
renames In_Addr_Access_Pointers.Value
|
||||
(Source_Hostent.H_Addr_List, Terminator => null);
|
||||
|
||||
begin
|
||||
Result := -1;
|
||||
Names_Length := C.Strings.Strlen (Source_Hostent.H_Name) + 1;
|
||||
|
||||
for J in Source_Aliases'Range loop
|
||||
if Source_Aliases (J) /= C.Strings.Null_Ptr then
|
||||
Names_Length :=
|
||||
Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
declare
|
||||
type In_Addr_Array is array (Source_Addresses'Range)
|
||||
of aliased In_Addr;
|
||||
|
||||
type Netdb_Host_Data is record
|
||||
Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
|
||||
Names : aliased char_array (1 .. Names_Length);
|
||||
|
||||
Addresses_List : aliased In_Addr_Access_Array
|
||||
(In_Addr_Array'Range);
|
||||
Addresses : In_Addr_Array;
|
||||
-- ??? This assumes support only for Inet family
|
||||
|
||||
end record;
|
||||
|
||||
Netdb_Data : Netdb_Host_Data;
|
||||
pragma Import (Ada, Netdb_Data);
|
||||
for Netdb_Data'Address use Target_Buffer;
|
||||
|
||||
Names_Index : size_t := Netdb_Data.Names'First;
|
||||
-- Index of first available location in Netdb_Data.Names
|
||||
|
||||
begin
|
||||
if Netdb_Data'Size / 8 > Target_Buffer_Length then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Copy host name
|
||||
|
||||
Store_Name
|
||||
(C.Strings.Value (Source_Hostent.H_Name),
|
||||
Netdb_Data.Names, Names_Index,
|
||||
Target_Hostent.H_Name);
|
||||
|
||||
-- Copy aliases (null-terminated string pointer array)
|
||||
|
||||
Target_Hostent.H_Aliases :=
|
||||
Netdb_Data.Aliases_List
|
||||
(Netdb_Data.Aliases_List'First)'Unchecked_Access;
|
||||
for J in Netdb_Data.Aliases_List'Range loop
|
||||
if J = Netdb_Data.Aliases_List'Last then
|
||||
Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
|
||||
else
|
||||
Store_Name
|
||||
(C.Strings.Value (Source_Aliases (J)),
|
||||
Netdb_Data.Names, Names_Index,
|
||||
Netdb_Data.Aliases_List (J));
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- Copy address type and length
|
||||
|
||||
Target_Hostent.H_Addrtype := Source_Hostent.H_Addrtype;
|
||||
Target_Hostent.H_Length := Source_Hostent.H_Length;
|
||||
|
||||
-- Copy addresses
|
||||
|
||||
Target_Hostent.H_Addr_List :=
|
||||
Netdb_Data.Addresses_List
|
||||
(Netdb_Data.Addresses_List'First)'Unchecked_Access;
|
||||
|
||||
for J in Netdb_Data.Addresses'Range loop
|
||||
if J = Netdb_Data.Addresses'Last then
|
||||
Netdb_Data.Addresses_List (J) := null;
|
||||
else
|
||||
Netdb_Data.Addresses_List (J) :=
|
||||
Netdb_Data.Addresses (J)'Unchecked_Access;
|
||||
|
||||
Netdb_Data.Addresses (J) := Source_Addresses (J).all;
|
||||
end if;
|
||||
end loop;
|
||||
end;
|
||||
|
||||
Result := 0;
|
||||
end Copy_Host_Entry;
|
||||
|
||||
------------------------
|
||||
-- Copy_Service_Entry --
|
||||
------------------------
|
||||
|
||||
procedure Copy_Service_Entry
|
||||
(Source_Servent : Servent;
|
||||
Target_Servent : out Servent;
|
||||
Target_Buffer : System.Address;
|
||||
Target_Buffer_Length : C.int;
|
||||
Result : out C.int)
|
||||
is
|
||||
use type C.Strings.chars_ptr;
|
||||
|
||||
Names_Length : size_t;
|
||||
|
||||
Source_Aliases : Chars_Ptr_Array
|
||||
renames Chars_Ptr_Pointers.Value
|
||||
(Source_Servent.S_Aliases, Terminator => C.Strings.Null_Ptr);
|
||||
-- Null-terminated list of aliases (last element of this array is
|
||||
-- Null_Ptr).
|
||||
|
||||
begin
|
||||
Result := -1;
|
||||
Names_Length := C.Strings.Strlen (Source_Servent.S_Name) + 1
|
||||
+ C.Strings.Strlen (Source_Servent.S_Proto) + 1;
|
||||
|
||||
for J in Source_Aliases'Range loop
|
||||
if Source_Aliases (J) /= C.Strings.Null_Ptr then
|
||||
Names_Length :=
|
||||
Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
declare
|
||||
type Netdb_Service_Data is record
|
||||
Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
|
||||
Names : aliased char_array (1 .. Names_Length);
|
||||
end record;
|
||||
|
||||
Netdb_Data : Netdb_Service_Data;
|
||||
pragma Import (Ada, Netdb_Data);
|
||||
for Netdb_Data'Address use Target_Buffer;
|
||||
|
||||
Names_Index : size_t := Netdb_Data.Names'First;
|
||||
-- Index of first available location in Netdb_Data.Names
|
||||
|
||||
begin
|
||||
if Netdb_Data'Size / 8 > Target_Buffer_Length then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Copy service name
|
||||
|
||||
Store_Name
|
||||
(C.Strings.Value (Source_Servent.S_Name),
|
||||
Netdb_Data.Names, Names_Index,
|
||||
Target_Servent.S_Name);
|
||||
|
||||
-- Copy aliases (null-terminated string pointer array)
|
||||
|
||||
Target_Servent.S_Aliases :=
|
||||
Netdb_Data.Aliases_List
|
||||
(Netdb_Data.Aliases_List'First)'Unchecked_Access;
|
||||
|
||||
-- Copy port number
|
||||
|
||||
Target_Servent.S_Port := Source_Servent.S_Port;
|
||||
|
||||
-- Copy protocol name
|
||||
|
||||
Store_Name
|
||||
(C.Strings.Value (Source_Servent.S_Proto),
|
||||
Netdb_Data.Names, Names_Index,
|
||||
Target_Servent.S_Proto);
|
||||
|
||||
for J in Netdb_Data.Aliases_List'Range loop
|
||||
if J = Netdb_Data.Aliases_List'Last then
|
||||
Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
|
||||
else
|
||||
Store_Name
|
||||
(C.Strings.Value (Source_Aliases (J)),
|
||||
Netdb_Data.Names, Names_Index,
|
||||
Netdb_Data.Aliases_List (J));
|
||||
end if;
|
||||
end loop;
|
||||
end;
|
||||
|
||||
Result := 0;
|
||||
end Copy_Service_Entry;
|
||||
|
||||
------------------------
|
||||
-- Safe_Gethostbyaddr --
|
||||
------------------------
|
||||
|
||||
function Safe_Gethostbyaddr
|
||||
(Addr : System.Address;
|
||||
Addr_Len : C.int;
|
||||
Addr_Type : C.int;
|
||||
Ret : not null access Hostent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int;
|
||||
H_Errnop : not null access C.int) return C.int
|
||||
is
|
||||
HE : Hostent_Access;
|
||||
Result : C.int;
|
||||
begin
|
||||
Result := -1;
|
||||
GNAT.Task_Lock.Lock;
|
||||
HE := Nonreentrant_Gethostbyaddr (Addr, Addr_Len, Addr_Type);
|
||||
|
||||
if HE = null then
|
||||
H_Errnop.all := C.int (Host_Errno);
|
||||
goto Unlock_Return;
|
||||
end if;
|
||||
|
||||
-- Now copy the data to the user-provided buffer
|
||||
|
||||
Copy_Host_Entry
|
||||
(Source_Hostent => HE.all,
|
||||
Target_Hostent => Ret.all,
|
||||
Target_Buffer => Buf,
|
||||
Target_Buffer_Length => Buflen,
|
||||
Result => Result);
|
||||
|
||||
<<Unlock_Return>>
|
||||
GNAT.Task_Lock.Unlock;
|
||||
return Result;
|
||||
end Safe_Gethostbyaddr;
|
||||
|
||||
------------------------
|
||||
-- Safe_Gethostbyname --
|
||||
------------------------
|
||||
|
||||
function Safe_Gethostbyname
|
||||
(Name : C.char_array;
|
||||
Ret : not null access Hostent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int;
|
||||
H_Errnop : not null access C.int) return C.int
|
||||
is
|
||||
HE : Hostent_Access;
|
||||
Result : C.int;
|
||||
begin
|
||||
Result := -1;
|
||||
GNAT.Task_Lock.Lock;
|
||||
HE := Nonreentrant_Gethostbyname (Name);
|
||||
|
||||
if HE = null then
|
||||
H_Errnop.all := C.int (Host_Errno);
|
||||
goto Unlock_Return;
|
||||
end if;
|
||||
|
||||
-- Now copy the data to the user-provided buffer
|
||||
|
||||
Copy_Host_Entry
|
||||
(Source_Hostent => HE.all,
|
||||
Target_Hostent => Ret.all,
|
||||
Target_Buffer => Buf,
|
||||
Target_Buffer_Length => Buflen,
|
||||
Result => Result);
|
||||
|
||||
<<Unlock_Return>>
|
||||
GNAT.Task_Lock.Unlock;
|
||||
return Result;
|
||||
end Safe_Gethostbyname;
|
||||
|
||||
------------------------
|
||||
-- Safe_Getservbyname --
|
||||
------------------------
|
||||
|
||||
function Safe_Getservbyname
|
||||
(Name : C.char_array;
|
||||
Proto : C.char_array;
|
||||
Ret : not null access Servent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int) return C.int
|
||||
is
|
||||
SE : Servent_Access;
|
||||
Result : C.int;
|
||||
begin
|
||||
Result := -1;
|
||||
GNAT.Task_Lock.Lock;
|
||||
SE := Nonreentrant_Getservbyname (Name, Proto);
|
||||
|
||||
if SE = null then
|
||||
goto Unlock_Return;
|
||||
end if;
|
||||
|
||||
-- Now copy the data to the user-provided buffer
|
||||
|
||||
Copy_Service_Entry
|
||||
(Source_Servent => SE.all,
|
||||
Target_Servent => Ret.all,
|
||||
Target_Buffer => Buf,
|
||||
Target_Buffer_Length => Buflen,
|
||||
Result => Result);
|
||||
|
||||
<<Unlock_Return>>
|
||||
GNAT.Task_Lock.Unlock;
|
||||
return Result;
|
||||
end Safe_Getservbyname;
|
||||
|
||||
------------------------
|
||||
-- Safe_Getservbyport --
|
||||
------------------------
|
||||
|
||||
function Safe_Getservbyport
|
||||
(Port : C.int;
|
||||
Proto : C.char_array;
|
||||
Ret : not null access Servent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int) return C.int
|
||||
is
|
||||
SE : Servent_Access;
|
||||
Result : C.int;
|
||||
|
||||
begin
|
||||
Result := -1;
|
||||
GNAT.Task_Lock.Lock;
|
||||
SE := Nonreentrant_Getservbyport (Port, Proto);
|
||||
|
||||
if SE = null then
|
||||
goto Unlock_Return;
|
||||
end if;
|
||||
|
||||
-- Now copy the data to the user-provided buffer
|
||||
|
||||
Copy_Service_Entry
|
||||
(Source_Servent => SE.all,
|
||||
Target_Servent => Ret.all,
|
||||
Target_Buffer => Buf,
|
||||
Target_Buffer_Length => Buflen,
|
||||
Result => Result);
|
||||
|
||||
<<Unlock_Return>>
|
||||
GNAT.Task_Lock.Unlock;
|
||||
return Result;
|
||||
end Safe_Getservbyport;
|
||||
|
||||
----------------
|
||||
-- Store_Name --
|
||||
----------------
|
||||
|
||||
procedure Store_Name
|
||||
(Name : char_array;
|
||||
Storage : in out char_array;
|
||||
Storage_Index : in out size_t;
|
||||
Stored_Name : out C.Strings.chars_ptr)
|
||||
is
|
||||
First : constant C.size_t := Storage_Index;
|
||||
Last : constant C.size_t := Storage_Index + Name'Length - 1;
|
||||
begin
|
||||
Storage (First .. Last) := Name;
|
||||
Stored_Name := C.Strings.To_Chars_Ptr
|
||||
(Storage (First .. Last)'Unrestricted_Access);
|
||||
Storage_Index := Last + 1;
|
||||
end Store_Name;
|
||||
|
||||
end GNAT.Sockets.Thin.Task_Safe_NetDB;
|
||||
78
gcc/ada/g-sttsne-locking.ads
Normal file
78
gcc/ada/g-sttsne-locking.ads
Normal file
@ -0,0 +1,78 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2007, 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- --
|
||||
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
||||
-- for more details. You should have received a copy of the GNU General --
|
||||
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
||||
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
|
||||
-- Boston, MA 02110-1301, USA. --
|
||||
-- --
|
||||
-- As a special exception, if other files instantiate generics from this --
|
||||
-- unit, or you link this unit with other files to produce an executable, --
|
||||
-- this unit does not by itself cause the resulting executable to be --
|
||||
-- covered by the GNU General Public License. This exception does not --
|
||||
-- however invalidate any other reasons why the executable file might be --
|
||||
-- covered by the GNU Public License. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This version is used on VMS and LynxOS
|
||||
|
||||
package GNAT.Sockets.Thin.Task_Safe_NetDB is
|
||||
|
||||
----------------------------------------
|
||||
-- Reentrant network databases access --
|
||||
----------------------------------------
|
||||
|
||||
-- The following routines wrap the Nonreentrant_ versions using the task
|
||||
-- lock, and copy the relevant data structures (under the lock) into the
|
||||
-- result. The Nonreentrant_ versions are expected to be in the parent
|
||||
-- package GNAT.Sockets.Thin (on platforms that use this version of
|
||||
-- Task_Safe_NetDB).
|
||||
|
||||
function Safe_Gethostbyname
|
||||
(Name : C.char_array;
|
||||
Ret : not null access Hostent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int;
|
||||
H_Errnop : not null access C.int) return C.int;
|
||||
|
||||
function Safe_Gethostbyaddr
|
||||
(Addr : System.Address;
|
||||
Addr_Len : C.int;
|
||||
Addr_Type : C.int;
|
||||
Ret : not null access Hostent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int;
|
||||
H_Errnop : not null access C.int) return C.int;
|
||||
|
||||
function Safe_Getservbyname
|
||||
(Name : C.char_array;
|
||||
Proto : C.char_array;
|
||||
Ret : not null access Servent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int) return C.int;
|
||||
|
||||
function Safe_Getservbyport
|
||||
(Port : C.int;
|
||||
Proto : C.char_array;
|
||||
Ret : not null access Servent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int) return C.int;
|
||||
|
||||
end GNAT.Sockets.Thin.Task_Safe_NetDB;
|
||||
202
gcc/ada/g-sttsne-vxworks.adb
Normal file
202
gcc/ada/g-sttsne-vxworks.adb
Normal file
@ -0,0 +1,202 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2007, 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- --
|
||||
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
||||
-- for more details. You should have received a copy of the GNU General --
|
||||
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
||||
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
|
||||
-- Boston, MA 02110-1301, USA. --
|
||||
-- --
|
||||
-- As a special exception, if other files instantiate generics from this --
|
||||
-- unit, or you link this unit with other files to produce an executable, --
|
||||
-- this unit does not by itself cause the resulting executable to be --
|
||||
-- covered by the GNU General Public License. This exception does not --
|
||||
-- however invalidate any other reasons why the executable file might be --
|
||||
-- covered by the GNU Public License. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Interfaces.C; use Interfaces.C;
|
||||
|
||||
package body GNAT.Sockets.Thin.Task_Safe_NetDB is
|
||||
|
||||
-- The following additional data is returned by Safe_Gethostbyname
|
||||
-- and Safe_Getostbyaddr in the user provided buffer.
|
||||
|
||||
type Netdb_Host_Data (Name_Length : C.size_t) is record
|
||||
Address : aliased In_Addr;
|
||||
Addr_List : aliased In_Addr_Access_Array (0 .. 1);
|
||||
Name : aliased C.char_array (0 .. Name_Length);
|
||||
end record;
|
||||
|
||||
Alias_Access : constant Chars_Ptr_Pointers.Pointer :=
|
||||
new C.Strings.chars_ptr'(C.Strings.Null_Ptr);
|
||||
-- Constant used to create a Hostent record manually
|
||||
|
||||
------------------------
|
||||
-- Safe_Gethostbyaddr --
|
||||
------------------------
|
||||
|
||||
function Safe_Gethostbyaddr
|
||||
(Addr : System.Address;
|
||||
Addr_Len : C.int;
|
||||
Addr_Type : C.int;
|
||||
Ret : not null access Hostent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int;
|
||||
H_Errnop : not null access C.int) return C.int
|
||||
is
|
||||
type int_Access is access int;
|
||||
function To_Pointer is
|
||||
new Ada.Unchecked_Conversion (System.Address, int_Access);
|
||||
|
||||
function VxWorks_hostGetByAddr
|
||||
(Addr : C.int; Buf : System.Address) return C.int;
|
||||
pragma Import (C, VxWorks_hostGetByAddr, "hostGetByAddr");
|
||||
|
||||
Netdb_Data : Netdb_Host_Data (Name_Length => Max_Name_Length);
|
||||
pragma Import (Ada, Netdb_Data);
|
||||
for Netdb_Data'Address use Buf;
|
||||
|
||||
pragma Unreferenced (H_Errnop);
|
||||
-- VxWorks does not provide h_errno
|
||||
|
||||
begin
|
||||
pragma Assert (Addr_Type = Constants.AF_INET);
|
||||
pragma Assert (Addr_Len = In_Addr'Size / 8);
|
||||
|
||||
-- Check that provided buffer is sufficiently large to hold the
|
||||
-- data we want to return.
|
||||
|
||||
if Netdb_Data'Size / 8 > Buflen then
|
||||
return -1;
|
||||
end if;
|
||||
|
||||
if VxWorks_hostGetByAddr (To_Pointer (Addr).all,
|
||||
Netdb_Data.Name'Address)
|
||||
/= Constants.OK
|
||||
then
|
||||
return -1;
|
||||
end if;
|
||||
|
||||
Netdb_Data.Address := To_In_Addr (To_Pointer (Addr).all);
|
||||
Netdb_Data.Addr_List :=
|
||||
(0 => Netdb_Data.Address'Unchecked_Access,
|
||||
1 => null);
|
||||
|
||||
Ret.H_Name := C.Strings.To_Chars_Ptr
|
||||
(Netdb_Data.Name'Unrestricted_Access);
|
||||
Ret.H_Aliases := Alias_Access;
|
||||
Ret.H_Addrtype := Constants.AF_INET;
|
||||
Ret.H_Length := 4;
|
||||
Ret.H_Addr_List :=
|
||||
Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
|
||||
return 0;
|
||||
end Safe_Gethostbyaddr;
|
||||
|
||||
------------------------
|
||||
-- Safe_Gethostbyname --
|
||||
------------------------
|
||||
|
||||
function Safe_Gethostbyname
|
||||
(Name : C.char_array;
|
||||
Ret : not null access Hostent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int;
|
||||
H_Errnop : not null access C.int) return C.int
|
||||
is
|
||||
function VxWorks_hostGetByName
|
||||
(Name : C.char_array) return C.int;
|
||||
pragma Import (C, VxWorks_hostGetByName, "hostGetByName");
|
||||
|
||||
Addr : C.int;
|
||||
|
||||
pragma Unreferenced (H_Errnop);
|
||||
-- VxWorks does not provide h_errno
|
||||
|
||||
begin
|
||||
Addr := VxWorks_hostGetByName (Name);
|
||||
if Addr = Constants.ERROR then
|
||||
return -1;
|
||||
end if;
|
||||
|
||||
declare
|
||||
Netdb_Data : Netdb_Host_Data (Name_Length => Name'Length);
|
||||
pragma Import (Ada, Netdb_Data);
|
||||
for Netdb_Data'Address use Buf;
|
||||
|
||||
begin
|
||||
-- Check that provided buffer is sufficiently large to hold the
|
||||
-- data we want to return.
|
||||
|
||||
if Netdb_Data'Size / 8 > Buflen then
|
||||
return -1;
|
||||
end if;
|
||||
|
||||
Netdb_Data.Address := To_In_Addr (Addr);
|
||||
Netdb_Data.Addr_List :=
|
||||
(0 => Netdb_Data.Address'Unchecked_Access,
|
||||
1 => null);
|
||||
Netdb_Data.Name (Netdb_Data.Name'First .. Name'Length - 1) := Name;
|
||||
|
||||
Ret.H_Name := C.Strings.To_Chars_Ptr
|
||||
(Netdb_Data.Name'Unrestricted_Access);
|
||||
Ret.H_Aliases := Alias_Access;
|
||||
Ret.H_Addrtype := Constants.AF_INET;
|
||||
Ret.H_Length := 4;
|
||||
Ret.H_Addr_List :=
|
||||
Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
|
||||
end;
|
||||
return 0;
|
||||
end Safe_Gethostbyname;
|
||||
|
||||
------------------------
|
||||
-- Safe_Getservbyname --
|
||||
------------------------
|
||||
|
||||
function Safe_Getservbyname
|
||||
(Name : C.char_array;
|
||||
Proto : C.char_array;
|
||||
Ret : not null access Servent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int) return C.int
|
||||
is
|
||||
pragma Unreferenced (Name, Proto, Ret, Buf, Buflen);
|
||||
begin
|
||||
-- Not available under VxWorks
|
||||
return -1;
|
||||
end Safe_Getservbyname;
|
||||
|
||||
------------------------
|
||||
-- Safe_Getservbyport --
|
||||
------------------------
|
||||
|
||||
function Safe_Getservbyport
|
||||
(Port : C.int;
|
||||
Proto : C.char_array;
|
||||
Ret : not null access Servent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int) return C.int
|
||||
is
|
||||
pragma Unreferenced (Port, Proto, Ret, Buf, Buflen);
|
||||
begin
|
||||
-- Not available under VxWorks
|
||||
return -1;
|
||||
end Safe_Getservbyport;
|
||||
|
||||
end GNAT.Sockets.Thin.Task_Safe_NetDB;
|
||||
72
gcc/ada/g-sttsne-vxworks.ads
Normal file
72
gcc/ada/g-sttsne-vxworks.ads
Normal file
@ -0,0 +1,72 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2007, 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- --
|
||||
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
||||
-- for more details. You should have received a copy of the GNU General --
|
||||
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
||||
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
|
||||
-- Boston, MA 02110-1301, USA. --
|
||||
-- --
|
||||
-- As a special exception, if other files instantiate generics from this --
|
||||
-- unit, or you link this unit with other files to produce an executable, --
|
||||
-- this unit does not by itself cause the resulting executable to be --
|
||||
-- covered by the GNU General Public License. This exception does not --
|
||||
-- however invalidate any other reasons why the executable file might be --
|
||||
-- covered by the GNU Public License. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This version is used on VxWorks
|
||||
|
||||
package GNAT.Sockets.Thin.Task_Safe_NetDB is
|
||||
|
||||
----------------------------------------
|
||||
-- Reentrant network databases access --
|
||||
----------------------------------------
|
||||
|
||||
function Safe_Gethostbyname
|
||||
(Name : C.char_array;
|
||||
Ret : not null access Hostent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int;
|
||||
H_Errnop : not null access C.int) return C.int;
|
||||
|
||||
function Safe_Gethostbyaddr
|
||||
(Addr : System.Address;
|
||||
Addr_Len : C.int;
|
||||
Addr_Type : C.int;
|
||||
Ret : not null access Hostent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int;
|
||||
H_Errnop : not null access C.int) return C.int;
|
||||
|
||||
function Safe_Getservbyname
|
||||
(Name : C.char_array;
|
||||
Proto : C.char_array;
|
||||
Ret : not null access Servent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int) return C.int;
|
||||
|
||||
function Safe_Getservbyport
|
||||
(Port : C.int;
|
||||
Proto : C.char_array;
|
||||
Ret : not null access Servent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int) return C.int;
|
||||
|
||||
end GNAT.Sockets.Thin.Task_Safe_NetDB;
|
||||
81
gcc/ada/g-sttsne.ads
Normal file
81
gcc/ada/g-sttsne.ads
Normal file
@ -0,0 +1,81 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2007, 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- --
|
||||
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
||||
-- for more details. You should have received a copy of the GNU General --
|
||||
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
||||
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
|
||||
-- Boston, MA 02110-1301, USA. --
|
||||
-- --
|
||||
-- As a special exception, if other files instantiate generics from this --
|
||||
-- unit, or you link this unit with other files to produce an executable, --
|
||||
-- this unit does not by itself cause the resulting executable to be --
|
||||
-- covered by the GNU General Public License. This exception does not --
|
||||
-- however invalidate any other reasons why the executable file might be --
|
||||
-- covered by the GNU Public License. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package exports reentrant NetDB subprograms. This is the default
|
||||
-- version, used on most platforms. The routines are implemented by importing
|
||||
-- from C; see gsocket.h for details. Different versions are provided on
|
||||
-- platforms where this functionality is implemented in Ada.
|
||||
|
||||
package GNAT.Sockets.Thin.Task_Safe_NetDB is
|
||||
|
||||
----------------------------------------
|
||||
-- Reentrant network databases access --
|
||||
----------------------------------------
|
||||
|
||||
function Safe_Gethostbyname
|
||||
(Name : C.char_array;
|
||||
Ret : not null access Hostent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int;
|
||||
H_Errnop : not null access C.int) return C.int;
|
||||
|
||||
function Safe_Gethostbyaddr
|
||||
(Addr : System.Address;
|
||||
Addr_Len : C.int;
|
||||
Addr_Type : C.int;
|
||||
Ret : not null access Hostent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int;
|
||||
H_Errnop : not null access C.int) return C.int;
|
||||
|
||||
function Safe_Getservbyname
|
||||
(Name : C.char_array;
|
||||
Proto : C.char_array;
|
||||
Ret : not null access Servent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int) return C.int;
|
||||
|
||||
function Safe_Getservbyport
|
||||
(Port : C.int;
|
||||
Proto : C.char_array;
|
||||
Ret : not null access Servent;
|
||||
Buf : System.Address;
|
||||
Buflen : C.int) return C.int;
|
||||
|
||||
private
|
||||
pragma Import (C, Safe_Gethostbyname, "__gnat_safe_gethostbyname");
|
||||
pragma Import (C, Safe_Gethostbyaddr, "__gnat_safe_gethostbyaddr");
|
||||
pragma Import (C, Safe_Getservbyname, "__gnat_safe_getservbyname");
|
||||
pragma Import (C, Safe_Getservbyport, "__gnat_safe_getservbyport");
|
||||
|
||||
end GNAT.Sockets.Thin.Task_Safe_NetDB;
|
||||
Loading…
x
Reference in New Issue
Block a user