From: Thomas Quinot Date: Mon, 24 Feb 2014 16:54:41 +0000 (+0000) Subject: s-fileio.adb (Errno_Message): Remove, use shared version from s-os_lib instead. X-Git-Tag: releases/gcc-4.9.0~727 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=3e5b1f324798b549d61995939bf09e1728bacb95;p=thirdparty%2Fgcc.git s-fileio.adb (Errno_Message): Remove, use shared version from s-os_lib instead. 2014-02-24 Thomas Quinot * s-fileio.adb (Errno_Message): Remove, use shared version from s-os_lib instead. * s-crtrun.ads, Makefile.rtl: Remove now unused unit. * g-stseme (Socket_Error_Message): Reimplement in terms of new s-os_lib function. * g-socthi.ads, g-socthi.adb: Change profile of Socket_Error_Message to return String to allow the above. * g-socket.adb, g-socthi-mingw.adb, g-socthi-mingw.ads, * g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb, * g-socthi-vxworks.ads: Update to account for the above profile change. * a-tags.adb: Use strlen builtin binding provided by s-crtl. * s-crtl.ads (strncpy): New procedure. * s-os_lib.adb (Copy_Attributes): Import just once (strncpy): Use import from s-crtl. * a-envvar.adb, osint.adb: Use imports of C runtime functions from s-crtl instead of re-importing locally. From-SVN: r208079 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 24bac5752829..e31ec1edf7ba 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2014-02-24 Thomas Quinot + + * s-fileio.adb (Errno_Message): Remove, use shared version from + s-os_lib instead. + * s-crtrun.ads, Makefile.rtl: Remove now unused unit. + * g-stseme (Socket_Error_Message): Reimplement in terms of new + s-os_lib function. + * g-socthi.ads, g-socthi.adb: Change profile of + Socket_Error_Message to return String to allow the above. + * g-socket.adb, g-socthi-mingw.adb, g-socthi-mingw.ads, + * g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb, + * g-socthi-vxworks.ads: Update to account for the above profile + change. + * a-tags.adb: Use strlen builtin binding provided by s-crtl. + * s-crtl.ads (strncpy): New procedure. + * s-os_lib.adb (Copy_Attributes): Import just once (strncpy): + Use import from s-crtl. + * a-envvar.adb, osint.adb: Use imports of C runtime functions + from s-crtl instead of re-importing locally. + 2014-02-24 Hristian Kirtchev * sem_prag.adb (Analyze_Global_Item): Emit the diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index e4f2a5948d9e..6496dc7396c4 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -509,7 +509,6 @@ GNATRTL_NONTASKING_OBJS= \ s-conca9$(objext) \ s-crc32$(objext) \ s-crtl$(objext) \ - s-crtrun$(objext) \ s-diflio$(objext) \ s-dim$(objext) \ s-diinio$(objext) \ diff --git a/gcc/ada/a-envvar.adb b/gcc/ada/a-envvar.adb index edcbeb86039e..85368f8bf95b 100644 --- a/gcc/ada/a-envvar.adb +++ b/gcc/ada/a-envvar.adb @@ -29,7 +29,7 @@ -- -- ------------------------------------------------------------------------------ -with System; +with System.CRTL; with Interfaces.C.Strings; with Ada.Unchecked_Deallocation; @@ -188,14 +188,11 @@ package body Ada.Environment_Variables is ----------- function Value (Name : String) return String is - use System; + use System, System.CRTL; procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address); pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv"); - procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer); - pragma Import (C, Strncpy, "strncpy"); - Env_Value_Ptr : aliased Address; Env_Value_Length : aliased Integer; F_Name : aliased String (1 .. Name'Length + 1); @@ -215,7 +212,7 @@ package body Ada.Environment_Variables is declare Result : aliased String (1 .. Env_Value_Length); begin - Strncpy (Result'Address, Env_Value_Ptr, Env_Value_Length); + strncpy (Result'Address, Env_Value_Ptr, size_t (Env_Value_Length)); return Result; end; else diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb index d45c37861c4b..887bd148718d 100644 --- a/gcc/ada/a-tags.adb +++ b/gcc/ada/a-tags.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -31,6 +31,7 @@ with Ada.Exceptions; with Ada.Unchecked_Conversion; +with System.CRTL; use System.CRTL; with System.HTable; with System.Storage_Elements; use System.Storage_Elements; with System.WCh_Con; use System.WCh_Con; @@ -56,10 +57,6 @@ package body Ada.Tags is -- table. This is Inline_Always since it is called from other Inline_ -- Always subprograms where we want no out of line code to be generated. - function Length (Str : Cstring_Ptr) return Natural; - -- Length of string represented by the given pointer (treating the string - -- as a C-style string, which is Nul terminated). - function OSD (T : Tag) return Object_Specific_Data_Ptr; -- Ada 2005 (AI-251): Given a pointer T to a secondary dispatch table, -- retrieve the address of the record containing the Object Specific @@ -273,10 +270,11 @@ package body Ada.Tags is function Hash (F : System.Address) return HTable_Headers is function H is new System.HTable.Hash (HTable_Headers); - Str : constant Cstring_Ptr := To_Cstring_Ptr (F); - Res : constant HTable_Headers := H (Str (1 .. Length (Str))); + Str : String (1 .. Integer (strlen (F))); + for Str'Address use F; + pragma Import (Ada, Str); begin - return Res; + return H (Str); end Hash; ----------------- @@ -310,7 +308,8 @@ package body Ada.Tags is procedure Check_TSD (TSD : Type_Specific_Data_Ptr) is T : Tag; - E_Tag_Len : constant Integer := Length (TSD.External_Tag); + E_Tag_Len : constant Integer := + Integer (strlen (TSD.External_Tag.all'Address)); E_Tag : String (1 .. E_Tag_Len); for E_Tag'Address use TSD.External_Tag.all'Address; pragma Import (Ada, E_Tag); @@ -487,7 +486,7 @@ package body Ada.Tags is TSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size); TSD := To_Type_Specific_Data_Ptr (TSD_Ptr.all); Result := TSD.Expanded_Name; - return Result (1 .. Length (Result)); + return Result (1 .. Integer (strlen (Result.all'Address))); end Expanded_Name; ------------------ @@ -507,7 +506,7 @@ package body Ada.Tags is TSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size); TSD := To_Type_Specific_Data_Ptr (TSD_Ptr.all); Result := TSD.External_Tag; - return Result (1 .. Length (Result)); + return Result (1 .. Integer (strlen (Result.all'Address))); end External_Tag; --------------------- @@ -731,24 +730,6 @@ package body Ada.Tags is and then D_TSD.Access_Level = A_TSD.Access_Level; end Is_Descendant_At_Same_Level; - ------------ - -- Length -- - ------------ - - -- Should this be reimplemented using the strlen GCC builtin??? - - function Length (Str : Cstring_Ptr) return Natural is - Len : Integer; - - begin - Len := 1; - while Str (Len) /= ASCII.NUL loop - Len := Len + 1; - end loop; - - return Len - 1; - end Length; - ------------------- -- Offset_To_Top -- ------------------- diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index bafd224f5b97..f65b2709ea29 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -1720,8 +1720,7 @@ package body GNAT.Sockets is use type C.Strings.chars_ptr; begin raise Socket_Error with - Err_Code_Image (Error) - & C.Strings.Value (Socket_Error_Message (Error)); + Err_Code_Image (Error) & Socket_Error_Message (Error); end Raise_Socket_Error; ---------- diff --git a/gcc/ada/g-socthi-dummy.adb b/gcc/ada/g-socthi-dummy.adb index b5ed8e26e152..625eb82754ef 100644 --- a/gcc/ada/g-socthi-dummy.adb +++ b/gcc/ada/g-socthi-dummy.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2012, AdaCore -- +-- Copyright (C) 2001-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- diff --git a/gcc/ada/g-socthi-dummy.ads b/gcc/ada/g-socthi-dummy.ads index d7fc9824fc21..47b5e6cfd780 100644 --- a/gcc/ada/g-socthi-dummy.ads +++ b/gcc/ada/g-socthi-dummy.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2012, AdaCore -- +-- Copyright (C) 2001-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb index ad82c167d67b..daeefbead003 100644 --- a/gcc/ada/g-socthi-mingw.adb +++ b/gcc/ada/g-socthi-mingw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2012, AdaCore -- +-- Copyright (C) 2001-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -565,69 +565,70 @@ package body GNAT.Sockets.Thin is -- Socket_Error_Message -- -------------------------- - function Socket_Error_Message - (Errno : Integer) return C.Strings.chars_ptr - is + function Socket_Error_Message (Errno : Integer) return String is use GNAT.Sockets.SOSC; + Errm : C.Strings.chars_ptr; + begin case Errno is - 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 EINTR => Errm := N_EINTR; + when EBADF => Errm := N_EBADF; + when EACCES => Errm := N_EACCES; + when EFAULT => Errm := N_EFAULT; + when EINVAL => Errm := N_EINVAL; + when EMFILE => Errm := N_EMFILE; + when EWOULDBLOCK => Errm := N_EWOULDBLOCK; + when EINPROGRESS => Errm := N_EINPROGRESS; + when EALREADY => Errm := N_EALREADY; + when ENOTSOCK => Errm := N_ENOTSOCK; + when EDESTADDRREQ => Errm := N_EDESTADDRREQ; + when EMSGSIZE => Errm := N_EMSGSIZE; + when EPROTOTYPE => Errm := N_EPROTOTYPE; + when ENOPROTOOPT => Errm := N_ENOPROTOOPT; + when EPROTONOSUPPORT => Errm := N_EPROTONOSUPPORT; + when ESOCKTNOSUPPORT => Errm := N_ESOCKTNOSUPPORT; + when EOPNOTSUPP => Errm := N_EOPNOTSUPP; + when EPFNOSUPPORT => Errm := N_EPFNOSUPPORT; + when EAFNOSUPPORT => Errm := N_EAFNOSUPPORT; + when EADDRINUSE => Errm := N_EADDRINUSE; + when EADDRNOTAVAIL => Errm := N_EADDRNOTAVAIL; + when ENETDOWN => Errm := N_ENETDOWN; + when ENETUNREACH => Errm := N_ENETUNREACH; + when ENETRESET => Errm := N_ENETRESET; + when ECONNABORTED => Errm := N_ECONNABORTED; + when ECONNRESET => Errm := N_ECONNRESET; + when ENOBUFS => Errm := N_ENOBUFS; + when EISCONN => Errm := N_EISCONN; + when ENOTCONN => Errm := N_ENOTCONN; + when ESHUTDOWN => Errm := N_ESHUTDOWN; + when ETOOMANYREFS => Errm := N_ETOOMANYREFS; + when ETIMEDOUT => Errm := N_ETIMEDOUT; + when ECONNREFUSED => Errm := N_ECONNREFUSED; + when ELOOP => Errm := N_ELOOP; + when ENAMETOOLONG => Errm := N_ENAMETOOLONG; + when EHOSTDOWN => Errm := N_EHOSTDOWN; + when EHOSTUNREACH => Errm := N_EHOSTUNREACH; -- Windows-specific error codes - when WSASYSNOTREADY => return Error_Messages (N_WSASYSNOTREADY); + when WSASYSNOTREADY => Errm := N_WSASYSNOTREADY; when WSAVERNOTSUPPORTED => - return Error_Messages (N_WSAVERNOTSUPPORTED); + Errm := N_WSAVERNOTSUPPORTED; when WSANOTINITIALISED => - return Error_Messages (N_WSANOTINITIALISED); - when WSAEDISCON => return Error_Messages (N_WSAEDISCON); + Errm := N_WSANOTINITIALISED; + when WSAEDISCON => Errm := N_WSAEDISCON; -- h_errno values - 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 HOST_NOT_FOUND => Errm := N_HOST_NOT_FOUND; + when TRY_AGAIN => Errm := N_TRY_AGAIN; + when NO_RECOVERY => Errm := N_NO_RECOVERY; + when NO_DATA => Errm := N_NO_DATA; - when others => return Error_Messages (N_OTHERS); + when others => Errm := N_OTHERS; end case; + return Value (Errm); end Socket_Error_Message; end GNAT.Sockets.Thin; diff --git a/gcc/ada/g-socthi-mingw.ads b/gcc/ada/g-socthi-mingw.ads index b1493a7cfed5..4a7c51fe3f3a 100644 --- a/gcc/ada/g-socthi-mingw.ads +++ b/gcc/ada/g-socthi-mingw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2012, AdaCore -- +-- Copyright (C) 2001-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -56,7 +56,7 @@ package GNAT.Sockets.Thin is procedure Set_Socket_Errno (Errno : Integer); -- Set last socket error number - function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr; + function Socket_Error_Message (Errno : Integer) return String; -- Returns the error message string for the error number Errno. If Errno is -- not known, returns "Unknown system error". diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb index 8a49dc5b0d54..5248c62f0666 100644 --- a/gcc/ada/g-socthi-vms.adb +++ b/gcc/ada/g-socthi-vms.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2012, AdaCore -- +-- Copyright (C) 2001-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -500,8 +500,6 @@ package body GNAT.Sockets.Thin is -- Socket_Error_Message -- -------------------------- - function Socket_Error_Message - (Errno : Integer) return C.Strings.chars_ptr - is separate; + function Socket_Error_Message (Errno : Integer) return String is separate; end GNAT.Sockets.Thin; diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads index 3aea7d227785..9be7e4a198c4 100644 --- a/gcc/ada/g-socthi-vms.ads +++ b/gcc/ada/g-socthi-vms.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2012, AdaCore -- +-- Copyright (C) 2002-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -59,7 +59,7 @@ package GNAT.Sockets.Thin is procedure Set_Socket_Errno (Errno : Integer) renames GNAT.OS_Lib.Set_Errno; -- Set last socket error number - function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr; + function Socket_Error_Message (Errno : Integer) return String; -- Returns the error message string for the error number Errno. If Errno is -- not known, returns "Unknown system error". diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb index 87549edb6c6a..689f450e6596 100644 --- a/gcc/ada/g-socthi-vxworks.adb +++ b/gcc/ada/g-socthi-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2012, AdaCore -- +-- Copyright (C) 2002-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -485,8 +485,6 @@ package body GNAT.Sockets.Thin is -- Socket_Error_Message -- -------------------------- - function Socket_Error_Message - (Errno : Integer) return C.Strings.chars_ptr - is separate; + function Socket_Error_Message (Errno : Integer) return String is separate; end GNAT.Sockets.Thin; diff --git a/gcc/ada/g-socthi-vxworks.ads b/gcc/ada/g-socthi-vxworks.ads index 793258baa969..4eb3a0f22301 100644 --- a/gcc/ada/g-socthi-vxworks.ads +++ b/gcc/ada/g-socthi-vxworks.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2012, AdaCore -- +-- Copyright (C) 2002-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -57,7 +57,7 @@ package GNAT.Sockets.Thin is procedure Set_Socket_Errno (Errno : Integer) renames GNAT.OS_Lib.Set_Errno; -- Set last socket error number - function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr; + function Socket_Error_Message (Errno : Integer) return String; -- Returns the error message string for the error number Errno. If Errno is -- not known, returns "Unknown system error". diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index 801936f9ba5c..fe7119e3a561 100644 --- a/gcc/ada/g-socthi.adb +++ b/gcc/ada/g-socthi.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2012, AdaCore -- +-- Copyright (C) 2001-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -57,8 +57,7 @@ package body GNAT.Sockets.Thin is -- non-blocking mode and we spend a period of time Quantum between -- two attempts on a blocking operation. - Unknown_System_Error : constant C.Strings.chars_ptr := - C.Strings.New_String ("Unknown system error"); + Unknown_System_Error : constant String := "Unknown system error"; -- Comments required for following functions ??? @@ -490,8 +489,6 @@ package body GNAT.Sockets.Thin is -- Socket_Error_Message -- -------------------------- - function Socket_Error_Message - (Errno : Integer) return C.Strings.chars_ptr - is separate; + function Socket_Error_Message (Errno : Integer) return String is separate; end GNAT.Sockets.Thin; diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads index b034e2585383..250f7a1c4e64 100644 --- a/gcc/ada/g-socthi.ads +++ b/gcc/ada/g-socthi.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2012, AdaCore -- +-- Copyright (C) 2001-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -58,7 +58,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 C.Strings.chars_ptr; + function Socket_Error_Message (Errno : Integer) return String; -- Returns the error message string for the error number Errno. If Errno is -- not known, returns "Unknown system error". diff --git a/gcc/ada/g-stseme.adb b/gcc/ada/g-stseme.adb index 2e797b09a6e5..40e7c495af3d 100644 --- a/gcc/ada/g-stseme.adb +++ b/gcc/ada/g-stseme.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2007-2009, AdaCore -- +-- Copyright (C) 2007-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -34,8 +34,6 @@ -- since on that platform socket errno values are distinct from the system -- ones: there is a specific variant of this function in g-socthi-mingw.adb. -with System.CRTL.Runtime; - separate (GNAT.Sockets.Thin) -------------------------- @@ -43,16 +41,8 @@ separate (GNAT.Sockets.Thin) -------------------------- function Socket_Error_Message - (Errno : Integer) return C.Strings.chars_ptr + (Errno : Integer) return String is - use type Interfaces.C.Strings.chars_ptr; - C_Msg : constant C.Strings.chars_ptr := - System.CRTL.Runtime.strerror (Errno); - begin - if C_Msg = C.Strings.Null_Ptr then - return Unknown_System_Error; - else - return C_Msg; - end if; + return Errno_Message (Errno, Default => Unknown_System_Error); end Socket_Error_Message; diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads index 8e8aa2d7fc81..cde3dd143daa 100644 --- a/gcc/ada/s-crtl.ads +++ b/gcc/ada/s-crtl.ads @@ -67,13 +67,26 @@ package System.CRTL is pragma Convention (C, Filename_Encoding); -- Describes the filename's encoding - function atoi (A : System.Address) return Integer; - pragma Import (C, atoi, "atoi"); + -------------------- + -- GCC intrinsics -- + -------------------- + + -- The following functions are imported with convention Intrinsic so that + -- we take advantage of back-end builtins if present (else we fall back + -- to C library functions by the same names). function strlen (A : System.Address) return size_t; pragma Import (Intrinsic, strlen, "strlen"); - -- Import with convention Intrinsic so that we take advantage of the GCC - -- builtin where available (and fall back to the library function if not). + + procedure strncpy (dest, src : System.Address; n : size_t); + pragma Import (Intrinsic, strncpy, "strncpy"); + + ------------------------------- + -- Other C runtime functions -- + ------------------------------- + + function atoi (A : System.Address) return Integer; + pragma Import (C, atoi, "atoi"); procedure clearerr (stream : FILEs); pragma Import (C, clearerr, "clearerr"); diff --git a/gcc/ada/s-crtrun.ads b/gcc/ada/s-crtrun.ads deleted file mode 100644 index 281e54fe5ed1..000000000000 --- a/gcc/ada/s-crtrun.ads +++ /dev/null @@ -1,46 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- S Y S T E M . C R T L . R U N T I M E -- --- -- --- S p e c -- --- -- --- Copyright (C) 2009, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package provides the low level interface to the C runtime library --- (additional declarations for use in the Ada runtime only, not in the --- compiler itself). - -with Interfaces.C.Strings; - -package System.CRTL.Runtime is - pragma Preelaborate; - - subtype chars_ptr is Interfaces.C.Strings.chars_ptr; - - function strerror (errno : int) return chars_ptr; - pragma Import (C, strerror, "strerror"); - -end System.CRTL.Runtime; diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index 01313a09cff2..c166729838e0 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -33,10 +33,9 @@ with Ada.Finalization; use Ada.Finalization; with Ada.IO_Exceptions; use Ada.IO_Exceptions; with Interfaces.C; -with Interfaces.C.Strings; use Interfaces.C.Strings; with Interfaces.C_Streams; use Interfaces.C_Streams; -with System.CRTL.Runtime; +with System.CRTL; with System.Case_Util; use System.Case_Util; with System.OS_Lib; with System.Soft_Links; @@ -130,15 +129,9 @@ package body System.File_IO is -- the access method from the Access_Method field of the FCB. function Errno_Message - (Errno : Integer := OS_Lib.Errno) return String; - function Errno_Message - (Name : String; + (Name : String; Errno : Integer := OS_Lib.Errno) return String; - -- Return a message suitable for "raise ... with Errno_Message (...)". - -- Errno defaults to the current errno, but should be passed explicitly if - -- there is significant code in between the call that sets errno and the - -- call to Errno_Message, in case that code also sets errno. The version - -- with Name includes that file name in the message. + -- Return Errno_Message for Errno, with file name prepended procedure Raise_Device_Error (File : AFCB_Ptr; @@ -241,7 +234,7 @@ package body System.File_IO is Close_Status : int := 0; Dup_Strm : Boolean := False; File : AFCB_Ptr renames File_Ptr.all; - Errno : Integer; + Errno : Integer := 0; begin -- Take a task lock, to protect the global data value Open_Files @@ -351,7 +344,7 @@ package body System.File_IO is -- we did the open, and we want to unlink the right file. if unlink (Filename'Address) = -1 then - raise Use_Error with Errno_Message; + raise Use_Error with OS_Lib.Errno_Message; end if; end; end Delete; @@ -383,23 +376,12 @@ package body System.File_IO is -- Errno_Message -- ------------------- - function Errno_Message (Errno : Integer := OS_Lib.Errno) return String is - Message : constant chars_ptr := CRTL.Runtime.strerror (Errno); - - begin - if Message = Null_Ptr then - return "errno =" & Errno'Img; - else - return Value (Message); - end if; - end Errno_Message; - function Errno_Message (Name : String; Errno : Integer := OS_Lib.Errno) return String is begin - return Name & ": " & String'(Errno_Message (Errno)); + return Name & ": " & OS_Lib.Errno_Message (Err => Errno); end Errno_Message; -------------- @@ -1321,7 +1303,7 @@ package body System.File_IO is clearerr (File.Stream); end if; - raise Device_Error with Errno_Message (Errno); + raise Device_Error with OS_Lib.Errno_Message (Err => Errno); end Raise_Device_Error; -------------- diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 7b6a28b4408c..0f1b4d115ef6 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -40,6 +40,11 @@ with System.Soft_Links; package body System.OS_Lib is + subtype size_t is CRTL.size_t; + + procedure Strncpy (dest, src : System.Address; n : size_t) + renames CRTL.strncpy; + -- Imported procedures Dup and Dup2 are used in procedures Spawn and -- Non_Blocking_Spawn. @@ -49,6 +54,13 @@ package body System.OS_Lib is procedure Dup2 (Old_Fd, New_Fd : File_Descriptor); pragma Import (C, Dup2, "__gnat_dup2"); + function Copy_Attributes + (From, To : System.Address; + Mode : Integer) return Integer; + pragma Import (C, Copy_Attributes, "__gnat_copy_attribs"); + -- Mode = 0 - copy only time stamps. + -- Mode = 1 - copy time stamps and read/write/execute attributes + On_Windows : constant Boolean := Directory_Separator = '\'; -- An indication that we are on Windows. Used in Normalize_Pathname, to -- deal with drive letters in the beginning of absolute paths. @@ -265,17 +277,17 @@ package body System.OS_Lib is ----------- procedure Close (FD : File_Descriptor) is - procedure C_Close (FD : File_Descriptor); - pragma Import (C, C_Close, "close"); + use CRTL; + Discard : constant int := close (int (FD)); + pragma Unreferenced (Discard); begin - C_Close (FD); + null; end Close; procedure Close (FD : File_Descriptor; Status : out Boolean) is - function C_Close (FD : File_Descriptor) return Integer; - pragma Import (C, C_Close, "close"); + use CRTL; begin - Status := (C_Close (FD) = 0); + Status := (close (int (FD)) = 0); end Close; --------------- @@ -442,14 +454,6 @@ package body System.OS_Lib is ------------- procedure Copy_To (To_Name : String) is - - function Copy_Attributes - (From, To : System.Address; - Mode : Integer) return Integer; - pragma Import (C, Copy_Attributes, "__gnat_copy_attribs"); - -- Mode = 0 - copy only time stamps. - -- Mode = 1 - copy time stamps and read/write/execute attributes - C_From : String (1 .. Name'Length + 1); C_To : String (1 .. To_Name'Length + 1); @@ -609,13 +613,6 @@ package body System.OS_Lib is ---------------------- procedure Copy_Time_Stamps (Source, Dest : String; Success : out Boolean) is - function Copy_Attributes - (From, To : System.Address; - Mode : Integer) return Integer; - pragma Import (C, Copy_Attributes, "__gnat_copy_attribs"); - -- Mode = 0 - copy only time stamps. - -- Mode = 1 - copy time stamps and read/write/execute attributes - begin if Is_Regular_File (Source) and then Is_Writable_File (Dest) then declare @@ -976,9 +973,6 @@ package body System.OS_Lib is procedure Get_Suffix_Ptr (Length, Ptr : Address); pragma Import (C, Get_Suffix_Ptr, "__gnat_get_debuggable_suffix_ptr"); - procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer); - pragma Import (C, Strncpy, "strncpy"); - Suffix_Ptr : Address; Suffix_Length : Integer; Result : String_Access; @@ -988,7 +982,7 @@ package body System.OS_Lib is Result := new String (1 .. Suffix_Length); if Suffix_Length > 0 then - Strncpy (Result.all'Address, Suffix_Ptr, Suffix_Length); + Strncpy (Result.all'Address, Suffix_Ptr, size_t (Suffix_Length)); end if; return Result; @@ -1002,9 +996,6 @@ package body System.OS_Lib is procedure Get_Suffix_Ptr (Length, Ptr : Address); pragma Import (C, Get_Suffix_Ptr, "__gnat_get_executable_suffix_ptr"); - procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer); - pragma Import (C, Strncpy, "strncpy"); - Suffix_Ptr : Address; Suffix_Length : Integer; Result : String_Access; @@ -1014,7 +1005,7 @@ package body System.OS_Lib is Result := new String (1 .. Suffix_Length); if Suffix_Length > 0 then - Strncpy (Result.all'Address, Suffix_Ptr, Suffix_Length); + Strncpy (Result.all'Address, Suffix_Ptr, size_t (Suffix_Length)); end if; return Result; @@ -1028,9 +1019,6 @@ package body System.OS_Lib is procedure Get_Suffix_Ptr (Length, Ptr : Address); pragma Import (C, Get_Suffix_Ptr, "__gnat_get_object_suffix_ptr"); - procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer); - pragma Import (C, Strncpy, "strncpy"); - Suffix_Ptr : Address; Suffix_Length : Integer; Result : String_Access; @@ -1040,7 +1028,7 @@ package body System.OS_Lib is Result := new String (1 .. Suffix_Length); if Suffix_Length > 0 then - Strncpy (Result.all'Address, Suffix_Ptr, Suffix_Length); + Strncpy (Result.all'Address, Suffix_Ptr, size_t (Suffix_Length)); end if; return Result; @@ -1055,9 +1043,6 @@ package body System.OS_Lib is pragma Import (C, Target_Exec_Ext_Ptr, "__gnat_target_debuggable_extension"); - procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer); - pragma Import (C, Strncpy, "strncpy"); - Suffix_Length : Integer; Result : String_Access; @@ -1066,7 +1051,8 @@ package body System.OS_Lib is Result := new String (1 .. Suffix_Length); if Suffix_Length > 0 then - Strncpy (Result.all'Address, Target_Exec_Ext_Ptr, Suffix_Length); + Strncpy + (Result.all'Address, Target_Exec_Ext_Ptr, size_t (Suffix_Length)); end if; return Result; @@ -1081,9 +1067,6 @@ package body System.OS_Lib is pragma Import (C, Target_Exec_Ext_Ptr, "__gnat_target_executable_extension"); - procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer); - pragma Import (C, Strncpy, "strncpy"); - Suffix_Length : Integer; Result : String_Access; @@ -1092,7 +1075,8 @@ package body System.OS_Lib is Result := new String (1 .. Suffix_Length); if Suffix_Length > 0 then - Strncpy (Result.all'Address, Target_Exec_Ext_Ptr, Suffix_Length); + Strncpy + (Result.all'Address, Target_Exec_Ext_Ptr, size_t (Suffix_Length)); end if; return Result; @@ -1107,9 +1091,6 @@ package body System.OS_Lib is pragma Import (C, Target_Object_Ext_Ptr, "__gnat_target_object_extension"); - procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer); - pragma Import (C, Strncpy, "strncpy"); - Suffix_Length : Integer; Result : String_Access; @@ -1118,7 +1099,8 @@ package body System.OS_Lib is Result := new String (1 .. Suffix_Length); if Suffix_Length > 0 then - Strncpy (Result.all'Address, Target_Object_Ext_Ptr, Suffix_Length); + Strncpy + (Result.all'Address, Target_Object_Ext_Ptr, size_t (Suffix_Length)); end if; return Result; @@ -1132,9 +1114,6 @@ package body System.OS_Lib is procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address); pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv"); - procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer); - pragma Import (C, Strncpy, "strncpy"); - Env_Value_Ptr : aliased Address; Env_Value_Length : aliased Integer; F_Name : aliased String (1 .. Name'Length + 1); @@ -1150,7 +1129,8 @@ package body System.OS_Lib is Result := new String (1 .. Env_Value_Length); if Env_Value_Length > 0 then - Strncpy (Result.all'Address, Env_Value_Ptr, Env_Value_Length); + Strncpy + (Result.all'Address, Env_Value_Ptr, size_t (Env_Value_Length)); end if; return Result; @@ -1456,9 +1436,6 @@ package body System.OS_Lib is function Locate_Exec_On_Path (C_Exec_Name : Address) return Address; pragma Import (C, Locate_Exec_On_Path, "__gnat_locate_exec_on_path"); - procedure Free (Ptr : System.Address); - pragma Import (C, Free, "free"); - C_Exec_Name : String (1 .. Exec_Name'Length + 1); Path_Addr : Address; Path_Len : Integer; @@ -1476,7 +1453,7 @@ package body System.OS_Lib is else Result := To_Path_String_Access (Path_Addr, Path_Len); - Free (Path_Addr); + CRTL.free (Path_Addr); -- Always return an absolute path name @@ -1506,9 +1483,6 @@ package body System.OS_Lib is (C_File_Name, Path_Val : Address) return Address; pragma Import (C, Locate_Regular_File, "__gnat_locate_regular_file"); - procedure Free (Ptr : System.Address); - pragma Import (C, Free, "free"); - Path_Addr : Address; Path_Len : Integer; Result : String_Access; @@ -1522,7 +1496,7 @@ package body System.OS_Lib is else Result := To_Path_String_Access (Path_Addr, Path_Len); - Free (Path_Addr); + CRTL.free (Path_Addr); return Result; end if; end Locate_Regular_File;