A-M baby

Task/Memory-allocation/0DESCRIPTION

@@ -0,0 +1 @@
+Show how to explicitly allocate and deallocate blocks of memory in your language. Show access to different types of memory (i.e., [[heap]], [[system stack|stack]], shared, foreign) if applicable.

Task/Memory-allocation/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Basic language learning

Task/Memory-allocation/360-Assembly/memory-allocation.360

@@ -0,0 +1,22 @@
+* Request to Get Storage Managed by "GETMAIN" Supervisor Call (SVC 4)
+       LA    1,PLIST       Point Reg 1 to GETMAIN/FREEMAIN Parm List
+       SVC   4             Issue GETMAIN SVC
+       LTR   15,15         Register 15 = 0?
+       BZ    GOTSTG         Yes: Got Storage
+*      [...]                 No: Handle GETMAIN Failure
+GOTSTG L     2,STG@        Load Reg (any Reg) with Addr of Aquired Stg
+*      [...]               Continue
+* Request to Free Storage Managed by "FREEMAIN" Supervisor Call (SVC 5)
+       LA    1,PLIST       Point Reg 1 to GETMAIN/FREEMAIN Parm List
+       SVC   5             Issue FREEMAIN SVC
+       LTR   15,15         Register 15 = 0?
+       BZ    STGFRE         Yes: Storage Freed
+*      [...]                 No: Handle FREEMAIN Failure
+STGFRE EQU   *             Storage Freed
+*      [...]               Continue
+*
+STG@   DS    A             Address of Stg Area (Aquired or to be Freed)
+PLIST  EQU   *             10-Byte GETMAIN/FREEMAIN Parameter List
+       DC    A(256)        Number of Bytes; Max=16777208 ((2**24)-8)
+       DC    A(STG@)       Pointer to Address of Storage Area
+       DC    X'0000'       (Unconditional Request; Subpool 0)

Task/Memory-allocation/ALGOL-68/memory-allocation-1.alg

@@ -0,0 +1 @@
+MODE MYSTRUCT = STRUCT(INT i, j, k, REAL r, COMPL c);

Task/Memory-allocation/ALGOL-68/memory-allocation-2.alg

@@ -0,0 +1 @@
+REF MYSTRUCT l = LOC MYSTRUCT;

Task/Memory-allocation/ALGOL-68/memory-allocation-3.alg

@@ -0,0 +1 @@
+REF MYSTRUCT h = HEAP MYSTRUCT;

Task/Memory-allocation/ALGOL-68/memory-allocation-4.alg

@@ -0,0 +1,3 @@
+[666]MYSTRUCT pool;
+INT new pool := LWB pool-1;
+REF MYSTRUCT p = pool[new pool +:=1];

Task/Memory-allocation/ALGOL-68/memory-allocation-5.alg

@@ -0,0 +1 @@
+MYSTRUCT i;

Task/Memory-allocation/Ada/memory-allocation-1.ada

@@ -0,0 +1,5 @@
+declare
+   X : Integer; -- Allocated on the stack
+begin
+   ...
+end; -- X is freed

Task/Memory-allocation/Ada/memory-allocation-2.ada

@@ -0,0 +1,6 @@
+declare
+   type Integer_Ptr is access Integer;
+   Ptr : Integer_Ptr := new Integer; -- Allocated in the heap
+begin
+   ...
+end; -- Memory is freed because Integer_Ptr is finalized

Task/Memory-allocation/Ada/memory-allocation-3.ada

@@ -0,0 +1,8 @@
+declare
+   type Integer_Ptr is access Integer;
+   procedure Free is new Ada.Unchecked_Deallocation (Integer, Integer_Ptr)
+   Ptr : Integer_Ptr := new Integer; -- Allocated in the heap
+begin
+   Free (Ptr); -- Explicit deallocation
+   ...
+end;

Task/Memory-allocation/Ada/memory-allocation-4.ada

@@ -0,0 +1,3 @@
+package P is
+   X : Integer; -- Allocated in the result the package elaboration
+end P;

Task/Memory-allocation/AutoHotkey/memory-allocation.ahk

@@ -0,0 +1,2 @@
+VarSetCapacity(Var, 10240000)  ; allocate 10 megabytes
+VarSetCapacity(Var, 0)  ; free it

Task/Memory-allocation/BBC-BASIC/memory-allocation-1.bbc

@@ -0,0 +1,3 @@
+      size% = 12345
+      DIM mem% size%-1
+      PRINT ; size% " bytes of heap allocated at " ; mem%

Task/Memory-allocation/BBC-BASIC/memory-allocation-2.bbc

@@ -0,0 +1,9 @@
+      size% = 12345
+      PROCstack(size%)
+      END
+
+      DEF PROCstack(s%)
+      LOCAL mem%
+      DIM mem% LOCAL s%-1
+      PRINT ; s% " bytes of stack allocated at " ; mem%
+      ENDPROC

Task/Memory-allocation/Bracmat/memory-allocation.bracmat

@@ -0,0 +1,10 @@
+( alc$2000:?p           {allocate 2000 bytes}
+& pok$(!p,123456789,4)  { poke a large value as a 4 byte integer }
+& pok$(!p+4,0,4)        { poke zeros in the next 4 bytes }
+& out$(pee$(!p,1))      { peek the first byte }
+& out$(pee$(!p+2,2))    { peek the short int located at the third and fourth byte }
+& out$(pee$(!p,4))      { peek the first four bytes }
+& out$(pee$(!p+6,2))    { peek the two bytes from the zeroed-out range }
+& out$(pee$(!p+1000,2)) { peek some uninitialized data }
+& fre$!p                { free the memory }
+&);

Task/Memory-allocation/C++/memory-allocation-1.cpp

@@ -0,0 +1,23 @@
+#include <string>
+
+int main()
+{
+  int* p;
+
+  p = new int;    // allocate a single int, uninitialized
+  delete p;       // deallocate it
+
+  p = new int(2); // allocate a single int, initialized with 2
+  delete p;       // deallocate it
+
+  std::string* p2;
+
+  p2 = new std::string; // allocate a single string, default-initialized
+  delete p2;            // deallocate it
+
+  p = new int[10]; // allocate an array of 10 ints, uninitialized
+  delete[] p;      // deallocation of arrays must use delete[]
+
+  p2 = new std::string[10]; // allocate an array of 10 strings, default-initialized
+  delete[] p2;              // deallocate it
+}

Task/Memory-allocation/C++/memory-allocation-2.cpp

@@ -0,0 +1,5 @@
+int main()
+{
+  void* memory = operator new(20); // allocate 20 bytes of memory
+  operator delete(memory);         // deallocate it
+}

Task/Memory-allocation/C++/memory-allocation-3.cpp

@@ -0,0 +1,12 @@
+#include <new>
+
+int main()
+{
+  union
+  {
+    int alignment_dummy; // make sure the block is correctly aligned for ints
+    char data[2*sizeof(int)]; // enough space for 10 ints
+  };
+  int* p = new(&data) int(3); // construct an int at the beginning of data
+  new(p+1) int(5); // construct another int directly following
+}

Task/Memory-allocation/C++/memory-allocation-4.cpp

@@ -0,0 +1,2 @@
+void* memory_for_p = operator new(sizeof(int));
+int* p = new(memory_for_p) int(3);

Task/Memory-allocation/C++/memory-allocation-5.cpp

@@ -0,0 +1,3 @@
+#include <new>
+
+int* p = new(std::nothrow) int(3);

Task/Memory-allocation/C++/memory-allocation-6.cpp

@@ -0,0 +1,27 @@
+#include <cstddef>
+#include <cstdlib>
+#include <new>
+
+class MyClass
+{
+public:
+  void* operator new(std::size_t size)
+  {
+    void* p = std::malloc(size);
+    if (!p) throw std::bad_alloc();
+    return p;
+  }
+  void operator delete(void* p)
+  {
+    free(p);
+  }
+};
+
+int main()
+{
+  MyClass* p = new MyClass; // uses class specific operator new
+  delete p;                 // uses class specific operator delete
+
+  int* p2 = new int; // uses default operator new
+  delete p2;         // uses default operator delete
+}

Task/Memory-allocation/C++/memory-allocation-7.cpp

@@ -0,0 +1,15 @@
+class arena { /* ... */ };
+
+void* operator new(std::size_t size, arena& a)
+{
+  return arena.alloc(size);
+}
+
+void operator delete(void* p, arena& a)
+{
+  arena.dealloc(p);
+}
+
+arena whatever(/* ... */);
+
+int* p = new(whatever) int(3); // uses operator new from above to allocate from the arena whatever

Task/Memory-allocation/C++/memory-allocation-8.cpp

@@ -0,0 +1,9 @@
+class MyClass { /*...*/ };
+
+int main()
+{
+  MyClass* p = new(whatever) MyClass; // allocate memory for myclass from arena and construct a MyClass object there
+  // ...
+  p->~MyClass(); // explicitly destruct *p
+  operator delete(p, whatever); // explicitly deallocate the memory
+}

Task/Memory-allocation/C/memory-allocation-1.c

@@ -0,0 +1,18 @@
+#include <stdlib.h>
+
+/* size of "members", in bytes */
+#define SIZEOF_MEMB (sizeof(int))
+#define NMEMB 100
+
+int main()
+{
+  int *ints = malloc(SIZEOF_MEMB*NMEMB);
+  /* realloc can be used to increase or decrease an already
+     allocated memory (same as malloc if ints is NULL) */
+  ints = realloc(ints, sizeof(int)*(NMEMB+1));
+  /* calloc set the memory to 0s */
+  int *int2 = calloc(NMEMB, SIZEOF_MEMB);
+  /* all use the same free */
+  free(ints); free(int2);
+  return 0;
+}

Task/Memory-allocation/C/memory-allocation-2.c

@@ -0,0 +1,17 @@
+int func()
+{
+  int ints[NMEMB]; /* it resembles malloc ... */
+  int *int2;       /* here the only thing allocated on the stack is a pointer */
+  char intstack[SIZEOF_MEMB*NMEMB]; /* to show resemblance to malloc */
+  int2 = (int *)intstack;           /* but this is educative, do not do so unless... */
+
+  {
+    const char *pointers_to_char[NMEMB];
+    /* use pointers_to_char */
+    pointers_to_char[0] = "educative";
+  } /* outside the block, the variable "disappears" */
+
+  /* here we can use ints, int2, intstack vars, which are not seen elsewhere of course */
+
+  return 0;
+}

Task/Memory-allocation/C/memory-allocation-3.c

@@ -0,0 +1,8 @@
+#include <alloca.h>
+int *funcA()
+{
+  int *ints = alloca(SIZEOF_MEMB*NMEMB);
+  ints[0] = 0;                                  /* use it */
+  return ints; /* BUT THIS IS WRONG! It is not like malloc: the memory
+                  does not "survive"! */
+}

Task/Memory-allocation/C/memory-allocation-4.c

@@ -0,0 +1,14 @@
+/* this is global */
+int integers[NMEMB]; /* should be initialized with 0s */
+
+int funcB()
+{
+  static int ints[NMEMB]; /* this is "static", i.e. the memory "survive" even
+                             when the function exits, but the symbol's scope is local */
+  return integers[0] + ints[0];
+}
+
+void funcC(int a)
+{
+  integers[0] = a;
+}

Task/Memory-allocation/Common-Lisp/memory-allocation-1.lisp

@@ -0,0 +1,5 @@
+(defun show-allocation ()
+  (let ((a (cons 1 2))
+        (b (cons 1 2)))
+    (declare (dynamic-extent b))
+    (list a b)))

Task/Memory-allocation/Common-Lisp/memory-allocation-2.lisp

@@ -0,0 +1 @@
+(show-allocation)

Task/Memory-allocation/E/memory-allocation.e

@@ -0,0 +1,2 @@
+? <elib:tables.makeFlexList>.fromType(<type:java.lang.Byte>, 128)
+# value: [].diverge()

Task/Memory-allocation/Factor/memory-allocation-1.factor

@@ -0,0 +1 @@
+2000 malloc  (...do stuff..)  free

Task/Memory-allocation/Factor/memory-allocation-2.factor

@@ -0,0 +1,6 @@
+STRUCT: foo { a int } { b foo* } ;
+
+[
+    foo malloc-struct &free ! gets freed at end of the current with-destructors scope
+    ! do stuff
+] with-destructors

Task/Memory-allocation/Forth/memory-allocation-1.fth

@@ -0,0 +1,10 @@
+unused .  \ memory available for use in dictionary
+here .    \ current dictionary memory pointer
+: mem, ( addr len -- ) here over allot swap move ;
+: s, ( str len -- ) here over char+ allot place align ;   \ built-in on some forths
+: ,"  [char] " parse s, ;
+variable num
+create array  60 cells allot
+create struct  0 , 10 ,  char A c,  ," string"
+unused .
+here .

Task/Memory-allocation/Forth/memory-allocation-2.fth

@@ -0,0 +1,5 @@
+marker foo
+: temp  ... ;
+create dummy 300 allot
+-150 allot      \ trim the size of dummy by 150 bytes
+foo    \ removes foo, temp, and dummy from the list of definitions

Task/Memory-allocation/Forth/memory-allocation-3.fth

@@ -0,0 +1,3 @@
+4096 allocate throw  ( addr )
+dup 4096 erase
+( addr ) free throw

Task/Memory-allocation/Fortran/memory-allocation.f

@@ -0,0 +1,15 @@
+program allocation_test
+
+ implicit none
+
+ real,dimension(:),allocatable :: vector
+ real,dimension(:,:),allocatable :: matrix
+
+ integer,parameter :: n = 100 !size to allocate
+
+ allocate(vector(n))   !allocate a vector
+ allocate(matrix(n,n)) !allocate a matrix
+ deallocate(vector)    !deallocate a vector
+ deallocate(matrix)    !deallocate a matrix
+
+end program allocation_test

Task/Memory-allocation/Go/memory-allocation-1.go

@@ -0,0 +1,4 @@
+func inc(n int) {
+    x := n + 1
+    println(x)
+}

Task/Memory-allocation/Go/memory-allocation-2.go

@@ -0,0 +1,4 @@
+func inc(n int) *int {
+    x := n + 1
+    return &x
+}

Task/Memory-allocation/Go/memory-allocation-3.go

@@ -0,0 +1 @@
+type s struct{a, b int}

Task/Memory-allocation/Go/memory-allocation-4.go

@@ -0,0 +1 @@
+&s{}

Task/Memory-allocation/Go/memory-allocation-5.go

@@ -0,0 +1 @@
+new(s)

Task/Memory-allocation/Go/memory-allocation-6.go

@@ -0,0 +1,3 @@
+make([]int, 3)
+make(map[int]int)
+make(chan int)

Task/Memory-allocation/Haskell/memory-allocation-1.hs

@@ -0,0 +1,9 @@
+import Foreign
+
+bytealloc :: IO ()
+bytealloc = do
+  a0 <- mallocBytes 100 -- Allocate 100 bytes
+  free a0 -- Free them again
+  allocaBytes 100 $ \a -> -- Allocate 100 bytes; automatically
+                          -- freed when closure finishes
+    poke (a::Ptr Word32) 0

Task/Memory-allocation/Haskell/memory-allocation-2.hs

@@ -0,0 +1,8 @@
+import Foreign
+
+typedalloc :: IO ()
+typedalloc = do
+  w <- malloc
+  poke w (100 :: Word32)
+  free w
+  alloca $ \a -> poke a (100 :: Word32)

Task/Memory-allocation/J/memory-allocation-1.j

@@ -0,0 +1,3 @@
+   require 'dll'
+   mema 1000
+57139856

Task/Memory-allocation/J/memory-allocation-2.j

@@ -0,0 +1 @@
+memf 57139856

Task/Memory-allocation/Java/memory-allocation-1.java

@@ -0,0 +1,5 @@
+//All of these objects will be deallocated automatically once the program leaves
+//their scope and there are no more pointers to the objects
+Object foo = new Object(); //Allocate an Object and a reference to it
+int[] fooArray = new int[size]; //Allocate all spaces in an array and a reference to it
+int x = 0; //Allocate an integer and set its value to 0

Task/Memory-allocation/Java/memory-allocation-2.java

@@ -0,0 +1,7 @@
+public class Blah{
+   //...other methods/data members...
+   protected void finalize() throws Throwable{
+      //Finalization code here
+   }
+   //...other methods/data members...
+}

Task/Memory-allocation/Java/memory-allocation-3.java

@@ -0,0 +1,12 @@
+public class NoFinalize {
+    public static final void main(String[] params) {
+        NoFinalize nf = new NoFinalize();
+    }
+    public NoFinalize() {
+        System.out.println("created");
+    }
+    @Override
+    protected void finalize() {
+        System.out.println("finalized");
+    }
+}

Task/Memory-allocation/MATLAB/memory-allocation.m

@@ -0,0 +1,7 @@
+   A = zeros(1000); 	% allocates memory for a 1000x1000 double precision matrix.
+   clear A;		% deallocates memory
+
+   b = zeros(1,100000);	% pre-allocate memory to improve performance
+   for k=1:100000,
+	b(k) = 5*k*k-3*k+2;
+   end

Task/Memory-allocation/Maxima/memory-allocation.maxima

@@ -0,0 +1,20 @@
+/* Maxima allocates memory dynamically and uses a garbage collector.
+Here is how to check available memory */
+
+room();
+  3221/3221   72.3%       2 CONS RATIO COMPLEX STRUCTURE
+   272/307    61.6%         FIXNUM SHORT-FLOAT CHARACTER RANDOM-STATE READTABLE SPICE
+   226/404    90.8%         SYMBOL STREAM
+     1/2      37.2%         PACKAGE
+   127/373    44.9%         ARRAY HASH-TABLE VECTOR BIT-VECTOR PATHNAME CCLOSURE CLOSURE
+   370/370    49.1%       1 STRING
+   325/440     8.2%         CFUN BIGNUM LONG-FLOAT
+    31/115    98.9%         SFUN GFUN VFUN AFUN CFDATA
+  1188/1447                 contiguous (478 blocks)
+       11532                hole
+       5242    5.0%         relocatable
+      4573 pages for cells
+     22535 total pages
+     97138 pages available
+     11399 pages in heap but not gc'd + pages needed for gc marking
+    131072 maximum pages

Task/Memory-allocation/Python/memory-allocation.py

@@ -0,0 +1,15 @@
+>>> from array import array
+>>> argslist = [('l', []), ('c', 'hello world'), ('u', u'hello \u2641'),
+	('l', [1, 2, 3, 4, 5]), ('d', [1.0, 2.0, 3.14])]
+>>> for typecode, initializer in argslist:
+	a = array(typecode, initializer)
+	print a
+	del a
+
+	
+array('l')
+array('c', 'hello world')
+array('u', u'hello \u2641')
+array('l', [1, 2, 3, 4, 5])
+array('d', [1.0, 2.0, 3.1400000000000001])
+>>>

Task/Memory-allocation/R/memory-allocation.r

@@ -0,0 +1,6 @@
+x=numeric(10)  # allocate a numeric vector of size 10 to x
+rm(x)  # remove x
+
+x=vector("list",10) #allocate a list of length 10
+x=vector("numeric",10) #same as x=numeric(10), space allocated to list vector above now freed
+rm(x)  # remove x

Task/Memory-allocation/REXX/memory-allocation-1.rexx

@@ -0,0 +1 @@
+Axtec_god.3='Quetzalcoatl ("feathered serpent"), god of learning, civilization, regeneration, wind and storms'

Task/Memory-allocation/REXX/memory-allocation-2.rexx

@@ -0,0 +1,3 @@
+drop  xyz  NamesRoster  j  k  m  caves  names.  Axtec_god.  Hopi  Hopi
+
+/* it's not considered an error to DROP a variable that isn't defined.*/

Task/Memory-allocation/Ruby/memory-allocation.rb

@@ -0,0 +1,6 @@
+class Thingamajig
+  def initialize
+    fail 'not yet implemented'
+  end
+end
+t = Thingamajig.allocate

Task/Memory-allocation/Tcl/memory-allocation-1.tcl

@@ -0,0 +1,195 @@
+#include <tcl.h>
+
+/* A data structure used to enforce data safety */
+struct block {
+    int size;
+    unsigned char data[4];
+};
+
+static int
+Memalloc(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc, Tcl_Obj *const *objv)
+{
+    Tcl_HashTable *nameMap = clientData;
+    static int nameCounter = 0;
+    char nameBuf[30];
+    Tcl_HashEntry *hPtr;
+    int size, dummy;
+    struct block *blockPtr;
+
+    /* Parse arguments */
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "size");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIntFromObj(interp, objv[1], &size) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (size < 1) {
+	Tcl_AppendResult(interp, "size must be positive", NULL);
+	return TCL_ERROR;
+    }
+
+    /* The ckalloc() function will panic on failure to allocate. */
+    blockPtr = (struct block *)
+	    ckalloc(sizeof(struct block) + (unsigned) (size<4 ? 0 : size-4));
+
+    /* Set up block */
+    blockPtr->size = size;
+    memset(blockPtr->data, 0, blockPtr->size);
+
+    /* Give it a name and return the name */
+    sprintf(nameBuf, "block%d", nameCounter++);
+    hPtr = Tcl_CreateHashEntry(nameMap, nameBuf, &dummy);
+    Tcl_SetHashValue(hPtr, blockPtr);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(nameBuf, -1));
+    return TCL_OK;
+}
+
+static int
+Memfree(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc, Tcl_Obj *const *objv)
+{
+    Tcl_HashTable *nameMap = clientData;
+    Tcl_HashEntry *hPtr;
+    struct block *blockPtr;
+
+    /* Parse the arguments */
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "handle");
+	return TCL_ERROR;
+    }
+    hPtr = Tcl_FindHashEntry(nameMap, Tcl_GetString(objv[1]));
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "unknown handle", NULL);
+	return TCL_ERROR;
+    }
+    blockPtr = Tcl_GetHashValue(hPtr);
+
+    /* Squelch the memory */
+    Tcl_DeleteHashEntry(hPtr);
+    ckfree((char *) blockPtr);
+    return TCL_OK;
+}
+
+static int
+Memset(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc, Tcl_Obj *const *objv)
+{
+    Tcl_HashTable *nameMap = clientData;
+    Tcl_HashEntry *hPtr;
+    struct block *blockPtr;
+    int index, byte;
+
+    /* Parse the arguments */
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "handle index byte");
+	return TCL_ERROR;
+    }
+    hPtr = Tcl_FindHashEntry(nameMap, Tcl_GetString(objv[1]));
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "unknown handle", NULL);
+	return TCL_ERROR;
+    }
+    blockPtr = Tcl_GetHashValue(hPtr);
+    if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK
+	    || Tcl_GetIntFromObj(interp, objv[3], &byte) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (index < 0 || index >= blockPtr->size) {
+	Tcl_AppendResult(interp, "index out of range", NULL);
+	return TCL_ERROR;
+    }
+
+    /* Update the byte of the data block */
+    blockPtr->data[index] = (unsigned char) byte;
+    return TCL_OK;
+}
+
+static int
+Memget(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc, Tcl_Obj *const *objv)
+{
+    Tcl_HashTable *nameMap = clientData;
+    Tcl_HashEntry *hPtr;
+    struct block *blockPtr;
+    int index, byte;
+
+    /* Parse the arguments */
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "handle index");
+	return TCL_ERROR;
+    }
+    hPtr = Tcl_FindHashEntry(nameMap, Tcl_GetString(objv[1]));
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "unknown handle", NULL);
+	return TCL_ERROR;
+    }
+    blockPtr = Tcl_GetHashValue(hPtr);
+    if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (index < 0 || index >= blockPtr->size) {
+	Tcl_AppendResult(interp, "index out of range", NULL);
+	return TCL_ERROR;
+    }
+
+    /* Read the byte from the data block and return it */
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(blockPtr->data[index]));
+    return TCL_OK;
+}
+
+static int
+Memaddr(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc, Tcl_Obj *const *objv)
+{
+    Tcl_HashTable *nameMap = clientData;
+    Tcl_HashEntry *hPtr;
+    struct block *blockPtr;
+    int addr;
+
+    /* Parse the arguments */
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "handle");
+	return TCL_ERROR;
+    }
+    hPtr = Tcl_FindHashEntry(nameMap, Tcl_GetString(objv[1]));
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "unknown handle", NULL);
+	return TCL_ERROR;
+    }
+    blockPtr = Tcl_GetHashValue(hPtr);
+
+    /* This next line is non-portable */
+    addr = (int) blockPtr->data;
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(addr));
+    return TCL_OK;
+}
+
+int
+Memalloc_Init(Tcl_Interp *interp)
+{
+    /* Make the hash table */
+    Tcl_HashTable *hashPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+    Tcl_InitHashTable(hashPtr, TCL_STRING_KEYS);
+
+    /* Register the commands */
+    Tcl_CreateObjCommand(interp, "memalloc", Memalloc, hashPtr, NULL);
+    Tcl_CreateObjCommand(interp, "memfree", Memfree, hashPtr, NULL);
+    Tcl_CreateObjCommand(interp, "memset", Memset, hashPtr, NULL);
+    Tcl_CreateObjCommand(interp, "memget", Memget, hashPtr, NULL);
+    Tcl_CreateObjCommand(interp, "memaddr", Memaddr, hashPtr, NULL);
+
+    /* Register the package */
+    return Tcl_PkgProvide(interp, "memalloc", "1.0");
+}

Task/Memory-allocation/Tcl/memory-allocation-2.tcl

@@ -0,0 +1,8 @@
+package require memalloc
+
+set block [memalloc 1000]
+puts "allocated $block at [memaddr $block]"
+memset $block 42 79
+someOtherCommand [memaddr $block]
+puts "$block\[42\] is now [memget $block 42]"
+memfree $block