1package body Opt57 is
2
3   type Phase_Enum is (None_Phase, FE_Init_Phase, FE_Phase);
4
5   type Message_State is (No_Messages, Some_Messages);
6
7   type Module_List_Array is array (Phase_Enum, Message_State) of List;
8
9   type Private_Module_Factory is limited record
10      Module_Lists : Module_List_Array;
11   end record;
12
13   type Element_Array is array (Positive range <>) of Module_Factory_Ptr;
14
15   type Hash_Table is array (Positive range <>) of aliased Module_Factory_Ptr;
16
17   type Heap_Data_Rec (Table_Last : Positive) is limited record
18      Number_Of_Elements : Positive;
19      Table              : Hash_Table (1 .. Table_Last);
20   end record;
21
22   type Heap_Data_Ptr is access Heap_Data_Rec;
23
24   type Table is limited record
25      Data : Heap_Data_Ptr;
26   end record;
27
28   function All_Elements (M : Table) return Element_Array is
29      Result : Element_Array (1 .. Natural (M.Data.Number_Of_Elements));
30      Last   : Natural := 0;
31   begin
32      for H in M.Data.Table'Range loop
33         Last := Last + 1;
34         Result (Last) := M.Data.Table(H);
35      end loop;
36      return Result;
37   end;
38
39   The_Factories : Table;
40
41   subtype Language_Array is Element_Array;
42   type Language_Array_Ptr is access Language_Array;
43   All_Languages : Language_Array_Ptr := null;
44
45   procedure Init is
46   begin
47      if All_Languages = null then
48         All_Languages := new Language_Array'(All_Elements (The_Factories));
49      end if;
50   end;
51
52   function Is_Empty (L : List) return Boolean is
53   begin
54      return Link_Constant (L.Next) = L'Unchecked_Access;
55   end;
56
57   function First (L : List) return Linkable_Ptr is
58   begin
59      return Links_Type (L.Next.all).Container.all'Access;
60   end;
61
62   procedure Update is
63      Check_New_Dependences : Boolean := False;
64   begin
65      loop
66         for Lang_Index in All_Languages'Range loop
67            for Has_Messages in Message_State loop
68               declare
69                  L : List renames
70                    All_Languages (Lang_Index).Priv.Module_Lists
71                      (FE_Init_Phase, Has_Messages);
72               begin
73                  while not Is_Empty (L) loop
74                     declare
75                        Module_In_Init_State : constant Module_Ptr :=
76                          Module_Ptr (First (L));
77                        Pin_Dependence : Pinned (Module_In_Init_State);
78                     begin
79                        Check_New_Dependences := True;
80                     end;
81                  end loop;
82               end;
83            end loop;
84         end loop;
85         exit when not Check_New_Dependences;
86      end loop;
87   end;
88
89end Opt57;
90