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