qmckl/src/qmckl_memory.org

** Memory management

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

 2 files are produced:
 - a source file : =qmckl_memory.c=
 - a test   file : =test_qmckl_memory.c=

*** Headers                                                        :noexport:
    #+BEGIN_SRC C :tangle qmckl_memory.c
#include "qmckl.h"
#include <assert.h>
    #+END_SRC

    #+BEGIN_SRC C :tangle test_qmckl_memory.c
#include "qmckl.h"
#include "munit.h"
MunitResult test_qmckl_memory() {
    #+END_SRC

*** ~qmckl_malloc~

    Memory allocation function, letting 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.

    #+BEGIN_SRC C :tangle qmckl.h
void* qmckl_malloc(const qmckl_context ctx, const size_t size);
    #+END_SRC

    #+BEGIN_SRC f90 :tangle qmckl_f.f90
  interface
     type (c_ptr) function qmckl_malloc (context, size) bind(C)
       use, intrinsic :: iso_c_binding
       integer (c_int64_t), intent(in), value :: context
       integer (c_int64_t), intent(in), value :: size
     end function qmckl_malloc
  end interface
    #+END_SRC

**** Source
     #+BEGIN_SRC C :tangle qmckl_memory.c
void* qmckl_malloc(const qmckl_context ctx, const size_t size) {
  if (ctx == (qmckl_context) 0) {}; /* Avoid unused argument warning */
  void * result = malloc( (size_t) size );
  assert (result != NULL) ;
  return result;
}

     #+END_SRC

**** Test                                                          :noexport:
     #+BEGIN_SRC C :tangle test_qmckl_memory.c
int *a = NULL;
munit_assert(a == NULL);
a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int));
munit_assert(a != NULL);
a[0] = 1;
a[1] = 2;
a[2] = 3;
munit_assert_int(a[0], ==, 1);
munit_assert_int(a[1], ==, 2);
munit_assert_int(a[2], ==, 3);
     #+END_SRC

*** ~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 qmckl.h
qmckl_exit_code qmckl_free(qmckl_context context, void *ptr);
    #+END_SRC

    #+BEGIN_SRC f90 :tangle qmckl_f.f90
  interface
     integer (c_int32_t) function qmckl_free (context, ptr) bind(C)
       use, intrinsic :: iso_c_binding
       integer (c_int64_t), intent(in), value :: context
       type (c_ptr), intent(in), value :: ptr
     end function qmckl_free
  end interface
    #+END_SRC

**** Source
     #+BEGIN_SRC C :tangle qmckl_memory.c
qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) {
  if (context == 0) return QMCKL_INVALID_ARG_1;
  if (ptr == NULL)  return QMCKL_INVALID_ARG_2;
  free(ptr);
  return QMCKL_SUCCESS;
}
     #+END_SRC

**** Test                                                          :noexport:
     #+BEGIN_SRC C :tangle test_qmckl_memory.c
munit_assert(a != NULL);
qmckl_exit_code rc;
rc = qmckl_free( (qmckl_context) 1, a);
munit_assert(rc == QMCKL_SUCCESS);

     #+END_SRC

*** End of files                                                   :noexport:

**** Test
   #+BEGIN_SRC C :comments org :tangle test_qmckl_memory.c
  return MUNIT_OK;
}

   #+END_SRC
 

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