+2016-05-02 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch6.adb (Expand_Call): When inlining a call to a function
+ declared in a package instance, locate the instance node of the
+ package after the actual package declaration. skipping over
+ pragmas that may have been introduced when the generic unit
+ carries aspects that are transformed into pragmas.
+
+2016-05-02 Bob Duff <duff@adacore.com>
+
+ * s-memory.adb (Alloc, Realloc): Move checks
+ for Size = 0 or size_t'Last into the Result = System.Null_Address
+ path for efficiency. Improve comments (based on actual C language
+ requirements for malloc).
+ * exp_util.adb (Build_Allocate_Deallocate_Proc): Optimize the
+ case where we are using the default Global_Pool_Object, and we
+ don't need the heavy finalization machinery.
+
2016-05-02 Gary Dismukes <dismukes@adacore.com>
* exp_util.ads, sem_ch12.adb: Minor reformatting.
and then Optimization_Level > 0
then
declare
- Inst : Entity_Id;
- Decl : Node_Id;
+ Decl : Node_Id;
+ Inst : Entity_Id;
+ Inst_Node : Node_Id;
begin
Inst := Scope (Subp);
null;
else
- Add_Pending_Instantiation (Next (Decl), Decl);
+ -- The instantiation node follows the package
+ -- declaration for the instance. If the generic
+ -- unit had aspect specifications, they have
+ -- been transformed into pragmas in the instance,
+ -- and the instance node appears after them.
+
+ Inst_Node := Next (Decl);
+
+ while Nkind (Inst_Node) /= N_Package_Instantiation loop
+ Inst_Node := Next (Inst_Node);
+ end loop;
+
+ Add_Pending_Instantiation (Inst_Node, Decl);
end if;
end if;
end;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2016, 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- --
pragma Compiler_Unit_Warning;
-with Ada.Exceptions;
-with System.Soft_Links;
-with System.Parameters;
with System.CRTL;
+with System.Parameters;
+with System.Soft_Links;
package body System.Memory is
- use Ada.Exceptions;
use System.Soft_Links;
function c_malloc (Size : System.CRTL.size_t) return System.Address
-----------
function Alloc (Size : size_t) return System.Address is
- Result : System.Address;
- Actual_Size : size_t := Size;
-
+ Result : System.Address;
begin
- if Size = size_t'Last then
- Raise_Exception (Storage_Error'Identity, "object too large");
- end if;
-
- -- Change size from zero to non-zero. We still want a proper pointer
- -- for the zero case because pointers to zero length objects have to
- -- be distinct, but we can't just go ahead and allocate zero bytes,
- -- since some malloc's return zero for a zero argument.
-
- if Size = 0 then
- Actual_Size := 1;
- end if;
-
if Parameters.No_Abort then
- Result := c_malloc (System.CRTL.size_t (Actual_Size));
+ Result := c_malloc (System.CRTL.size_t (Size));
else
Abort_Defer.all;
- Result := c_malloc (System.CRTL.size_t (Actual_Size));
+ Result := c_malloc (System.CRTL.size_t (Size));
Abort_Undefer.all;
end if;
if Result = System.Null_Address then
- Raise_Exception (Storage_Error'Identity, "heap exhausted");
+ -- If Size = 0, we can't allocate 0 bytes, because then two different
+ -- allocators, one of which has Size = 0, could return pointers that
+ -- compare equal, which is wrong. (Nonnull pointers compare equal if
+ -- and only if they designate the same object, and two different
+ -- allocators allocate two different objects).
+
+ -- malloc(0) is defined to allocate a non-zero-sized object (in which
+ -- case we won't get here, and all is well) or NULL, in which case we
+ -- get here. We also get here in case of error. So check for the
+ -- zero-size case, and allocate 1 byte. Otherwise, raise
+ -- Storage_Error.
+
+ -- We check for zero size here, rather than at the start, for
+ -- efficiency.
+
+ if Size = 0 then
+ return Alloc (1);
+ end if;
+
+ if Size = size_t'Last then
+ raise Storage_Error with "object too large";
+ end if;
+
+ raise Storage_Error with "heap exhausted";
end if;
return Result;
return System.Address
is
Result : System.Address;
- Actual_Size : constant size_t := Size;
-
begin
- if Size = size_t'Last then
- Raise_Exception (Storage_Error'Identity, "object too large");
- end if;
-
if Parameters.No_Abort then
- Result := c_realloc (Ptr, System.CRTL.size_t (Actual_Size));
+ Result := c_realloc (Ptr, System.CRTL.size_t (Size));
else
Abort_Defer.all;
- Result := c_realloc (Ptr, System.CRTL.size_t (Actual_Size));
+ Result := c_realloc (Ptr, System.CRTL.size_t (Size));
Abort_Undefer.all;
end if;
if Result = System.Null_Address then
- Raise_Exception (Storage_Error'Identity, "heap exhausted");
+ if Size = size_t'Last then
+ raise Storage_Error with "object too large";
+ end if;
+
+ raise Storage_Error with "heap exhausted";
end if;
return Result;
projects / gcc.git / commitdiff