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=-0.3 required=5.0 tests=BAYES_00,
	REPLYTO_WITHOUT_TO_CC autolearn=no autolearn_force=no version=3.4.4
Path: 
 eternal-september.org!reader01.eternal-september.org!reader02.eternal-september.org!news.eternal-september.org!news.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "G.B." <bauhaus@futureapps.invalid>
Newsgroups: comp.lang.ada
Subject: Re: A simple question about the "new" allocator
Date: Tue, 12 Aug 2014 15:38:20 +0200
Organization: A noiseless patient Spider
Message-ID: <lsd5ca$pj0$1@dont-email.me>
References: <d4137ad0-148a-4cf9-a6d8-c36e60ae7c9f@googlegroups.com>
 <q8dnwsh5glsw.1f88qzc525z4r$.dlg@40tude.net>
Reply-To: nonlegitur@futureapps.de
Mime-Version: 1.0
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit
Injection-Date: Tue, 12 Aug 2014 13:38:18 +0000 (UTC)
Injection-Info: mx05.eternal-september.org;
 posting-host="b96887e80893c84a90c3007226ca0d1c";
	logging-data="26208"; mail-complaints-to="abuse@eternal-september.org";
	posting-account="U2FsdGVkX180Pr9Wwef9jf1WLoiyMJ923VotD2+94SA="
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.9;
 rv:24.0) Gecko/20100101 Thunderbird/24.6.0
In-Reply-To: <q8dnwsh5glsw.1f88qzc525z4r$.dlg@40tude.net>
Cancel-Lock: sha1:yJVYS1LyNu2t3cDOI/SPHYfu60E=
Xref: news.eternal-september.org comp.lang.ada:21679
Date: 2014-08-12T15:38:20+02:00
List-Id: <comp.lang.ada>

On 12.08.14 09:35, Dmitry A. Kazakov wrote:
> On Mon, 11 Aug 2014 23:54:50 -0700 (PDT), NiGHTS wrote:
>
>> With all default configurations using a typical Ada compiler, will the following code run indefinitely without fail or will it eventually crash?
>>
>> procedure main is
>>
>>      Test : access Positive;
>>
>> begin
>>
>>      loop
>>          Test := new Positive;
>>      end loop;
>>
>> end main;
>>
>> If this does crash, what would be another way to write this program so
>> that it does not crash?
>>
>> I would prefer not to use Ada.Unchecked_Deallocation.
>
> Write a custom memory pool that does not allocate anything. Make Test a
> pointer to that pool.
>
> P.S. It might sound silly, but such pools are actually useful. When the
> object is already allocated and you want to initialize it and get a pointer
> to, one way to do that is using a fake allocator.

One such storage pool, tailored to the problem, and therefore likely
not applicable to every problem:

with System.Storage_Pools;
with System.Storage_Elements;

generic
    type T is private;
package My_Switching_Pool is

    pragma Preelaborate (My_Switching_Pool);

    use System;

    type Alternating_Pool
      is new Storage_Pools.Root_Storage_Pool with private;
    --  Provides storage for exactly two items of formal type `T`.

    overriding
    procedure Allocate
      (Pool                     : in out Alternating_Pool;
       Storage_Address          :    out Address;
       Size_In_Storage_Elements : in     Storage_Elements.Storage_Count;
       Alignment                : in     Storage_Elements.Storage_Count);
    --  makes the other of the two items available for storage

    overriding
    procedure Deallocate
      (Pool                     : in out Alternating_Pool;
       Storage_Address          : in     Address;
       Size_In_Storage_Elements : in     Storage_Elements.Storage_Count;
       Alignment                : in     Storage_Elements.Storage_Count);

    overriding
    function Storage_Size
      (Pool : Alternating_Pool) return Storage_Elements.Storage_Count;

private
    type Names is (Fst, Snd);
    type Pair is array (Names) of T;

    type Alternating_Pool
      is new Storage_Pools.Root_Storage_Pool with
       record
          In_Use : Names := Snd;
       end record;

    The_Data : Pair;

end My_Switching_Pool;

package body My_Switching_Pool is

    overriding
    procedure Allocate
      (Pool                     : in out Alternating_Pool;
       Storage_Address          :    out Address;
       Size_In_Storage_Elements : in     Storage_Elements.Storage_Count;
       Alignment                : in     Storage_Elements.Storage_Count)
    is
    begin
       -- switch components of `The_Data`
       Pool.In_Use := (if Pool.In_Use = Fst
                       then Snd
                       else Fst);
       Storage_Address := The_Data (Pool.In_Use)'Address;
    end Allocate;

    overriding
    procedure Deallocate
      (Pool                     : in out Alternating_Pool;
       Storage_Address          : in     Address;
       Size_In_Storage_Elements : in     Storage_Elements.Storage_Count;
       Alignment                : in     Storage_Elements.Storage_Count)
    is
    begin
       null;
    end Deallocate;

    overriding
    function Storage_Size
      (Pool : Alternating_Pool)
       return Storage_Elements.Storage_Count
    is
       use type Storage_Elements.Storage_Count;
    begin
       return Pair'Size / Storage_Elements.Storage_Element'Size;
    end Storage_Size;

end My_Switching_Pool;

with My_Switching_Pool;
procedure Main is

    package Two_Numbers is new My_Switching_Pool (T => Positive);

    The_Pool : Two_Numbers.Alternating_Pool;

    type Positive_Ptr is access Positive
       with Storage_Pool => The_Pool;

    Test : Positive_Ptr;

begin

    loop
       Test := new Positive;
    end loop;

end Main;