Add all the A tasks

Task/Arena-storage-pool/0DESCRIPTION

@@ -0,0 +1,16 @@
+Dynamically allocated objects take their memory from a [[heap]]. The memory for an object is provided by an '''allocator''' which maintains the storage pool used for the [[heap]]. Often a call to allocator is denoted as
+<lang ada>
+P := new T
+</lang>
+where T is the type of an allocated object and P is a [[reference]] to the object.
+
+The storage pool chosen by the allocator can be determined by either:
+* the object type T;
+* the type of pointer P.
+In the former case objects can be allocated only in one storage pool. In the latter case objects of the type can be allocated in any storage pool or on the [[stack]].
+
+'''Task description'''<br>
+The task is to show how allocators and user-defined storage pools are supported by the language. In particular:
+# define an arena storage pool. An arena is a pool in which objects are allocated individually, but freed by groups.
+# allocate some objects (e.g., integers) in the pool.
+Explain what controls the storage pool choice in the language.

Task/Arena-storage-pool/1META.yaml

@@ -0,0 +1,3 @@
+---
+category:
+- Encyclopedia

Task/Arena-storage-pool/Ada/arena-storage-pool-1.ada

@@ -0,0 +1,2 @@
+type My_Pointer is access My_Object;
+for My_Pointer'Storage_Pool use My_Pool;

Task/Arena-storage-pool/Ada/arena-storage-pool-2.ada

@@ -0,0 +1,27 @@
+with System.Storage_Elements;  use System.Storage_Elements;
+with System.Storage_Pools;     use System.Storage_Pools;
+
+package Arena_Pools is
+   type Arena (Size : Storage_Count) is new Root_Storage_Pool with private;
+   overriding
+      procedure Allocate
+                (  Pool      : in out Arena;
+                   Address   : out System.Address;
+                   Size      : Storage_Count;
+                   Alignment : Storage_Count
+                );
+   overriding
+      procedure Deallocate
+                (  Pool      : in out Arena;
+                   Address   : System.Address;
+                   Size      : Storage_Count;
+                   Alignment : Storage_Count
+                )  is null;
+   overriding
+      function Storage_Size (Pool : Arena) return Storage_Count;
+private
+   type Arena (Size : Storage_Count) is new Root_Storage_Pool with record
+      Free : Storage_Offset := 1;
+      Core : Storage_Array (1..Size);
+   end record;
+end Arena_Pools;

Task/Arena-storage-pool/Ada/arena-storage-pool-3.ada

@@ -0,0 +1,22 @@
+package body Arena_Pools is
+   procedure Allocate
+             (  Pool      : in out Arena;
+                Address   : out System.Address;
+                Size      : Storage_Count;
+                Alignment : Storage_Count
+             )  is
+      Free : constant Storage_Offset :=
+         Pool.Free + Alignment - Pool.Core (Pool.Free)'Address mod Alignment + Size;
+   begin
+      if Free - 1 > Pool.Size then
+         raise Storage_Error;
+      end if;
+      Pool.Free := Free;
+      Address := Pool.Core (Pool.Free - Size)'Address;
+   end Allocate;
+
+   function Storage_Size (Pool : Arena) return Storage_Count is
+   begin
+      return Pool.Size;
+   end Storage_Size;
+end Arena_Pools;

Task/Arena-storage-pool/Ada/arena-storage-pool-4.ada

@@ -0,0 +1,15 @@
+with Arena_Pools;
+use  Arena_Pools;
+
+procedure Test_Allocator is
+   Pool : Arena_Pools.Arena (1024);
+   type Integer_Ptr is access Integer;
+   for Integer_Ptr'Storage_Pool use Pool;
+
+   X : Integer_Ptr := new Integer'(1);
+   Y : Integer_Ptr := new Integer'(2);
+   Z : Integer_Ptr;
+begin
+   Z := new Integer;
+   Z.all := X.all + Y.all;
+end Test_Allocator;

Task/Arena-storage-pool/C/arena-storage-pool-1.c

@@ -0,0 +1 @@
+#include <stdlib.h>

Task/Arena-storage-pool/C/arena-storage-pool-2.c

@@ -0,0 +1,3 @@
+int *var = malloc(n*sizeof(int));
+Typename *var = malloc(sizeof(Typename));
+Typename *var = malloc(sizeof var[0]);

Task/Arena-storage-pool/C/arena-storage-pool-3.c

@@ -0,0 +1,3 @@
+typedef struct mytypeStruct { .... } sMyType, *MyType;
+
+MyType var = malloc(sizeof(sMyType));

Task/Arena-storage-pool/C/arena-storage-pool-4.c

@@ -0,0 +1,6 @@
+/* allocate an array of n MyTypes */
+MyType var = calloc(n, sizeof(sMyType));
+
+MyType third = var+3;       /* a reference to the 3rd item allocated */
+
+MyType fourth = &var[4];    /* another way, getting the fourth item */

Task/Arena-storage-pool/C/arena-storage-pool-5.c

@@ -0,0 +1 @@
+free(var);

Task/Arena-storage-pool/C/arena-storage-pool-6.c

@@ -0,0 +1 @@
+Typename *var = alloca(sizeof(Typename));

Task/Arena-storage-pool/REXX/arena-storage-pool.rexx

@@ -0,0 +1,11 @@
+/*REXX doesn't have declarations/allocations of variables, */
+/*     but this is the closest to an allocation:           */
+
+stemmed_array.= 0    /*any undefined element will have this value. */
+
+stemmed_array.1    = '1st entry'
+stemmed_array.2    = '2nd entry'
+stemmed_array.6000 = 12 ** 2
+stemmed_array.dog  = stemmed_array.6000 / 2
+
+drop stemmed_array.

Task/Arena-storage-pool/Tcl/arena-storage-pool-1.tcl

@@ -0,0 +1,81 @@
+package require Tcl 8.6
+oo::class create Pool {
+    superclass oo::class
+    variable capacity pool busy
+    unexport create
+    constructor args {
+	next {*}$args
+	set capacity 100
+	set pool [set busy {}]
+    }
+    method new {args} {
+	if {[llength $pool]} {
+	    set pool [lassign $pool obj]
+	} else {
+	    if {[llength $busy] >= $capacity} {
+		throw {POOL CAPACITY} "exceeded capacity: $capacity"
+	    }
+	    set obj [next]
+	    set newobj [namespace current]::[namespace tail $obj]
+	    rename $obj $newobj
+	    set obj $newobj
+	}
+	try {
+	    [info object namespace $obj]::my Init {*}$args
+	} on error {msg opt} {
+	    lappend pool $obj
+	    return -options $opt $msg
+	}
+	lappend busy $obj
+	return $obj
+    }
+    method ReturnToPool obj {
+	try {
+	    if {"Finalize" in [info object methods $obj -all -private]} {
+		[info object namespace $obj]::my Finalize
+	    }
+	} on error {msg opt} {
+	    after 0 [list return -options $opt $msg]
+	    return false
+	}
+	set idx [lsearch -exact $busy $obj]
+	set busy [lreplace $busy $idx $idx]
+	if {[llength $pool] + [llength $busy] + 1 <= $capacity} {
+	    lappend pool $obj
+	    return true
+	} else {
+	    return false
+	}
+    }
+    method capacity {{value {}}} {
+	if {[llength [info level 0]] == 3} {
+	    if {$value < $capacity} {
+		while {[llength $pool] > 0 && [llength $pool] + [llength $busy] > $value} {
+		    set pool [lassign $pool obj]
+		    rename $obj {}
+		}
+	    }
+	    set capacity [expr {$value >> 0}]
+	} else {
+	    return $capacity
+	}
+    }
+    method clearPool {} {
+	foreach obj $busy {
+	    $obj destroy
+	}
+    }
+    method destroy {} {
+	my clearPool
+	next
+    }
+    self method create {class {definition {}}} {
+	set cls [next $class $definition]
+	oo::define $cls method destroy {} {
+	    if {![[info object namespace [self class]]::my ReturnToPool [self]]} {
+		next
+	    }
+	}
+	return $cls
+    }
+}

Task/Arena-storage-pool/Tcl/arena-storage-pool-2.tcl

@@ -0,0 +1,53 @@
+Pool create PoolExample {
+    variable int
+
+    method Init value {
+	puts stderr "Initializing [self] with $value"
+	set int $value
+	incr int 0
+    }
+    method Finalize {} {
+	puts stderr "Finalizing [self] which held $int"
+    }
+
+    method value {{newValue {}}} {
+	if {[llength [info level 0]] == 3} {
+	    set int [incr newValue 0]
+	} else {
+	    return $int
+	}
+    }
+}
+
+PoolExample capacity 10
+set objs {}
+try {
+    for {set i 0} {$i < 20} {incr i} {
+	lappend objs [PoolExample new $i]
+    }
+} trap {POOL CAPACITY} msg {
+    puts "trapped: $msg"
+}
+puts -nonewline "number of objects: [llength $objs]\n\t"
+foreach o $objs {
+    puts -nonewline "[$o value] "
+}
+puts ""
+set objs [lassign $objs a b c]
+$a destroy
+$b destroy
+$c destroy
+PoolExample capacity 9
+try {
+    for {} {$i < 20} {incr i} {
+	lappend objs [PoolExample new $i]
+    }
+} trap {POOL CAPACITY} msg {
+    puts "trapped: $msg"
+}
+puts -nonewline "number of objects: [llength $objs]\n\t"
+foreach o $objs {
+    puts -nonewline "[$o value] "
+}
+puts ""
+PoolExample clearPool