From: Arnaud Charlet Date: Wed, 29 Jan 2014 15:27:54 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=0830210cffd9a14a5cebcb637b23db9606ad2aba;p=gcc.git [multiple changes] 2014-01-29 Emmanuel Briot * s-regexp.adb (Create_Secondary_Table): Automatically grow the state machine as needed. (Dump): New subprogram. 2014-01-29 Tristan Gingold * exp_ch9.adb (Expand_N_Protected_Type_Declaration): Add Expand_Entry_Declaration to factorize code. From-SVN: r207250 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f79ca89b129..126caade912 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2014-01-29 Emmanuel Briot + + * s-regexp.adb (Create_Secondary_Table): Automatically grow the state + machine as needed. + (Dump): New subprogram. + +2014-01-29 Tristan Gingold + + * exp_ch9.adb (Expand_N_Protected_Type_Declaration): Add + Expand_Entry_Declaration to factorize code. + 2014-01-29 Ed Schonberg * checks.adb: minor clarification. diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 7c570a84a02..04277ec04d1 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -8795,8 +8795,6 @@ package body Exp_Ch9 is Comp_Id : Entity_Id; Sub : Node_Id; Current_Node : Node_Id := N; - Bdef : Entity_Id := Empty; -- avoid uninit warning - Edef : Entity_Id := Empty; -- avoid uninit warning Entries_Aggr : Node_Id; Body_Id : Entity_Id; Body_Arr : Node_Id; @@ -8808,6 +8806,10 @@ package body Exp_Ch9 is -- to the internal body, for possible inlining later on. The source -- operation is invisible to the back-end and is never actually called. + procedure Expand_Entry_Declaration (Comp : Entity_Id); + -- Create the subprograms for the barrier and for the body, and append + -- then to Entry_Bodies_Array. + function Static_Component_Size (Comp : Entity_Id) return Boolean; -- When compiling under the Ravenscar profile, private components must -- have a static size, or else a protected object will require heap @@ -8865,6 +8867,67 @@ package body Exp_Ch9 is end if; end Static_Component_Size; + ------------------------------ + -- Expand_Entry_Declaration -- + ------------------------------ + + procedure Expand_Entry_Declaration (Comp : Entity_Id) is + Bdef : Entity_Id; + Edef : Entity_Id; + begin + E_Count := E_Count + 1; + Comp_Id := Defining_Identifier (Comp); + + Edef := + Make_Defining_Identifier (Loc, + Build_Selected_Name (Prot_Typ, Comp_Id, 'E')); + Sub := + Make_Subprogram_Declaration (Loc, + Specification => + Build_Protected_Entry_Specification (Loc, Edef, Comp_Id)); + + Insert_After (Current_Node, Sub); + Analyze (Sub); + + -- Build wrapper procedure for pre/postconditions + + Build_PPC_Wrapper (Comp_Id, N); + + Set_Protected_Body_Subprogram + (Defining_Identifier (Comp), + Defining_Unit_Name (Specification (Sub))); + + Current_Node := Sub; + + Bdef := + Make_Defining_Identifier (Loc, + Chars => Build_Selected_Name (Prot_Typ, Comp_Id, 'B')); + Sub := + Make_Subprogram_Declaration (Loc, + Specification => + Build_Barrier_Function_Specification (Loc, Bdef)); + + Insert_After (Current_Node, Sub); + Analyze (Sub); + Set_Protected_Body_Subprogram (Bdef, Bdef); + Set_Barrier_Function (Comp_Id, Bdef); + Set_Scope (Bdef, Scope (Comp_Id)); + Current_Node := Sub; + + -- Collect pointers to the protected subprogram and the barrier + -- of the current entry, for insertion into Entry_Bodies_Array. + + Append_To (Expressions (Entries_Aggr), + Make_Aggregate (Loc, + Expressions => New_List ( + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Bdef, Loc), + Attribute_Name => Name_Unrestricted_Access), + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Edef, Loc), + Attribute_Name => Name_Unrestricted_Access)))); + end Expand_Entry_Declaration; + ---------------------- -- Register_Handler -- ---------------------- @@ -9054,7 +9117,7 @@ package body Exp_Ch9 is end loop; end if; - -- Except for the lock-free implementation, prepend the _Object field + -- Except for the lock-free implementation, append the _Object field -- with the right type to the component list. We need to compute the -- number of entries, and in some cases the number of Attach_Handler -- pragmas. @@ -9258,57 +9321,9 @@ package body Exp_Ch9 is end if; elsif Nkind (Comp) = N_Entry_Declaration then - E_Count := E_Count + 1; - Comp_Id := Defining_Identifier (Comp); - Edef := - Make_Defining_Identifier (Loc, - Build_Selected_Name (Prot_Typ, Comp_Id, 'E')); - Sub := - Make_Subprogram_Declaration (Loc, - Specification => - Build_Protected_Entry_Specification (Loc, Edef, Comp_Id)); + Expand_Entry_Declaration (Comp); - Insert_After (Current_Node, Sub); - Analyze (Sub); - - -- Build wrapper procedure for pre/postconditions - - Build_PPC_Wrapper (Comp_Id, N); - - Set_Protected_Body_Subprogram - (Defining_Identifier (Comp), - Defining_Unit_Name (Specification (Sub))); - - Current_Node := Sub; - - Bdef := - Make_Defining_Identifier (Loc, - Chars => Build_Selected_Name (Prot_Typ, Comp_Id, 'B')); - Sub := - Make_Subprogram_Declaration (Loc, - Specification => - Build_Barrier_Function_Specification (Loc, Bdef)); - - Insert_After (Current_Node, Sub); - Analyze (Sub); - Set_Protected_Body_Subprogram (Bdef, Bdef); - Set_Barrier_Function (Comp_Id, Bdef); - Set_Scope (Bdef, Scope (Comp_Id)); - Current_Node := Sub; - - -- Collect pointers to the protected subprogram and the barrier - -- of the current entry, for insertion into Entry_Bodies_Array. - - Append_To (Expressions (Entries_Aggr), - Make_Aggregate (Loc, - Expressions => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Bdef, Loc), - Attribute_Name => Name_Unrestricted_Access), - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Edef, Loc), - Attribute_Name => Name_Unrestricted_Access)))); end if; Next (Comp); @@ -9321,54 +9336,7 @@ package body Exp_Ch9 is Comp := First (Private_Declarations (Pdef)); while Present (Comp) loop if Nkind (Comp) = N_Entry_Declaration then - E_Count := E_Count + 1; - Comp_Id := Defining_Identifier (Comp); - - Edef := - Make_Defining_Identifier (Loc, - Build_Selected_Name (Prot_Typ, Comp_Id, 'E')); - Sub := - Make_Subprogram_Declaration (Loc, - Specification => - Build_Protected_Entry_Specification (Loc, Edef, Comp_Id)); - - Insert_After (Current_Node, Sub); - Analyze (Sub); - - Set_Protected_Body_Subprogram - (Defining_Identifier (Comp), - Defining_Unit_Name (Specification (Sub))); - - Current_Node := Sub; - - Bdef := - Make_Defining_Identifier (Loc, - Chars => Build_Selected_Name (Prot_Typ, Comp_Id, 'E')); - - Sub := - Make_Subprogram_Declaration (Loc, - Specification => - Build_Barrier_Function_Specification (Loc, Bdef)); - - Insert_After (Current_Node, Sub); - Analyze (Sub); - Set_Protected_Body_Subprogram (Bdef, Bdef); - Set_Barrier_Function (Comp_Id, Bdef); - Set_Scope (Bdef, Scope (Comp_Id)); - Current_Node := Sub; - - -- Collect pointers to the protected subprogram and the barrier - -- of the current entry, for insertion into Entry_Bodies_Array. - - Append_To (Expressions (Entries_Aggr), - Make_Aggregate (Loc, - Expressions => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Bdef, Loc), - Attribute_Name => Name_Unrestricted_Access), - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Edef, Loc), - Attribute_Name => Name_Unrestricted_Access)))); + Expand_Entry_Declaration (Comp); end if; Next (Comp); @@ -9406,15 +9374,7 @@ package body Exp_Ch9 is Aliased_Present => True, Object_Definition => New_Reference_To (RTE (RE_Entry_Body), Loc), - Expression => - Make_Aggregate (Loc, - Expressions => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Bdef, Loc), - Attribute_Name => Name_Unrestricted_Access), - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Edef, Loc), - Attribute_Name => Name_Unrestricted_Access)))); + Expression => Remove_Head (Expressions (Entries_Aggr))); when others => raise Program_Error; diff --git a/gcc/ada/s-regexp.adb b/gcc/ada/s-regexp.adb index 56c38a8a5ee..fe720669ff7 100644 --- a/gcc/ada/s-regexp.adb +++ b/gcc/ada/s-regexp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2012, AdaCore -- +-- Copyright (C) 1999-2013, AdaCore -- -- -- -- 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- -- @@ -30,11 +30,19 @@ ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; +with Ada.Text_IO; use Ada.Text_IO; with System.Case_Util; package body System.Regexp is + Initial_Max_States_In_Primary_Table : constant := 100; + -- Initial size for the number of states in the indefinite state + -- machine. The number of states will be increased as needed. + -- + -- This is also used as the maximal number of meta states (groups of + -- states) in the secondary table. + Open_Paren : constant Character := '('; Close_Paren : constant Character := ')'; Open_Bracket : constant Character := '['; @@ -69,6 +77,56 @@ package body System.Regexp is end record; -- Deterministic finite-state machine + procedure Dump + (Table : Regexp_Array_Access; + Map : Mapping; + Alphabet_Size : Column_Index; + Num_States : State_Index; + Start_State : State_Index; + End_State : State_Index); + -- Display the state machine (indeterministic, from the first pass) on + -- stdout. + + ---------- + -- Dump -- + ---------- + + procedure Dump + (Table : Regexp_Array_Access; + Map : Mapping; + Alphabet_Size : Column_Index; + Num_States : State_Index; + Start_State : State_Index; + End_State : State_Index) + is + Empty_Char : constant Column_Index := Alphabet_Size + 1; + Col : Column_Index; + begin + for S in Table'First (1) .. Num_States loop + if S = Start_State then + Put ("Start" & S'Img & " => "); + elsif S = End_State then + Put ("End " & S'Img); + else + Put ("State" & S'Img & " => "); + end if; + + for C in Map'Range loop + Col := Map (C); + if Table (S, Col) /= 0 then + Put (Table (S, Col)'Img & "(" & C'Img & ")"); + end if; + end loop; + + for Col in Empty_Char .. Table'Last (2) loop + exit when Table (S, Col) = 0; + Put (Table (S, Col)'Img & " (empty)"); + end loop; + + New_Line; + end loop; + end Dump; + ----------------------- -- Local Subprograms -- ----------------------- @@ -1373,52 +1431,104 @@ package body System.Regexp is Start_State : State_Index; End_State : State_Index) return Regexp is - pragma Warnings (Off, Num_States); - Last_Index : constant State_Index := First_Table'Last (1); - type Meta_State is array (1 .. Last_Index) of Boolean; - - Table : Regexp_Array (1 .. Last_Index, 0 .. Alphabet_Size) := - (others => (others => 0)); - Meta_States : array (1 .. Last_Index + 1) of Meta_State := - (others => (others => False)); + type Meta_State is array (0 .. Last_Index) of Boolean; + pragma Pack (Meta_State); + -- Whether a state from first_table belongs to a metastate. + + No_States : constant Meta_State := (others => False); + + type Meta_States_Array is array (State_Index range <>) of Meta_State; + type Meta_States_List is access all Meta_States_Array; + procedure Unchecked_Free is new Ada.Unchecked_Deallocation + (Meta_States_Array, Meta_States_List); + Meta_States : Meta_States_List; + -- Components of meta-states. A given state might belong to + -- several meta-states. + -- This array grows dynamically. + + type Char_To_State is array (0 .. Alphabet_Size) of State_Index; + type Meta_States_Transition_Arr is + array (State_Index range <>) of Char_To_State; + type Meta_States_Transition is access all Meta_States_Transition_Arr; + procedure Unchecked_Free is new Ada.Unchecked_Deallocation + (Meta_States_Transition_Arr, Meta_States_Transition); + Table : Meta_States_Transition; + -- Documents the transitions between each meta-state. The + -- first index is the meta-state, the second column is the + -- character seen in the input, the value is the new meta-state. Temp_State_Not_Null : Boolean; - Is_Final : Boolean_Array (1 .. Last_Index) := (others => False); - Current_State : State_Index := 1; + -- The current meta-state we are creating + Nb_State : State_Index := 1; + -- The total number of meta-states created so far. procedure Closure - (State : in out Meta_State; - Item : State_Index); + (Meta_State : State_Index; + State : State_Index); -- Compute the closure of the state (that is every other state which -- has a empty-character transition) and add it to the state + procedure Ensure_Meta_State (Meta : State_Index); + -- grows the Meta_States array as needed to make sure that there + -- is enough space to store the new meta state. + + ----------------------- + -- Ensure_Meta_State -- + ----------------------- + + procedure Ensure_Meta_State (Meta : State_Index) is + Tmp : Meta_States_List := Meta_States; + Tmp2 : Meta_States_Transition := Table; + begin + if Meta_States = null then + Meta_States := new Meta_States_Array + (1 .. State_Index'Max (Last_Index, Meta) + 1); + Meta_States (Meta_States'Range) := (others => No_States); + + Table := new Meta_States_Transition_Arr + (1 .. State_Index'Max (Last_Index, Meta) + 1); + Table.all := (others => (others => 0)); + + elsif Meta > Meta_States'Last then + Meta_States := new Meta_States_Array + (1 .. State_Index'Max (2 * Tmp'Last, Meta)); + Meta_States (Tmp'Range) := Tmp.all; + Meta_States (Tmp'Last + 1 .. Meta_States'Last) := + (others => No_States); + Unchecked_Free (Tmp); + + Table := new Meta_States_Transition_Arr + (1 .. State_Index'Max (2 * Tmp2'Last, Meta) + 1); + Table (Tmp2'Range) := Tmp2.all; + Table (Tmp2'Last + 1 .. Table'Last) := + (others => (others => 0)); + Unchecked_Free (Tmp2); + end if; + end Ensure_Meta_State; + ------------- -- Closure -- ------------- procedure Closure - (State : in out Meta_State; - Item : State_Index) - is + (Meta_State : State_Index; + State : State_Index) is begin - if State (Item) then - return; - end if; - - State (Item) := True; + if not Meta_States (Meta_State)(State) then + Meta_States (Meta_State)(State) := True; - for Column in Alphabet_Size + 1 .. First_Table'Last (2) loop - if First_Table (Item, Column) = 0 then - return; - end if; + -- For each transition on empty-character - Closure (State, First_Table (Item, Column)); - end loop; + for Column in Alphabet_Size + 1 .. First_Table'Last (2) loop + exit when First_Table (State, Column) = 0; + Closure (Meta_State, First_Table (State, Column)); + end loop; + end if; end Closure; -- Start of processing for Create_Secondary_Table @@ -1426,30 +1536,29 @@ package body System.Regexp is begin -- Create a new state - Closure (Meta_States (Current_State), Start_State); - - while Current_State <= Nb_State loop + Ensure_Meta_State (Current_State); + Closure (Current_State, Start_State); - -- If this new meta-state includes the primary table end state, - -- then this meta-state will be a final state in the regexp + if False then + Dump (First_Table, Map, Alphabet_Size, Num_States, + Start_State, End_State); + end if; - if Meta_States (Current_State)(End_State) then - Is_Final (Current_State) := True; - end if; + while Current_State <= Nb_State loop + -- We will be trying, below, to create the next meta-state + Ensure_Meta_State (Nb_State + 1); -- For every character in the regexp, calculate the possible -- transitions from Current_State for Column in 0 .. Alphabet_Size loop - Meta_States (Nb_State + 1) := (others => False); Temp_State_Not_Null := False; for K in Meta_States (Current_State)'Range loop if Meta_States (Current_State)(K) and then First_Table (K, Column) /= 0 then - Closure - (Meta_States (Nb_State + 1), First_Table (K, Column)); + Closure (Nb_State + 1, First_Table (K, Column)); Temp_State_Not_Null := True; end if; end loop; @@ -1462,16 +1571,20 @@ package body System.Regexp is for K in 1 .. Nb_State loop if Meta_States (K) = Meta_States (Nb_State + 1) then - Table (Current_State, Column) := K; + Table (Current_State)(Column) := K; + + -- reset data, for the next time we try that state + Meta_States (Nb_State + 1) := No_States; exit; end if; end loop; -- If not, create a new state - if Table (Current_State, Column) = 0 then + if Table (Current_State)(Column) = 0 then Nb_State := Nb_State + 1; - Table (Current_State, Column) := Nb_State; + Ensure_Meta_State (Nb_State + 1); + Table (Current_State)(Column) := Nb_State; end if; end if; end loop; @@ -1488,15 +1601,21 @@ package body System.Regexp is R := new Regexp_Value (Alphabet_Size => Alphabet_Size, Num_States => Nb_State); R.Map := Map; - R.Is_Final := Is_Final (1 .. Nb_State); R.Case_Sensitive := Case_Sensitive; + for S in 1 .. Nb_State loop + R.Is_Final (S) := Meta_States (S)(End_State); + end loop; + for State in 1 .. Nb_State loop for K in 0 .. Alphabet_Size loop - R.States (State, K) := Table (State, K); + R.States (State, K) := Table (State)(K); end loop; end loop; + Unchecked_Free (Meta_States); + Unchecked_Free (Table); + return (Ada.Finalization.Controlled with R => R); end; end Create_Secondary_Table; @@ -1546,7 +1665,7 @@ package body System.Regexp is R : Regexp; begin - Table := new Regexp_Array (1 .. 100, + Table := new Regexp_Array (1 .. Initial_Max_States_In_Primary_Table, 0 .. Alphabet_Size + 10); if not Glob then Create_Primary_Table (Table, Num_States, Start_State, End_State); @@ -1558,7 +1677,7 @@ package body System.Regexp is -- Creates the secondary table R := Create_Secondary_Table - (Table, Num_States, Start_State, End_State); + (Table, Num_States, Start_State, End_State); Free (Table); return R; end;