-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2008, Free Software Foundation, Inc. --
-- --
-- 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- --
-- OUT or IN OUT parameter to a procedure call. If the result is
-- True, then Insert_Node is set to point to the call.
+ function Build_Shared_Var_Proc_Call
+ (Loc : Source_Ptr;
+ E : Node_Id;
+ N : Name_Id) return Node_Id;
+ -- Build a call to support procedure N for shared object E (provided by
+ -- the instance of System.Shared_Storage.Shared_Var_Procs associated to E).
+
+ --------------------------------
+ -- Build_Shared_Var_Proc_Call --
+ --------------------------------
+
+ function Build_Shared_Var_Proc_Call
+ (Loc : Source_Ptr;
+ E : Entity_Id;
+ N : Name_Id) return Node_Id is
+ begin
+ return Make_Procedure_Call_Statement (Loc,
+ Name => Make_Selected_Component (Loc,
+ Prefix =>
+ New_Occurrence_Of (Shared_Var_Procs_Instance (E), Loc),
+ Selector_Name => Make_Identifier (Loc, Chars => N)));
+ end Build_Shared_Var_Proc_Call;
+
---------------------
-- Add_Read_Before --
---------------------
procedure Add_Read_Before (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Ent : constant Node_Id := Entity (N);
-
begin
- if Present (Shared_Var_Read_Proc (Ent)) then
- Insert_Action (N,
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (Shared_Var_Read_Proc (Ent), Loc),
- Parameter_Associations => Empty_List));
+ if Present (Shared_Var_Procs_Instance (Ent)) then
+ Insert_Action (N, Build_Shared_Var_Proc_Call (Loc, Ent, Name_Read));
end if;
end Add_Read_Before;
-- Now, right after the Lock, insert a call to read the object
Insert_Before_And_Analyze (Inode,
- Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (Shared_Var_Read_Proc (Obj), Loc)));
+ Build_Shared_Var_Proc_Call (Loc, Obj, Name_Read));
-- Now insert the Unlock call after
if Nkind (N) = N_Procedure_Call_Statement then
Insert_After_And_Analyze (Inode,
- Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (Shared_Var_Assign_Proc (Obj), Loc)));
+ Build_Shared_Var_Proc_Call (Loc, Obj, Name_Write));
end if;
end Add_Shared_Var_Lock_Procs;
Ent : constant Node_Id := Entity (N);
begin
- if Present (Shared_Var_Assign_Proc (Ent)) then
+ if Present (Shared_Var_Procs_Instance (Ent)) then
Insert_After_And_Analyze (Insert_Node,
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (Shared_Var_Assign_Proc (Ent), Loc),
- Parameter_Associations => Empty_List));
+ Build_Shared_Var_Proc_Call (Loc, Ent, Name_Write));
end if;
end Add_Write_After;
Ent : constant Entity_Id := Defining_Identifier (N);
Typ : constant Entity_Id := Etype (Ent);
Vnm : String_Id;
- Atr : Node_Id;
After : constant Node_Id := Next (N);
-- Node located right after N originally (after insertion of the SV
-- procs this node is right after the last inserted node).
- Assign_Proc : constant Entity_Id :=
- Make_Defining_Identifier (Loc,
- Chars => New_External_Name (Chars (Ent), 'A'));
-
- Read_Proc : constant Entity_Id :=
- Make_Defining_Identifier (Loc,
- Chars => New_External_Name (Chars (Ent), 'R'));
+ SVP_Instance : constant Entity_Id := Make_Defining_Identifier (Loc,
+ Chars => New_External_Name (Chars (Ent), 'G'));
+ -- Instance of System.Shared_Storage.Shared_Var_Procs associated
+ -- with Ent.
- S : Entity_Id;
+ Instantiation : Node_Id;
+ -- Package instanciation node for SVP_Instance
-- Start of processing for Make_Shared_Var_Procs
Build_Full_Name (Ent, Vnm);
-- We turn off Shared_Passive during construction and analysis of
- -- the assign and read routines, to avoid improper attempts to
- -- process the variable references within these procedures.
+ -- the generic package instantition, to avoid improper attempts to
+ -- process the variable references within these instantiation.
Set_Is_Shared_Passive (Ent, False);
- -- Construct assignment routine
-
- -- procedure VarA is
- -- S : Ada.Streams.Stream_IO.Stream_Access;
- -- begin
- -- S := Shared_Var_WOpen ("pkg.var");
- -- typ'Write (S, var);
- -- Shared_Var_Close (S);
- -- end VarA;
-
- S := Make_Defining_Identifier (Loc, Name_uS);
-
- Atr :=
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Typ, Loc),
- Attribute_Name => Name_Write,
- Expressions => New_List (
- New_Reference_To (S, Loc),
- New_Occurrence_Of (Ent, Loc)));
-
- Insert_After_And_Analyze (N,
- Make_Subprogram_Body (Loc,
- Specification =>
- Make_Procedure_Specification (Loc,
- Defining_Unit_Name => Assign_Proc),
-
- -- S : Ada.Streams.Stream_IO.Stream_Access;
-
- Declarations => New_List (
- Make_Object_Declaration (Loc,
- Defining_Identifier => S,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Stream_Access), Loc))),
-
- Handled_Statement_Sequence =>
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => New_List (
-
- -- S := Shared_Var_WOpen ("pkg.var");
-
- Make_Assignment_Statement (Loc,
- Name => New_Reference_To (S, Loc),
- Expression =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of
- (RTE (RE_Shared_Var_WOpen), Loc),
- Parameter_Associations => New_List (
- Make_String_Literal (Loc, Vnm)))),
-
- Atr,
-
- -- Shared_Var_Close (S);
-
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Shared_Var_Close), Loc),
- Parameter_Associations =>
- New_List (New_Reference_To (S, Loc)))))));
-
- -- Construct read routine
-
- -- procedure varR is
- -- S : Ada.Streams.Stream_IO.Stream_Access;
- -- begin
- -- S := Shared_Var_ROpen ("pkg.var");
- -- if S /= null then
- -- typ'Read (S, Var);
- -- Shared_Var_Close (S);
- -- end if;
- -- end varR;
-
- S := Make_Defining_Identifier (Loc, Name_uS);
-
- Atr :=
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Typ, Loc),
- Attribute_Name => Name_Read,
- Expressions => New_List (
- New_Reference_To (S, Loc),
- New_Occurrence_Of (Ent, Loc)));
-
- Insert_After_And_Analyze (N,
- Make_Subprogram_Body (Loc,
- Specification =>
- Make_Procedure_Specification (Loc,
- Defining_Unit_Name => Read_Proc),
-
- -- S : Ada.Streams.Stream_IO.Stream_Access;
-
- Declarations => New_List (
- Make_Object_Declaration (Loc,
- Defining_Identifier => S,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Stream_Access), Loc))),
-
- Handled_Statement_Sequence =>
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => New_List (
-
- -- S := Shared_Var_ROpen ("pkg.var");
-
- Make_Assignment_Statement (Loc,
- Name => New_Reference_To (S, Loc),
- Expression =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of
- (RTE (RE_Shared_Var_ROpen), Loc),
- Parameter_Associations => New_List (
- Make_String_Literal (Loc, Vnm)))),
-
- -- if S /= null then
-
- Make_Implicit_If_Statement (N,
- Condition =>
- Make_Op_Ne (Loc,
- Left_Opnd => New_Reference_To (S, Loc),
- Right_Opnd => Make_Null (Loc)),
-
- Then_Statements => New_List (
-
- -- typ'Read (S, Var);
-
- Atr,
-
- -- Shared_Var_Close (S);
-
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of
- (RTE (RE_Shared_Var_Close), Loc),
- Parameter_Associations =>
- New_List (New_Reference_To (S, Loc)))))))));
-
- Set_Is_Shared_Passive (Ent, True);
- Set_Shared_Var_Assign_Proc (Ent, Assign_Proc);
- Set_Shared_Var_Read_Proc (Ent, Read_Proc);
+ -- Construct generic package instantiation
+
+ -- package varG is new Shared_Var_Procs (Typ, var, "pkg.var");
+
+ Instantiation :=
+ Make_Package_Instantiation (Loc,
+ Defining_Unit_Name => SVP_Instance,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Shared_Var_Procs), Loc),
+ Generic_Associations => New_List (
+ Make_Generic_Association (Loc, Explicit_Generic_Actual_Parameter =>
+ New_Occurrence_Of (Typ, Loc)),
+ Make_Generic_Association (Loc, Explicit_Generic_Actual_Parameter =>
+ New_Occurrence_Of (Ent, Loc)),
+ Make_Generic_Association (Loc, Explicit_Generic_Actual_Parameter =>
+ Make_String_Literal (Loc, Vnm))));
+
+ Insert_After_And_Analyze (N, Instantiation);
+
+ Set_Is_Shared_Passive (Ent, True);
+ Set_Shared_Var_Procs_Instance
+ (Ent, Defining_Entity (Instance_Spec (Instantiation)));
-- Return last node before After
-- The approach is as follows:
--- For each shared variable, var, an access routine varR is created whose
--- body has the following form (this example is for Pkg.Var):
-
--- procedure varR is
--- S : Ada.Streams.Stream_IO.Stream_Access;
--- begin
--- S := Shared_Var_ROpen ("pkg.var");
--- if S /= null then
--- typ'Read (S);
--- Shared_Var_Close (S);
--- end if;
--- end varR;
+-- For each shared variable, var, an instanciation of the below generic
+-- package is created which provides Read and Write supporting procedures.
-- The routine Shared_Var_ROpen in package System.Shared_Storage
-- either returns null if the storage does not exist, or otherwise a
-- Stream_Access value that references the corresponding shared
-- storage, ready to read the current value.
--- Each reference to the shared variable, var, is preceded by a
--- call to the corresponding varR procedure, which either leaves the
--- initial value unchanged if the storage does not exist, or reads
--- the current value from the shared storage.
-
--- In addition, for each shared variable, var, an assignment routine
--- is created whose body has the following form (again for Pkg.Var)
-
--- procedure VarA is
--- S : Ada.Streams.Stream_IO.Stream_Access;
--- begin
--- S := Shared_Var_WOpen ("pkg.var");
--- typ'Write (S, var);
--- Shared_Var_Close (S);
--- end VarA;
-
-- The routine Shared_Var_WOpen in package System.Shared_Storage
-- returns a Stream_Access value that references the corresponding
-- shared storage, ready to write the new value.
--- Each assignment to the shared variable, var, is followed by a call
--- to the corresponding varA procedure, which writes the new value to
--- the shared storage.
-
-- Note that there is no general synchronization for these storage
-- read and write operations, since it is assumed that a correctly
-- operating programs will provide appropriate synchronization. In
-- generated as the last operation in the body of a protected
-- subprogram.
+ -- This generic package is instantiated for each shared passive
+ -- variable. It provides supporting procedures called upon each
+ -- read or write access by the expanded code.
+
+ generic
+
+ type Typ is limited private;
+ -- Shared passive variable type
+
+ V : in out Typ;
+ -- Shared passive variable
+
+ Full_Name : String;
+ -- Shared passive variable storage name
+
+ package Shared_Var_Procs is
+
+ procedure Read;
+ -- Shared passive variable access routine. Each reference to the
+ -- shared variable, V, is preceded by a call to the corresponding
+ -- Read procedure, which either leaves the initial value unchanged
+ -- if the storage does not exist, or reads the current value from
+ -- the shared storage.
+
+ procedure Write;
+ -- Shared passive variable assignement routine. Each assignment to
+ -- the shared variable, V, is followed by a call to the corresponding
+ -- Write procedure, which writes the new value to the shared storage.
+
+ end Shared_Var_Procs;
+
end System.Shared_Storage;
OSDN Git Service
