diff options
35 files changed, 889 insertions, 763 deletions
diff --git a/gcc/ada/1ssecsta.adb b/gcc/ada/1ssecsta.adb index 3f3bf78be90..2a8eee7d83f 100644 --- a/gcc/ada/1ssecsta.adb +++ b/gcc/ada/1ssecsta.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -94,7 +94,7 @@ package body System.Secondary_Stack is end if; Address := Sec_Stack.Mem (Sec_Stack.Top)'Address; - Sec_Stack.Top := Sec_Stack.Top + Mark_Id (Max_Size); + Sec_Stack.Top := Sec_Stack.Top + Max_Size; end SS_Allocate; ------------- diff --git a/gcc/ada/3vsocthi.adb b/gcc/ada/3vsocthi.adb index 94bfccb1b7a..41b32d16e9a 100644 --- a/gcc/ada/3vsocthi.adb +++ b/gcc/ada/3vsocthi.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2004 Ada Core Technologies, 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- -- @@ -58,33 +58,32 @@ package body GNAT.Sockets.Thin is Thread_Blocking_IO : Boolean := True; + Unknown_System_Error : constant C.Strings.chars_ptr := + C.Strings.New_String ("Unknown system error"); + function Syscall_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) - return C.int; + Addrlen : access C.int) return C.int; pragma Import (C, Syscall_Accept, "accept"); function Syscall_Connect (S : C.int; Name : System.Address; - Namelen : C.int) - return C.int; + Namelen : C.int) return C.int; pragma Import (C, Syscall_Connect, "connect"); function Syscall_Ioctl (S : C.int; Req : C.int; - Arg : Int_Access) - return C.int; + Arg : Int_Access) return C.int; pragma Import (C, Syscall_Ioctl, "ioctl"); function Syscall_Recv (S : C.int; Msg : System.Address; Len : C.int; - Flags : C.int) - return C.int; + Flags : C.int) return C.int; pragma Import (C, Syscall_Recv, "recv"); function Syscall_Recvfrom @@ -93,8 +92,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) - return C.int; + Fromlen : access C.int) return C.int; pragma Import (C, Syscall_Recvfrom, "recvfrom"); function Syscall_Send @@ -116,8 +114,7 @@ package body GNAT.Sockets.Thin is pragma Import (C, Syscall_Sendto, "sendto"); function Syscall_Socket - (Domain, Typ, Protocol : C.int) - return C.int; + (Domain, Typ, Protocol : C.int) return C.int; pragma Import (C, Syscall_Socket, "socket"); function Non_Blocking_Socket (S : C.int) return Boolean; @@ -130,8 +127,7 @@ package body GNAT.Sockets.Thin is function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) - return C.int + Addrlen : access C.int) return C.int is R : C.int; Val : aliased C.int := 1; @@ -170,8 +166,7 @@ package body GNAT.Sockets.Thin is function C_Connect (S : C.int; Name : System.Address; - Namelen : C.int) - return C.int + Namelen : C.int) return C.int is Res : C.int; @@ -231,10 +226,9 @@ package body GNAT.Sockets.Thin is ------------- function C_Ioctl - (S : C.int; - Req : C.int; - Arg : Int_Access) - return C.int + (S : C.int; + Req : C.int; + Arg : Int_Access) return C.int is begin if not Thread_Blocking_IO @@ -256,8 +250,7 @@ package body GNAT.Sockets.Thin is (S : C.int; Msg : System.Address; Len : C.int; - Flags : C.int) - return C.int + Flags : C.int) return C.int is Res : C.int; @@ -284,8 +277,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) - return C.int + Fromlen : access C.int) return C.int is Res : C.int; @@ -310,8 +302,7 @@ package body GNAT.Sockets.Thin is (S : C.int; Msg : System.Address; Len : C.int; - Flags : C.int) - return C.int + Flags : C.int) return C.int is Res : C.int; @@ -338,8 +329,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; To : Sockaddr_In_Access; - Tolen : C.int) - return C.int + Tolen : C.int) return C.int is Res : C.int; @@ -363,8 +353,7 @@ package body GNAT.Sockets.Thin is function C_Socket (Domain : C.int; Typ : C.int; - Protocol : C.int) - return C.int + Protocol : C.int) return C.int is R : C.int; Val : aliased C.int := 1; @@ -412,7 +401,6 @@ package body GNAT.Sockets.Thin is function Non_Blocking_Socket (S : C.int) return Boolean is R : Boolean; - begin Task_Lock.Lock; R := Is_Socket_In_Set (Non_Blocking_Sockets, S); @@ -424,10 +412,7 @@ package body GNAT.Sockets.Thin is -- Set_Address -- ----------------- - procedure Set_Address - (Sin : Sockaddr_In_Access; - Address : In_Addr) - is + procedure Set_Address (Sin : Sockaddr_In_Access; Address : In_Addr) is begin Sin.Sin_Addr := Address; end Set_Address; @@ -436,10 +421,7 @@ package body GNAT.Sockets.Thin is -- Set_Family -- ---------------- - procedure Set_Family - (Sin : Sockaddr_In_Access; - Family : C.int) - is + procedure Set_Family (Sin : Sockaddr_In_Access; Family : C.int) is begin Sin.Sin_Family := C.unsigned_short (Family); end Set_Family; @@ -448,13 +430,9 @@ package body GNAT.Sockets.Thin is -- Set_Length -- ---------------- - procedure Set_Length - (Sin : Sockaddr_In_Access; - Len : C.int) - is + procedure Set_Length (Sin : Sockaddr_In_Access; Len : C.int) is pragma Unreferenced (Sin); pragma Unreferenced (Len); - begin null; end Set_Length; @@ -480,10 +458,7 @@ package body GNAT.Sockets.Thin is -- Set_Port -- -------------- - procedure Set_Port - (Sin : Sockaddr_In_Access; - Port : C.unsigned_short) - is + procedure Set_Port (Sin : Sockaddr_In_Access; Port : C.unsigned_short) is begin Sin.Sin_Port := Port; end Set_Port; @@ -492,7 +467,9 @@ package body GNAT.Sockets.Thin is -- Socket_Error_Message -- -------------------------- - function Socket_Error_Message (Errno : Integer) return String is + function Socket_Error_Message + (Errno : Integer) return C.Strings.chars_ptr + is use type Interfaces.C.Strings.chars_ptr; C_Msg : C.Strings.chars_ptr; @@ -501,10 +478,9 @@ package body GNAT.Sockets.Thin is C_Msg := C_Strerror (C.int (Errno)); if C_Msg = C.Strings.Null_Ptr then - return "Unknown system error"; - + return Unknown_System_Error; else - return C.Strings.Value (C_Msg); + return C_Msg; end if; end Socket_Error_Message; @@ -515,8 +491,7 @@ package body GNAT.Sockets.Thin is function C_Readv (Fd : C.int; Iov : System.Address; - Iovcnt : C.int) - return C.int + Iovcnt : C.int) return C.int is Res : C.int; Count : C.int := 0; @@ -548,8 +523,7 @@ package body GNAT.Sockets.Thin is function C_Writev (Fd : C.int; Iov : System.Address; - Iovcnt : C.int) - return C.int + Iovcnt : C.int) return C.int is Res : C.int; Count : C.int := 0; diff --git a/gcc/ada/3vsocthi.ads b/gcc/ada/3vsocthi.ads index 62a1d082564..a3985525f7c 100644 --- a/gcc/ada/3vsocthi.ads +++ b/gcc/ada/3vsocthi.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2002-2004 Ada Core Technologies, 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- -- @@ -60,7 +60,7 @@ package GNAT.Sockets.Thin is function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number. - function Socket_Error_Message (Errno : Integer) return String; + 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". diff --git a/gcc/ada/3wsocthi.adb b/gcc/ada/3wsocthi.adb index 601c7b52993..a948bdeedfa 100644 --- a/gcc/ada/3wsocthi.adb +++ b/gcc/ada/3wsocthi.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2004 Ada Core Technologies, 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- -- @@ -38,6 +38,7 @@ -- This version is for NT. with GNAT.Sockets.Constants; use GNAT.Sockets.Constants; +with Interfaces.C.Strings; use Interfaces.C.Strings; with System; use System; @@ -71,6 +72,166 @@ package body GNAT.Sockets.Thin is return C.int; pragma Import (Stdcall, Standard_Select, "select"); + type Error_Type is + (N_EINTR, + N_EBADF, + N_EACCES, + N_EFAULT, + N_EINVAL, + N_EMFILE, + N_EWOULDBLOCK, + N_EINPROGRESS, + N_EALREADY, + N_ENOTSOCK, + N_EDESTADDRREQ, + N_EMSGSIZE, + N_EPROTOTYPE, + N_ENOPROTOOPT, + N_EPROTONOSUPPORT, + N_ESOCKTNOSUPPORT, + N_EOPNOTSUPP, + N_EPFNOSUPPORT, + N_EAFNOSUPPORT, + N_EADDRINUSE, + N_EADDRNOTAVAIL, + N_ENETDOWN, + N_ENETUNREACH, + N_ENETRESET, + N_ECONNABORTED, + N_ECONNRESET, + N_ENOBUFS, + N_EISCONN, + N_ENOTCONN, + N_ESHUTDOWN, + N_ETOOMANYREFS, + N_ETIMEDOUT, + N_ECONNREFUSED, + N_ELOOP, + N_ENAMETOOLONG, + N_EHOSTDOWN, + N_EHOSTUNREACH, + N_SYSNOTREADY, + N_VERNOTSUPPORTED, + N_NOTINITIALISED, + N_EDISCON, + N_HOST_NOT_FOUND, + N_TRY_AGAIN, + N_NO_RECOVERY, + N_NO_DATA, + N_OTHERS); + + Error_Messages : constant array (Error_Type) of chars_ptr := + (N_EINTR => + New_String ("Interrupted system call"), + N_EBADF => + New_String ("Bad file number"), + N_EACCES => + New_String ("Permission denied"), + N_EFAULT => + New_String ("Bad address"), + N_EINVAL => + New_String ("Invalid argument"), + N_EMFILE => + New_String ("Too many open files"), + N_EWOULDBLOCK => + New_String ("Operation would block"), + N_EINPROGRESS => + New_String ("Operation now in progress. This error is " + & "returned if any Windows Sockets API " + & "function is called while a blocking " + & "function is in progress"), + N_EALREADY => + New_String ("Operation already in progress"), + N_ENOTSOCK => + New_String ("Socket operation on nonsocket"), + N_EDESTADDRREQ => + New_String ("Destination address required"), + N_EMSGSIZE => + New_String ("Message too long"), + N_EPROTOTYPE => + New_String ("Protocol wrong type for socket"), + N_ENOPROTOOPT => + New_String ("Protocol not available"), + N_EPROTONOSUPPORT => + New_String ("Protocol not supported"), + N_ESOCKTNOSUPPORT => + New_String ("Socket type not supported"), + N_EOPNOTSUPP => + New_String ("Operation not supported on socket"), + N_EPFNOSUPPORT => + New_String ("Protocol family not supported"), + N_EAFNOSUPPORT => + New_String ("Address family not supported by protocol family"), + N_EADDRINUSE => + New_String ("Address already in use"), + N_EADDRNOTAVAIL => + New_String ("Cannot assign requested address"), + N_ENETDOWN => + New_String ("Network is down. This error may be " + & "reported at any time if the Windows " + & "Sockets implementation detects an " + & "underlying failure"), + N_ENETUNREACH => + New_String ("Network is unreachable"), + N_ENETRESET => + New_String ("Network dropped connection on reset"), + N_ECONNABORTED => + New_String ("Software caused connection abort"), + N_ECONNRESET => + New_String ("Connection reset by peer"), + N_ENOBUFS => + New_String ("No buffer space available"), + N_EISCONN => + New_String ("Socket is already connected"), + N_ENOTCONN => + New_String ("Socket is not connected"), + N_ESHUTDOWN => + New_String ("Cannot send after socket shutdown"), + N_ETOOMANYREFS => + New_String ("Too many references: cannot splice"), + N_ETIMEDOUT => + New_String ("Connection timed out"), + N_ECONNREFUSED => + New_String ("Connection refused"), + N_ELOOP => + New_String ("Too many levels of symbolic links"), + N_ENAMETOOLONG => + New_String ("File name too long"), + N_EHOSTDOWN => + New_String ("Host is down"), + N_EHOSTUNREACH => + New_String ("No route to host"), + N_SYSNOTREADY => + New_String ("Returned by WSAStartup(), indicating that " + & "the network subsystem is unusable"), + N_VERNOTSUPPORTED => + New_String ("Returned by WSAStartup(), indicating that " + & "the Windows Sockets DLL cannot support " + & "this application"), + N_NOTINITIALISED => + New_String ("Winsock not initialized. This message is " + & "returned by any function except WSAStartup(), " + & "indicating that a successful WSAStartup() has " + & "not yet been performed"), + N_EDISCON => + New_String ("Disconnect"), + N_HOST_NOT_FOUND => + New_String ("Host not found. This message indicates " + & "that the key (name, address, and so on) was not found"), + N_TRY_AGAIN => + New_String ("Nonauthoritative host not found. This error may " + & "suggest that the name service itself is not " + & "functioning"), + N_NO_RECOVERY => + New_String ("Nonrecoverable error. This error may suggest that the " + & "name service itself is not functioning"), + N_NO_DATA => + New_String ("Valid name, no data record of requested type. " + & "This error indicates that the key (name, address, " + & "and so on) was not found."), + N_OTHERS => + New_String ("Unknown system error")); + --------------- -- C_Connect -- --------------- @@ -366,165 +527,60 @@ package body GNAT.Sockets.Thin is -- Socket_Error_Message -- -------------------------- - function Socket_Error_Message (Errno : Integer) return String is + function Socket_Error_Message + (Errno : Integer) + return C.Strings.chars_ptr + is use GNAT.Sockets.Constants; begin case Errno is - when EINTR => - return "Interrupted system call"; - - when EBADF => - return "Bad file number"; - - when EACCES => - return "Permission denied"; - - when EFAULT => - return "Bad address"; - - when EINVAL => - return "Invalid argument"; - - when EMFILE => - return "Too many open files"; - - when EWOULDBLOCK => - return "Operation would block"; - - when EINPROGRESS => - return "Operation now in progress. This error is " - & "returned if any Windows Sockets API " - & "function is called while a blocking " - & "function is in progress"; - - when EALREADY => - return "Operation already in progress"; - - when ENOTSOCK => - return "Socket operation on nonsocket"; - - when EDESTADDRREQ => - return "Destination address required"; - - when EMSGSIZE => - return "Message too long"; - - when EPROTOTYPE => - return "Protocol wrong type for socket"; - - when ENOPROTOOPT => - return "Protocol not available"; - - when EPROTONOSUPPORT => - return "Protocol not supported"; - - when ESOCKTNOSUPPORT => - return "Socket type not supported"; - - when EOPNOTSUPP => - return "Operation not supported on socket"; - - when EPFNOSUPPORT => - return "Protocol family not supported"; - - when EAFNOSUPPORT => - return "Address family not supported by protocol family"; - - when EADDRINUSE => - return "Address already in use"; - - when EADDRNOTAVAIL => - return "Cannot assign requested address"; - - when ENETDOWN => - return "Network is down. This error may be " - & "reported at any time if the Windows " - & "Sockets implementation detects an " - & "underlying failure"; - - when ENETUNREACH => - return "Network is unreachable"; - - when ENETRESET => - return "Network dropped connection on reset"; - - when ECONNABORTED => - return "Software caused connection abort"; - - when ECONNRESET => - return "Connection reset by peer"; - - when ENOBUFS => - return "No buffer space available"; - - when EISCONN => - return "Socket is already connected"; - - when ENOTCONN => - return "Socket is not connected"; - - when ESHUTDOWN => - return "Cannot send after socket shutdown"; - - when ETOOMANYREFS => - return "Too many references: cannot splice"; - - when ETIMEDOUT => - return "Connection timed out"; - - when ECONNREFUSED => - return "Connection refused"; - - when ELOOP => - return "Too many levels of symbolic links"; - - when ENAMETOOLONG => - return "File name too long"; - - when EHOSTDOWN => - return "Host is down"; - - when EHOSTUNREACH => - return "No route to host"; - - when SYSNOTREADY => - return "Returned by WSAStartup(), indicating that " - & "the network subsystem is unusable"; - - when VERNOTSUPPORTED => - return "Returned by WSAStartup(), indicating that " - & "the Windows Sockets DLL cannot support this application"; - - when NOTINITIALISED => - return "Winsock not initialized. This message is " - & "returned by any function except WSAStartup(), " - & "indicating that a successful WSAStartup() has " - & "not yet been performed"; - - when EDISCON => - return "Disconnect"; - - when HOST_NOT_FOUND => - return "Host not found. This message indicates " - & "that the key (name, address, and so on) was not found"; - - when TRY_AGAIN => - return "Nonauthoritative host not found. This error may " - & "suggest that the name service itself is not functioning"; - - when NO_RECOVERY => - return "Nonrecoverable error. This error may suggest that the " - & "name service itself is not functioning"; - - when NO_DATA => - return "Valid name, no data record of requested type. " - & "This error indicates that the key (name, address, " - & "and so on) was not found."; - - when others => - return "Unknown system error"; - + when EINTR => return Error_Messages (N_EINTR); + when EBADF => return Error_Messages (N_EBADF); + when EACCES => return Error_Messages (N_EACCES); + when EFAULT => return Error_Messages (N_EFAULT); + when EINVAL => return Error_Messages (N_EINVAL); + when EMFILE => return Error_Messages (N_EMFILE); + when EWOULDBLOCK => return Error_Messages (N_EWOULDBLOCK); + when EINPROGRESS => return Error_Messages (N_EINPROGRESS); + when EALREADY => return Error_Messages (N_EALREADY); + when ENOTSOCK => return Error_Messages (N_ENOTSOCK); + when EDESTADDRREQ => return Error_Messages (N_EDESTADDRREQ); + when EMSGSIZE => return Error_Messages (N_EMSGSIZE); + when EPROTOTYPE => return Error_Messages (N_EPROTOTYPE); + when ENOPROTOOPT => return Error_Messages (N_ENOPROTOOPT); + when EPROTONOSUPPORT => return Error_Messages (N_EPROTONOSUPPORT); + when ESOCKTNOSUPPORT => return Error_Messages (N_ESOCKTNOSUPPORT); + when EOPNOTSUPP => return Error_Messages (N_EOPNOTSUPP); + when EPFNOSUPPORT => return Error_Messages (N_EPFNOSUPPORT); + when EAFNOSUPPORT => return Error_Messages (N_EAFNOSUPPORT); + when EADDRINUSE => return Error_Messages (N_EADDRINUSE); + when EADDRNOTAVAIL => return Error_Messages (N_EADDRNOTAVAIL); + when ENETDOWN => return Error_Messages (N_ENETDOWN); + when ENETUNREACH => return Error_Messages (N_ENETUNREACH); + when ENETRESET => return Error_Messages (N_ENETRESET); + when ECONNABORTED => return Error_Messages (N_ECONNABORTED); + when ECONNRESET => return Error_Messages (N_ECONNRESET); + when ENOBUFS => return Error_Messages (N_ENOBUFS); + when EISCONN => return Error_Messages (N_EISCONN); + when ENOTCONN => return Error_Messages (N_ENOTCONN); + when ESHUTDOWN => return Error_Messages (N_ESHUTDOWN); + when ETOOMANYREFS => return Error_Messages (N_ETOOMANYREFS); + when ETIMEDOUT => return Error_Messages (N_ETIMEDOUT); + when ECONNREFUSED => return Error_Messages (N_ECONNREFUSED); + when ELOOP => return Error_Messages (N_ELOOP); + when ENAMETOOLONG => return Error_Messages (N_ENAMETOOLONG); + when EHOSTDOWN => return Error_Messages (N_EHOSTDOWN); + when EHOSTUNREACH => return Error_Messages (N_EHOSTUNREACH); + when SYSNOTREADY => return Error_Messages (N_SYSNOTREADY); + when VERNOTSUPPORTED => return Error_Messages (N_VERNOTSUPPORTED); + when NOTINITIALISED => return Error_Messages (N_NOTINITIALISED); + when EDISCON => return Error_Messages (N_EDISCON); + when HOST_NOT_FOUND => return Error_Messages (N_HOST_NOT_FOUND); + when TRY_AGAIN => return Error_Messages (N_TRY_AGAIN); + when NO_RECOVERY => return Error_Messages (N_NO_RECOVERY); + when NO_DATA => return Error_Messages (N_NO_DATA); + when others => return Error_Messages (N_OTHERS); end case; end Socket_Error_Message; diff --git a/gcc/ada/3wsocthi.ads b/gcc/ada/3wsocthi.ads index 0fb5e4a798d..5ee990e8628 100644 --- a/gcc/ada/3wsocthi.ads +++ b/gcc/ada/3wsocthi.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2004 Ada Core Technologies, 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- -- @@ -60,7 +60,9 @@ package GNAT.Sockets.Thin is procedure Set_Socket_Errno (Errno : Integer); -- Set last socket error number. - function Socket_Error_Message (Errno : Integer) return String; + 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". @@ -177,10 +179,10 @@ package GNAT.Sockets.Thin is -- 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; + 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 @@ -196,102 +198,85 @@ package GNAT.Sockets.Thin is function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) - return C.int; + Addrlen : access C.int) return C.int; function C_Bind (S : C.int; Name : System.Address; - Namelen : C.int) - return C.int; + Namelen : C.int) return C.int; function C_Close - (Fd : C.int) - return C.int; + (Fd : C.int) return C.int; function C_Connect (S : C.int; Name : System.Address; - Namelen : C.int) - return C.int; + Namelen : C.int) return C.int; function C_Gethostbyaddr (Addr : System.Address; Length : C.int; - Typ : C.int) - return Hostent_Access; + Typ : C.int) return Hostent_Access; function C_Gethostbyname - (Name : C.char_array) - return Hostent_Access; + (Name : C.char_array) return Hostent_Access; function C_Gethostname (Name : System.Address; - Namelen : C.int) - return C.int; + Namelen : C.int) return C.int; function C_Getpeername (S : C.int; Name : System.Address; - Namelen : access C.int) - return C.int; + Namelen : access C.int) return C.int; function C_Getservbyname (Name : C.char_array; - Proto : C.char_array) - return Servent_Access; + Proto : C.char_array) return Servent_Access; function C_Getservbyport (Port : C.int; - Proto : C.char_array) - return Servent_Access; + Proto : C.char_array) return Servent_Access; function C_Getsockname (S : C.int; Name : System.Address; - Namelen : access C.int) - return C.int; + Namelen : access C.int) return C.int; function C_Getsockopt (S : C.int; Level : C.int; Optname : C.int; Optval : System.Address; - Optlen : access C.int) - return C.int; + Optlen : access C.int) return C.int; function C_Inet_Addr - (Cp : C.Strings.chars_ptr) - return C.int; + (Cp : C.Strings.chars_ptr) return C.int; function C_Ioctl (S : C.int; Req : C.int; - Arg : Int_Access) - return C.int; + Arg : Int_Access) return C.int; function C_Listen - (S, Backlog : C.int) - return C.int; + (S : C.int; + Backlog : C.int) return C.int; function C_Read (Fildes : C.int; Buf : System.Address; - Nbyte : C.int) - return C.int; + Nbyte : C.int) return C.int; function C_Readv (Socket : C.int; Iov : System.Address; - Iovcnt : C.int) - return C.int; + Iovcnt : C.int) return C.int; function C_Recv (S : C.int; Buf : System.Address; Len : C.int; - Flags : C.int) - return C.int; + Flags : C.int) return C.int; function C_Recvfrom (S : C.int; @@ -299,23 +284,20 @@ package GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) - return C.int; + Fromlen : access C.int) return C.int; function C_Select (Nfds : C.int; Readfds : Fd_Set_Access; Writefds : Fd_Set_Access; Exceptfds : Fd_Set_Access; - Timeout : Timeval_Access) - return C.int; + Timeout : Timeval_Access) return C.int; function C_Send (S : C.int; Buf : System.Address; Len : C.int; - Flags : C.int) - return C.int; + Flags : C.int) return C.int; function C_Sendto (S : C.int; @@ -323,55 +305,46 @@ package GNAT.Sockets.Thin is Len : C.int; Flags : C.int; To : Sockaddr_In_Access; - Tolen : C.int) - return C.int; + Tolen : C.int) return C.int; function C_Setsockopt (S : C.int; Level : C.int; Optname : C.int; Optval : System.Address; - Optlen : C.int) - return C.int; + Optlen : C.int) return C.int; function C_Shutdown (S : C.int; - How : C.int) - return C.int; + How : C.int) return C.int; function C_Socket (Domain : C.int; Typ : C.int; - Protocol : C.int) - return C.int; + Protocol : C.int) return C.int; function C_Strerror - (Errnum : C.int) - return C.Strings.chars_ptr; + (Errnum : C.int) return C.Strings.chars_ptr; function C_System - (Command : System.Address) - return C.int; + (Command : System.Address) return C.int; function C_Write (Fildes : C.int; Buf : System.Address; - Nbyte : C.int) - return C.int; + Nbyte : C.int) return C.int; function C_Writev (Socket : C.int; Iov : System.Address; - Iovcnt : C.int) - return C.int; + Iovcnt : C.int) return C.int; function WSAStartup (WS_Version : Interfaces.C.int; - WSADataAddress : System.Address) - return Interfaces.C.int; + WSADataAddress : System.Address) return Interfaces.C.int; procedure Free_Socket_Set - (Set : Fd_Set_Access); + (Set : Fd_Set_Access); -- Free system-dependent socket set. procedure Get_Socket_From_Set @@ -391,8 +364,7 @@ package GNAT.Sockets.Thin is function Is_Socket_In_Set (Set : Fd_Set_Access; - Socket : C.int) - return Boolean; + Socket : C.int) return Boolean; -- Check whether Socket is in the socket set procedure Last_Socket_In_Set @@ -405,8 +377,7 @@ package GNAT.Sockets.Thin is -- set back to the real largest socket in the socket set. function New_Socket_Set - (Set : Fd_Set_Access) - return Fd_Set_Access; + (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. diff --git a/gcc/ada/3zsocthi.adb b/gcc/ada/3zsocthi.adb index 92788e646f7..6d28e629b81 100644 --- a/gcc/ada/3zsocthi.adb +++ b/gcc/ada/3zsocthi.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2002-2004 Ada Core Technologies, 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- -- @@ -63,6 +63,9 @@ package body GNAT.Sockets.Thin is 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". @@ -588,7 +591,9 @@ package body GNAT.Sockets.Thin is -- Socket_Error_Message -- -------------------------- - function Socket_Error_Message (Errno : Integer) return String is + function Socket_Error_Message + (Errno : Integer) return C.Strings.chars_ptr + is use type Interfaces.C.Strings.chars_ptr; C_Msg : C.Strings.chars_ptr; @@ -597,9 +602,10 @@ package body GNAT.Sockets.Thin is C_Msg := C_Strerror (C.int (Errno)); if C_Msg = C.Strings.Null_Ptr then - return "Unknown system error"; + return Unknown_System_Error; + else - return C.Strings.Value (C_Msg); + return C_Msg; end if; end Socket_Error_Message; diff --git a/gcc/ada/3zsocthi.ads b/gcc/ada/3zsocthi.ads index 7ff589b5444..3642a038bec 100644 --- a/gcc/ada/3zsocthi.ads +++ b/gcc/ada/3zsocthi.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2002-2004 Ada Core Technologies, 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- -- @@ -59,7 +59,7 @@ package GNAT.Sockets.Thin is function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number. - function Socket_Error_Message (Errno : Integer) return String; + 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". diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in index 052230baa8d..bdd029298bb 100644 --- a/gcc/ada/Make-lang.in +++ b/gcc/ada/Make-lang.in @@ -1391,14 +1391,14 @@ ada/checks.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \ ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \ ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \ - ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \ - ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ - ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \ - ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \ - ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \ - ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \ - ada/urealp.ads ada/validsw.ads + ada/stringt.adb ada/system.ads ada/s-exctab.ads ada/s-htable.ads \ + ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \ + ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ + ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ + ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ + ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/comperr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/comperr.ads ada/comperr.adb \ @@ -1555,14 +1555,14 @@ ada/exp_aggr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \ ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \ ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \ - ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \ - ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \ - ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ - ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ - ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ - ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ - ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/urealp.ads ada/validsw.ads + ada/stringt.adb ada/system.ads ada/s-exctab.ads ada/s-exctab.adb \ + ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \ + ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ + ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \ + ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ + ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ + ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ + ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/exp_attr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \ @@ -1679,23 +1679,19 @@ ada/exp_ch2.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/exp_ch3.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \ - ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \ - ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \ - ada/erroutc.ads ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads \ - ada/exp_ch3.ads ada/exp_ch3.adb ada/exp_ch4.ads ada/exp_ch7.ads \ - ada/exp_ch9.ads ada/exp_disp.ads ada/exp_dist.ads ada/exp_smem.ads \ - ada/exp_strm.ads ada/exp_tss.ads ada/exp_tss.adb ada/exp_util.ads \ - ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \ - ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \ - ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/itypes.ads \ - ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/nlists.ads \ - ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \ - ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \ - ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads ada/sem_cat.ads \ - ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch8.ads \ - ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_eval.ads \ - ada/sem_intr.ads ada/sem_mech.ads ada/sem_res.ads ada/sem_res.adb \ - ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \ + ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \ + ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_aggr.ads \ + ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch3.ads ada/exp_ch3.adb \ + ada/exp_ch4.ads ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_disp.ads \ + ada/exp_dist.ads ada/exp_smem.ads ada/exp_strm.ads ada/exp_tss.ads \ + ada/exp_tss.adb ada/exp_util.ads ada/fname.ads ada/fname-uf.ads \ + ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \ + ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \ + ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \ + ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \ + ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/sem.ads \ + ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_mech.ads \ + ada/sem_res.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \ ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \ ada/stand.ads ada/stringt.ads ada/stringt.adb ada/system.ads \ ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \ @@ -1749,16 +1745,17 @@ ada/exp_ch5.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/sem_ch13.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \ ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \ ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \ - ada/sprint.ads ada/stand.ads ada/stringt.ads ada/style.ads \ - ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \ - ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \ - ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \ - ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ - ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ - ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ - ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ - ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/widechar.ads + ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \ + ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \ + ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \ + ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \ + ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ + ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \ + ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ + ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ + ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ + ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \ + ada/widechar.ads ada/exp_ch6.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \ @@ -1969,13 +1966,13 @@ ada/exp_fixd.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/sem_ch8.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads \ ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \ ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \ - ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \ - ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \ - ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \ - ada/table.adb ada/tbuild.ads ada/tree_io.ads ada/types.ads \ - ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \ - ada/urealp.ads ada/urealp.adb + ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \ + ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \ + ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ + ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/tbuild.ads ada/tree_io.ads \ + ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \ + ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/exp_imgv.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \ @@ -2132,14 +2129,14 @@ ada/exp_util.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads \ ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \ - ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \ - ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ - ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \ - ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \ - ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \ - ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \ - ada/urealp.ads ada/urealp.adb ada/validsw.ads + ada/stringt.adb ada/system.ads ada/s-exctab.ads ada/s-htable.ads \ + ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \ + ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ + ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ + ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ + ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads ada/exp_vfpt.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \ @@ -2870,34 +2867,31 @@ ada/sem.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/sem_aggr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \ - ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \ - ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \ - ada/erroutc.ads ada/eval_fat.ads ada/exp_ch11.ads ada/exp_ch2.ads \ - ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \ - ada/expander.ads ada/fname.ads ada/freeze.ads ada/get_targ.ads \ - ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-speche.ads \ - ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \ - ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib-xref.ads \ - ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \ - ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \ - ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \ - ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_aggr.adb \ - ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch4.ads \ - ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \ - ada/sem_elab.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads \ - ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \ - ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ - ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \ - ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \ - ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \ - ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \ - ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ - ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \ - ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \ - ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \ - ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \ - ada/validsw.ads ada/widechar.ads + ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \ + ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \ + ada/eval_fat.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch7.ads \ + ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/fname.ads \ + ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \ + ada/g-os_lib.ads ada/g-speche.ads ada/g-string.ads ada/gnatvsn.ads \ + ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \ + ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \ + ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \ + ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \ + ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_aggr.ads \ + ada/sem_aggr.adb ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch8.ads \ + ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads \ + ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \ + ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \ + ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \ + ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \ + ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \ + ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \ + ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ + ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ + ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ + ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \ + ada/urealp.ads ada/validsw.ads ada/widechar.ads ada/sem_attr.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \ ada/a-except.ads ada/alloc.ads ada/atree.ads ada/atree.adb \ @@ -3010,36 +3004,33 @@ ada/sem_ch11.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/sem_ch12.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \ ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/checks.ads \ - ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \ - ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \ - ada/erroutc.ads ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads \ - ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \ - ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \ - ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \ - ada/inline.ads ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib.adb \ - ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-xref.ads \ - ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \ - ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \ - ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \ - ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \ + ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \ + ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \ + ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \ + ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \ + ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \ + ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \ + ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \ + ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \ + ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \ + ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \ + ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \ ada/sem_cat.ads ada/sem_ch10.ads ada/sem_ch12.ads ada/sem_ch12.adb \ - ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch6.ads \ - ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \ - ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads ada/sem_intr.ads \ - ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \ - ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ - ada/sinfo-cn.ads ada/sinput.ads ada/sinput-l.ads ada/snames.ads \ - ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \ - ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \ - ada/s-crc32.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \ - ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \ - ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ - ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \ - ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ - ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ - ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ - ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \ - ada/widechar.ads + ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \ + ada/sem_ch8.ads ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads \ + ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ + ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \ + ada/sinput.ads ada/sinput-l.ads ada/snames.ads ada/stand.ads \ + ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \ + ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \ + ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-htable.adb \ + ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \ + ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ + ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ + ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ + ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads ada/sem_ch13.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \ @@ -3100,17 +3091,17 @@ ada/sem_ch3.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/sem_mech.ads ada/sem_res.ads ada/sem_res.adb ada/sem_smem.ads \ ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \ ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \ - ada/sprint.ads ada/stand.ads ada/stringt.ads ada/style.ads \ - ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \ - ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \ - ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \ - ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ - ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ - ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ - ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ - ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads \ - ada/widechar.ads + ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \ + ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \ + ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \ + ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \ + ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ + ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \ + ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ + ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ + ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ + ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \ + ada/validsw.ads ada/widechar.ads ada/sem_ch4.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \ @@ -3142,65 +3133,61 @@ ada/sem_ch4.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/sem_ch5.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \ - ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \ - ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \ - ada/eval_fat.ads ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_tss.ads \ - ada/exp_util.ads ada/expander.ads ada/fname.ads ada/freeze.ads \ - ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \ - ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \ - ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib-xref.ads \ - ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \ - ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \ - ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \ - ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \ - ada/sem_case.ads ada/sem_case.adb ada/sem_cat.ads ada/sem_ch3.ads \ - ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch5.adb ada/sem_ch6.ads \ - ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads \ - ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads ada/sem_res.ads \ - ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ - ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \ - ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \ - ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \ - ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \ - ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \ - ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ - ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \ - ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ - ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads ada/types.ads \ - ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \ - ada/urealp.ads ada/validsw.ads ada/widechar.ads - -ada/sem_ch6.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ - ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \ - ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \ - ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \ - ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads ada/expander.ads \ + ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \ + ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \ + ada/exp_ch2.ads ada/exp_tss.ads ada/exp_util.ads ada/expander.ads \ ada/fname.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \ ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \ - ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \ - ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \ - ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \ - ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \ - ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \ - ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \ - ada/sem_aggr.ads ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch12.ads \ - ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \ - ada/sem_ch6.adb ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \ - ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads ada/sem_intr.ads \ - ada/sem_mech.ads ada/sem_prag.ads ada/sem_res.ads ada/sem_res.adb \ - ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \ - ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads \ - ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \ - ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \ - ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-carun8.ads \ + ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \ + ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \ + ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \ + ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \ + ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_case.ads \ + ada/sem_case.adb ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch5.ads \ + ada/sem_ch5.adb ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads \ + ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \ + ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ + ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \ + ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \ + ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \ ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \ ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \ - ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \ - ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \ - ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \ - ada/urealp.ads ada/validsw.ads ada/widechar.ads + ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_io.ads \ + ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \ + ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \ + ada/widechar.ads + +ada/sem_ch6.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ + ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \ + ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \ + ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch7.ads \ + ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \ + ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \ + ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \ + ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/lib.ads \ + ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads \ + ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \ + ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \ + ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \ + ada/scng.adb ada/sem.ads ada/sem_cat.ads ada/sem_ch12.ads \ + ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \ + ada/sem_ch6.adb ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \ + ada/sem_elim.ads ada/sem_eval.ads ada/sem_mech.ads ada/sem_prag.ads \ + ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ + ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \ + ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \ + ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \ + ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \ + ada/s-carun8.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \ + ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \ + ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ + ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ + ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \ + ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/widechar.ads ada/sem_ch7.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \ diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 61ac93e1f82..061597236ae 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -559,7 +559,14 @@ package body CStand is -- Create type definition node for type String Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc); - Set_Subtype_Indication (Tdef_Node, Identifier_For (S_Character)); + declare + CompDef_Node : Node_Id; + begin + CompDef_Node := New_Node (N_Component_Definition, Stloc); + Set_Aliased_Present (CompDef_Node, False); + Set_Subtype_Indication (CompDef_Node, Identifier_For (S_Character)); + Set_Component_Definition (Tdef_Node, CompDef_Node); + end; Set_Subtype_Marks (Tdef_Node, New_List); Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node)); Set_Type_Definition (Parent (Standard_String), Tdef_Node); @@ -581,7 +588,15 @@ package body CStand is -- Create type definition node for type Wide_String Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc); - Set_Subtype_Indication (Tdef_Node, Identifier_For (S_Wide_Character)); + declare + CompDef_Node : Node_Id; + begin + CompDef_Node := New_Node (N_Component_Definition, Stloc); + Set_Aliased_Present (CompDef_Node, False); + Set_Subtype_Indication (CompDef_Node, + Identifier_For (S_Wide_Character)); + Set_Component_Definition (Tdef_Node, CompDef_Node); + end; Set_Subtype_Marks (Tdef_Node, New_List); Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node)); Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node); @@ -1119,7 +1134,11 @@ package body CStand is Append ( Make_Component_Declaration (Stloc, Defining_Identifier => Comp, - Subtype_Indication => New_Occurrence_Of (Etype (Comp), Stloc)), + Component_Definition => + Make_Component_Definition (Stloc, + Aliased_Present => False, + Subtype_Indication => New_Occurrence_Of (Etype (Comp), + Stloc))), Comp_List); Next_Entity (Comp); diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 10c35d37f01..a0169259ceb 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -3062,8 +3062,11 @@ package body Exp_Aggr is Type_Definition => Make_Constrained_Array_Definition (Loc, Discrete_Subtype_Definitions => Indices, - Subtype_Indication => - New_Occurrence_Of (Component_Type (Typ), Loc))); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (Component_Type (Typ), Loc)))); Insert_Action (N, Decl); Analyze (Decl); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index bac09db7abf..634a2ba983e 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -1937,7 +1937,8 @@ package body Exp_Ch3 is Decl := First_Non_Pragma (Component_Items (Comp_List)); while Present (Decl) loop Loc := Sloc (Decl); - Build_Record_Checks (Subtype_Indication (Decl), Check_List); + Build_Record_Checks + (Subtype_Indication (Component_Definition (Decl)), Check_List); Id := Defining_Identifier (Decl); Typ := Etype (Id); @@ -2725,7 +2726,10 @@ package body Exp_Ch3 is Comp_Decl := Make_Component_Declaration (Loc, Defining_Identifier => Parent_N, - Subtype_Indication => New_Reference_To (Par_Subtype, Loc)); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Reference_To (Par_Subtype, Loc))); if Null_Present (Rec_Ext_Part) then Set_Component_List (Rec_Ext_Part, @@ -3302,7 +3306,10 @@ package body Exp_Ch3 is Comp_Decl := Make_Component_Declaration (Loc, Defining_Identifier => Ent, - Subtype_Indication => New_Reference_To (Controller_Type, Loc)); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Reference_To (Controller_Type, Loc))); if Null_Present (Comp_List) or else Is_Empty_List (Component_Items (Comp_List)) @@ -3393,8 +3400,10 @@ package body Exp_Ch3 is Comp_Decl := Make_Component_Declaration (Sloc_N, Defining_Identifier => Tag_Component (T), - Subtype_Indication => - New_Reference_To (RTE (RE_Tag), Sloc_N)); + Component_Definition => + Make_Component_Definition (Sloc_N, + Aliased_Present => False, + Subtype_Indication => New_Reference_To (RTE (RE_Tag), Sloc_N))); if Null_Present (Comp_List) or else Is_Empty_List (Component_Items (Comp_List)) @@ -3410,7 +3419,7 @@ package body Exp_Ch3 is -- already been analyzed previously. Here we just insure that the -- tree is coherent with the semantic decoration - Find_Type (Subtype_Indication (Comp_Decl)); + Find_Type (Subtype_Indication (Component_Definition (Comp_Decl))); exception when RE_Not_Available => @@ -3579,7 +3588,10 @@ package body Exp_Ch3 is High_Bound => Make_Integer_Literal (Loc, Num - 1))))), - Subtype_Indication => New_Reference_To (Typ, Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Reference_To (Typ, Loc))), Expression => Make_Aggregate (Loc, diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index e77b3cd60c7..2db7c839145 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -2611,8 +2611,11 @@ package body Exp_Ch9 is (Etype (Discrete_Subtype_Definition (Parent (Efam)))), Loc))), - Subtype_Indication => - New_Reference_To (Standard_Character, Loc))); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Reference_To (Standard_Character, Loc)))); Insert_After (Current_Node, Efam_Decl); Current_Node := Efam_Decl; @@ -2623,17 +2626,21 @@ package body Exp_Ch9 is Defining_Identifier => Make_Defining_Identifier (Loc, Chars (Efam)), - Subtype_Indication => - Make_Subtype_Indication (Loc, - Subtype_Mark => - New_Occurrence_Of (Efam_Type, Loc), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + Make_Subtype_Indication (Loc, + Subtype_Mark => + New_Occurrence_Of (Efam_Type, Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List ( + New_Occurrence_Of + (Etype (Discrete_Subtype_Definition + (Parent (Efam))), Loc))))))); + - Constraint => - Make_Index_Or_Discriminant_Constraint (Loc, - Constraints => New_List ( - New_Occurrence_Of - (Etype (Discrete_Subtype_Definition - (Parent (Efam))), Loc)))))); end if; Next_Entity (Efam); @@ -3265,14 +3272,19 @@ package body Exp_Ch9 is Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, New_Internal_Name ('P')), - Subtype_Indication => - New_Occurrence_Of (RTE (RE_Address), Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (RTE (RE_Address), Loc))), Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, New_Internal_Name ('S')), - Subtype_Indication => - New_Occurrence_Of (D_T2, Loc))); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Occurrence_Of (D_T2, Loc)))); Decl2 := Make_Full_Type_Declaration (Loc, @@ -4668,7 +4680,10 @@ package body Exp_Ch9 is Append_To (Components, Make_Component_Declaration (Loc, Defining_Identifier => Component, - Subtype_Indication => New_Reference_To (Ctype, Loc))); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Reference_To (Ctype, Loc)))); Next_Formal_With_Extras (Formal); end loop; @@ -5227,8 +5242,10 @@ package body Exp_Ch9 is Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_uObject), - Aliased_Present => True, - Subtype_Indication => Protection_Subtype); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => True, + Subtype_Indication => Protection_Subtype)); end; pragma Assert (Present (Pdef)); @@ -5246,8 +5263,13 @@ package body Exp_Ch9 is Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Sloc (Pent), Chars (Pent)), - Subtype_Indication => - New_Copy_Tree (Subtype_Indication (Priv), Discr_Map), + Component_Definition => + Make_Component_Definition (Sloc (Pent), + Aliased_Present => False, + Subtype_Indication => + New_Copy_Tree (Subtype_Indication + (Component_Definition (Priv)), + Discr_Map)), Expression => Expression (Priv)); Append_To (Cdecls, New_Priv); @@ -7175,7 +7197,11 @@ package body Exp_Ch9 is Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_uTask_Id), - Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_ID), Loc))); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_ID), + Loc)))); -- Add components for entry families @@ -7216,7 +7242,11 @@ package body Exp_Ch9 is Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_uPriority), - Subtype_Indication => New_Reference_To (Standard_Integer, Loc), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Reference_To (Standard_Integer, + Loc)), Expression => Expr)); end; end if; @@ -7231,7 +7261,11 @@ package body Exp_Ch9 is Defining_Identifier => Make_Defining_Identifier (Loc, Name_uSize), - Subtype_Indication => New_Reference_To (RTE (RE_Size_Type), Loc), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Reference_To (RTE (RE_Size_Type), + Loc)), Expression => Convert_To (RTE (RE_Size_Type), @@ -7249,8 +7283,11 @@ package body Exp_Ch9 is Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_uTask_Info), - Subtype_Indication => - New_Reference_To (RTE (RE_Task_Info_Type), Loc), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Reference_To (RTE (RE_Task_Info_Type), Loc)), Expression => New_Copy ( Expression (First ( Pragma_Argument_Associations ( diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index a5bab92cb04..c8451ac0271 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -1886,26 +1886,38 @@ package body Exp_Dist is Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_Origin), - Subtype_Indication => - New_Occurrence_Of (RTE (RE_Partition_ID), Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (RTE (RE_Partition_ID), Loc))), Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_Receiver), - Subtype_Indication => - New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (RTE (RE_Unsigned_64), Loc))), Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_Addr), - Subtype_Indication => - New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (RTE (RE_Unsigned_64), Loc))), Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_Asynchronous), - Subtype_Indication => - New_Occurrence_Of (Standard_Boolean, Loc)))))); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (Standard_Boolean, Loc))))))); Append_To (Decls, Stub_Type_Declaration); Analyze (Stub_Type_Declaration); diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 7f3a8f0858d..5989cbc3b5c 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2004 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- -- @@ -140,7 +140,10 @@ package body Exp_Imgv is Make_Range (Loc, Low_Bound => Make_Integer_Literal (Loc, 0), High_Bound => Make_Integer_Literal (Loc, Nlit))), - Subtype_Indication => New_Occurrence_Of (Ityp, Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Occurrence_Of (Ityp, Loc))), Expression => Make_Aggregate (Loc, diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index a0440cae4b5..558e251d5a3 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -958,15 +958,21 @@ package body Exp_Pakd is Typedef := Make_Unconstrained_Array_Definition (Loc, Subtype_Marks => Indexes, - Subtype_Indication => - New_Occurrence_Of (Ctyp, Loc)); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (Ctyp, Loc))); else Typedef := Make_Constrained_Array_Definition (Loc, Discrete_Subtype_Definitions => Indexes, - Subtype_Indication => - New_Occurrence_Of (Ctyp, Loc)); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (Ctyp, Loc))); end if; Decl := diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 5ad0618a16a..98802f15039 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -2009,6 +2009,7 @@ package body Exp_Util is N_Compilation_Unit_Aux | N_Component_Clause | N_Component_Declaration | + N_Component_Definition | N_Component_List | N_Constrained_Array_Definition | N_Decimal_Fixed_Point_Definition | @@ -2813,13 +2814,22 @@ package body Exp_Util is Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_uParent), - Subtype_Indication => New_Reference_To (Constr_Root, Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Reference_To (Constr_Root, Loc))), Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('C')), - Subtype_Indication => New_Reference_To (Str_Type, Loc))), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Reference_To (Str_Type, Loc)))), + Variant_Part => Empty)))); Insert_Actions (E, List_Def); diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 5ad723bab26..bea61efccc4 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2004 Ada Core Technologies, 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- -- @@ -1403,7 +1403,8 @@ package body GNAT.Sockets is begin Ada.Exceptions.Raise_Exception - (Socket_Error'Identity, Image (Error) & Socket_Error_Message (Error)); + (Socket_Error'Identity, + Image (Error) & C.Strings.Value (Socket_Error_Message (Error))); end Raise_Socket_Error; ---------- diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index 2c337e00ea2..49f3c8d244b 100644 --- a/gcc/ada/g-socthi.adb +++ b/gcc/ada/g-socthi.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2004 Ada Core Technologies, 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- -- @@ -44,8 +44,8 @@ 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); + Non_Blocking_Sockets : constant Fd_Set_Access := + New_Socket_Set (No_Socket_Set); -- 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 @@ -62,33 +62,32 @@ package body GNAT.Sockets.Thin is Thread_Blocking_IO : Boolean := True; + Unknown_System_Error : constant C.Strings.chars_ptr := + C.Strings.New_String ("Unknown system error"); + function Syscall_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) - return C.int; + Addrlen : access C.int) return C.int; pragma Import (C, Syscall_Accept, "accept"); function Syscall_Connect (S : C.int; Name : System.Address; - Namelen : C.int) - return C.int; + Namelen : C.int) return C.int; pragma Import (C, Syscall_Connect, "connect"); function Syscall_Ioctl (S : C.int; Req : C.int; - Arg : Int_Access) - return C.int; + Arg : Int_Access) return C.int; pragma Import (C, Syscall_Ioctl, "ioctl"); function Syscall_Recv (S : C.int; Msg : System.Address; Len : C.int; - Flags : C.int) - return C.int; + Flags : C.int) return C.int; pragma Import (C, Syscall_Recv, "recv"); function Syscall_Recvfrom @@ -97,16 +96,14 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) - return C.int; + Fromlen : access C.int) return C.int; pragma Import (C, Syscall_Recvfrom, "recvfrom"); function Syscall_Send (S : C.int; Msg : System.Address; Len : C.int; - Flags : C.int) - return C.int; + Flags : C.int) return C.int; pragma Import (C, Syscall_Send, "send"); function Syscall_Sendto @@ -115,13 +112,13 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; To : Sockaddr_In_Access; - Tolen : C.int) - return C.int; + Tolen : C.int) return C.int; pragma Import (C, Syscall_Sendto, "sendto"); function Syscall_Socket - (Domain, Typ, Protocol : C.int) - return C.int; + (Domain : C.int; + Typ : C.int; + Protocol : C.int) return C.int; pragma Import (C, Syscall_Socket, "socket"); function Non_Blocking_Socket (S : C.int) return Boolean; @@ -134,8 +131,7 @@ package body GNAT.Sockets.Thin is function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) - return C.int + Addrlen : access C.int) return C.int is R : C.int; Val : aliased C.int := 1; @@ -174,8 +170,7 @@ package body GNAT.Sockets.Thin is function C_Connect (S : C.int; Name : System.Address; - Namelen : C.int) - return C.int + Namelen : C.int) return C.int is Res : C.int; @@ -235,10 +230,9 @@ package body GNAT.Sockets.Thin is ------------- function C_Ioctl - (S : C.int; - Req : C.int; - Arg : Int_Access) - return C.int + (S : C.int; + Req : C.int; + Arg : Int_Access) return C.int is begin if not Thread_Blocking_IO @@ -260,8 +254,7 @@ package body GNAT.Sockets.Thin is (S : C.int; Msg : System.Address; Len : C.int; - Flags : C.int) - return C.int + Flags : C.int) return C.int is Res : C.int; @@ -288,8 +281,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) - return C.int + Fromlen : access C.int) return C.int is Res : C.int; @@ -314,8 +306,7 @@ package body GNAT.Sockets.Thin is (S : C.int; Msg : System.Address; Len : C.int; - Flags : C.int) - return C.int + Flags : C.int) return C.int is Res : C.int; @@ -342,8 +333,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; To : Sockaddr_In_Access; - Tolen : C.int) - return C.int + Tolen : C.int) return C.int is Res : C.int; @@ -367,8 +357,7 @@ package body GNAT.Sockets.Thin is function C_Socket (Domain : C.int; Typ : C.int; - Protocol : C.int) - return C.int + Protocol : C.int) return C.int is R : C.int; Val : aliased C.int := 1; @@ -416,7 +405,6 @@ package body GNAT.Sockets.Thin is function Non_Blocking_Socket (S : C.int) return Boolean is R : Boolean; - begin Task_Lock.Lock; R := Is_Socket_In_Set (Non_Blocking_Sockets, S); @@ -433,7 +421,7 @@ package body GNAT.Sockets.Thin is Address : In_Addr) is begin - Sin.Sin_Addr := Address; + Sin.Sin_Addr := Address; end Set_Address; ---------------- @@ -496,7 +484,9 @@ package body GNAT.Sockets.Thin is -- Socket_Error_Message -- -------------------------- - function Socket_Error_Message (Errno : Integer) return String is + function Socket_Error_Message + (Errno : Integer) return C.Strings.chars_ptr + is use type Interfaces.C.Strings.chars_ptr; C_Msg : C.Strings.chars_ptr; @@ -505,10 +495,10 @@ package body GNAT.Sockets.Thin is C_Msg := C_Strerror (C.int (Errno)); if C_Msg = C.Strings.Null_Ptr then - return "Unknown system error"; + return Unknown_System_Error; else - return C.Strings.Value (C_Msg); + return C_Msg; end if; end Socket_Error_Message; diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads index 3155fd0e502..f8b7aca88c5 100644 --- a/gcc/ada/g-socthi.ads +++ b/gcc/ada/g-socthi.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2003 Ada Core Technologies, Inc. -- +-- Copyright (C) 2001-2004 Ada Core Technologies, 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- -- @@ -61,7 +61,7 @@ package GNAT.Sockets.Thin is function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number. - function Socket_Error_Message (Errno : Integer) return String; + 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". @@ -198,100 +198,85 @@ package GNAT.Sockets.Thin is function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) - return C.int; + Addrlen : access C.int) return C.int; function C_Bind (S : C.int; Name : System.Address; - Namelen : C.int) - return C.int; + Namelen : C.int) return C.int; function C_Close - (Fd : C.int) - return C.int; + (Fd : C.int) return C.int; function C_Connect (S : C.int; Name : System.Address; - Namelen : C.int) - return C.int; + Namelen : C.int) return C.int; function C_Gethostbyaddr (Addr : System.Address; Len : C.int; - Typ : C.int) - return Hostent_Access; + Typ : C.int) return Hostent_Access; function C_Gethostbyname - (Name : C.char_array) - return Hostent_Access; + (Name : C.char_array) return Hostent_Access; function C_Gethostname (Name : System.Address; - Namelen : C.int) - return C.int; + Namelen : C.int) return C.int; function C_Getpeername (S : C.int; Name : System.Address; - Namelen : access C.int) - return C.int; + Namelen : access C.int) return C.int; function C_Getservbyname (Name : C.char_array; - Proto : C.char_array) - return Servent_Access; + Proto : C.char_array) return Servent_Access; function C_Getservbyport (Port : C.int; - Proto : C.char_array) - return Servent_Access; + Proto : C.char_array) return Servent_Access; function C_Getsockname (S : C.int; Name : System.Address; - Namelen : access C.int) - return C.int; + Namelen : access C.int) return C.int; function C_Getsockopt (S : C.int; Level : C.int; Optname : C.int; Optval : System.Address; - Optlen : access C.int) - return C.int; + Optlen : access C.int) return C.int; function C_Inet_Addr - (Cp : C.Strings.chars_ptr) - return C.int; + (Cp : C.Strings.chars_ptr) return C.int; function C_Ioctl (S : C.int; Req : C.int; - Arg : Int_Access) - return C.int; + Arg : Int_Access) return C.int; - function C_Listen (S, Backlog : C.int) return C.int; + function C_Listen + (S : C.int; + Backlog : C.int) return C.int; function C_Read (Fd : C.int; Buf : System.Address; - Count : C.int) - return C.int; + Count : C.int) return C.int; function C_Readv (Fd : C.int; Iov : System.Address; - Iovcnt : C.int) - return C.int; + Iovcnt : C.int) return C.int; function C_Recv (S : C.int; Msg : System.Address; Len : C.int; - Flags : C.int) - return C.int; + Flags : C.int) return C.int; function C_Recvfrom (S : C.int; @@ -299,23 +284,20 @@ package GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) - return C.int; + Fromlen : access C.int) return C.int; function C_Select (Nfds : C.int; Readfds : Fd_Set_Access; Writefds : Fd_Set_Access; Exceptfds : Fd_Set_Access; - Timeout : Timeval_Access) - return C.int; + Timeout : Timeval_Access) return C.int; function C_Send (S : C.int; Msg : System.Address; Len : C.int; - Flags : C.int) - return C.int; + Flags : C.int) return C.int; function C_Sendto (S : C.int; @@ -323,47 +305,39 @@ package GNAT.Sockets.Thin is Len : C.int; Flags : C.int; To : Sockaddr_In_Access; - Tolen : C.int) - return C.int; + Tolen : C.int) return C.int; function C_Setsockopt (S : C.int; Level : C.int; Optname : C.int; Optval : System.Address; - Optlen : C.int) - return C.int; + Optlen : C.int) return C.int; function C_Shutdown - (S : C.int; - How : C.int) - return C.int; + (S : C.int; + How : C.int) return C.int; function C_Socket (Domain : C.int; Typ : C.int; - Protocol : C.int) - return C.int; + Protocol : C.int) return C.int; function C_Strerror - (Errnum : C.int) - return C.Strings.chars_ptr; + (Errnum : C.int) return C.Strings.chars_ptr; function C_System - (Command : System.Address) - return C.int; + (Command : System.Address) return C.int; function C_Write (Fd : C.int; Buf : System.Address; - Count : C.int) - return C.int; + Count : C.int) return C.int; function C_Writev (Fd : C.int; Iov : System.Address; - Iovcnt : C.int) - return C.int; + Iovcnt : C.int) return C.int; procedure Free_Socket_Set (Set : Fd_Set_Access); @@ -386,8 +360,7 @@ package GNAT.Sockets.Thin is function Is_Socket_In_Set (Set : Fd_Set_Access; - Socket : C.int) - return Boolean; + Socket : C.int) return Boolean; -- Check whether Socket is in the socket set procedure Last_Socket_In_Set @@ -400,8 +373,7 @@ package GNAT.Sockets.Thin is -- set back to the real largest socket in the socket set. function New_Socket_Set - (Set : Fd_Set_Access) - return Fd_Set_Access; + (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. diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index d2a8645fc19..f501d95fa8e 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2004 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- -- @@ -229,6 +229,7 @@ package body Impunit is "g-regist", -- GNAT.Registry "g-regpat", -- GNAT.Regpat "g-semaph", -- GNAT.Semaphores + "g-sestin", -- GNAT.Secondary_Stack_Info "g-signal", -- GNAT.Signals "g-socket", -- GNAT.Sockets "g-souinf", -- GNAT.Source_Info diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index bc663a1a93c..64ae4b7fcf1 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2004, 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- -- @@ -604,9 +604,7 @@ package body Lib.Xref is exit; end if; - -- For a subtype, go to ancestor subtype. If it is a - -- subtype created for a generic actual, not clear yet - -- what is the right type to use ??? + -- For a subtype, go to ancestor subtype. else Tref := Ancestor_Subtype (Tref); @@ -651,6 +649,19 @@ package body Lib.Xref is if Sloc (Tref) = Standard_Location or else Comes_From_Source (Tref) then + -- If the reference is a subtype created for a generic + -- actual, go to actual directly, the inner subtype is + -- not user visible. + + if Nkind (Parent (Tref)) = N_Subtype_Declaration + and then not Comes_From_Source (Parent (Tref)) + and then + (Is_Wrapper_Package (Scope (Tref)) + or else Is_Generic_Instance (Scope (Tref))) + then + Tref := Base_Type (Tref); + end if; + return; end if; end loop; diff --git a/gcc/ada/link.c b/gcc/ada/link.c index c9d4d803fb6..dd20d03b10d 100644 --- a/gcc/ada/link.c +++ b/gcc/ada/link.c @@ -157,7 +157,7 @@ const char *object_library_extension = ".a"; #elif defined (__FreeBSD__) char *object_file_option = ""; char *run_path_option = ""; -char shared_libgnat_default = SHARED; +char shared_libgnat_default = STATIC; int link_max = 2147483647; unsigned char objlist_file_supported = 0; unsigned char using_gnu_linker = 0; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 8236c5897d7..44c809d9738 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -2018,10 +2018,11 @@ package body Ch3 is -- Error recovery: can raise Error_Resync function P_Array_Type_Definition return Node_Id is - Array_Loc : Source_Ptr; - Def_Node : Node_Id; - Subs_List : List_Id; - Scan_State : Saved_Scan_State; + Array_Loc : Source_Ptr; + CompDef_Node : Node_Id; + Def_Node : Node_Id; + Subs_List : List_Id; + Scan_State : Saved_Scan_State; begin Array_Loc := Token_Ptr; @@ -2079,12 +2080,16 @@ package body Ch3 is T_Right_Paren; T_Of; + CompDef_Node := New_Node (N_Component_Definition, Token_Ptr); + if Token = Tok_Aliased then - Set_Aliased_Present (Def_Node, True); + Set_Aliased_Present (CompDef_Node, True); Scan; -- past ALIASED end if; - Set_Subtype_Indication (Def_Node, P_Subtype_Indication); + Set_Subtype_Indication (CompDef_Node, P_Subtype_Indication); + Set_Component_Definition (Def_Node, CompDef_Node); + return Def_Node; end P_Array_Type_Definition; @@ -2728,11 +2733,12 @@ package body Ch3 is -- items, do we need to add this capability sometime in the future ??? procedure P_Component_Items (Decls : List_Id) is - Decl_Node : Node_Id; - Scan_State : Saved_Scan_State; - Num_Idents : Nat; - Ident : Nat; - Ident_Sloc : Source_Ptr; + CompDef_Node : Node_Id; + Decl_Node : Node_Id; + Scan_State : Saved_Scan_State; + Num_Idents : Nat; + Ident : Nat; + Ident_Sloc : Source_Ptr; Idents : array (Int range 1 .. 4096) of Entity_Id; -- This array holds the list of defining identifiers. The upper bound @@ -2783,13 +2789,15 @@ package body Ch3 is Scan; end if; + CompDef_Node := New_Node (N_Component_Definition, Token_Ptr); + if Token_Name = Name_Aliased then Check_95_Keyword (Tok_Aliased, Tok_Identifier); end if; if Token = Tok_Aliased then Scan; -- past ALIASED - Set_Aliased_Present (Decl_Node, True); + Set_Aliased_Present (CompDef_Node, True); end if; if Token = Tok_Array then @@ -2797,8 +2805,9 @@ package body Ch3 is raise Error_Resync; end if; - Set_Subtype_Indication (Decl_Node, P_Subtype_Indication); - Set_Expression (Decl_Node, Init_Expr_Opt); + Set_Subtype_Indication (CompDef_Node, P_Subtype_Indication); + Set_Component_Definition (Decl_Node, CompDef_Node); + Set_Expression (Decl_Node, Init_Expr_Opt); if Ident > 1 then Set_Prev_Ids (Decl_Node, True); diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index edbb6ddb0cc..2d2c86a51db 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -574,6 +574,7 @@ package body Sem is N_Compilation_Unit_Aux | N_Component_Association | N_Component_Clause | + N_Component_Definition | N_Component_List | N_Constrained_Array_Definition | N_Decimal_Fixed_Point_Definition | diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 93593cfaee0..e7fb9d49440 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -906,7 +906,8 @@ package body Sem_Ch3 is begin Generate_Definition (Id); Enter_Name (Id); - T := Find_Type_Of_Object (Subtype_Indication (N), N); + T := Find_Type_Of_Object (Subtype_Indication (Component_Definition (N)), + N); -- If the subtype is a constrained subtype of the enclosing record, -- (which must have a partial view) the back-end does not handle @@ -916,15 +917,16 @@ package body Sem_Ch3 is -- removed from discriminant constraints. if Ekind (T) = E_Access_Subtype - and then Is_Entity_Name (Subtype_Indication (N)) + and then Is_Entity_Name (Subtype_Indication (Component_Definition (N))) and then Comes_From_Source (T) and then Nkind (Parent (T)) = N_Subtype_Declaration and then Etype (Directly_Designated_Type (T)) = Current_Scope then Rewrite - (Subtype_Indication (N), + (Subtype_Indication (Component_Definition (N)), New_Copy_Tree (Subtype_Indication (Parent (T)))); - T := Find_Type_Of_Object (Subtype_Indication (N), N); + T := Find_Type_Of_Object + (Subtype_Indication (Component_Definition (N)), N); end if; -- If the component declaration includes a default expression, then we @@ -944,7 +946,7 @@ package body Sem_Ch3 is if Is_Indefinite_Subtype (T) and then Chars (Id) /= Name_uParent then Error_Msg_N ("unconstrained subtype in component declaration", - Subtype_Indication (N)); + Subtype_Indication (Component_Definition (N))); -- Components cannot be abstract, except for the special case of -- the _Parent field (case of extending an abstract tagged type) @@ -954,9 +956,9 @@ package body Sem_Ch3 is end if; Set_Etype (Id, T); - Set_Is_Aliased (Id, Aliased_Present (N)); + Set_Is_Aliased (Id, Aliased_Present (Component_Definition (N))); - -- If the this component is private (or depends on a private type), + -- If this component is private (or depends on a private type), -- flag the record type to indicate that some operations are not -- available. @@ -2727,7 +2729,7 @@ package body Sem_Ch3 is ---------------------------- procedure Array_Type_Declaration (T : in out Entity_Id; Def : Node_Id) is - Component_Def : constant Node_Id := Subtype_Indication (Def); + Component_Def : constant Node_Id := Component_Definition (Def); Element_Type : Entity_Id; Implicit_Base : Entity_Id; Index : Node_Id; @@ -2764,7 +2766,8 @@ package body Sem_Ch3 is Nb_Index := Nb_Index + 1; end loop; - Element_Type := Process_Subtype (Component_Def, P, Related_Id, 'C'); + Element_Type := Process_Subtype (Subtype_Indication (Component_Def), + P, Related_Id, 'C'); -- Constrained array case @@ -2830,7 +2833,7 @@ package body Sem_Ch3 is Set_Component_Type (Base_Type (T), Element_Type); - if Aliased_Present (Def) then + if Aliased_Present (Component_Definition (Def)) then Set_Has_Aliased_Components (Etype (T)); end if; @@ -2874,12 +2877,13 @@ package body Sem_Ch3 is if Is_Indefinite_Subtype (Element_Type) then Error_Msg_N - ("unconstrained element type in array declaration ", - Component_Def); + ("unconstrained element type in array declaration", + Subtype_Indication (Component_Def)); elsif Is_Abstract (Element_Type) then - Error_Msg_N ("The type of a component cannot be abstract ", - Component_Def); + Error_Msg_N + ("The type of a component cannot be abstract", + Subtype_Indication (Component_Def)); end if; end Array_Type_Declaration; @@ -2900,15 +2904,15 @@ package body Sem_Ch3 is Discr_Con_Elist : Elist_Id; Discr_Con_El : Elmt_Id; - Subt : Entity_Id; + Subt : Entity_Id; begin -- Set the designated type so it is available in case this is -- an access to a self-referential type, e.g. a standard list -- type with a next pointer. Will be reset after subtype is built. - Set_Directly_Designated_Type (Derived_Type, - Designated_Type (Parent_Type)); + Set_Directly_Designated_Type + (Derived_Type, Designated_Type (Parent_Type)); Subt := Process_Subtype (S, N); @@ -5592,10 +5596,10 @@ package body Sem_Ch3 is if Discrim_Present then null; - elsif Nkind (Parent (Def)) = N_Component_Declaration + elsif Nkind (Parent (Parent (Def))) = N_Component_Declaration and then Has_Per_Object_Constraint - (Defining_Identifier (Parent (Def))) + (Defining_Identifier (Parent (Parent (Def)))) then null; @@ -9525,11 +9529,18 @@ package body Sem_Ch3 is Related_Nod : Node_Id) return Entity_Id is Def_Kind : constant Node_Kind := Nkind (Obj_Def); - P : constant Node_Id := Parent (Obj_Def); + P : Node_Id := Parent (Obj_Def); T : Entity_Id; Nam : Name_Id; begin + -- If the parent is a component_definition node we climb to the + -- component_declaration node + + if Nkind (P) = N_Component_Definition then + P := Parent (P); + end if; + -- Case of an anonymous array subtype if Def_Kind = N_Constrained_Array_Definition diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 4edfee86850..7c408bf33d3 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -1652,6 +1652,17 @@ package body Sem_Ch7 is Set_Is_Immediately_Visible (Id, False); + -- If this is a private type with a full view (for example a local + -- subtype of a private type declared elsewhere), ensure that the + -- full view is also removed from visibility: it may be exposed when + -- swapping views in an instantiation. + + if Is_Type (Id) + and then Present (Full_View (Id)) + then + Set_Is_Immediately_Visible (Full_View (Id), False); + end if; + if Is_Tagged_Type (Id) and then Ekind (Id) = E_Record_Type then Check_Abstract_Overriding (Id); end if; diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb index 70f96942d1c..c6a9862daf6 100644 --- a/gcc/ada/sem_dist.adb +++ b/gcc/ada/sem_dist.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -427,44 +427,55 @@ package body Sem_Dist is Defining_Identifier => Make_Defining_Identifier (Loc, Chars => Name_Ras), - Subtype_Indication => - New_Occurrence_Of - (RTE (RE_Unsigned_64), Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (RTE (RE_Unsigned_64), Loc))), Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Chars => Name_Origin), - Subtype_Indication => - New_Reference_To - (Standard_Integer, - Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Reference_To + (Standard_Integer, Loc))), Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Chars => Name_Receiver), - Subtype_Indication => - New_Reference_To - (RTE (RE_Unsigned_64), Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Reference_To + (RTE (RE_Unsigned_64), Loc))), Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Chars => Name_Subp_Id), - Subtype_Indication => - New_Reference_To - (Standard_Natural, - Loc)), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Reference_To + (Standard_Natural, Loc))), Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Chars => Name_Async), - Subtype_Indication => - New_Reference_To - (Standard_Boolean, - Loc)))))); + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Reference_To + (Standard_Boolean, Loc))))))); Insert_After (N, New_Type_Decl); Set_Equivalent_Type (User_Type, Fat_Type); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 4ad662dbac1..c9fec25348b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9375,7 +9375,7 @@ package body Sem_Prag is declare Sindic : constant Node_Id := - Subtype_Indication (Comp); + Subtype_Indication (Component_Definition (Comp)); begin if Nkind (Sindic) = N_Subtype_Indication then diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 7bcd986fe75..0fb3fdf8c2b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -382,7 +382,7 @@ package body Sem_Res is if Nkind (P) = N_Range_Constraint and then Nkind (Parent (P)) = N_Subtype_Indication - and then Nkind (Parent (Parent (P))) = N_Component_Declaration + and then Nkind (Parent (Parent (P))) = N_Component_Definition then Error_Msg_N ("discriminant cannot constrain scalar type", N); @@ -409,7 +409,7 @@ package body Sem_Res is and then not (Nkind (Parent (P)) = N_Subtype_Indication and then - (Nkind (Parent (Parent (P))) = N_Component_Declaration + (Nkind (Parent (Parent (P))) = N_Component_Definition or else Nkind (Parent (Parent (P))) = N_Subtype_Declaration) and then Paren_Count (N) = 0) then @@ -559,7 +559,7 @@ package body Sem_Res is if (Nkind (P) = N_Subtype_Indication and then - (Nkind (Parent (P)) = N_Component_Declaration + (Nkind (Parent (P)) = N_Component_Definition or else Nkind (Parent (P)) = N_Derived_Type_Definition) and then D = Constraint (P)) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 269e1322c4c..0c52cc30c30 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -3219,8 +3219,9 @@ package body Sem_Util is ------------------------------ function Has_Dependent_Constraint (Comp : Entity_Id) return Boolean is - Comp_Decl : constant Node_Id := Parent (Comp); - Subt_Indic : constant Node_Id := Subtype_Indication (Comp_Decl); + Comp_Decl : constant Node_Id := Parent (Comp); + Subt_Indic : constant Node_Id := + Subtype_Indication (Component_Definition (Comp_Decl)); Constr : Node_Id; Assn : Node_Id; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index f8d22784d0c..9791e20fd6c 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -170,10 +170,8 @@ package body Sinfo is (N : Node_Id) return Boolean is begin pragma Assert (False - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Constrained_Array_Definition - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Unconstrained_Array_Definition); + or else NT (N).Nkind = N_Component_Definition + or else NT (N).Nkind = N_Object_Declaration); return Flag4 (N); end Aliased_Present; @@ -376,6 +374,16 @@ package body Sinfo is return List3 (N); end Component_Clauses; + function Component_Definition + (N : Node_Id) return Node_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Component_Declaration + or else NT (N).Nkind = N_Constrained_Array_Definition + or else NT (N).Nkind = N_Unconstrained_Array_Definition); + return Node4 (N); + end Component_Definition; + function Component_Items (N : Node_Id) return List_Id is begin @@ -2293,12 +2301,10 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Access_To_Object_Definition - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Constrained_Array_Definition + or else NT (N).Nkind = N_Component_Definition or else NT (N).Nkind = N_Derived_Type_Definition or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Subtype_Declaration - or else NT (N).Nkind = N_Unconstrained_Array_Definition); + or else NT (N).Nkind = N_Subtype_Declaration); return Node5 (N); end Subtype_Indication; @@ -2612,10 +2618,8 @@ package body Sinfo is (N : Node_Id; Val : Boolean := True) is begin pragma Assert (False - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Constrained_Array_Definition - or else NT (N).Nkind = N_Object_Declaration - or else NT (N).Nkind = N_Unconstrained_Array_Definition); + or else NT (N).Nkind = N_Component_Definition + or else NT (N).Nkind = N_Object_Declaration); Set_Flag4 (N, Val); end Set_Aliased_Present; @@ -2818,6 +2822,16 @@ package body Sinfo is Set_List3_With_Parent (N, Val); end Set_Component_Clauses; + procedure Set_Component_Definition + (N : Node_Id; Val : Node_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Component_Declaration + or else NT (N).Nkind = N_Constrained_Array_Definition + or else NT (N).Nkind = N_Unconstrained_Array_Definition); + Set_Node4_With_Parent (N, Val); + end Set_Component_Definition; + procedure Set_Component_Items (N : Node_Id; Val : List_Id) is begin @@ -4725,12 +4739,10 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Access_To_Object_Definition - or else NT (N).Nkind = N_Component_Declaration - or else NT (N).Nkind = N_Constrained_Array_Definition + or else NT (N).Nkind = N_Component_Definition or else NT (N).Nkind = N_Derived_Type_Definition or else NT (N).Nkind = N_Private_Extension_Declaration - or else NT (N).Nkind = N_Subtype_Declaration - or else NT (N).Nkind = N_Unconstrained_Array_Definition); + or else NT (N).Nkind = N_Subtype_Declaration); Set_Node5_With_Parent (N, Val); end Set_Subtype_Indication; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index de8b23eb7d0..97f55c01d9c 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -2275,8 +2275,7 @@ package Sinfo is -- N_Unconstrained_Array_Definition -- Sloc points to ARRAY -- Subtype_Marks (List2) - -- Aliased_Present (Flag4) from component definition - -- Subtype_Indication (Node5) from component definition + -- Component_Definition (Node4) ----------------------------------- -- 3.6 Index Subtype Definition -- @@ -2304,8 +2303,7 @@ package Sinfo is -- N_Constrained_Array_Definition -- Sloc points to ARRAY -- Discrete_Subtype_Definitions (List2) - -- Aliased_Present (Flag4) from component definition - -- Subtype_Indication (Node5) from component definition + -- Component_Definition (Node4) -------------------------------------- -- 3.6 Discrete Subtype Definition -- @@ -2320,16 +2318,17 @@ package Sinfo is -- COMPONENT_DEFINITION ::= [aliased] SUBTYPE_INDICATION - -- There is no explicit node in the tree for a component definition. - -- Instead the subtype indication appears directly, and the ALIASED - -- indication (Aliased_Present flag) is in the parent node. - -- Note: although the syntax does not permit a component definition to -- be an anonymous array (and the parser will diagnose such an attempt -- with an appropriate message), it is possible for anonymous arrays -- to appear as component definitions. The semantics and back end handle -- this case properly, and the expander in fact generates such cases. + -- N_Component_Definition + -- Sloc points to ALIASED or to first token of subtype mark + -- Aliased_Present (Flag4) + -- Subtype_Indication (Node5) + ----------------------------- -- 3.6.1 Index Constraint -- ----------------------------- @@ -2537,8 +2536,7 @@ package Sinfo is -- N_Component_Declaration -- Sloc points to first identifier -- Defining_Identifier (Node1) - -- Aliased_Present (Flag4) from component definition - -- Subtype_Indication (Node5) from component definition + -- Component_Definition (Node4) -- Expression (Node3) (set to Empty if no default expression) -- More_Ids (Flag5) (set to False if no more identifiers in list) -- Prev_Ids (Flag6) (set to False if no previous identifiers in list) @@ -6651,6 +6649,7 @@ package Sinfo is N_Compilation_Unit, N_Compilation_Unit_Aux, N_Component_Association, + N_Component_Definition, N_Component_List, N_Derived_Type_Definition, N_Decimal_Fixed_Point_Definition, @@ -6968,6 +6967,9 @@ package Sinfo is function Component_Clauses (N : Node_Id) return List_Id; -- List3 + function Component_Definition + (N : Node_Id) return Node_Id; -- Node4 + function Component_Items (N : Node_Id) return List_Id; -- List3 @@ -7748,6 +7750,9 @@ package Sinfo is procedure Set_Component_Clauses (N : Node_Id; Val : List_Id); -- List3 + procedure Set_Component_Definition + (N : Node_Id; Val : Node_Id); -- Node4 + procedure Set_Component_Items (N : Node_Id; Val : List_Id); -- List3 @@ -8471,6 +8476,7 @@ package Sinfo is pragma Inline (Compile_Time_Known_Aggregate); pragma Inline (Component_Associations); pragma Inline (Component_Clauses); + pragma Inline (Component_Definition); pragma Inline (Component_Items); pragma Inline (Component_List); pragma Inline (Component_Name); @@ -8728,6 +8734,7 @@ package Sinfo is pragma Inline (Set_Compile_Time_Known_Aggregate); pragma Inline (Set_Component_Associations); pragma Inline (Set_Component_Clauses); + pragma Inline (Set_Component_Definition); pragma Inline (Set_Component_Items); pragma Inline (Set_Component_List); pragma Inline (Set_Component_Name); diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 7fe0a83a36d..a5031aae8a8 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -949,15 +949,17 @@ package body Sprint is Sprint_Node (Last_Bit (Node)); Write_Char (';'); + when N_Component_Definition => + Set_Debug_Sloc; + if Aliased_Present (Node) then + Write_Str_With_Col_Check ("aliased "); + end if; + Sprint_Node (Subtype_Indication (Node)); + when N_Component_Declaration => if Write_Indent_Identifiers_Sloc (Node) then Write_Str (" : "); - - if Aliased_Present (Node) then - Write_Str_With_Col_Check ("aliased "); - end if; - - Sprint_Node (Subtype_Indication (Node)); + Sprint_Node (Component_Definition (Node)); if Present (Expression (Node)) then Write_Str (" := "); @@ -1010,11 +1012,7 @@ package body Sprint is Sprint_Paren_Comma_List (Discrete_Subtype_Definitions (Node)); Write_Str (" of "); - if Aliased_Present (Node) then - Write_Str_With_Col_Check ("aliased "); - end if; - - Sprint_Node (Subtype_Indication (Node)); + Sprint_Node (Component_Definition (Node)); when N_Decimal_Fixed_Point_Definition => Write_Str_With_Col_Check_Sloc (" delta "); @@ -2439,12 +2437,7 @@ package body Sprint is end; Write_Str (") of "); - - if Aliased_Present (Node) then - Write_Str_With_Col_Check ("aliased "); - end if; - - Sprint_Node (Subtype_Indication (Node)); + Sprint_Node (Component_Definition (Node)); when N_Unused_At_Start | N_Unused_At_End => Write_Indent_Str ("***** Error, unused node encountered *****"); diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index c174fb0fc4f..92934bc3b7c 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -2805,9 +2805,8 @@ tree_transform (Node_Id gnat_node) case N_Expanded_Name: case N_Attribute_Reference: if (Is_Eliminated (Entity (Name (gnat_node)))) - post_error_ne ("cannot call eliminated subprogram &!", - gnat_node, Entity (Name (gnat_node))); - } + Eliminate_Error_Msg (gnat_node, Entity (Name (gnat_node))); + } if (TREE_CODE (gnu_subprog_type) != FUNCTION_TYPE) gigi_abort (317); diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index c729f483791..7b42274316e 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004, 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- -- @@ -339,7 +339,7 @@ begin Write_Switch_Char ("wxx"); Write_Line ("Enable selected warning modes, xx = list of parameters:"); - Write_Line (" a turn on all optional warnings (except b,d,h,l)"); + Write_Line (" a turn on all optional warnings (except d,h,l)"); Write_Line (" A turn off all optional warnings"); Write_Line (" c turn on warnings for constant conditional"); Write_Line (" C* turn off warnings for constant conditional"); |