aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorThomas Quinot <quinot@adacore.com>2014-02-24 16:54:41 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2014-02-24 17:54:41 +0100
commit3e5b1f324798b549d61995939bf09e1728bacb95 (patch)
tree7da7de3843015498f4fd50b583ef216d74825c10 /gcc
parentc6d2191a0da9f40899da20933f008242f90262e0 (diff)
downloadgcc-3e5b1f324798b549d61995939bf09e1728bacb95.zip
gcc-3e5b1f324798b549d61995939bf09e1728bacb95.tar.gz
gcc-3e5b1f324798b549d61995939bf09e1728bacb95.tar.bz2
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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog20
-rw-r--r--gcc/ada/Makefile.rtl1
-rw-r--r--gcc/ada/a-envvar.adb9
-rw-r--r--gcc/ada/a-tags.adb39
-rw-r--r--gcc/ada/g-socket.adb3
-rw-r--r--gcc/ada/g-socthi-dummy.adb2
-rw-r--r--gcc/ada/g-socthi-dummy.ads2
-rw-r--r--gcc/ada/g-socthi-mingw.adb101
-rw-r--r--gcc/ada/g-socthi-mingw.ads4
-rw-r--r--gcc/ada/g-socthi-vms.adb6
-rw-r--r--gcc/ada/g-socthi-vms.ads4
-rw-r--r--gcc/ada/g-socthi-vxworks.adb6
-rw-r--r--gcc/ada/g-socthi-vxworks.ads4
-rw-r--r--gcc/ada/g-socthi.adb9
-rw-r--r--gcc/ada/g-socthi.ads4
-rw-r--r--gcc/ada/g-stseme.adb16
-rw-r--r--gcc/ada/s-crtl.ads21
-rw-r--r--gcc/ada/s-crtrun.ads46
-rw-r--r--gcc/ada/s-fileio.adb32
-rw-r--r--gcc/ada/s-os_lib.adb88
20 files changed, 160 insertions, 257 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 24bac57..e31ec1e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+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
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index e4f2a59..6496dc7 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 edcbeb8..85368f8 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 d45c378..887bd14 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 bafd224..f65b270 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 b5ed8e2..625eb82 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 d7fc982..47b5e6c 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 ad82c16..daeefbe 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 b1493a7..4a7c51f 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 8a49dc5..5248c62 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 3aea7d2..9be7e4a1 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 87549ed..689f450 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 793258b..4eb3a0f2 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 801936f..fe7119e 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 b034e25..250f7a1 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 2e797b0..40e7c49 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 8e8aa2d7..cde3dd1 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 281e54f..0000000
--- 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 --
--- <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;
diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb
index 01313a0..c166729 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 7b6a28b..0f1b4d1 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;