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~

    #+BEGIN_SRC C :tangle qmckl.h
void* qmckl_free(void *ptr);
    #+END_SRC

    #+BEGIN_SRC f90 :tangle qmckl_f.f90
  interface
     type (c_ptr) function qmckl_free (ptr) bind(C)
       use, intrinsic :: iso_c_binding
       type (c_ptr), intent(in), value :: ptr
     end function qmckl_free
  end interface
    #+END_SRC
**** Source
     #+BEGIN_SRC C :tangle qmckl_memory.c
void* qmckl_free(void *ptr) {
  assert (ptr != NULL);
  free(ptr);
  return NULL;
}

     #+END_SRC

**** Test                                                          :noexport:
     #+BEGIN_SRC C :tangle test_qmckl_memory.c
munit_assert(a != NULL);
a = qmckl_free(a);
munit_assert(a == NULL);

     #+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