diff options
| -rw-r--r-- | gcc/ada/exp_smem.adb | 226 | ||||
| -rw-r--r-- | gcc/ada/exp_smem.ads | 13 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/s-shasto.adb | 41 | ||||
| -rw-r--r-- | gcc/ada/s-shasto.ads | 65 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 25 |
6 files changed, 165 insertions, 209 deletions
diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb index ae1ea9b68d0..0e3fc2379a4 100644 --- a/gcc/ada/exp_smem.adb +++ b/gcc/ada/exp_smem.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -71,6 +71,29 @@ package body Exp_Smem is -- 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 -- --------------------- @@ -78,14 +101,9 @@ package body Exp_Smem is 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; @@ -134,8 +152,7 @@ package body Exp_Smem is -- 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 @@ -150,8 +167,7 @@ package body Exp_Smem is 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; @@ -165,12 +181,9 @@ package body Exp_Smem is 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; @@ -276,21 +289,18 @@ package body Exp_Smem is 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 @@ -298,149 +308,33 @@ package body Exp_Smem is 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 diff --git a/gcc/ada/exp_smem.ads b/gcc/ada/exp_smem.ads index 69b4ee90eba..d1738255187 100644 --- a/gcc/ada/exp_smem.ads +++ b/gcc/ada/exp_smem.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -49,10 +49,11 @@ package Exp_Smem is -- read/write calls for the protected object within the lock region. function Make_Shared_Var_Procs (N : Node_Id) return Node_Id; - -- N is the node for the declaration of a shared passive variable. This - -- procedure constructs and inserts the read and assignment procedures - -- for the shared memory variable. See System.Shared_Storage for a full - -- description of these procedures and how they are used. The last inserted - -- node is returned. + -- N is the node for the declaration of a shared passive variable. + -- This procedure constructs an instantiation of + -- System.Shared_Storage.Shared_Var_Procs that contains the read and + -- assignment procedures for the shared memory variable. + -- See System.Shared_Storage for a full description of these procedures + -- and how they are used. The last inserted node is returned. end Exp_Smem; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index ef61b8fd0e5..83f745499e2 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -83,7 +83,7 @@ package Rtsfind is -- Names of the form System_Tasking_xxx are second level children of the -- package System.Tasking. For example, System_Tasking_Stages refers to - -- refers to the package System.Tasking.Stages. + -- the package System.Tasking.Stages. -- Other names stand for themselves (e.g. System for package System) @@ -1255,6 +1255,7 @@ package Rtsfind is RE_Shared_Var_ROpen, -- System.Shared_Storage RE_Shared_Var_Unlock, -- System.Shared_Storage RE_Shared_Var_WOpen, -- System.Shared_Storage + RE_Shared_Var_Procs, -- System.Shared_Storage RE_Abort_Undefer_Direct, -- System.Standard_Library RE_Exception_Code, -- System.Standard_Library @@ -2382,6 +2383,7 @@ package Rtsfind is RE_Shared_Var_ROpen => System_Shared_Storage, RE_Shared_Var_Unlock => System_Shared_Storage, RE_Shared_Var_WOpen => System_Shared_Storage, + RE_Shared_Var_Procs => System_Shared_Storage, RE_Abort_Undefer_Direct => System_Standard_Library, RE_Exception_Code => System_Standard_Library, diff --git a/gcc/ada/s-shasto.adb b/gcc/ada/s-shasto.adb index 5dd775725bb..c4ef8628c0b 100644 --- a/gcc/ada/s-shasto.adb +++ b/gcc/ada/s-shasto.adb @@ -6,8 +6,8 @@ -- -- -- 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- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- @@ -364,6 +364,43 @@ package body System.Shared_Storage is end Shared_Var_Lock; ---------------------- + -- Shared_Var_Procs -- + ---------------------- + + package body Shared_Var_Procs is + + use type SIO.Stream_Access; + + ---------- + -- Read -- + ---------- + + procedure Read is + S : SIO.Stream_Access := null; + begin + S := Shared_Var_ROpen (Full_Name); + if S /= null then + Typ'Read (S, V); + Shared_Var_Close (S); + end if; + end Read; + + ------------ + -- Write -- + ------------ + + procedure Write is + S : SIO.Stream_Access := null; + begin + S := Shared_Var_WOpen (Full_Name); + Typ'Write (S, V); + Shared_Var_Close (S); + return; + end Write; + + end Shared_Var_Procs; + + ---------------------- -- Shared_Var_ROpen -- ---------------------- diff --git a/gcc/ada/s-shasto.ads b/gcc/ada/s-shasto.ads index fc4055b9826..8046fd5b2f6 100644 --- a/gcc/ada/s-shasto.ads +++ b/gcc/ada/s-shasto.ads @@ -79,48 +79,18 @@ -- 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 @@ -219,4 +189,35 @@ package System.Shared_Storage is -- 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; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 6a7846eacba..c2536dfc70c 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1278,7 +1278,8 @@ package body Sem_Attr is and then Convention (Etype (P)) = Convention_CPP and then Is_CPP_Class (Root_Type (Etype (P))) then - Error_Attr_P ("invalid use of % attribute with CPP tagged type"); + Error_Attr_P + ("invalid use of % attribute with 'C'P'P tagged type"); end if; end Check_Not_CPP_Type; @@ -1459,6 +1460,14 @@ package body Sem_Attr is Etyp : Entity_Id; Btyp : Entity_Id; + In_Shared_Var_Procs : Boolean; + -- True when compiling the body of System.Shared_Storage. + -- Shared_Var_Procs. For this runtime package (always compiled in + -- GNAT mode), we allow stream attributes references for limited + -- types for the case where shared passive objects are implemented + -- using stream attributes, which is the default in GNAT's persistent + -- storage implementation. + begin Validate_Non_Static_Attribute_Function_Call; @@ -1492,7 +1501,19 @@ package body Sem_Attr is -- in Ada 2005 mode), or a pragma Stream_Convert applies to Btyp -- (with no visibility restriction). - if Comes_From_Source (N) + declare + Gen_Body : constant Node_Id := Enclosing_Generic_Body (N); + begin + if Present (Gen_Body) then + In_Shared_Var_Procs := + Is_RTE (Corresponding_Spec (Gen_Body), RE_Shared_Var_Procs); + else + In_Shared_Var_Procs := False; + end if; + end; + + if (Comes_From_Source (N) + and then not (In_Shared_Var_Procs or In_Instance)) and then not Stream_Attribute_Available (P_Type, Nam) and then not Has_Rep_Pragma (Btyp, Name_Stream_Convert) then |