2004-10-04 Vincent Celier <celier@gnat.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / s-memory.adb

diff --git a/gcc/ada/s-memory.adb b/gcc/ada/s-memory.adb
index 4f11aec..66637c7 100644 (file)
--- a/gcc/ada/s-memory.adb
+++ b/gcc/ada/s-memory.adb
@@ -4,15 +4,9 @@
 --                                                                          --
 --                         S Y S T E M . M E M O R Y                        --
 --                                                                          --
---                                 S p e c                                  --
+--                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.2 $
---                                                                          --
---             Copyright (C) 2001 Free Software Foundation, Inc.            --
---                                                                          --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the  contents of the part following the private keyword. --
+--          Copyright (C) 2001-2003 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- --
@@ -33,7 +27,7 @@
 -- covered by the  GNU Public License.                                      --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
 --                                                                          --
 ------------------------------------------------------------------------------
 
@@ -51,21 +45,23 @@
 
 with Ada.Exceptions;
 with System.Soft_Links;
+with System.Parameters;
+with System.CRTL;
 
 package body System.Memory is
 
    use Ada.Exceptions;
    use System.Soft_Links;
 
-   function c_malloc (Size : size_t) return System.Address;
-   pragma Import (C, c_malloc, "malloc");
+   function c_malloc (Size : System.CRTL.size_t) return System.Address
+    renames System.CRTL.malloc;
 
-   procedure c_free (Ptr : System.Address);
-   pragma Import (C, c_free, "free");
+   procedure c_free (Ptr : System.Address)
+     renames System.CRTL.free;
 
    function c_realloc
-     (Ptr : System.Address; Size : size_t) return System.Address;
-   pragma Import (C, c_realloc, "realloc");
+     (Ptr : System.Address; Size : System.CRTL.size_t) return System.Address
+     renames System.CRTL.realloc;
 
    -----------
    -- Alloc --
@@ -89,9 +85,13 @@ package body System.Memory is
          Actual_Size := 1;
       end if;
 
-      Abort_Defer.all;
-      Result := c_malloc (Actual_Size);
-      Abort_Undefer.all;
+      if Parameters.No_Abort then
+         Result := c_malloc (System.CRTL.size_t (Actual_Size));
+      else
+         Abort_Defer.all;
+         Result := c_malloc (System.CRTL.size_t (Actual_Size));
+         Abort_Undefer.all;
+      end if;
 
       if Result = System.Null_Address then
          Raise_Exception (Storage_Error'Identity, "heap exhausted");
@@ -106,9 +106,13 @@ package body System.Memory is
 
    procedure Free (Ptr : System.Address) is
    begin
-      Abort_Defer.all;
-      c_free (Ptr);
-      Abort_Undefer.all;
+      if Parameters.No_Abort then
+         c_free (Ptr);
+      else
+         Abort_Defer.all;
+         c_free (Ptr);
+         Abort_Undefer.all;
+      end if;
    end Free;
 
    -------------
@@ -121,16 +125,20 @@ package body System.Memory is
       return System.Address
    is
       Result      : System.Address;
-      Actual_Size : size_t := Size;
+      Actual_Size : constant size_t := Size;
 
    begin
       if Size = size_t'Last then
          Raise_Exception (Storage_Error'Identity, "object too large");
       end if;
 
-      Abort_Defer.all;
-      Result := c_realloc (Ptr, Actual_Size);
-      Abort_Undefer.all;
+      if Parameters.No_Abort then
+         Result := c_realloc (Ptr, System.CRTL.size_t (Actual_Size));
+      else
+         Abort_Defer.all;
+         Result := c_realloc (Ptr, System.CRTL.size_t (Actual_Size));
+         Abort_Undefer.all;
+      end if;
 
       if Result = System.Null_Address then
          Raise_Exception (Storage_Error'Identity, "heap exhausted");