-- dA Forces output of representation information, including full
-- information for all internal type and object entities, as well
-- as all user defined type and object entities including private
- -- and incomplete types.
+ -- and incomplete types. This debug switch also automatically sets
+ -- the equivalent of -gnatR3m.
-- dB Output debug encodings for types and variants. See Exp_Dbug for
-- exact form of the generated output.
-- Compilation unit node for main unit
Main_Kind : Node_Kind;
- -- Kind of main compilation unit node.
+ -- Kind of main compilation unit node
Back_End_Mode : Back_End.Back_End_Mode_Type;
-- Record back end mode
("cannot locate file system.ads");
raise Unrecoverable_Error;
- -- Here if system.ads successfully read. Remember its source index.
+ -- Remember source index of system.ads (which was read successfully)
else
System_Source_File_Index := S;
Configurable_Run_Time_Mode := True;
end if;
+ -- Set -gnatR3m mode if debug flag A set
+
+ if Debug_Flag_AA then
+ Back_Annotate_Rep_Info := True;
+ List_Representation_Info := 1;
+ List_Representation_Info_Mechanisms := True;
+ end if;
+
-- Output copyright notice if full list mode
if (Verbose_Mode or Full_List)
-- the Java VM, since representations are largely symbolic there.
if Back_End_Mode = Declarations_Only
- and then (not (Back_Annotate_Rep_Info or Debug_Flag_AA)
- or else Main_Kind = N_Subunit
- or else Targparm.Frontend_Layout_On_Target
- or else Hostparm.Java_VM)
+ and then (not Back_Annotate_Rep_Info
+ or else Main_Kind = N_Subunit
+ or else Targparm.Frontend_Layout_On_Target
+ or else Hostparm.Java_VM)
then
Sem_Ch13.Validate_Unchecked_Conversions;
Errout.Finalize;
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2004 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- --
-- --
------------------------------------------------------------------------------
-with Alloc; use Alloc;
-with Atree; use Atree;
-with Casing; use Casing;
-with Debug; use Debug;
-with Einfo; use Einfo;
-with Lib; use Lib;
-with Namet; use Namet;
-with Opt; use Opt;
-with Output; use Output;
-with Sinfo; use Sinfo;
-with Sinput; use Sinput;
-with Snames; use Snames;
-with Stand; use Stand;
-with Table; use Table;
-with Uname; use Uname;
-with Urealp; use Urealp;
+with Alloc; use Alloc;
+with Atree; use Atree;
+with Casing; use Casing;
+with Debug; use Debug;
+with Einfo; use Einfo;
+with Lib; use Lib;
+with Namet; use Namet;
+with Opt; use Opt;
+with Output; use Output;
+with Sinfo; use Sinfo;
+with Sinput; use Sinput;
+with Snames; use Snames;
+with Stand; use Stand;
+with Table; use Table;
+with Uname; use Uname;
+with Urealp; use Urealp;
package body Repinfo is
-- Create_Discrim_Ref --
------------------------
- function Create_Discrim_Ref
- (Discr : Entity_Id)
- return Node_Ref
- is
+ function Create_Discrim_Ref (Discr : Entity_Id) return Node_Ref is
N : constant Uint := Discriminant_Number (Discr);
T : Nat;
-
begin
Rep_Table.Increment_Last;
T := Rep_Table.Last;
-- Create_Dynamic_SO_Ref --
---------------------------
- function Create_Dynamic_SO_Ref
- (E : Entity_Id)
- return Dynamic_SO_Ref
- is
+ function Create_Dynamic_SO_Ref (E : Entity_Id) return Dynamic_SO_Ref is
T : Nat;
-
begin
Dynamic_SO_Entity_Table.Increment_Last;
T := Dynamic_SO_Entity_Table.Last;
(Expr : TCode;
Op1 : Node_Ref_Or_Val;
Op2 : Node_Ref_Or_Val := No_Uint;
- Op3 : Node_Ref_Or_Val := No_Uint)
- return Node_Ref
+ Op3 : Node_Ref_Or_Val := No_Uint) return Node_Ref
is
T : Nat;
-
begin
Rep_Table.Increment_Last;
T := Rep_Table.Last;
Rep_Table.Table (T).Op1 := Op1;
Rep_Table.Table (T).Op2 := Op2;
Rep_Table.Table (T).Op3 := Op3;
-
return UI_From_Int (-T);
end Create_Node;
-- Get_Dynamic_SO_Entity --
---------------------------
- function Get_Dynamic_SO_Entity
- (U : Dynamic_SO_Ref)
- return Entity_Id
- is
+ function Get_Dynamic_SO_Entity (U : Dynamic_SO_Ref) return Entity_Id is
begin
return Dynamic_SO_Entity_Table.Table (-UI_To_Int (U));
end Get_Dynamic_SO_Entity;
procedure List_Array_Info (Ent : Entity_Id) is
begin
List_Type_Info (Ent);
-
Write_Str ("for ");
List_Name (Ent);
Write_Str ("'Component_Size use ");
function Find_Declaration (E : Entity_Id) return Node_Id is
Decl : Node_Id;
+
begin
Decl := Parent (E);
-
while Present (Decl)
and then Nkind (Decl) /= N_Package_Body
and then Nkind (Decl) /= N_Subprogram_Declaration
Col : Nat;
begin
- if Debug_Flag_AA then
- List_Representation_Info := 3;
- List_Representation_Info_Mechanisms := True;
- end if;
-
if List_Representation_Info /= 0
or else List_Representation_Info_Mechanisms
then
---------------
function Rep_Value
- (Val : Node_Ref_Or_Val;
- D : Discrim_List)
- return Uint
+ (Val : Node_Ref_Or_Val;
+ D : Discrim_List) return Uint
is
function B (Val : Boolean) return Uint;
-- Returns Uint_0 for False, Uint_1 for True
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2004 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- --
-- Back-Annotation by Gigi --
-----------------------------
- -- The following interface is used by gigi if Backend_Layout is True.
+ -- The following interface is used by gigi if Backend_Layout is True
-- As part of the processing in gigi, the types are laid out and
-- appropriate values computed for the sizes and component positions
-- The following declarations are for use by gigi for back annotation
function Create_Node
- (Expr : TCode;
- Op1 : Node_Ref_Or_Val;
- Op2 : Node_Ref_Or_Val := No_Uint;
- Op3 : Node_Ref_Or_Val := No_Uint)
- return Node_Ref;
+ (Expr : TCode;
+ Op1 : Node_Ref_Or_Val;
+ Op2 : Node_Ref_Or_Val := No_Uint;
+ Op3 : Node_Ref_Or_Val := No_Uint) return Node_Ref;
-- Creates a node with using the tree code defined by Expr and from
-- 1-3 operands as required (unused operands set as shown to No_Uint)
-- Note that this call can be used to create a discriminant reference
-- by using (Expr => Discrim_Val, Op1 => discriminant_number).
- function Create_Discrim_Ref
- (Discr : Entity_Id)
- return Node_Ref;
- -- Creates a refrerence to the discriminant whose entity is Discr.
+ function Create_Discrim_Ref (Discr : Entity_Id) return Node_Ref;
+ -- Creates a refrerence to the discriminant whose entity is Discr
--------------------------------------------------------
-- Front-End Interface for Dynamic Size/Offset Values --
-- Given a SO_Ref (Uint) value, returns True iff the SO_Ref value
-- represents a static Size/Offset value (i.e. it is non-negative).
- function Create_Dynamic_SO_Ref
- (E : Entity_Id)
- return Dynamic_SO_Ref;
+ function Create_Dynamic_SO_Ref (E : Entity_Id) return Dynamic_SO_Ref;
-- Given the Entity_Id for a constant (case 1), the Node_Id for an
-- expression (case 2), or the Entity_Id for a function (case 3),
-- this function returns a (negative) Uint value that can be used
-- to retrieve the entity or expression for later use.
- function Get_Dynamic_SO_Entity
- (U : Dynamic_SO_Ref)
- return Entity_Id;
+ function Get_Dynamic_SO_Entity (U : Dynamic_SO_Ref) return Entity_Id;
-- Retrieve the Node_Id or Entity_Id stored by a previous call to
-- Create_Dynamic_SO_Ref. The approach is that the front end makes
-- the necessary Create_Dynamic_SO_Ref calls to associate the node
-- Type used to represent list of discriminant values
function Rep_Value
- (Val : Node_Ref_Or_Val;
- D : Discrim_List)
- return Uint;
+ (Val : Node_Ref_Or_Val;
+ D : Discrim_List) return Uint;
-- Given the contents of a First_Bit_Position or Esize field containing
-- a node reference (i.e. a negative Uint value) and D, the list of
-- discriminant values, returns the interpreted value of this field.