s-fileio.adb (Errno_Message): Remove, use shared version from s-os_lib instead.

2014-02-24  Thomas Quinot  <quinot@adacore.com>

	* 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

gcc/ada/ChangeLog

+2014-02-24  Thomas Quinot  <quinot@adacore.com>
+
+	* 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  <kirtchev@adacore.com>
 
 	* sem_prag.adb (Analyze_Global_Item): Emit the

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) \

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

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 --
    -------------------

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;
 
    ----------

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- --

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- --

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;

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".
 

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;

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".
 

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;

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".
 

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;

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".
 

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;

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");

gcc/ada/s-crtrun.ads

-------------------------------------------------------------------------------
---                                                                          --
---                        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    --
--- <http://www.gnu.org/licenses/>.                                          --
---                                                                          --
--- 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;

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;
       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;
 
    --------------

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;