* Other Optimization Switches::
* Optimization and Strict Aliasing::
* Aliased Variables and Optimization::
+* Atomic Variables and Optimization::
* Passive Task Optimization::
@ifset vms
This means that the above example will in fact "work" reliably,
that is, it will produce the expected results.
+@node Atomic Variables and Optimization
+@subsection Atomic Variables and Optimization
+@cindex Atomic
+There are two considerations with regard to performance when
+atomic variables are used.
+
+First, the RM only guarantees that access to atomic variables
+be atomic, it has nothing to say about how this is achieved,
+though there is a strong implication that this should not be
+achieved by explicit locking code. Indeed GNAT will never
+generate any locking code for atomic variable access (it will
+simply reject any attempt to make a variable or type atomic
+if the atomic access cannot be achieved without such locking code).
+
+That being said, it is important to understand that you cannot
+assume that the entire variable will always be accessed. Consider
+this example:
+
+@smallexample @c ada
+type R is record
+ A,B,C,D : Character;
+end record;
+for R'Size use 32;
+for R'Alignment use 4;
+
+RV : R;
+pragma Atomic (RV);
+X : Character;
+...
+X := RV.B;
+@end smallexample
+
+@noindent
+You cannot assume that the reference to @code{RV.B}
+will read the entire 32-bit
+variable with a single load instruction. It is perfectly legitimate if
+the hardware allows it to do a byte read of just the B field. This read
+is still atomic, which is all the RM requires. GNAT can and does take
+advantage of this, depending on the architecture and optimization level.
+Any assumption to the contrary is non-portable and risky. Even if you
+examine the assembly language and see a full 32-bit load, this might
+change in a future version of the compiler.
+
+If your application requires that all accesses to @code{RV} in this
+example be full 32-bit loads, you need to make a copy for the access
+as in:
+
+@smallexample @c ada
+declare
+ RV_Copy : constant R := RV;
+begin
+ X := RV_Copy.B;
+end;
+@end smallexample
+
+
+@noindent
+Now the reference to RV must read the whole variable.
+Actually one can imagine some compiler which figures
+out that the whole copy is not required (because only
+the B field is actually accessed), but GNAT
+certainly won't do that, and we don't know of any
+compiler that would not handle this right, and the
+above code will in practice work portably across
+all architectures (that permit the Atomic declaration).
+
+The second issue with atomic variables has to do with
+the possible requirement of generating synchronization
+code. For more details on this, consult the sections on
+the pragmas Enable/Disable_Atomic_Synchronization in the
+GNAT Reference Manual. If performance is critical, and
+such synchronization code is not required, it may be
+useful to disable it.
+
@node Passive Task Optimization
@subsection Passive Task Optimization
@cindex Passive Task
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
-with Ada.Text_IO; use Ada.Text_IO;
-
with System.Case_Util;
package body System.Regexp is
type Regexp_Array is array
(State_Index range <>, Column_Index range <>) of State_Index;
- -- First index is for the state number
- -- Second index is for the character type
- -- Contents is the new State
+ -- First index is for the state number. Second index is for the character
+ -- type. Contents is the new State.
type Regexp_Array_Access is access Regexp_Array;
- -- Use this type through the functions Set below, so that it
- -- can grow dynamically depending on the needs.
+ -- Use this type through the functions Set below, so that it can grow
+ -- dynamically depending on the needs.
type Mapping is array (Character'Range) of Column_Index;
-- Mapping between characters and column in the Regexp_Array
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 --
-----------------------
function Get
(Table : Regexp_Array_Access;
State : State_Index;
- Column : Column_Index)
- return State_Index;
- -- Returns the value in the table at (State, Column).
- -- If this index does not exist in the table, returns 0
+ Column : Column_Index) return State_Index;
+ -- Returns the value in the table at (State, Column). If this index does
+ -- not exist in the table, returns zero.
procedure Free is new Ada.Unchecked_Deallocation
(Regexp_Array, Regexp_Array_Access);
procedure Adjust (R : in out Regexp) is
Tmp : Regexp_Access;
-
begin
if R.R /= null then
Tmp := new Regexp_Value (Alphabet_Size => R.R.Alphabet_Size,
function Compile
(Pattern : String;
Glob : Boolean := False;
- Case_Sensitive : Boolean := True)
- return Regexp
+ Case_Sensitive : Boolean := True) return Regexp
is
S : String := Pattern;
-- The pattern which is really compiled (when the pattern is case
-- parenthesis sub-expressions.
--
-- Table : at the end of the procedure : Column 0 is for any character
- -- ('.') and the last columns are for no character (closure)
- -- Num_States is set to the number of states in the table
- -- Start_State is the number of the starting state in the regexp
- -- End_State is the number of the final state when the regexp matches
+ -- ('.') and the last columns are for no character (closure). Num_States
+ -- is set to the number of states in the table Start_State is the number
+ -- of the starting state in the regexp End_State is the number of the
+ -- final state when the regexp matches.
procedure Create_Primary_Table_Glob
(Table : out Regexp_Array_Access;
function Create_Secondary_Table
(First_Table : Regexp_Array_Access;
- Num_States : State_Index;
Start_State : State_Index;
- End_State : State_Index)
- return Regexp;
+ End_State : State_Index) return Regexp;
-- Creates the definitive table representing the regular expression
-- This is actually a transformation of the primary table First_Table,
-- where every state is grouped with the states in its 'no-character'
J := J + 1;
end loop;
- -- A close bracket must follow a open_bracket,
- -- and cannot be found alone on the line
+ -- A close bracket must follow a open_bracket and cannot be
+ -- found alone on the line
when Close_Bracket =>
Raise_Exception
Add_In_Map (S (J));
else
- -- \ not allowed at the end of the regexp
+ -- Back slash \ not allowed at the end of the regexp
Raise_Exception
("Incorrect character '\' in regular expression", J);
End_Index : Integer;
Start_State : out State_Index;
End_State : out State_Index);
- -- Fill the table for the regexp Simple.
- -- This is the recursive procedure called to handle () expressions
- -- If End_State = 0, then the call to Create_Simple creates an
- -- independent regexp, not a concatenation
- -- Start_Index .. End_Index is the starting index in the string S.
+ -- Fill the table for the regexp Simple. This is the recursive
+ -- procedure called to handle () expressions If End_State = 0, then
+ -- the call to Create_Simple creates an independent regexp, not a
+ -- concatenation Start_Index .. End_Index is the starting index in
+ -- the string S.
--
-- Warning: it may look like we are creating too many empty-string
-- transitions, but they are needed to get the correct regexp.
function Next_Sub_Expression
(Start_Index : Integer;
- End_Index : Integer)
- return Integer;
+ End_Index : Integer) return Integer;
-- Returns the index of the last character of the next sub-expression
-- in Simple. Index cannot be greater than End_Index.
function Next_Sub_Expression
(Start_Index : Integer;
- End_Index : Integer)
- return Integer
+ End_Index : Integer) return Integer
is
J : Integer := Start_Index;
Start_On_Alter : Boolean := False;
(State : State_Index;
To_State : State_Index)
is
- J : Column_Index := Empty_Char;
+ J : Column_Index;
begin
+ J := Empty_Char;
while Get (Table, State, J) /= 0 loop
J := J + 1;
end loop;
- Set (Table, State, J,
- Value => To_State);
+ Set (Table, State, J, Value => To_State);
end Add_Empty_Char;
-------------------
Start_State : out State_Index;
End_State : out State_Index)
is
- J : Integer := Start_Index;
+ J : Integer;
Last_Start : State_Index := 0;
begin
Start_State := 0;
End_State := 0;
+ J := Start_Index;
while J <= End_Index loop
case S (J) is
then
declare
Start : constant Integer := J - 1;
+
begin
J := J + 1;
function Create_Secondary_Table
(First_Table : Regexp_Array_Access;
- Num_States : State_Index;
Start_State : State_Index;
End_State : State_Index) return Regexp
is
-----------------------
procedure Ensure_Meta_State (Meta : State_Index) is
- Tmp : Meta_States_List := Meta_States;
+ Tmp : Meta_States_List := Meta_States;
Tmp2 : Meta_States_Transition := Table;
+
begin
if Meta_States = null then
Meta_States := new Meta_States_Array
procedure Closure
(Meta_State : State_Index;
- State : State_Index) is
+ State : State_Index)
+ is
begin
if not Meta_States (Meta_State)(State) then
Meta_States (Meta_State)(State) := True;
Ensure_Meta_State (Current_State);
Closure (Current_State, Start_State);
- if False then
- Dump (First_Table, Map, Alphabet_Size, Num_States,
- Start_State, End_State);
- 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
+ -- transitions from Current_State.
for Column in 0 .. Alphabet_Size loop
Temp_State_Not_Null := False;
if Meta_States (K) = Meta_States (Nb_State + 1) then
Table (Current_State)(Column) := K;
- -- reset data, for the next time we try that state
+ -- Reset data, for the next time we try that state
+
Meta_States (Nb_State + 1) := No_States;
exit;
end if;
begin
-- Special case for the empty string: it always matches, and the
-- following processing would fail on it.
+
if S = "" then
return (Ada.Finalization.Controlled with
R => new Regexp_Value'
-- Creates the secondary table
- R := Create_Secondary_Table
- (Table, Num_States, Start_State, End_State);
+ R := Create_Secondary_Table (Table, Start_State, End_State);
Free (Table);
return R;
end;
procedure Finalize (R : in out Regexp) is
procedure Free is new
Ada.Unchecked_Deallocation (Regexp_Value, Regexp_Access);
-
begin
Free (R.R);
end Finalize;
Table (State, Column) := Value;
else
-- Doubles the size of the table until it is big enough that
- -- (State, Column) is a valid index
+ -- (State, Column) is a valid index.
New_Lines := Table'Last (1) * (State / Table'Last (1) + 1);
New_Columns := Table'Last (2) * (Column / Table'Last (2) + 1);
procedure Analyze_Package_Body_Contract (Body_Id : Entity_Id);
-- Analyze all delayed aspects chained on the contract of package body
-- Body_Id as if they appeared at the end of a declarative region. The
- -- aspects in consideration are:
+ -- aspects that are considered are:
-- Refined_State
procedure Analyze_Package_Contract (Pack_Id : Entity_Id);
-- Analyze all delayed aspects chained on the contract of package Pack_Id
- -- as if they appeared at the end of a declarative region. The aspects in
- -- consideration are:
+ -- as if they appeared at the end of a declarative region. The aspects
+ -- that are considered are:
-- Initial_Condition
-- Initializes
-- Part_Of
-- On entrance to a package body, make declarations in package spec
-- immediately visible.
-
+ --
-- When compiling the body of a package, both routines are called in
-- succession. When compiling the body of a child package, the call
-- to Install_Private_Declaration is immediate for private children,
-- calling stubs.
procedure New_Private_Type (N : Node_Id; Id : Entity_Id; Def : Node_Id);
- -- Common processing for private type declarations and for formal
- -- private type declarations. For private types, N and Def are the type
- -- declaration node; for formal private types, Def is the formal type
- -- definition.
+ -- Common processing for private type declarations and for formal private
+ -- type declarations. For private types, N and Def are the type declaration
+ -- node; for formal private types, Def is the formal type definition.
procedure Uninstall_Declarations (P : Entity_Id);
- -- At the end of a package declaration or body, declarations in the
- -- visible part are no longer immediately visible, and declarations in
- -- the private part are not visible at all. For inner packages, place
- -- visible entities at the end of their homonym chains. For compilation
- -- units, make all entities invisible. In both cases, exchange private
- -- and visible declarations to restore order of elaboration.
+ -- At the end of a package declaration or body, declarations in the visible
+ -- part are no longer immediately visible, and declarations in the private
+ -- part are not visible at all. For inner packages, place visible entities
+ -- at the end of their homonym chains. For compilation units, make
+ -- all entities invisible. In both cases, exchange private and visible
+ -- declarations to restore order of elaboration.
end Sem_Ch7;
projects / thirdparty / gcc.git / commitdiff
