-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
-- The second method is faster
+ -- Similarly, rr and rrd allow breaking on rewriting of a given node.
+
ww : Node_Id'Base := Node_Id'First - 1;
pragma Export (Ada, ww); -- trick the optimizer
Watch_Node : Node_Id'Base renames ww;
-- If Node = Watch_Node, this prints out the new node and calls
-- New_Node_Breakpoint. Otherwise, does nothing.
+ procedure rr;
+ pragma Export (Ada, rr);
+ procedure Rewrite_Breakpoint renames rr;
+ -- This doesn't do anything interesting; it's just for setting breakpoint
+ -- on as explained above.
+
+ procedure rrd (Old_Node, New_Node : Node_Id);
+ pragma Export (Ada, rrd);
+ procedure Rewrite_Debugging_Output
+ (Old_Node, New_Node : Node_Id) renames rrd;
+ -- For debugging. If debugging is turned on, Rewrite calls this. If debug
+ -- flag N is turned on, this prints out the new node.
+ --
+ -- If Old_Node = Watch_Node, this prints out the old and new nodes and
+ -- calls Rewrite_Breakpoint. Otherwise, does nothing.
+
+ procedure Node_Debug_Output (Op : String; N : Node_Id);
+ -- Common code for nnr and rrd. Write Op followed by information about N
+
-----------------------------
-- Local Objects and Types --
-----------------------------
begin
if Debug_Flag_N or else Node_Is_Watched then
- Write_Str ("Allocate ");
-
- if Nkind (N) in N_Entity then
- Write_Str ("entity");
- else
- Write_Str ("node");
- end if;
-
- Write_Str (", Id = ");
- Write_Int (Int (N));
- Write_Str (" ");
- Write_Location (Sloc (N));
- Write_Str (" ");
- Write_Str (Node_Kind'Image (Nkind (N)));
- Write_Eol;
+ Node_Debug_Output ("Allocate", N);
if Node_Is_Watched then
New_Node_Breakpoint;
begin
return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7, V8, V9);
end Nkind_In;
+
--------
-- No --
--------
return N = Empty;
end No;
+ -----------------------
+ -- Node_Debug_Output --
+ -----------------------
+
+ procedure Node_Debug_Output (Op : String; N : Node_Id) is
+ begin
+ Write_Str (Op);
+
+ if Nkind (N) in N_Entity then
+ Write_Str (" entity");
+ else
+ Write_Str (" node");
+ end if;
+
+ Write_Str (" Id = ");
+ Write_Int (Int (N));
+ Write_Str (" ");
+ Write_Location (Sloc (N));
+ Write_Str (" ");
+ Write_Str (Node_Kind'Image (Nkind (N)));
+ Write_Eol;
+ end Node_Debug_Output;
+
-------------------
-- Nodes_Address --
-------------------
(not Has_Extension (Old_Node)
and not Has_Extension (New_Node)
and not Nodes.Table (New_Node).In_List);
+ pragma Debug (Rewrite_Debugging_Output (Old_Node, New_Node));
if Nkind (Old_Node) in N_Subexpr then
Old_Paren_Count := Paren_Count (Old_Node);
Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
end Rewrite;
+ -------------------------
+ -- Rewrite_Breakpoint --
+ -------------------------
+
+ procedure rr is -- Rewrite_Breakpoint
+ begin
+ Write_Str ("Watched node ");
+ Write_Int (Int (Watch_Node));
+ Write_Str (" rewritten");
+ Write_Eol;
+ end rr;
+
+ ------------------------------
+ -- Rewrite_Debugging_Output --
+ ------------------------------
+
+ procedure rrd (Old_Node, New_Node : Node_Id) is -- Rewrite_Debugging_Output
+ Node_Is_Watched : constant Boolean := Old_Node = Watch_Node;
+
+ begin
+ if Debug_Flag_N or else Node_Is_Watched then
+ Node_Debug_Output ("Rewrite", Old_Node);
+ Node_Debug_Output ("into", New_Node);
+
+ if Node_Is_Watched then
+ Rewrite_Breakpoint;
+ end if;
+ end if;
+ end rrd;
+
------------------
-- Set_Analyzed --
------------------
function Operand_Type_In_Scope (S : Entity_Id) return Boolean;
-- If the operand is not universal, and the operator is given by a
- -- expanded name, verify that the operand has an interpretation with
+ -- expanded name, verify that the operand has an interpretation with
-- a type defined in the given scope of the operator.
function Type_In_P (Test : Kind_Test) return Entity_Id;
-- you courtesy of b33302a. The type itself must be frozen, so we must
-- find the type of the proper class in the given scope.
- -- A final wrinkle is the multiplication operator for fixed point
- -- types, which is defined in Standard only, and not in the scope of
- -- the fixed_point type itself.
+ -- A final wrinkle is the multiplication operator for fixed point types,
+ -- which is defined in Standard only, and not in the scope of the
+ -- fixed_point type itself.
if Nkind (Name (N)) = N_Expanded_Name then
Pack := Entity (Prefix (Name (N)));
- -- If the entity being called is defined in the given package,
- -- it is a renaming of a predefined operator, and known to be
- -- legal.
+ -- If the entity being called is defined in the given package, it is
+ -- a renaming of a predefined operator, and known to be legal.
if Scope (Entity (Name (N))) = Pack
and then Pack /= Standard_Standard
elsif In_Instance then
null;
- elsif (Op_Name = Name_Op_Multiply
- or else Op_Name = Name_Op_Divide)
+ elsif (Op_Name = Name_Op_Multiply or else Op_Name = Name_Op_Divide)
and then Is_Fixed_Point_Type (Etype (Left_Opnd (Op_Node)))
and then Is_Fixed_Point_Type (Etype (Right_Opnd (Op_Node)))
then
Error := True;
end if;
- -- Ada 2005, AI-420: Predefined equality on Universal_Access
- -- is available.
+ -- Ada 2005, AI-420: Predefined equality on Universal_Access is
+ -- available.
elsif Ada_Version >= Ada_05
and then (Op_Name = Name_Op_Eq or else Op_Name = Name_Op_Ne)
if Pack /= Standard_Standard then
if Opnd_Type = Universal_Integer then
- Orig_Type := Type_In_P (Is_Integer_Type'Access);
+ Orig_Type := Type_In_P (Is_Integer_Type'Access);
elsif Opnd_Type = Universal_Real then
Orig_Type := Type_In_P (Is_Real_Type'Access);
Orig_Type := Type_In_P (Is_String_Type'Access);
elsif Opnd_Type = Any_Access then
- Orig_Type := Type_In_P (Is_Definite_Access_Type'Access);
+ Orig_Type := Type_In_P (Is_Definite_Access_Type'Access);
elsif Opnd_Type = Any_Composite then
Orig_Type := Type_In_P (Is_Composite_Type'Access);
projects / thirdparty / gcc.git / commitdiff
