if Java_VM then
- -- Suppress the tag assignment when Java_VM because JVM tags
- -- are represented implicitly in objects.
+ -- Suppress the tag assignment when Java_VM because JVM tags are
+ -- represented implicitly in objects.
null;
and then Is_Tagged_Type (Underlying_Type (T))
then
TagT := Underlying_Type (T);
- TagR := Unchecked_Convert_To (Underlying_Type (T),
- Make_Explicit_Dereference (Loc,
- New_Reference_To (Temp, Loc)));
-
+ TagR :=
+ Unchecked_Convert_To (Underlying_Type (T),
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Reference_To (Temp, Loc)));
end if;
if Present (TagT) then
Unchecked_Convert_To (T,
Make_Explicit_Dereference (Loc,
- New_Reference_To (Temp, Loc))),
+ Prefix => New_Reference_To (Temp, Loc))),
Typ => T,
Flist_Ref => Flist,
- With_Attach => Attach));
+ With_Attach => Attach,
+ Allocator => True));
end if;
end;
end if;
procedure Expand_N_Explicit_Dereference (N : Node_Id) is
begin
- -- The only processing required is an insertion of an explicit
- -- dereference call for the checked storage pool case.
+ -- Insert explicit dereference call for the checked storage pool case
Insert_Dereference_Action (Prefix (N));
end Expand_N_Explicit_Dereference;
-- Signed integer cases, done using either Integer or Long_Long_Integer.
-- It is not worth having routines for Short_[Short_]Integer, since for
-- most machines it would not help, and it would generate more code that
- -- might need certification in the HI-E case.
+ -- might need certification when a certified run time is required.
-- In the integer cases, we have two routines, one for when overflow
- -- checks are required, and one when they are not required, since
- -- there is a real gain in ommitting checks on many machines.
+ -- checks are required, and one when they are not required, since there
+ -- is a real gain in omitting checks on many machines.
elsif Rtyp = Base_Type (Standard_Long_Long_Integer)
or else (Rtyp = Base_Type (Standard_Long_Integer)
or else Is_Interface (Left_Type)
then
+ -- Issue error if IW_Membership operation not available in a
+ -- configurable run time setting.
+
+ if not RTE_Available (RE_IW_Membership) then
+ Error_Msg_CRT ("abstract interface types", N);
+ return Empty;
+ end if;
+
return
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_IW_Membership), Loc),
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
Set_End_Label (Handled_Statement_Sequence (N), End_Lab);
Wrapped := True;
+ -- Comment needed here, see RH for 1.306 ???
+
+ if Nkind (N) = N_Subprogram_Body then
+ Set_Has_Nested_Block_With_Handler (Current_Scope);
+ end if;
+
-- Otherwise we do not wrap
else
-----------------------
function Make_Adjust_Call
- (Ref : Node_Id;
- Typ : Entity_Id;
- Flist_Ref : Node_Id;
- With_Attach : Node_Id) return List_Id
+ (Ref : Node_Id;
+ Typ : Entity_Id;
+ Flist_Ref : Node_Id;
+ With_Attach : Node_Id;
+ Allocator : Boolean := False) return List_Id
is
Loc : constant Source_Ptr := Sloc (Ref);
Res : constant List_Id := New_List;
Attach := Make_Integer_Literal (Loc, 0);
end if;
+ -- Special case for allocators: need initialization of the chain
+ -- pointers. For the 0 case, reset them to null.
+
+ if Allocator then
+ pragma Assert (Nkind (Attach) = N_Integer_Literal);
+
+ if Intval (Attach) = 0 then
+ Set_Intval (Attach, Uint_4);
+ end if;
+ end if;
+
-- Generate:
- -- Deep_Adjust (Flist_Ref, Ref, With_Attach);
+ -- Deep_Adjust (Flist_Ref, Ref, Attach);
if Has_Controlled_Component (Utyp)
or else Is_Class_Wide_Type (Typ)
Pid := Corresponding_Concurrent_Type (Param_Type);
end if;
- exit when not Present (Param) or else Present (Pid);
+ exit when No (Param) or else Present (Pid);
Next (Param);
end loop;
(Ref : Node_Id;
Typ : Entity_Id;
Flist_Ref : Node_Id;
- With_Attach : Node_Id) return List_Id;
+ With_Attach : Node_Id;
+ Allocator : Boolean := False) return List_Id;
-- Ref is an expression (with no-side effect and is not required to
-- have been previously analyzed) that references the object to be
-- adjusted. Typ is the expected type of Ref, which is a controlled
-- details are in the body. The objects must be attached when the adjust
-- takes place after an initialization expression but not when it takes
-- place after a regular assignment.
+ --
+ -- If Allocator is True, we are adjusting a newly-created object. The
+ -- existing chaining pointers should not be left unchanged, because they
+ -- may come from a bit-for-bit copy of those from an initializing object.
+ -- So, when this flag is True, if the chaining pointers should otherwise
+ -- be left unset, instead they are reset to null.
function Make_Final_Call
(Ref : Node_Id;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
new Unchecked_Conversion (Address, RC_Ptr);
procedure Raise_Exception_No_Defer
- (E : in Exception_Id;
- Message : in String := "");
+ (E : Exception_Id;
+ Message : String := "");
pragma Import (Ada, Raise_Exception_No_Defer,
"ada__exceptions__raise_exception_no_defer");
pragma No_Return (Raise_Exception_No_Defer);
P.Next := L;
L := Obj'Unchecked_Access;
end;
+
+ -- Make the object completely unattached (case of a library-level,
+ -- Finalize_Storage_Only object).
+
+ elsif Nb_Link = 4 then
+ Obj.Prev := null;
+ Obj.Next := null;
end if;
end Attach_To_Final_List;
projects / gcc.git / commitdiff