diff options
Diffstat (limited to 'gcc-4.4.0/gcc/ada/g-sttsne-vxworks.adb')
| -rw-r--r-- | gcc-4.4.0/gcc/ada/g-sttsne-vxworks.adb | 206 |
1 files changed, 206 insertions, 0 deletions
diff --git a/gcc-4.4.0/gcc/ada/g-sttsne-vxworks.adb b/gcc-4.4.0/gcc/ada/g-sttsne-vxworks.adb new file mode 100644 index 000000000..be0578d04 --- /dev/null +++ b/gcc-4.4.0/gcc/ada/g-sttsne-vxworks.adb @@ -0,0 +1,206 @@ +------------------------------------------------------------------------------ +-- -- +-- 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-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- -- +-- 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. Note that the corresponding spec is in +-- g-sttsne-locking.ads. + +with Ada.Unchecked_Conversion; +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 = SOSC.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) + /= SOSC.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 := SOSC.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 = SOSC.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 := SOSC.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; |