Classwide-type assignments

Classwide-type assignments

[jsanchor]

Hello there:

I have asked this question before but with no luck, maybe today I'll get an
answer.

I have been trying to assign classwide types with no luck.
type PARENT_TYPE is abstract tagged
record
   checksum : NATURAL32;
end record;

type PTR_TO_DATA is access all PARENT_TYPE'class;

package CONVERT_TO_NVM_TYPE is new
      SYSTEM.Address_to_Access_Conversions(PARENT_TYPE'class);
--------------------------------------------------------------
type RAM_TYPE is new PARENT_TYPE with
record
   number_1 : integer;
end record;

RAM_object : aliased RAM_TYPE;
RAM_ptr    : CONVERT_TO_NVM_TYPE.Object_Pointer;

RAM_ptr    := CONVERT_TO_NVM_TYPE.To_Pointer(RAM_object.all'address);
ptr_to_RAM := PTR_TO_DATA(ptr_to_data); --casting
-----------------------------------------------------------

NVM_Address        : constant SYSTEM.Address :=
      SYSTEM.STORAGE_ELEMENTS.To_Address(16#00E00000#);

NVM_ptr    : CONVERT_TO_NVM_TYPE.Object_Pointer;

--get an access type to the location in NVM where data is stored.
NVM_ptr    := CONVERT_TO_NVM_TYPE.To_Pointer(NVM_Address);
ptr_to_NVM := PTR_TO_DATA(NVM_PTR);

AND then,


ptr_to_NVM.all := ptr_to_RAM.all; <-- the following statement compiles.

But nothing happens, when I run the code.

HAs anybody done this kind of thing before??
Thank you in advance.

Jay S.



-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/       Search, Read, Discuss, or Start Your Own    

Re: Classwide-type assignments

[Niklas Holsti]

jsanchor@cs5.dasd.honeywell.com wrote:

  [ snip ]

> I have been trying to assign classwide types with no luck.
> type PARENT_TYPE is abstract tagged
> record
>    checksum : NATURAL32;
> end record;
> 
> type PTR_TO_DATA is access all PARENT_TYPE'class;
> 
> package CONVERT_TO_NVM_TYPE is new
>       SYSTEM.Address_to_Access_Conversions(PARENT_TYPE'class);
> --------------------------------------------------------------
> type RAM_TYPE is new PARENT_TYPE with
> record
>    number_1 : integer;
> end record;
> 
> RAM_object : aliased RAM_TYPE;
> RAM_ptr    : CONVERT_TO_NVM_TYPE.Object_Pointer;
> 
> RAM_ptr    := CONVERT_TO_NVM_TYPE.To_Pointer(RAM_object.all'address);
> ptr_to_RAM := PTR_TO_DATA(ptr_to_data); --casting
                            ***********
                           (should perhaps be RAM_ptr?)

> -----------------------------------------------------------
> 
> NVM_Address        : constant SYSTEM.Address :=
>       SYSTEM.STORAGE_ELEMENTS.To_Address(16#00E00000#);
> 
> NVM_ptr    : CONVERT_TO_NVM_TYPE.Object_Pointer;
> 
> --get an access type to the location in NVM where data is stored.
> NVM_ptr    := CONVERT_TO_NVM_TYPE.To_Pointer(NVM_Address);
> ptr_to_NVM := PTR_TO_DATA(NVM_PTR);
> 
> AND then,
> 
> ptr_to_NVM.all := ptr_to_RAM.all; <-- the following statement compiles.
> 
> But nothing happens, when I run the code.

The target of the assignment (ptr_to_NVM.all) is of class-wide
type and the expression (ptr_to_RAM.all) is dynamically tagged.
This means that the assignment includes a check that the tag
of the target is the same as the tag of the expression, by
LRM 5.2(10).

Your program (at least the part shown) does not initialize
the target area (at NVM_Address), so the tag check will access
an undefined tag value. I'm confident that this means that
the program is erroneous (ie. the effects are unpredictable).
I think but am not sure that this follows from LRM 13.3(13).

I don't think that you can use ":=" to move class-wide
data to an uninitialized memory area. Perhaps you could
make a custom Storage Pool that allocates target objects
from the NV RAM? Then you could clone the RAM object into
the NV RAM using "new" for the NV RAM Storage Pool.

A simpler approach would be to use a low-level memory copy
based on RAM_object'size. You could implement a generic
copy package parametrized by the type, to hide the low-level
stuff.

Sorry for not being very specific in my suggestions, but
I hope they give you some pointers.

> Jay S.

Niklas Holsti

Re: Classwide-type assignments [longish]

[Niklas Holsti]

This continues my earlier posting, where I wrote:
> 
> jsanchor@cs5.dasd.honeywell.com wrote:
>   [ snip ]
> > I have been trying to assign classwide types with no luck.
    [ snip ]
> I don't think that you can use ":=" to move class-wide
> data to an uninitialized memory area. Perhaps you could
> make a custom Storage Pool that allocates target objects
> from the NV RAM? Then you could clone the RAM object into
> the NV RAM using "new" for the NV RAM Storage Pool.
    [ snip ]

Just for fun, I wrote a custom Storage_Pool sketch to handle
allocations in a special RAM area. Source code included below.
The allocator is trivial (sequential allocation, no deallocation)
but may give you a starting point if you decide to use this
approach.

I tested the program on an i486 with Linux 2.0.0 and GNAT 3.05.
The program consists of
    nv_main.adb      Main procedure
    nv_pool.ad[sb]   Custom storage pool
    nv_user.ad[sb]   Example client with descendant type.

The expected output is:

My_Int.Value =  12345
Allocating 8 elements, alignment = 4
New NV_Off = 8
NV.Value =  12345


Good luck,
Niklas Holsti


-------------- nv_main.adb
with NV_User;

procedure NV_Main is
begin
   NV_User.Use_It;
end NV_Main;


-------------- nv_user.ads
-- This package makes a descendant type of NV_Pool.NV_Object
-- and tries it out.

package NV_User is

   procedure Use_It;

end NV_User;


-------------- nv_user.adb
with NV_Pool;
with Text_IO;
use  Text_IO;

package body NV_User is

   -- The descendant type:
   type NV_Int is new NV_Pool.NV_Object with record
      Value : integer;
   end record;

   type Int_Pointer is access all NV_Int'Class;
   -- This access type can access either RAM or NV RAM objects,
   -- but will create new objects in NV RAM only.

   for Int_Pointer'Storage_Pool use NV_Pool.NV_Pointer'Storage_Pool;
   -- It's a nuisance to have to define the Storage_Pool for
   -- all descendant pointers. Perhaps a generic package could
   -- be made to sort of "mix in" the NV'ness facet.


   My_Int : aliased NV_Int;
   -- The RAM object to be copied to NV RAM.


   procedure Use_It
   is

      RAM_Ptr : Int_Pointer := My_Int'Access;
      -- Pointer to the RAM object (specific type).

      RAM_Class_Ptr : NV_Pool.Pointer := NV_Pool.Pointer (RAM_Ptr);
      -- Pointer to the RAM object (class-wide).

      NV_Ptr : Int_Pointer;
      -- Pointer to the NV RAM copy (specific type).

      NV_Class_Ptr : NV_Pool.Pointer;
      -- Pointer to the NV RAM copy (class-wide).

   begin

      My_Int.Value := 12345;
      -- Define the RAM data.

      Put_Line ("My_Int.Value = " & integer'image(My_Int.Value));

      NV_Ptr := new NV_Int;
      -- Create a place in the NV RAM of this type.
      -- This uses the custom NV storage pool.

      -- Note that the copy in NV RAM could be created simply
      -- by  "NV_Ptr := new NV_Int'(My_Int);".
      -- The following stuff with class-wide accesses is only
      -- to answer the original question on comp.lang.ada.

      NV_Class_Ptr := NV_Pool.Pointer (NV_Ptr);
      -- Make a class-wide pointer to the NV RAM place.

      NV_Class_Ptr.all := RAM_Class_Ptr.all;
      -- Copy the data, class-wide to class-wide.
      -- This includes a tag check. Note that the "new"
      -- for NV_Ptr sets the tag of the NV RAM cell, although
      -- the other components are undefined.

      Put_Line ("NV.Value = " & integer'image(NV_Ptr.Value));

   end Use_It;

end NV_User;


-------------- nv_pool.ads
with System.Storage_Pools;
with System.Storage_Elements;
use  System.Storage_Elements;

package NV_Pool is

   type NV_Object is abstract tagged null record;
   -- The root type for objects that can be copied to
   -- Non-Volatile memory.

   type NV_Pointer is access NV_Object'Class;
   -- Pointer to an object in the Non-Volatile memory.
   -- This access type has a custom storage pool that
   -- allocates areas from the Non-Volatile memory.
   -- Note that access types for descendants of NV_Object
   -- will NOT inherit the custom storage pool, but must
   -- specify it, for example:
   --    for My_NV_Pointer'Storage_Pool use
   --       NV_Pool.NV_Pointer'Storage_Pool;

   type Pointer is access all NV_Object'Class;
   -- Pointer to an object in the volatile memory or in
   -- the non-volatile memory.
   -- This access type uses the default storage pool.


private

   -- Custom Storage Pool for Non-Volatile objects.

   type NV_Storage_Pool is
      new System.Storage_Pools.Root_Storage_Pool
      with null record;

   procedure Allocate (
      Pool            : in out NV_Storage_Pool;
      Storage_Address : out System.Address;
      Size_In_Storage_Elements : in Storage_Count;
      Alignment       : in Storage_Count);

   procedure Deallocate (
      Pool            : in out NV_Storage_Pool;
      Storage_Address : in System.Address;
      Size_In_Storage_Elements : in Storage_Count;
      Alignment       : in Storage_Count);

   function Storage_Size (Pool : NV_Storage_Pool) return Storage_Count;

   NV_Storage : NV_Storage_Pool;

   -- Use the custom allocator for NV objects.

   for NV_Pointer'Storage_Pool use NV_Storage;

end NV_Pool;


-------------- nv_pool.adb
with Text_IO;

package body NV_Pool is
   
   -- Storage to simulate the Non-Volatile area.
   -- The important parts are NV_Size and NV_Address which are
   -- used in the storage pool operations.
   -- For a real NV RAM, modify the value of NV_Size, delete
   -- NV_Simu, and set NV_Address to the literal starting
   -- address.

   NV_Size    : constant Storage_Count  := 1000;

   subtype NV_Count is Storage_Count range 0 .. NV_Size;
   subtype NV_Index is NV_Count range 0 .. NV_Count'last - 1;

   NV_Simu    : array (NV_Index) of Storage_Element;
   NV_Address : constant System.Address :=
NV_Simu(NV_Simu'first)'address;


   -- Custom pool defined as NV_Size storage-elements starting
   -- at address NV_Address.

   NV_Off  : Storage_Offset := 0;
   --  Offset from NV_Address to the next free location.


   procedure Allocate (
      Pool            : in out NV_Storage_Pool;
      Storage_Address : out System.Address;
      Size_In_Storage_Elements : in Storage_Count;
      Alignment       : in Storage_Count)
   --
   -- Allocates NV memory sequentially from NV_Off.
   -- Updates NV_Off.
   --
   is

      Misalign : constant Integer_Address :=
         To_Integer (NV_Address + NV_Off) mod Integer_Address
(Alignment);
      -- The amount of misalignment in NV_Off.

      Next_Off : Storage_Offset;
      -- The aligned value of NV_Off.

   begin
      Text_IO.Put_Line (
         "Allocating"
         & Storage_Count'image(Size_In_Storage_Elements)
         & " elements, alignment ="
         & Storage_Count'image(Alignment));

      -- Check for alignment.
      if Misalign > 0 then
         -- Advance offset to next aligned location.
         Next_Off := NV_Off + (Alignment - Storage_Count(Misalign));
      else
         -- Already aligned.
         Next_Off := NV_Off;
      end if;

      -- Check if storage left.
      if NV_Size - Next_Off < Size_In_Storage_Elements then
         raise Storage_Error;
      end if;

      -- Return address and reserve space.
      Storage_Address := NV_Address + Next_Off;
      NV_Off          := Next_Off + Size_In_Storage_Elements;

      Text_IO.Put_Line (
         "New NV_Off =" & Storage_Offset'image(NV_Off));

   end Allocate;


  procedure Deallocate (
      Pool            : in out NV_Storage_Pool;
      Storage_Address : in System.Address;
      Size_In_Storage_Elements : in Storage_Count;
      Alignment       : in Storage_Count)
   --
   -- Deallocation is not implemented.
   --
   is
   begin
      Text_IO.Put_Line (
         "Deallocating"
         & Storage_Count'image (Size_In_Storage_Elements)
         & " elements, alignment ="
         & Storage_Count'image (Alignment)
         & ", address ="
         & Integer_Address'image(To_Integer(Storage_Address)));

      null;

   end Deallocate;


   function Storage_Size (Pool : NV_Storage_Pool) return Storage_Count
   is
   begin
      return NV_Size;
   end Storage_Size;


end NV_Pool;