+ ------------------------------
+ -- Add_Invocation_Construct --
+ ------------------------------
+
+ procedure Add_Invocation_Construct
+ (Body_Placement : Declaration_Placement_Kind;
+ Kind : Invocation_Construct_Kind;
+ Signature : Invocation_Signature_Id;
+ Spec_Placement : Declaration_Placement_Kind;
+ Update_Units : Boolean := True)
+ is
+ begin
+ pragma Assert (Present (Signature));
+
+ -- Create a invocation construct from the scanned attributes
+
+ Invocation_Constructs.Append
+ ((Body_Placement => Body_Placement,
+ Kind => Kind,
+ Signature => Signature,
+ Spec_Placement => Spec_Placement));
+
+ -- Update the invocation construct counter of the current unit only when
+ -- requested by the caller.
+
+ if Update_Units then
+ declare
+ Curr_Unit : Unit_Record renames Units.Table (Units.Last);
+
+ begin
+ Curr_Unit.Last_Invocation_Construct := Invocation_Constructs.Last;
+ end;
+ end if;
+ end Add_Invocation_Construct;
+
+ -----------------------------
+ -- Add_Invocation_Relation --
+ -----------------------------
+
+ procedure Add_Invocation_Relation
+ (Extra : Name_Id;
+ Invoker : Invocation_Signature_Id;
+ Kind : Invocation_Kind;
+ Target : Invocation_Signature_Id;
+ Update_Units : Boolean := True)
+ is
+ begin
+ pragma Assert (Present (Invoker));
+ pragma Assert (Kind /= No_Invocation);
+ pragma Assert (Present (Target));
+
+ -- Create an invocation relation from the scanned attributes
+
+ Invocation_Relations.Append
+ ((Extra => Extra,
+ Invoker => Invoker,
+ Kind => Kind,
+ Target => Target));
+
+ -- Update the invocation relation counter of the current unit only when
+ -- requested by the caller.
+
+ if Update_Units then
+ declare
+ Curr_Unit : Unit_Record renames Units.Table (Units.Last);
+
+ begin
+ Curr_Unit.Last_Invocation_Relation := Invocation_Relations.Last;
+ end;
+ end if;
+ end Add_Invocation_Relation;
+
+ --------------------
+ -- Body_Placement --
+ --------------------
+
+ function Body_Placement
+ (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind
+ is
+ begin
+ pragma Assert (Present (IC_Id));
+ return Invocation_Constructs.Table (IC_Id).Body_Placement;
+ end Body_Placement;
+
+ ----------------------------------------
+ -- Code_To_Declaration_Placement_Kind --
+ ----------------------------------------
+
+ function Code_To_Declaration_Placement_Kind
+ (Code : Character) return Declaration_Placement_Kind
+ is
+ begin
+ -- Determine which placement kind corresponds to the character code by
+ -- traversing the contents of the mapping table.
+
+ for Kind in Declaration_Placement_Kind loop
+ if Declaration_Placement_Codes (Kind) = Code then
+ return Kind;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end Code_To_Declaration_Placement_Kind;
+
+ ---------------------------------------
+ -- Code_To_Invocation_Construct_Kind --
+ ---------------------------------------
+
+ function Code_To_Invocation_Construct_Kind
+ (Code : Character) return Invocation_Construct_Kind
+ is
+ begin
+ -- Determine which invocation construct kind matches the character code
+ -- by traversing the contents of the mapping table.
+
+ for Kind in Invocation_Construct_Kind loop
+ if Invocation_Construct_Codes (Kind) = Code then
+ return Kind;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end Code_To_Invocation_Construct_Kind;
+
+ --------------------------------------------
+ -- Code_To_Invocation_Graph_Encoding_Kind --
+ --------------------------------------------
+
+ function Code_To_Invocation_Graph_Encoding_Kind
+ (Code : Character) return Invocation_Graph_Encoding_Kind
+ is
+ begin
+ -- Determine which invocation-graph encoding kind matches the character
+ -- code by traversing the contents of the mapping table.
+
+ for Kind in Invocation_Graph_Encoding_Kind loop
+ if Invocation_Graph_Encoding_Codes (Kind) = Code then
+ return Kind;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end Code_To_Invocation_Graph_Encoding_Kind;
+
+ -----------------------------
+ -- Code_To_Invocation_Kind --
+ -----------------------------
+
+ function Code_To_Invocation_Kind
+ (Code : Character) return Invocation_Kind
+ is
+ begin
+ -- Determine which invocation kind corresponds to the character code by
+ -- traversing the contents of the mapping table.
+
+ for Kind in Invocation_Kind loop
+ if Invocation_Codes (Kind) = Code then
+ return Kind;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end Code_To_Invocation_Kind;
+
+ ----------------------------------------
+ -- Code_To_Invocation_Graph_Line_Kind --
+ ----------------------------------------
+
+ function Code_To_Invocation_Graph_Line_Kind
+ (Code : Character) return Invocation_Graph_Line_Kind
+ is
+ begin
+ -- Determine which invocation-graph line kind matches the character
+ -- code by traversing the contents of the mapping table.
+
+ for Kind in Invocation_Graph_Line_Kind loop
+ if Invocation_Graph_Line_Codes (Kind) = Code then
+ return Kind;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end Code_To_Invocation_Graph_Line_Kind;
+
+ ------------
+ -- Column --
+ ------------
+
+ function Column (IS_Id : Invocation_Signature_Id) return Nat is
+ begin
+ pragma Assert (Present (IS_Id));
+ return Invocation_Signatures.Table (IS_Id).Column;
+ end Column;
+
+ ----------------------------------------
+ -- Declaration_Placement_Kind_To_Code --
+ ----------------------------------------
+
+ function Declaration_Placement_Kind_To_Code
+ (Kind : Declaration_Placement_Kind) return Character
+ is
+ begin
+ return Declaration_Placement_Codes (Kind);
+ end Declaration_Placement_Kind_To_Code;
+
+ -------------
+ -- Destroy --
+ -------------
+
+ procedure Destroy (IS_Id : in out Invocation_Signature_Id) is
+ pragma Unreferenced (IS_Id);
+ begin
+ null;
+ end Destroy;
+
+ -----------
+ -- Extra --
+ -----------
+
+ function Extra (IR_Id : Invocation_Relation_Id) return Name_Id is
+ begin
+ pragma Assert (Present (IR_Id));
+ return Invocation_Relations.Table (IR_Id).Extra;
+ end Extra;
+
+ -----------------------------------
+ -- For_Each_Invocation_Construct --
+ -----------------------------------
+
+ procedure For_Each_Invocation_Construct
+ (Processor : Invocation_Construct_Processor_Ptr)
+ is
+ begin
+ pragma Assert (Processor /= null);
+
+ for IC_Id in Invocation_Constructs.First ..
+ Invocation_Constructs.Last
+ loop
+ Processor.all (IC_Id);
+ end loop;
+ end For_Each_Invocation_Construct;
+
+ -----------------------------------
+ -- For_Each_Invocation_Construct --
+ -----------------------------------
+
+ procedure For_Each_Invocation_Construct
+ (U_Id : Unit_Id;
+ Processor : Invocation_Construct_Processor_Ptr)
+ is
+ pragma Assert (Present (U_Id));
+ pragma Assert (Processor /= null);
+
+ U_Rec : Unit_Record renames Units.Table (U_Id);
+
+ begin
+ for IC_Id in U_Rec.First_Invocation_Construct ..
+ U_Rec.Last_Invocation_Construct
+ loop
+ Processor.all (IC_Id);
+ end loop;
+ end For_Each_Invocation_Construct;
+
+ ----------------------------------
+ -- For_Each_Invocation_Relation --
+ ----------------------------------
+
+ procedure For_Each_Invocation_Relation
+ (Processor : Invocation_Relation_Processor_Ptr)
+ is
+ begin
+ pragma Assert (Processor /= null);
+
+ for IR_Id in Invocation_Relations.First ..
+ Invocation_Relations.Last
+ loop
+ Processor.all (IR_Id);
+ end loop;
+ end For_Each_Invocation_Relation;
+
+ ----------------------------------
+ -- For_Each_Invocation_Relation --
+ ----------------------------------
+
+ procedure For_Each_Invocation_Relation
+ (U_Id : Unit_Id;
+ Processor : Invocation_Relation_Processor_Ptr)
+ is
+ pragma Assert (Present (U_Id));
+ pragma Assert (Processor /= null);
+
+ U_Rec : Unit_Record renames Units.Table (U_Id);
+
+ begin
+ for IR_Id in U_Rec.First_Invocation_Relation ..
+ U_Rec.Last_Invocation_Relation
+ loop
+ Processor.all (IR_Id);
+ end loop;
+ end For_Each_Invocation_Relation;
+
+ ----------
+ -- Hash --
+ ----------
+
+ function Hash
+ (IS_Rec : Invocation_Signature_Record) return Bucket_Range_Type
+ is
+ Buffer : Bounded_String (2052);
+ IS_Nam : Name_Id;
+
+ begin
+ -- The hash is obtained in the following manner:
+ --
+ -- * A String signature based on the scope, name, line number, column
+ -- number, and locations, in the following format:
+ --
+ -- scope__name__line_column__locations
+ --
+ -- * The String is converted into a Name_Id
+ -- * The Name_Id is used as the hash
+
+ Append (Buffer, IS_Rec.Scope);
+ Append (Buffer, "__");
+ Append (Buffer, IS_Rec.Name);
+ Append (Buffer, "__");
+ Append (Buffer, IS_Rec.Line);
+ Append (Buffer, '_');
+ Append (Buffer, IS_Rec.Column);
+
+ if IS_Rec.Locations /= No_Name then
+ Append (Buffer, "__");
+ Append (Buffer, IS_Rec.Locations);
+ end if;
+
+ IS_Nam := Name_Find (Buffer);
+ return Bucket_Range_Type (IS_Nam);
+ end Hash;
+