#+TITLE: Memory management
#+SETUPFILE: ../tools/theme.setup
#+INCLUDE: ../tools/lib.org

We override the allocation functions to enable the possibility of
optimized libraries to fine-tune the memory allocation.


* Headers                                                          :noexport:

  #+begin_src c :tangle (eval c)
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif

#ifdef HAVE_STDINT_H
#include <stdint.h>
#elif HAVE_INTTYPES_H
#include <inttypes.h>
#endif

#include <stdlib.h>
#include <string.h>
#include <assert.h>

#include "qmckl.h"
#include "qmckl_memory_private_type.h"
#include "qmckl_context_private_type.h"
#include "qmckl_memory_private_func.h"
  #+end_src

  #+begin_src c :tangle (eval c_test) :noweb yes
#include "qmckl.h"
#include "assert.h"
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "qmckl_context_private_type.h"
#include "qmckl_memory_private_func.h"
int main() {
  #+end_src


  #+begin_src c :tangle (eval h_private_func) :noweb yes
#ifndef QMCKL_MEMORY_HPF
#define QMCKL_MEMORY_HPF
  #+end_src

  #+begin_src c :tangle (eval h_private_type) :noweb yes
#ifndef QMCKL_MEMORY_HPT
#define QMCKL_MEMORY_HPT

#include <stdint.h>
#include <stdlib.h>
  #+end_src

* Memory data structure for the context

  Every time a new block of memory is allocated, the information
  relative to the allocation is stored in a new ~qmckl_memory_info_struct~.
  A ~qmckl_memory_info_struct~ contains the pointer to the memory block,
  its size in bytes, and extra implementation-specific information such as
  alignment, pinning, if the memory should be allocated on CPU or GPU
  /etc/.

  #+begin_src c :tangle (eval h_private_type) :noweb yes
typedef struct qmckl_memory_info_struct {
  size_t size;
  void*  pointer;
} qmckl_memory_info_struct;

static const qmckl_memory_info_struct qmckl_memory_info_struct_zero =
  {
   .size = (size_t) 0,
   .pointer = NULL
  };
  #+end_src

  The ~memory~ element of the context is a data structure which
  contains an array of ~qmckl_memory_info_struct~, the size of the
  array, and the number of allocated blocks.

  #+begin_src c :tangle (eval h_private_type) :noweb yes
typedef struct qmckl_memory_struct {
  size_t                    n_allocated;
  size_t                    array_size;
  qmckl_memory_info_struct* element;
} qmckl_memory_struct;
  #+end_src

* Passing info to allocation routines

  Passing information to the allocation routine should be done by
  passing an instance of a ~qmckl_memory_info_struct~.

* Allocation/deallocation functions

  Memory allocation inside the library should be done with
  ~qmckl_malloc~. It lets the library choose how the memory will be
  allocated, and a pointer is returned to the user.  The context is
  passed to let the library store data related to the allocation
  inside the context. In this particular implementation of the library,
  we store a list of allocated pointers so that all the memory can be
  properly freed when the library is de-initialized.
  If the allocation failed, the ~NULL~ pointer is returned.

  The allocated memory block is zeroed using ~memset~.

  # Header
  #+begin_src c :tangle (eval h_private_func) :noexport
void* qmckl_malloc(qmckl_context context,
                   const qmckl_memory_info_struct info);
  #+end_src

  Here's a step-by-step explanation of ~qmckl_malloc~:

  1. The function takes two parameters: a ~qmckl_context~ and a
     ~qmckl_memory_info_struct~ containing the desired size of the memory
     block to allocate.

  2. The function checks if the provided ~qmckl_context~ is valid, using the
     ~qmckl_context_check~ function.

  3. The ~qmckl_context_struct~ pointer is retrieved from the provided
     ~qmckl_context~.

  4. The function then allocates memory:
     If the ~HAVE_HPC~ macro is defined, the memory allocation is done using
     the ~aligned_alloc~ function with a 64-byte alignment, rounding up the
     requested size to the nearest multiple of 64 bytes. If the ~HAVE_HPC~
     macro is not defined, the memory allocation is done using the standard
     ~malloc~ function.

  5  If the allocation fails, the function returns ~NULL~.

  6. The allocated memory block is zeroed using ~memset~.

  7. The function acquires a lock on the ~qmckl_context~ using ~qmckl_lock~.

  8. Inside the locked section, the function checks if the
     ~qmckl_memory_struct~ is full. If it is, it reallocates a larger array
     by doubling its size and updating the ~array_size~ member of the
     ~qmckl_memory_struct~.

  9. The function finds the first available ~qmckl_memory_info_struct~ slot
     in the element array of the ~qmckl_memory_struct~.

  # Source
  #+begin_src c :tangle (eval c)
void* qmckl_malloc(qmckl_context context, const qmckl_memory_info_struct info) {

  assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT);

  qmckl_context_struct* const ctx = (qmckl_context_struct*) context;

  /* Allocate memory and zero it */
#ifdef HAVE_HPC
  assert( ((info.size+64) >> 6) << 6 >= info.size );
  void * pointer = aligned_alloc(64, ((info.size+64) >> 6) << 6 );
#else
  void * pointer = malloc(info.size);
#endif
  if (pointer == NULL) {
    return NULL;
  }
  memset(pointer, 0, info.size);

  qmckl_lock(context);
  {
    /* If qmckl_memory_struct is full, reallocate a larger one */
    if (ctx->memory.n_allocated == ctx->memory.array_size) {
      const size_t old_size = ctx->memory.array_size;
      qmckl_memory_info_struct * new_array = realloc(ctx->memory.element,
                                                          2L * old_size *
                                                          sizeof(qmckl_memory_info_struct));
      if (new_array == NULL) {
        qmckl_unlock(context);
        free(pointer);
        return NULL;
      }

      memset( &(new_array[old_size]), 0, old_size * sizeof(qmckl_memory_info_struct) );
      ctx->memory.element = new_array;
      ctx->memory.array_size = 2L * old_size;
    }

    /* Find first NULL entry */
    size_t pos = (size_t) 0;
    while ( pos < ctx->memory.array_size && ctx->memory.element[pos].size > (size_t) 0) {
      pos += (size_t) 1;
    }
    assert (ctx->memory.element[pos].size == (size_t) 0);

    /* Copy info at the new location */
    memcpy(&(ctx->memory.element[pos]), &info, sizeof(qmckl_memory_info_struct));
    ctx->memory.element[pos].pointer = pointer;
    ctx->memory.n_allocated += (size_t) 1;
//printf("MALLOC: %5ld  %p\n", ctx->memory.n_allocated, ctx->memory.element[pos].pointer);
  }
  qmckl_unlock(context);

  return pointer;
}
  #+end_src


   # Test                                                            :noexport:
   #+begin_src c :tangle (eval c_test)
/* Create a context */
qmckl_context context = qmckl_context_create();

qmckl_memory_info_struct info = qmckl_memory_info_struct_zero;
info.size = (size_t) 3*sizeof(int);

/* Allocate an array of ints */
int *a = (int*) qmckl_malloc(context, info);

/* Check that array of ints is OK */
assert(a != NULL);
a[0] = 1;  assert(a[0] == 1);
a[1] = 2;  assert(a[1] == 2);
a[2] = 3;  assert(a[2] == 3);

/* Allocate another array of ints */
int *b = (int*) qmckl_malloc(context, info);

/* Check that array of ints is OK */
assert(b != NULL);
b[0] = 1;  assert(b[0] == 1);
b[1] = 2;  assert(b[1] == 2);
b[2] = 3;  assert(b[2] == 3);
   #+end_src

  When freeing the memory with ~qmckl_free~, the context is passed, in
  case some important information has been stored related to memory
  allocation and needs to be updated.

  #+begin_src c :tangle (eval h_private_func)
qmckl_exit_code qmckl_free(qmckl_context context,
                           void * const ptr);
  #+end_src

  Here's a step-by-step explanation of the ~qmckl_free~ function:

  1. The function takes two parameters: a ~qmckl_context~ and a pointer to
     the memory block (~ptr~) that needs to be deallocated.

  2. The function checks if the provided ~qmckl_context~ is valid, using the
     ~qmckl_context_check~ function. If it is not valid, it returns an error
     code ~QMCKL_INVALID_CONTEXT~ using the ~qmckl_failwith~ function.
   
  3. The function checks if the provided pointer is ~NULL~. If it is, it
     returns an error code ~QMCKL_INVALID_ARG_2~ using the ~qmckl_failwith~
     function.
   
  4. The ~qmckl_context_struct~ pointer is retrieved from the provided
     ~qmckl_context~.
   
  5. The function acquires a lock on the ~qmckl_context~ using ~qmckl_lock~.
     
  6. Inside the locked section, the function searches for the pointer in
     the element array of the ~qmckl_memory_struct~.
   
  7. If the pointer is not found in the array, it releases the lock and
     returns an error code ~QMCKL_INVALID_ARG_2~ using the ~qmckl_failwith~
     function.
     
  8. If the pointer is found, the memory block is deallocated using the
     standard ~free~ function.

  9. The ~qmckl_memory_info_struct~ at the found position is zeroed
     using ~memset~. This marks the slot as available for future
     allocations.
     
 10. The ~n_allocated~ member of the ~qmckl_memory_struct~ is decremented
     by one, as the memory block has been deallocated.

 11. The function releases the lock on the ~qmckl_context~ using ~qmckl_unlock~.

 12. Finally, the function returns ~QMCKL_SUCCESS~ to indicate
     successful deallocation of the memory block.
     
     
   # Source
   #+begin_src c :tangle (eval c)
qmckl_exit_code qmckl_free(qmckl_context context, void * const ptr) {

  if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
      return qmckl_failwith(context,
                            QMCKL_INVALID_CONTEXT,
                            "qmckl_free",
                            NULL);
  }

  if (ptr == NULL) {
    return qmckl_failwith(context,
                          QMCKL_INVALID_ARG_2,
                          "qmckl_free",
                          "NULL pointer");
  }

  qmckl_context_struct* const ctx = (qmckl_context_struct*) context;

  qmckl_lock(context);
  {
    /* Find pointer in array of saved pointers */
    size_t pos = (size_t) 0;
    while ( pos < ctx->memory.array_size && ctx->memory.element[pos].pointer != ptr) {
      pos += (size_t) 1;
    }

    if (pos >= ctx->memory.array_size) {
      /* Not found */
      qmckl_unlock(context);
      return qmckl_failwith(context,
                            QMCKL_INVALID_ARG_2,
                            "qmckl_free",
                            "Pointer not found in context");
    }

    /* Found */

    free(ptr);

    ctx->memory.n_allocated -= (size_t) 1;
//printf("FREE  : %5ld  %p\n", ctx->memory.n_allocated, ctx->memory.element[pos].pointer);
    ctx->memory.element[pos] = qmckl_memory_info_struct_zero;
  }
  qmckl_unlock(context);

  return QMCKL_SUCCESS;
}
   #+end_src

   # Test
   #+begin_src c :tangle (eval c_test) :exports none
qmckl_exit_code rc;
/* Assert that both arrays are allocated */
assert(a != NULL);
assert(b != NULL);

/* Free in NULL context */
rc = qmckl_free(QMCKL_NULL_CONTEXT, a);
assert(rc == QMCKL_INVALID_CONTEXT);

/* Free NULL pointer */
rc = qmckl_free(context, NULL);
assert(rc == QMCKL_INVALID_ARG_2);

/* Free for the first time */
rc = qmckl_free(context, a);
assert(rc == QMCKL_SUCCESS);

/* Free again */
rc = qmckl_free(context, a);
assert(rc == QMCKL_INVALID_ARG_2);

/* Clean up */
rc = qmckl_context_destroy(context);
assert(rc == QMCKL_SUCCESS);

   #+end_src

* Get the size of a memory block

  All the blocks allocated with ~qmckl_malloc~ keep track of how many
  bytes were allocated. Using ~qmckl_malloc_size~ allows to get this information.

  # Header
  #+begin_src c :tangle (eval h_private_func) :noexport
qmckl_exit_code
qmckl_get_malloc_info(qmckl_context context,
                      const void* pointer, 
                      qmckl_memory_info_struct* info);
  #+end_src

  # Source
  #+begin_src c :tangle (eval c)
qmckl_exit_code
qmckl_get_malloc_info(qmckl_context context,
                      const void* ptr, 
                      qmckl_memory_info_struct* info) 
{

  assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT);

  qmckl_context_struct* const ctx = (qmckl_context_struct*) context;

  if (ptr == NULL) {
    return qmckl_failwith(context,
                          QMCKL_INVALID_ARG_2,
                          "qmckl_get_malloc_info",
                          "Null pointer");
  }

  if (info == NULL) {
    return qmckl_failwith(context,
                          QMCKL_INVALID_ARG_3,
                          "qmckl_get_malloc_info",
                          "Null pointer");
  }

  qmckl_lock(context);
  {
    /* Find the pointer entry */
    size_t pos = (size_t) 0;
    while ( pos < ctx->memory.array_size && ctx->memory.element[pos].pointer != ptr) {
      pos += (size_t) 1;
    }

    if (pos >= ctx->memory.array_size) {
      /* Not found */
      qmckl_unlock(context);
      return qmckl_failwith(context,
                            QMCKL_INVALID_ARG_2,
                            "qmckl_get_malloc_info",
                            "Pointer not found in context");
    }

    /* Copy info */
    memcpy(info, &(ctx->memory.element[pos]), sizeof(qmckl_memory_info_struct));
  }
  qmckl_unlock(context);

  return QMCKL_SUCCESS;
}
  #+end_src


   # Test                                                            :noexport:
   #+begin_src c :tangle (eval c_test)
/* Create a context */
context = qmckl_context_create();

info = qmckl_memory_info_struct_zero;
info.size = (size_t) 3*sizeof(int);

/* Allocate an array of ints */
a = (int*) qmckl_malloc(context, info);

/* Check that the size of a is 3*sizeof(int) */
info = qmckl_memory_info_struct_zero;
rc = qmckl_get_malloc_info(context, NULL, &info);
assert (rc == QMCKL_INVALID_ARG_2);
rc = qmckl_get_malloc_info(context, &rc, &info);
assert (rc == QMCKL_INVALID_ARG_2);
rc = qmckl_get_malloc_info(context, a, &info);
assert (rc == QMCKL_SUCCESS);
assert (info.size == 3*sizeof(int));
rc = qmckl_context_destroy(context);
   #+end_src

* End of files                                                     :noexport:

  #+begin_src c :comments org :tangle (eval h_private_func)
#endif

  #+end_src

  #+begin_src c :comments org :tangle (eval h_private_type)
#endif

  #+end_src
** Test
  #+begin_src c :comments org :tangle (eval c_test)
  return 0;
}

  #+end_src


# -*- mode: org -*-
# vim: syntax=c