Commit 1d1bd8ad by Arnaud Charlet

[multiple changes]

2009-07-22  Robert Dewar  <dewar@adacore.com>

	* exp_tss.ads, sem_eval.adb: Minor reformatting

2009-07-22  Bob Duff  <duff@adacore.com>

	* exp_dist.adb, exp_dist.ads: Update comments.

From-SVN: r149933
parent 09494c32
2009-07-22 Robert Dewar <dewar@adacore.com>
* exp_tss.ads, sem_eval.adb: Minor reformatting
2009-07-22 Bob Duff <duff@adacore.com>
* exp_dist.adb, exp_dist.ads: Update comments.
2009-07-22 Brett Porter <porter@adacore.com> 2009-07-22 Brett Porter <porter@adacore.com>
* init.c (__gnat_init_float): For SPE, set bits in SPEFSCR instead of * init.c (__gnat_init_float): For SPE, set bits in SPEFSCR instead of
......
...@@ -64,10 +64,10 @@ package body Exp_Dist is ...@@ -64,10 +64,10 @@ package body Exp_Dist is
-- is built. This type has two properties: -- is built. This type has two properties:
-- 1) Since it has the same structure than RACW_Stub_Type, it can -- 1) Since it has the same structure as RACW_Stub_Type, it can
-- be converted to and from this type to make it suitable for -- be converted to and from this type to make it suitable for
-- System.Partition_Interface.Get_Unique_Remote_Pointer in order -- System.Partition_Interface.Get_Unique_Remote_Pointer in order
-- to avoid memory leaks when the same remote object arrive on the -- to avoid memory leaks when the same remote object arrives on the
-- same partition through several paths; -- same partition through several paths;
-- 2) It also has the same dispatching table as the designated type D, -- 2) It also has the same dispatching table as the designated type D,
...@@ -99,7 +99,7 @@ package body Exp_Dist is ...@@ -99,7 +99,7 @@ package body Exp_Dist is
function Hash (F : Name_Id) return Hash_Index; function Hash (F : Name_Id) return Hash_Index;
-- The generation of subprogram identifiers requires an overload counter -- The generation of subprogram identifiers requires an overload counter
-- to be associated with each remote subprogram names. These counters are -- to be associated with each remote subprogram name. These counters are
-- maintained in a hash table on name ids. -- maintained in a hash table on name ids.
type Subprogram_Identifiers is record type Subprogram_Identifiers is record
...@@ -170,10 +170,9 @@ package body Exp_Dist is ...@@ -170,10 +170,9 @@ package body Exp_Dist is
function Build_Remote_Subprogram_Proxy_Type function Build_Remote_Subprogram_Proxy_Type
(Loc : Source_Ptr; (Loc : Source_Ptr;
ACR_Expression : Node_Id) return Node_Id; ACR_Expression : Node_Id) return Node_Id;
-- Build and return a tagged record type definition for an RCI -- Build and return a tagged record type definition for an RCI subprogram
-- subprogram proxy type. -- proxy type. ACR_Expression is used as the initialization value for the
-- ACR_Expression is use as the initialization value for -- All_Calls_Remote component.
-- the All_Calls_Remote component.
function Build_Get_Unique_RP_Call function Build_Get_Unique_RP_Call
(Loc : Source_Ptr; (Loc : Source_Ptr;
...@@ -200,13 +199,13 @@ package body Exp_Dist is ...@@ -200,13 +199,13 @@ package body Exp_Dist is
New_Name : Name_Id := No_Name) return Node_Id; New_Name : Name_Id := No_Name) return Node_Id;
-- Build the calling stub for a given subprogram with the subprogram ID -- Build the calling stub for a given subprogram with the subprogram ID
-- being Subp_Id. If Stub_Type is given, then the "addr" field of -- being Subp_Id. If Stub_Type is given, then the "addr" field of
-- parameters of this type will be marshalled instead of the object -- parameters of this type will be marshalled instead of the object itself.
-- itself. It will then be converted into Stub_Type before performing -- It will then be converted into Stub_Type before performing the real
-- the real call. If Dynamically_Asynchronous is True, then it will be -- call. If Dynamically_Asynchronous is True, then it will be computed at
-- computed at run time whether the call is asynchronous or not. -- run time whether the call is asynchronous or not. Otherwise, the value
-- Otherwise, the value of the formal Asynchronous will be used. -- of the formal Asynchronous will be used. If Locator is not Empty, it
-- If Locator is not Empty, it will be used instead of RCI_Cache. If -- will be used instead of RCI_Cache. If New_Name is given, then it will
-- New_Name is given, then it will be used instead of the original name. -- be used instead of the original name.
function Build_RPC_Receiver_Specification function Build_RPC_Receiver_Specification
(RPC_Receiver : Entity_Id; (RPC_Receiver : Entity_Id;
...@@ -233,7 +232,7 @@ package body Exp_Dist is ...@@ -233,7 +232,7 @@ package body Exp_Dist is
function Could_Be_Asynchronous (Spec : Node_Id) return Boolean; function Could_Be_Asynchronous (Spec : Node_Id) return Boolean;
-- Return True if nothing prevents the program whose specification is -- Return True if nothing prevents the program whose specification is
-- given to be asynchronous (i.e. no out parameter). -- given to be asynchronous (i.e. no [IN] OUT parameters).
function Pack_Entity_Into_Stream_Access function Pack_Entity_Into_Stream_Access
(Loc : Source_Ptr; (Loc : Source_Ptr;
......
...@@ -58,7 +58,7 @@ package Exp_Dist is ...@@ -58,7 +58,7 @@ package Exp_Dist is
Body_Decls : List_Id); Body_Decls : List_Id);
-- Add primitive for the stub type, and the RPC receiver. The declarations -- Add primitive for the stub type, and the RPC receiver. The declarations
-- are inserted after Insertion_Node, while the bodies are appended at the -- are inserted after Insertion_Node, while the bodies are appended at the
-- end of Decls. -- end of Body_Decls.
procedure Remote_Types_Tagged_Full_View_Encountered procedure Remote_Types_Tagged_Full_View_Encountered
(Full_View : Entity_Id); (Full_View : Entity_Id);
...@@ -75,13 +75,13 @@ package Exp_Dist is ...@@ -75,13 +75,13 @@ package Exp_Dist is
-- at the end of the compilation unit, which is a package spec. -- at the end of the compilation unit, which is a package spec.
procedure Expand_Receiving_Stubs_Bodies (Unit_Node : Node_Id); procedure Expand_Receiving_Stubs_Bodies (Unit_Node : Node_Id);
-- Call the expansion phase for the calling stubs. The code will be added -- Call the expansion phase for the receiving stubs. The code will be added
-- at the end of the compilation unit, which may be either a package spec -- at the end of the compilation unit, which may be either a package spec
-- or a package body. -- or a package body.
procedure Expand_All_Calls_Remote_Subprogram_Call (N : Node_Id); procedure Expand_All_Calls_Remote_Subprogram_Call (N : Node_Id);
-- Rewrite a call to a subprogram located in a Remote_Call_Interface -- Rewrite a call to a subprogram located in a Remote_Call_Interface
-- package on which the pragma All_Calls_Remote applies so that it -- package to which the pragma All_Calls_Remote applies so that it
-- goes through the PCS. N is either an N_Procedure_Call_Statement -- goes through the PCS. N is either an N_Procedure_Call_Statement
-- or an N_Function_Call node. -- or an N_Function_Call node.
......
...@@ -72,8 +72,8 @@ package Exp_Tss is ...@@ -72,8 +72,8 @@ package Exp_Tss is
-- The following codes are used to denote TSSs: -- The following codes are used to denote TSSs:
-- Note: When making additions to this list, update the list in -- Note: When making additions to this list, make the corresponding change
-- snames.adb-tmpl -- to the list in snames.adb-tmpl.
type TSS_Name_Type is new String (1 .. 2); type TSS_Name_Type is new String (1 .. 2);
subtype TNT is TSS_Name_Type; subtype TNT is TSS_Name_Type;
......
...@@ -1953,11 +1953,11 @@ package body Sem_Eval is ...@@ -1953,11 +1953,11 @@ package body Sem_Eval is
T : constant Entity_Id := Etype (N); T : constant Entity_Id := Etype (N);
function In_Any_Integer_Context return Boolean; function In_Any_Integer_Context return Boolean;
-- If the literal is resolved with a specific type in a context -- If the literal is resolved with a specific type in a context where
-- where the expected type is Any_Integer, there are no range checks -- the expected type is Any_Integer, there are no range checks on the
-- on the literal. By the time the literal is evaluated, it carries -- literal. By the time the literal is evaluated, it carries the type
-- the type imposed by the enclosing expression, and we must recover -- imposed by the enclosing expression, and we must recover the context
-- the context to determine that Any_Integer is meant. -- to determine that Any_Integer is meant.
---------------------------- ----------------------------
-- In_Any_Integer_Context -- -- In_Any_Integer_Context --
...@@ -1969,8 +1969,8 @@ package body Sem_Eval is ...@@ -1969,8 +1969,8 @@ package body Sem_Eval is
begin begin
-- Any_Integer also appears in digits specifications for real types, -- Any_Integer also appears in digits specifications for real types,
-- but those have bounds smaller that those of any integer base -- but those have bounds smaller that those of any integer base type,
-- type, so we can safely ignore these cases. -- so we can safely ignore these cases.
return K = N_Number_Declaration return K = N_Number_Declaration
or else K = N_Attribute_Reference or else K = N_Attribute_Reference
...@@ -1984,9 +1984,9 @@ package body Sem_Eval is ...@@ -1984,9 +1984,9 @@ package body Sem_Eval is
begin begin
-- If the literal appears in a non-expression context, then it is -- If the literal appears in a non-expression context, then it is
-- certainly appearing in a non-static context, so check it. This -- certainly appearing in a non-static context, so check it. This is
-- is actually a redundant check, since Check_Non_Static_Context -- actually a redundant check, since Check_Non_Static_Context would
-- would check it, but it seems worth while avoiding the call. -- check it, but it seems worth while avoiding the call.
if Nkind (Parent (N)) not in N_Subexpr if Nkind (Parent (N)) not in N_Subexpr
and then not In_Any_Integer_Context and then not In_Any_Integer_Context
...@@ -2089,9 +2089,9 @@ package body Sem_Eval is ...@@ -2089,9 +2089,9 @@ package body Sem_Eval is
-- Eval_Membership_Op -- -- Eval_Membership_Op --
------------------------ ------------------------
-- A membership test is potentially static if the expression is static, -- A membership test is potentially static if the expression is static, and
-- and the range is a potentially static range, or is a subtype mark -- the range is a potentially static range, or is a subtype mark denoting a
-- denoting a static subtype (RM 4.9(12)). -- static subtype (RM 4.9(12)).
procedure Eval_Membership_Op (N : Node_Id) is procedure Eval_Membership_Op (N : Node_Id) is
Left : constant Node_Id := Left_Opnd (N); Left : constant Node_Id := Left_Opnd (N);
...@@ -2104,8 +2104,8 @@ package body Sem_Eval is ...@@ -2104,8 +2104,8 @@ package body Sem_Eval is
Fold : Boolean; Fold : Boolean;
begin begin
-- Ignore if error in either operand, except to make sure that -- Ignore if error in either operand, except to make sure that Any_Type
-- Any_Type is properly propagated to avoid junk cascaded errors. -- is properly propagated to avoid junk cascaded errors.
if Etype (Left) = Any_Type if Etype (Left) = Any_Type
or else Etype (Right) = Any_Type or else Etype (Right) = Any_Type
...@@ -2132,8 +2132,7 @@ package body Sem_Eval is ...@@ -2132,8 +2132,7 @@ package body Sem_Eval is
return; return;
end if; end if;
-- For string membership tests we will check the length -- For string membership tests we will check the length further on
-- further below.
if not Is_String_Type (Def_Id) then if not Is_String_Type (Def_Id) then
Lo := Type_Low_Bound (Def_Id); Lo := Type_Low_Bound (Def_Id);
...@@ -2189,8 +2188,8 @@ package body Sem_Eval is ...@@ -2189,8 +2188,8 @@ package body Sem_Eval is
end; end;
end if; end if;
-- Fold the membership test. We know we have a static range and Lo -- Fold the membership test. We know we have a static range and Lo and
-- and Hi are set to the expressions for the end points of this range. -- Hi are set to the expressions for the end points of this range.
elsif Is_Real_Type (Etype (Right)) then elsif Is_Real_Type (Etype (Right)) then
declare declare
...@@ -2357,10 +2356,10 @@ package body Sem_Eval is ...@@ -2357,10 +2356,10 @@ package body Sem_Eval is
Typ : constant Entity_Id := Etype (N); Typ : constant Entity_Id := Etype (N);
begin begin
-- Negation is equivalent to subtracting from the modulus minus -- Negation is equivalent to subtracting from the modulus minus one.
-- one. For a binary modulus this is equivalent to the ones- -- For a binary modulus this is equivalent to the ones-complement of
-- component of the original value. For non-binary modulus this -- the original value. For non-binary modulus this is an arbitrary
-- is an arbitrary but consistent definition. -- but consistent definition.
if Is_Modular_Integer_Type (Typ) then if Is_Modular_Integer_Type (Typ) then
Fold_Uint (N, Modulus (Typ) - 1 - Rint, Stat); Fold_Uint (N, Modulus (Typ) - 1 - Rint, Stat);
...@@ -2390,7 +2389,7 @@ package body Sem_Eval is ...@@ -2390,7 +2389,7 @@ package body Sem_Eval is
Hex : Boolean; Hex : Boolean;
begin begin
-- Can only fold if target is string or scalar and subtype is static -- Can only fold if target is string or scalar and subtype is static.
-- Also, do not fold if our parent is an allocator (this is because -- Also, do not fold if our parent is an allocator (this is because
-- the qualified expression is really part of the syntactic structure -- the qualified expression is really part of the syntactic structure
-- of an allocator, and we do not want to end up with something that -- of an allocator, and we do not want to end up with something that
...@@ -2402,8 +2401,8 @@ package body Sem_Eval is ...@@ -2402,8 +2401,8 @@ package body Sem_Eval is
then then
Check_Non_Static_Context (Operand); Check_Non_Static_Context (Operand);
-- If operand is known to raise constraint_error, set the -- If operand is known to raise constraint_error, set the flag on the
-- flag on the expression so it does not get optimized away. -- expression so it does not get optimized away.
if Nkind (Operand) = N_Raise_Constraint_Error then if Nkind (Operand) = N_Raise_Constraint_Error then
Set_Raises_Constraint_Error (N); Set_Raises_Constraint_Error (N);
...@@ -2480,9 +2479,9 @@ package body Sem_Eval is ...@@ -2480,9 +2479,9 @@ package body Sem_Eval is
PK : constant Node_Kind := Nkind (Parent (N)); PK : constant Node_Kind := Nkind (Parent (N));
begin begin
-- If the literal appears in a non-expression context -- If the literal appears in a non-expression context and not as part of
-- and not as part of a number declaration, then it is -- a number declaration, then it is appearing in a non-static context,
-- appearing in a non-static context, so check it. -- so check it.
if PK not in N_Subexpr and then PK /= N_Number_Declaration then if PK not in N_Subexpr and then PK /= N_Number_Declaration then
Check_Non_Static_Context (N); Check_Non_Static_Context (N);
...@@ -2529,8 +2528,8 @@ package body Sem_Eval is ...@@ -2529,8 +2528,8 @@ package body Sem_Eval is
Length_Mismatch : declare Length_Mismatch : declare
procedure Get_Static_Length (Op : Node_Id; Len : out Uint); procedure Get_Static_Length (Op : Node_Id; Len : out Uint);
-- If Op is an expression for a constrained array with a known -- If Op is an expression for a constrained array with a known at
-- at compile time length, then Len is set to this (non-negative -- compile time length, then Len is set to this (non-negative
-- length). Otherwise Len is set to minus 1. -- length). Otherwise Len is set to minus 1.
----------------------- -----------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment