mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-07-30 09:04:09 +02:00
151 lines
4.1 KiB
Org Mode
151 lines
4.1 KiB
Org Mode
#+TITLE: Memory management
|
|
#+SETUPFILE: ../docs/theme.setup
|
|
|
|
We override the allocation functions to enable the possibility of
|
|
optimized libraries to fine-tune the memory allocation.
|
|
|
|
|
|
* Headers :noexport:
|
|
|
|
#+NAME: filename
|
|
#+begin_src elisp tangle: no
|
|
(file-name-nondirectory (substring buffer-file-name 0 -4))
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval c)
|
|
#include <stdint.h>
|
|
#include <stdlib.h>
|
|
#include <assert.h>
|
|
|
|
#include "qmckl_error.h"
|
|
#include "qmckl_context.h"
|
|
#include "qmckl_context_private.h"
|
|
#include "qmckl_memory.h"
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval c_test) :noweb yes
|
|
#include "qmckl.h"
|
|
#include "munit.h"
|
|
MunitResult test_<<filename()>>() {
|
|
#+end_src
|
|
|
|
*
|
|
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.
|
|
|
|
# Header
|
|
#+begin_src c :tangle (eval h) :noexport
|
|
void* qmckl_malloc(qmckl_context context,
|
|
const size_t size);
|
|
#+end_src
|
|
|
|
# Source
|
|
#+begin_src c :tangle (eval c)
|
|
void* qmckl_malloc(qmckl_context context, const size_t size) {
|
|
|
|
void * pointer = malloc( (size_t) size );
|
|
|
|
if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) {
|
|
qmckl_exit_code rc;
|
|
rc = qmckl_context_append_memory(context, pointer, size);
|
|
assert (rc == QMCKL_SUCCESS);
|
|
}
|
|
|
|
return pointer;
|
|
}
|
|
#+end_src
|
|
# Fortran interface
|
|
#+begin_src f90 :tangle (eval fh) :noexport
|
|
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
|
|
|
|
** Test :noexport:
|
|
#+begin_src c :tangle (eval c_test)
|
|
int *a = NULL;
|
|
munit_assert(a == NULL);
|
|
a = (int*) qmckl_malloc( QMCKL_NULL_CONTEXT, 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 (eval h)
|
|
qmckl_exit_code qmckl_free(qmckl_context context,
|
|
void *ptr);
|
|
#+end_src
|
|
|
|
#+begin_src f90 :tangle (eval fh)
|
|
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 (eval c)
|
|
qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) {
|
|
if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) {
|
|
|
|
if (ptr == NULL) {
|
|
return qmckl_failwith(context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_free",
|
|
"NULL pointer");
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
rc = qmckl_context_remove_memory(context, ptr);
|
|
|
|
assert (rc == QMCKL_SUCCESS);
|
|
}
|
|
free(ptr);
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
** Test :noexport:
|
|
#+begin_src c :tangle (eval c_test)
|
|
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 (eval c_test)
|
|
return MUNIT_OK;
|
|
}
|
|
|
|
#+end_src
|
|
|
|
|
|
# -*- mode: org -*-
|
|
# vim: syntax=c
|