------------------------------------------------------------------------------ -- -- -- GNATELIM COMPONENTS -- -- -- -- G N A T E L I M . E N T I T I E S -- -- -- -- B o d y -- -- -- -- $Revision: 1.22 $ -- -- -- Copyright (c) 1997-2000, Free Software Foundation, Inc. -- -- -- -- Gnatelim is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. Gnatelim is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MER- -- -- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- -- Public License for more details. You should have received a copy of the -- -- GNU General Public License distributed with GNAT; see file COPYING. If -- -- not, write to the Free Software Foundation, 59 Temple Place Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- -- Gnatelim is distributed as a part of the ASIS implementation for GNAT -- -- (ASIS-for-GNAT). -- -- -- -- Gnatelim was originally developed by Alain Le Guennec -- -- -- -- Gnatelim is now maintained by Ada Core Technologies Inc -- -- (http://www.gnat.com). -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion; with Interfaces; use Interfaces; with GNATELIM.Errors; use GNATELIM.Errors; with Table; with GNAT.HTable; with Asis.Elements; use Asis.Elements; with Asis.Declarations; use Asis.Declarations; with Asis.Expressions; use Asis.Expressions; with Asis.Exceptions; use Asis.Exceptions; use Asis; with Ada.Characters.Handling; use Ada.Characters.Handling; package body GNATELIM.Entities is type Access_Wide_String is access all Wide_String; -- Starting with 3.10, the generic package is Standard.Table.Table. package List_Of_Used_Entities is new Standard.Table.Table (Table_Component_Type => Entity_Id, Table_Index_Type => Natural, Table_Low_Bound => 1, Table_Initial => 10, Table_Increment => 50, Table_Name => "List of used entities"); type Boolean_Flags is array (Flag_Range) of Boolean; -- For entities properties. type Static_Links is array (Link_Range) of Entity_Id; -- To link entities with other entities. type Entity is record Element : Asis.Element; -- This Element is always explicit (no "artificial constructs".) Name : Access_Wide_String; -- Defining name of the entity. Used_Entities : List_Of_Used_Entities.Saved_Table; -- List of entities used by transitivity -- when Entity is itself Used. -- We use the Save and Restore capabilities of the Table package -- to obtain a per-entity list of Used_Entities. Flags : Boolean_Flags; -- Properties of entities: -- -- Used : Boolean; -- Set to True if Entity can't be eliminated. -- -- Analyzed : Boolean; -- Used to avoid loops in call-graph cycles -- when doing transitive analysis. Links : Static_Links; -- Static links for various uses: -- -- Instance : Entity_Id; -- Since ASIS can't traverse generic-body expansions, -- we need to denote a given instance of an entity -- by using the Element in the template wrt to the right Instance. -- An Instance is an Entity corresponding to A_Generic_Instantiation. -- No_Entity is used for Entities that are not part of instance. -- -- Scope : Entity_Id; -- Scope containing the Entity. -- -- Homonym : Entity_Id; -- To keep track of overloaded subprograms. -- -- Some links are also used for HTables. end record; -- Keeps information about a given entity. -- Starting with 3.10, the generic package is Standard.Table.Table. package Entity_Table is new Standard.Table.Table (Table_Component_Type => Entity, Table_Index_Type => Entity_Id, Table_Low_Bound => No_Entity, Table_Initial => 100, Table_Increment => 50, Table_Name => "Entity table"); ------------------------- -- Local subprograms -- ------------------------- function Entities_Used_By (Id : Entity_Id) return Entity_Id_List; -- Returns all Entities used by Id Entity. procedure Perform_Transitive_Closure (Id : Entity_Id); -- ??? Documentation!!! function Corresponding_Name_Definition (Name : Asis.Element) return Asis.Defining_Name; -- ??? Documentation!!! function Get_Name (Entity : Entity_Id) return Access_Wide_String; -- ??? Documentation!!! procedure Set_Name (Id : Entity_Id; Name : Access_Wide_String); -- ??? Documentation!!! procedure Set_Element (Id : Entity_Id; Element : Asis.Element); -- ??? Documentation!!! -------------------- -- Boolean_Flag -- -------------------- package body Boolean_Flag is -- Keep track of the flag-slot that is allocated for this instance. Flag_Used : constant Flag_Range := Nb_Allocated_Flags + 1; procedure Set_Flag (Id : Entity_Id; Flag : Boolean) is begin pragma Assert (Id in Entity_Table.First .. Entity_Table.Last); Entity_Table.Table (Id).Flags (Flag_Used) := Flag; end Set_Flag; function Get_Flag (Id : Entity_Id) return Boolean is begin pragma Assert (Id in Entity_Table.First .. Entity_Table.Last); return Entity_Table.Table (Id).Flags (Flag_Used); end Get_Flag; begin Nb_Allocated_Flags := Nb_Allocated_Flags + 1; end Boolean_Flag; ------------------- -- Static_Link -- ------------------- package body Static_Link is -- Keep track of the link-slot that is allocated for this instance. Link_Used : constant Link_Range := Nb_Allocated_Links + 1; procedure Set_Link (Id : Entity_Id; Next : Entity_Id) is begin pragma Assert (Id in Entity_Table.First .. Entity_Table.Last); Entity_Table.Table (Id).Links (Link_Used) := Next; end Set_Link; function Get_Link (Id : Entity_Id) return Entity_Id is begin pragma Assert (Id in Entity_Table.First .. Entity_Table.Last); return Entity_Table.Table (Id).Links (Link_Used); end Get_Link; begin Nb_Allocated_Links := Nb_Allocated_Links + 1; end Static_Link; ------------------- -- Set_Element -- ------------------- procedure Set_Element (Id : Entity_Id; Element : Asis.Element) is begin Entity_Table.Table (Id).Element := Element; end Set_Element; ------------------- -- Get_Element -- ------------------- function Get_Element (Entity : Entity_Id) return Asis.Element is begin return Entity_Table.Table (Entity).Element; end Get_Element; ---------------- -- Set_Name -- ---------------- procedure Set_Name (Id : Entity_Id; Name : Access_Wide_String) is begin Entity_Table.Table (Id).Name := Name; end Set_Name; ---------------- -- Get_Name -- ---------------- function Get_Name (Entity : Entity_Id) return Access_Wide_String is begin return Entity_Table.Table (Entity).Name; end Get_Name; ---------------- -- Get_Name -- ---------------- function Get_Name (Entity : Entity_Id) return Wide_String is begin return Get_Name (Entity).all; end Get_Name; -------------------- -- Mastery flag -- -------------------- package Mastery_Flag is new Boolean_Flag; procedure Note_Mastery (Id : Entity_Id; Used : Boolean := True) renames Mastery_Flag.Set_Flag; function Is_A_Master (Entity : Entity_Id) return Boolean renames Mastery_Flag.Get_Flag; --------------------- -- Instance flag -- --------------------- package Instance_Flag is new Boolean_Flag; procedure Note_Instance (Id : Entity_Id; Used : Boolean := True) renames Instance_Flag.Set_Flag; function Is_An_Instance (Entity : Entity_Id) return Boolean renames Instance_Flag.Get_Flag; ----------------- -- Used flag -- ----------------- package Used_Flag is new Boolean_Flag; procedure Note_Use (Id : Entity_Id; Used : Boolean := True) renames Used_Flag.Set_Flag; function Is_Used (Entity : Entity_Id) return Boolean renames Used_Flag.Get_Flag; --------------------- -- Analyzed flag -- --------------------- package Analyzed_Flag is new Boolean_Flag; procedure Note_Analysis (Id : Entity_Id; Used : Boolean := True) renames Analyzed_Flag.Set_Flag; function Is_Analyzed (Id : Entity_Id) return Boolean renames Analyzed_Flag.Get_Flag; --------------------- -- Instance link -- --------------------- package Instance_Link is new Static_Link; procedure Set_Instance (Id : Entity_Id; Instance : Entity_Id) renames Instance_Link.Set_Link; function Get_Instance (Entity : Entity_Id) return Entity_Id renames Instance_Link.Get_Link; ------------------ -- Scope link -- ------------------ package Scope_Link is new Static_Link; procedure Set_Scope (Id : Entity_Id; Scope : Entity_Id) renames Scope_Link.Set_Link; function Get_Scope (Entity : Entity_Id) return Entity_Id renames Scope_Link.Get_Link; -------------------- -- Homonym link -- -------------------- package Homonym_Link is new Static_Link; procedure Set_Homonym (Id : Entity_Id; Homonym : Entity_Id) renames Homonym_Link.Set_Link; function Next_Homonym (Entity : Entity_Id) return Entity_Id renames Homonym_Link.Get_Link; function First_Homonym (Name : Wide_String; Scope : Entity_Id) return Entity_Id; -- Returns the first Entity in Scope named Name. -------------------------------- -- Hash Tables declarations -- -------------------------------- type Hash_Range1 is range 0 .. 2**16 - 1; -- Used to index the Entity_Information in hash-tables. -- A given Entity is uniquely denoted by an Element + an Instance. type Key1 is record Element : Asis.Element; Instance : Entity_Id; end record; function Get_Key (Entity : Entity_Id) return Key1; function Is_Equal (K1, K2 : Key1) return Boolean; function Hash (K : Key1) return Hash_Range1; package Link1 is new Static_Link; package Entity_HTable1 is new GNAT.HTable.Static_HTable (Header_Num => Hash_Range1, Element => Entity, Elmt_Ptr => Entity_Id, Null_Ptr => No_Entity, Set_Next => Link1.Set_Link, Next => Link1.Get_Link, Key => Key1, Get_Key => Get_Key, Hash => Hash, Equal => Is_Equal); type Hash_Range2 is range 0 .. 2**8 - 2; -- Used to index the Entity_Information in hash-tables. -- IMPORTANT: the range must not be wider than 255, -- otherwise instances of GNAT.HTable.Hash do not work ! -- This is clearly an hidden requirement (fixed in 3.11) -- A set of homonyms is uniquely denoted by a Name + a Scope. type Key2 is record Name : Access_Wide_String; Scope : Entity_Id; end record; function Get_Key (Entity : Entity_Id) return Key2; function Is_Equal (K1, K2 : Key2) return Boolean; function Hash (K : Key2) return Hash_Range2; package Link2 is new Static_Link; package Entity_HTable2 is new GNAT.HTable.Static_HTable (Header_Num => Hash_Range2, Element => Entity, Elmt_Ptr => Entity_Id, Null_Ptr => No_Entity, Set_Next => Link2.Set_Link, Next => Link2.Get_Link, Key => Key2, Get_Key => Get_Key, Hash => Hash, Equal => Is_Equal); --------------- -- Get_Key -- --------------- function Get_Key (Entity : Entity_Id) return Key1 is begin return Key1 '(Element => Get_Element (Entity), Instance => Get_Instance (Entity)); end Get_Key; ---------------- -- Is_Equal -- ---------------- function Is_Equal (K1, K2 : Key1) return Boolean is begin return K1.Instance = K2.Instance and then Asis.Elements.Is_Identical (K1.Element, K2.Element); end Is_Equal; ------------ -- Hash -- ------------ function Hash (K : Key1) return Hash_Range1 is function To_Unsigned_32 is new Ada.Unchecked_Conversion (Source => Asis.ASIS_Integer, Target => Unsigned_32); function To_ASIS_Integer is new Ada.Unchecked_Conversion (Source => Unsigned_32, Target => Asis.ASIS_Integer); ASIS_Hash : Asis.ASIS_Integer; Unsigned_32_Hash : Unsigned_32; begin ASIS_Hash := Asis.Elements.Hash (K.Element); Unsigned_32_Hash := To_Unsigned_32 (ASIS_Hash); Unsigned_32_Hash := Unsigned_32_Hash xor Rotate_Right (Unsigned_32_Hash, 16); ASIS_Hash := To_ASIS_Integer (Unsigned_32_Hash); return Hash_Range1 (ASIS_Hash mod Positive (Hash_Range1'Last - Hash_Range1'First + 1) + Integer (Hash_Range1'First)); end Hash; --------------- -- Get_Key -- --------------- function Get_Key (Entity : Entity_Id) return Key2 is begin return Key2 '(Name => Get_Name (Entity), Scope => Get_Scope (Entity)); end Get_Key; ---------------- -- Is_Equal -- ---------------- function Is_Equal (K1, K2 : Key2) return Boolean is N1 : Wide_String := K1.Name.all; N2 : Wide_String := K2.Name.all; begin return K1.Scope = K2.Scope -- and then K1.Name.all = K2.Name.all; and then N1 = N2; end Is_Equal; ------------ -- Hash -- ------------ function Hash is new GNAT.HTable.Hash (Hash_Range2); -- A generic hashing function working on String keys. -- Hash_Range2 must not be wider than 255 (GNAT.HTable bug) ! function Hash (K : Key2) return Hash_Range2 is begin return Hash (To_String (K.Name.all)); end Hash; ------------------------ -- Entities_Used_By -- ------------------------ function Entities_Used_By (Id : Entity_Id) return Entity_Id_List is begin List_Of_Used_Entities.Restore (Entity_Table.Table (Id).Used_Entities); declare Results : Entity_Id_List := Entity_Id_List (List_Of_Used_Entities.Table (List_Of_Used_Entities.First .. List_Of_Used_Entities.Last)); begin Entity_Table.Table (Id).Used_Entities := List_Of_Used_Entities.Save; return Results; end; end Entities_Used_By; ---------------------------------- -- Perform_Transitive_Closure -- ---------------------------------- procedure Perform_Transitive_Closure (Id : Entity_Id) is begin if not Is_Analyzed (Id) then Note_Analysis (Id); declare Used_Entities : Entity_Id_List := Entities_Used_By (Id); begin for E in Used_Entities'Range loop Note_Use (Used_Entities (E)); Perform_Transitive_Closure (Used_Entities (E)); end loop; end; -- Since we can't yet distinguish between homonyms, -- we also mark all its homonyms as used. declare Homonym : Entity_Id := First_Homonym (Id); begin while Present (Homonym) loop Note_Use (Homonym); Perform_Transitive_Closure (Homonym); Homonym := Next_Homonym (Homonym); end loop; end; end if; end Perform_Transitive_Closure; ------------------------------------- -- Corresponding_Name_Definition -- ------------------------------------- function Corresponding_Name_Definition (Name : Asis.Element) return Asis.Defining_Name is Tmp_Name : Asis.Expression; Defining_Name : Asis.Defining_Name; begin case Element_Kind (Name) is when An_Expression => Tmp_Name := Name; Unwind_Selection : loop case Expression_Kind (Tmp_Name) is when A_Selected_Component => Tmp_Name := Asis.Expressions.Selector (Tmp_Name); when An_Identifier | An_Operator_Symbol => exit Unwind_Selection; when others => return Asis.Nil_Element; end case; end loop Unwind_Selection; begin Defining_Name := Asis.Expressions.Corresponding_Name_Definition (Tmp_Name); -- This query may return Nil_Element for reference -- to implicit entities (eg. inherited/instance.) -- It may also raise Asis_Inappropriate_Element, -- if the Tmp_Name does not denote a declaration -- as it happens for certain pragma arguments. exception when ASIS_Inappropriate_Element => Defining_Name := Nil_Element; end; if Is_Nil (Defining_Name) then Warning ("Corresponding_Name_Definition not found !!!"); return Asis.Nil_Element; elsif Is_Part_Of_Implicit (Defining_Name) then return Asis.Nil_Element; else return Defining_Name; end if; when A_Defining_Name => return Name; when others => return Asis.Nil_Element; end case; end Corresponding_Name_Definition; ---------- -- No -- ---------- function No (Entity : Entity_Id) return Boolean is begin return Entity = No_Entity; end No; --------------- -- Present -- --------------- function Present (Entity : Entity_Id) return Boolean is begin return Entity /= No_Entity; end Present; ------------------ -- New_Entity -- ------------------ function New_Entity (Element : Asis.Element; Instance : Entity_Id; Name : Wide_String; Scope : Entity_Id) return Entity_Id is Element_Declaration : Asis.Declaration; New_Entity_Id : Entity_Id; Homonym : Entity_Id; begin if Present (Entity_HTable1.Get (Key1 '(Element => Element, Instance => Instance))) then raise Already_Registered; end if; if Element_Kind (Element) = A_Defining_Name then Element_Declaration := Enclosing_Element (Element); else Element_Declaration := Asis.Nil_Element; end if; -- Register the entity in the entity table. Entity_Table.Increment_Last; New_Entity_Id := Entity_Table.Last; List_Of_Used_Entities.Init; Entity_Table.Table (New_Entity_Id).Used_Entities := List_Of_Used_Entities.Save; Set_Element (New_Entity_Id, Element); Set_Instance (New_Entity_Id, Instance); Set_Scope (New_Entity_Id, Scope); Link1.Set_Link (New_Entity_Id, No_Entity); Link2.Set_Link (New_Entity_Id, No_Entity); case Declaration_Kind (Element_Declaration) is when A_Procedure_Declaration | A_Procedure_Body_Declaration | A_Procedure_Body_Stub | A_Procedure_Instantiation | A_Function_Declaration | A_Function_Body_Declaration | A_Function_Body_Stub | A_Function_Instantiation => Note_Mastery (New_Entity_Id, True); when others => Note_Mastery (New_Entity_Id, False); end case; Note_Instance (New_Entity_Id, Declaration_Kind (Element_Declaration) in A_Generic_Instantiation); Note_Use (New_Entity_Id, False); Note_Analysis (New_Entity_Id, False); -- Management of names for overloaded subprograms. Homonym := First_Homonym (Name, Scope); if No (Homonym) then -- We allocate a new Wide_String for this name, -- and register it in the homonym-hash-table. Set_Name (New_Entity_Id, new Wide_String '(Name)); Set_Homonym (New_Entity_Id, No_Entity); Entity_HTable2.Set (New_Entity_Id); else -- We reuse the same access string as for the first homonym, -- and then hook the new entity to the homonym list. if Name /= Get_Name (Homonym) then Error ("gnatelim: pb with homonym management: " & Name & "/=" & Get_Name (Homonym) & " ."); end if; Set_Name (New_Entity_Id, Get_Name (Homonym)); Set_Homonym (New_Entity_Id, Next_Homonym (Homonym)); Set_Homonym (Homonym, New_Entity_Id); end if; -- Finally, register the new entity in the hash table. Entity_HTable1.Set (New_Entity_Id); return New_Entity_Id; end New_Entity; --------------------------------- -- Corresponding_Declaration -- --------------------------------- function Corresponding_Declaration (Entity : Entity_Id) return Asis.Declaration is Element : Asis.Element; begin Element := Get_Element (Entity); if Element_Kind (Element) = A_Defining_Name then return Enclosing_Element (Element); else return Asis.Nil_Element; end if; end Corresponding_Declaration; --------------------- -- First_Homonym -- --------------------- function First_Homonym (Name : Wide_String; Scope : Entity_Id) return Entity_Id is New_Name : aliased Wide_String := Name; begin return Entity_HTable2.Get (Key2 '(Name => New_Name'Unchecked_Access, Scope => Scope)); -- Unchecked access is safe since no reference is kept by Get. end First_Homonym; function First_Homonym (Entity : Entity_Id) return Entity_Id is begin return Entity_HTable2.Get (Key2 '(Name => Get_Name (Entity), Scope => Get_Scope (Entity))); end First_Homonym; ---------------------------- -- Corresponding_Entity -- ---------------------------- function Corresponding_Entity (Element : Asis.Element; Instance : Entity_Id) return Entity_Id is Entity : Entity_Id; begin if Element_Kind (Element) = An_Expression then return Corresponding_Entity (Element => GNATELIM.Entities.Corresponding_Name_Definition (Element), Instance => Instance); elsif Element_Kind (Element) = A_Declaration then if Is_Part_Of_Inherited (Element) then -- We have an implicitly inherited subprogram declaration. -- The only thing we can do with the current ASIS-for-GNAT -- is to go back to the explicit declaration. -- Anyway, getting the explicit is the right thing to do, -- since there is no specific body in the object file -- for inherited subprograms; they share the explicit body. return Corresponding_Entity (Element => Asis.Declarations.Corresponding_Declaration (Element), Instance => Instance); elsif Declaration_Kind (Element) in A_Procedure_Instantiation .. A_Function_Instantiation then -- We have an instantiation of a subprogram declaration. -- We must go to the instantiated declaration. return Corresponding_Entity (Element => Asis.Declarations.Corresponding_Declaration (Element), Instance => Instance); else -- Asis.Declarations.Names fails on inherited declarations. return Corresponding_Entity ( Element => Asis.Declarations.Names (Element) (1), Instance => Instance); end if; elsif Element_Kind (Element) /= A_Defining_Name then -- There's nothing we can do. return No_Entity; -- From now on, we can safely assume we have A_Defining_Name. elsif Is_Part_Of_Inherited (Element) then -- We have an implicitly inherited subprogram defining_name. -- Let's go back to the explicit declaration. -- Going back to explicit is only possible on _declarations_ -- not on defining_names. Enclosing_Element must be used. return Corresponding_Entity (Element => Asis.Declarations.Corresponding_Declaration (Enclosing_Element (Element)), Instance => Instance); else -- Here we have an explicit (ie. traversable) defining name, -- with the corresponding enclosing instance. Entity := Entity_HTable1.Get (Key1 '(Element => Element, Instance => Instance)); if Present (Entity) then -- The Entity is in the current scope. return Entity; elsif No (Instance) then -- The Entity was not found in the current Instance, -- and the current Instance is not part of instance. -- Nothing else can be done. return No_Entity; else -- The Entity is not defined in the current Instance. -- Let's look in the instance containing the template. declare -- Here we rely on the Template being the first -- entity used by the instance. -- This is dirty: to be encapsulated. Used_By_Instance : Entity_Id_List := Entities_Used_By (Instance); Template : Entity_Id; begin if Used_By_Instance'Length > 0 then Template := Used_By_Instance (Used_By_Instance'First); return Corresponding_Entity (Element => Element, Instance => Get_Instance (Template)); else return No_Entity; end if; end; end if; end if; end Corresponding_Entity; ---------------------- -- Renamed_Entity -- ---------------------- function Renamed_Entity (Renaming : Entity_Id) return Entity_Id is begin return Corresponding_Entity (Element => Asis.Declarations.Renamed_Entity (Corresponding_Declaration (Renaming)), Instance => Get_Instance (Renaming)); end Renamed_Entity; ------------------------ -- Unwind_Renamings -- ------------------------ function Unwind_Renamings (Entity : Entity_Id) return Entity_Id is Renamed : Entity_Id := Entity; begin while Declaration_Kind (Corresponding_Declaration (Renamed)) in A_Renaming_Declaration loop Renamed := Renamed_Entity (Renamed); end loop; return Renamed; end Unwind_Renamings; ---------------- -- Note_Use -- ---------------- procedure Note_Use (Entity : Entity_Id; Used_By : Entity_Id) is begin if No (Entity) then -- A No_Entity. Ignored. (???) null; elsif No (Used_By) then -- Either we could not determine the Master, -- or we want to force an inconditional use. -- In both case, we mark the Entity as used. Note_Use (Entity); else pragma Assert (Used_By in Entity_Table.First .. Entity_Table.Last); List_Of_Used_Entities.Restore (Entity_Table.Table (Used_By).Used_Entities); List_Of_Used_Entities.Increment_Last; List_Of_Used_Entities.Table (List_Of_Used_Entities.Last) := Entity; Entity_Table.Table (Used_By).Used_Entities := List_Of_Used_Entities.Save; end if; end Note_Use; ---------------------------------- -- Perform_Transitive_Closure -- ---------------------------------- procedure Perform_Transitive_Closure is begin for Id in Entity_Table.First .. Entity_Table.Last loop if Is_Used (Id) then Perform_Transitive_Closure (Id); end if; end loop; end Perform_Transitive_Closure; --------------- -- Iterate -- --------------- procedure Iterate is Continue : Boolean := True; begin for Id in Entity_Id range Entity_Table.First .. Entity_Table.Last loop Action (Id, Continue); exit when not Continue; end loop; end Iterate; begin -- Register the No_Entity in the entity table. Entity_Table.Increment_Last; List_Of_Used_Entities.Init; Entity_Table.Table (No_Entity).Used_Entities := List_Of_Used_Entities.Save; Set_Element (No_Entity, Asis.Nil_Element); Set_Instance (No_Entity, No_Entity); Set_Scope (No_Entity, No_Entity); Set_Name (No_Entity, new Wide_String '("")); Set_Homonym (No_Entity, No_Entity); Link1.Set_Link (No_Entity, No_Entity); Link2.Set_Link (No_Entity, No_Entity); Note_Mastery (No_Entity, True); -- Environment task. Note_Instance (No_Entity, True); Note_Use (No_Entity, False); Note_Analysis (No_Entity, False); Entity_HTable1.Reset; Entity_HTable2.Reset; -- VERY important when actual for Elmt_Ptr is not an access type ! end GNATELIM.Entities;