[multiple changes]

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* s-pooloc.ads, s-pooglo.ads: Minor reformatting

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* einfo.ads, exp_ch4.adb: Minor reformatting.

2011-08-04  Jerome Lambourg  <lambourg@adacore.com>

	* back_end.ads (Gen_Or_Update_Object_File): Add more comments.

From-SVN: r177333
This commit is contained in:
Arnaud Charlet 2011-08-04 10:33:14 +02:00
parent a25f5ee669
commit 39ade2f908
6 changed files with 85 additions and 66 deletions

View File

@ -1,3 +1,21 @@
2011-08-04 Thomas Quinot <quinot@adacore.com>
* s-pooloc.ads, s-pooglo.ads: Minor reformatting
2011-08-04 Thomas Quinot <quinot@adacore.com>
PR ada/47880
* s-pooloc.adb (Deallocate): Fix the case of deallocating the only
allocated object.
2011-08-04 Robert Dewar <dewar@adacore.com>
* einfo.ads, exp_ch4.adb: Minor reformatting.
2011-08-04 Jerome Lambourg <lambourg@adacore.com>
* back_end.ads (Gen_Or_Update_Object_File): Add more comments.
2011-08-04 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_Composite_Equality): code cleanup: use component

View File

@ -83,7 +83,14 @@ package Back_End is
-- be added to the Compilation_Arguments table.
procedure Gen_Or_Update_Object_File;
-- Is used to generate the object file, or update it so that its timestamp
-- is updated.
-- Is used to generate the object file (if generated directly by gnat1), or
-- update it if it has already been generated by the call to Call_Back_End,
-- so that its timestamp is updated by the call.
--
-- This is a no-op with the gcc back-end (the object file is generated by
-- the assembler afterwards), but is needed for back-ends that directly
-- generate the final object file (such as the .NET backend) so that the
-- object file's timestamp is correct when compared with the corresponding
-- ali file by gnatmake.
end Back_End;

View File

@ -1273,8 +1273,9 @@ package Einfo is
-- the floating-point representation to be used.
-- Formal_Proof_On (Flag254)
-- Present in subprogram entities. Set for subprograms whose body
-- contains an Annotate pragma which forces formal proof on this body.
-- Present in subprogram and generic subprogram entities. Set on for
-- subprograms whose body contains an Annotate pragma which forces formal
-- proof on this body.
-- Freeze_Node (Node7)
-- Present in all entities. If there is an associated freeze node for
@ -5249,6 +5250,7 @@ package Einfo is
-- Delay_Cleanups (Flag114)
-- Delay_Subprogram_Descriptors (Flag50)
-- Discard_Names (Flag88)
-- Formal_Proof_On (Flag254)
-- Has_Completion (Flag26)
-- Has_Controlling_Result (Flag98)
-- Has_Invariants (Flag232)
@ -5395,6 +5397,7 @@ package Einfo is
-- Is_Primitive (Flag218)
-- Is_Thunk (Flag225)
-- Default_Expressions_Processed (Flag108)
-- Formal_Proof_On (Flag254)
-- Aren't there more flags and fields? seems like this list should be
-- more similar to the E_Function list, which is much longer ???
@ -5515,6 +5518,7 @@ package Einfo is
-- Delay_Cleanups (Flag114)
-- Delay_Subprogram_Descriptors (Flag50)
-- Discard_Names (Flag88)
-- Formal_Proof_On (Flag254)
-- Has_Completion (Flag26)
-- Has_Invariants (Flag232)
-- Has_Master_Entity (Flag21)

View File

@ -2125,7 +2125,7 @@ package body Exp_Ch4 is
if Chars (Prim) = Name_Op_Eq
and then Etype (First_Formal (Prim)) =
Etype (Next_Formal (First_Formal (Prim)))
Etype (Next_Formal (First_Formal (Prim)))
and then Etype (Prim) = Standard_Boolean
then
if Is_Abstract_Subprogram (Prim) then
@ -2136,7 +2136,7 @@ package body Exp_Ch4 is
else
return
Make_Function_Call (Loc,
Name => New_Reference_To (Prim, Loc),
Name => New_Reference_To (Prim, Loc),
Parameter_Associations => New_List (Lhs, Rhs));
end if;
end if;
@ -2177,7 +2177,7 @@ package body Exp_Ch4 is
if Is_Elementary_Type (Component_Type (Full_Type))
and then not Is_Floating_Point_Type (Component_Type (Full_Type))
then
return Make_Op_Eq (Loc, Left_Opnd => Lhs, Right_Opnd => Rhs);
return Make_Op_Eq (Loc, Left_Opnd => Lhs, Right_Opnd => Rhs);
-- For composite component types, and floating-point types, use the
-- expansion. This deals with tagged component types (where we use
@ -2248,10 +2248,10 @@ package body Exp_Ch4 is
begin
return
Make_Function_Call (Loc,
Name => New_Reference_To (Eq_Op, Loc),
Parameter_Associations =>
New_List (OK_Convert_To (T, Lhs),
OK_Convert_To (T, Rhs)));
Name => New_Reference_To (Eq_Op, Loc),
Parameter_Associations => New_List (
OK_Convert_To (T, Lhs),
OK_Convert_To (T, Rhs)));
end;
else
@ -2292,20 +2292,21 @@ package body Exp_Ch4 is
then
Lhs_Discr_Val :=
Make_Selected_Component (Loc,
Prefix => Prefix (Lhs),
Prefix => Prefix (Lhs),
Selector_Name =>
New_Copy (
Get_Discriminant_Value (
First_Discriminant (Lhs_Type),
Lhs_Type,
Stored_Constraint (Lhs_Type))));
New_Copy
(Get_Discriminant_Value
(First_Discriminant (Lhs_Type),
Lhs_Type,
Stored_Constraint (Lhs_Type))));
else
Lhs_Discr_Val := New_Copy (
Get_Discriminant_Value (
First_Discriminant (Lhs_Type),
Lhs_Type,
Stored_Constraint (Lhs_Type)));
Lhs_Discr_Val :=
New_Copy
(Get_Discriminant_Value
(First_Discriminant (Lhs_Type),
Lhs_Type,
Stored_Constraint (Lhs_Type)));
end if;
else
@ -2321,25 +2322,26 @@ package body Exp_Ch4 is
if Is_Constrained (Rhs_Type) then
if Nkind (Rhs) = N_Selected_Component
and then Has_Per_Object_Constraint (
Entity (Selector_Name (Rhs)))
and then Has_Per_Object_Constraint
(Entity (Selector_Name (Rhs)))
then
Rhs_Discr_Val :=
Make_Selected_Component (Loc,
Prefix => Prefix (Rhs),
Prefix => Prefix (Rhs),
Selector_Name =>
New_Copy (
Get_Discriminant_Value (
First_Discriminant (Rhs_Type),
Rhs_Type,
Stored_Constraint (Rhs_Type))));
New_Copy
(Get_Discriminant_Value
(First_Discriminant (Rhs_Type),
Rhs_Type,
Stored_Constraint (Rhs_Type))));
else
Rhs_Discr_Val := New_Copy (
Get_Discriminant_Value (
First_Discriminant (Rhs_Type),
Rhs_Type,
Stored_Constraint (Rhs_Type)));
Rhs_Discr_Val :=
New_Copy
(Get_Discriminant_Value
(First_Discriminant (Rhs_Type),
Rhs_Type,
Stored_Constraint (Rhs_Type)));
end if;
else
@ -2763,8 +2765,7 @@ package body Exp_Ch4 is
if J = N and then Result_May_Be_Null then
Last_Opnd_High_Bound :=
Convert_To (Ityp,
Make_Integer_Literal (Loc,
Intval => Expr_Value (Hi)));
Make_Integer_Literal (Loc, Expr_Value (Hi)));
end if;
-- Exclude null length case unless last operand
@ -2778,10 +2779,9 @@ package body Exp_Ch4 is
Is_Fixed_Length (NN) := True;
Fixed_Length (NN) := Len;
Opnd_Low_Bound (NN) := To_Ityp (
Make_Integer_Literal (Loc,
Intval => Expr_Value (Lo)));
Opnd_Low_Bound (NN) :=
To_Ityp
(Make_Integer_Literal (Loc, Expr_Value (Lo)));
Set := True;
end;
end if;
@ -2823,10 +2823,7 @@ package body Exp_Ch4 is
Make_Object_Declaration (Loc,
Defining_Identifier => Var_Length (NN),
Constant_Present => True,
Object_Definition =>
New_Occurrence_Of (Artyp, Loc),
Object_Definition => New_Occurrence_Of (Artyp, Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix =>
@ -2842,12 +2839,9 @@ package body Exp_Ch4 is
if NN = 1 then
if Is_Fixed_Length (1) then
Aggr_Length (1) :=
Make_Integer_Literal (Loc,
Intval => Fixed_Length (1));
Aggr_Length (1) := Make_Integer_Literal (Loc, Fixed_Length (1));
else
Aggr_Length (1) :=
New_Reference_To (Var_Length (1), Loc);
Aggr_Length (1) := New_Reference_To (Var_Length (1), Loc);
end if;
-- If entry is fixed length and only fixed lengths so far, make
@ -2876,10 +2870,7 @@ package body Exp_Ch4 is
Make_Object_Declaration (Loc,
Defining_Identifier => Ent,
Constant_Present => True,
Object_Definition =>
New_Occurrence_Of (Artyp, Loc),
Object_Definition => New_Occurrence_Of (Artyp, Loc),
Expression =>
Make_Op_Add (Loc,
Left_Opnd => New_Copy (Aggr_Length (NN - 1)),
@ -3214,13 +3205,12 @@ package body Exp_Ch4 is
Assign :=
Make_Implicit_If_Statement (Cnode,
Condition =>
Condition =>
Make_Op_Ne (Loc,
Left_Opnd =>
Left_Opnd =>
New_Occurrence_Of (Var_Length (J), Loc),
Right_Opnd => Make_Integer_Literal (Loc, 0)),
Then_Statements =>
New_List (Assign));
Then_Statements => New_List (Assign));
end if;
Insert_Action (Cnode, Assign, Suppress => All_Checks);

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -29,8 +29,8 @@
-- --
------------------------------------------------------------------------------
-- Storage pool corresponding to default global storage pool used for
-- types for which no storage pool is specified.
-- Storage pool corresponding to default global storage pool used for types
-- for which no storage pool is specified.
with System;
with System.Storage_Pools;
@ -43,9 +43,9 @@ package System.Pool_Global is
-- Allocation strategy:
-- Call to malloc/free for each Allocate/Deallocate
-- no user specifiable size
-- no automatic reclaim
-- minimal overhead
-- No user specifiable size
-- No automatic reclaim
-- Minimal overhead
-- Pool simulating the allocation/deallocation strategy used by the
-- compiler for access types globally declared.

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -45,7 +45,7 @@ package System.Pool_Local is
-- Allocation strategy:
-- Call to malloc/free for each Allocate/Deallocate
-- no user specifiable size
-- No user specifiable size
-- Space of allocated objects is reclaimed at pool finalization
-- Manages a list of allocated objects