exp_smem.ads, [...]: Construction of access and assign routines has been replaced by an...

2008-05-20  Kevin Pouget  <pouget@adacore.com>

	* exp_smem.ads, exp_smem.adb: Construction of access and assign
	routines has been replaced by an instantiation of
	System.Shared_Storage.Shared_Var_Procs generic package, while expanding
	shared variable declaration.
	Calls to access and assign routines have been replaced by calls to
	Read/Write routines of System.Shared_Storage.Shared_Var_Procs
	instantiated package.
	
	* rtsfind.ads: RE_Shared_Var_Procs entry has been added in RE_Unit_Table
	It identifies the new generic package added in s-shasto.

	* s-shasto.adb, s-shasto.ads: A new generic package has been added, it
	is instantiated for each shared passive variable. It provides
	supporting procedures called upon each read or write access by the
	expanded code.

	* sem_attr.adb:
	For this runtime unit (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.

From-SVN: r135627

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;

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,

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 --
    ----------------------
 

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;

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