From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,5ad62cc979f6c111 X-Google-Attributes: gid103376,public From: Niklas Holsti Subject: Re: Classwide-type assignments [longish] Date: 1998/10/15 Message-ID: <36251457.DCDE2B57@icon.fi> X-Deja-AN: 401128406 Content-Transfer-Encoding: 7bit References: <6vtl8g$v42$1@nnrp1.dejanews.com> <362392F7.8A226D64@icon.fi> Content-Type: text/plain; charset=us-ascii Organization: Space Systems Finland Ltd Mime-Version: 1.0 Newsgroups: comp.lang.ada Date: 1998-10-15T00:00:00+00:00 List-Id: 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;