1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-06-30 00:44:52 +02:00
qmckl/src/qmckl_memory.org

102 lines
2.5 KiB
Org Mode
Raw Normal View History

2020-11-05 15:34:58 +01:00
** Memory management
2020-10-22 01:24:14 +02:00
2020-11-05 15:34:58 +01:00
We override the allocation functions to enable the possibility of
optimized libraries to fine-tune the memory allocation.
2020-10-16 23:56:22 +02:00
2020-11-05 15:34:58 +01:00
2 files are produced:
- a source file : =qmckl_memory.c=
- a test file : =test_qmckl_memory.c=
2020-10-16 23:56:22 +02:00
2020-11-05 15:34:58 +01:00
*** Headers :noexport:
#+BEGIN_SRC C :tangle qmckl_memory.c
2020-10-16 23:56:22 +02:00
#include "qmckl.h"
2020-11-05 15:34:58 +01:00
#+END_SRC
2020-10-16 23:56:22 +02:00
2020-11-05 15:34:58 +01:00
#+BEGIN_SRC C :tangle test_qmckl_memory.c
2020-10-17 01:10:54 +02:00
#include "qmckl.h"
#include "munit.h"
2020-10-21 19:50:18 +02:00
MunitResult test_qmckl_memory() {
2020-11-05 15:34:58 +01:00
#+END_SRC
2020-10-16 23:56:22 +02:00
2020-12-03 18:57:15 +01:00
*** ~qmckl_malloc~
2020-11-05 15:27:25 +01:00
2020-11-05 15:34:58 +01:00
Memory allocation function, letting the library choose how the
memory will be allocated, and a pointer is returned to the user.
2020-11-05 15:27:25 +01:00
2020-11-05 15:34:58 +01:00
#+BEGIN_SRC C :tangle qmckl.h
2020-10-22 00:50:07 +02:00
void* qmckl_malloc(const qmckl_context ctx, const size_t size);
2020-11-05 15:34:58 +01:00
#+END_SRC
2020-10-16 23:56:22 +02:00
2020-11-05 15:34:58 +01:00
#+BEGIN_SRC f90 :tangle qmckl_f.f90
2020-11-05 15:27:25 +01:00
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
2020-11-05 15:34:58 +01:00
#+END_SRC
2020-11-05 15:27:25 +01:00
2020-11-05 15:34:58 +01:00
**** Source
#+BEGIN_SRC C :tangle qmckl_memory.c
2020-10-22 00:50:07 +02:00
void* qmckl_malloc(const qmckl_context ctx, const size_t size) {
if (ctx == (qmckl_context) 0) {
/* Avoids unused parameter error */
return malloc( (size_t) size );
}
2020-10-16 23:56:22 +02:00
return malloc( (size_t) size );
}
2020-11-05 15:34:58 +01:00
#+END_SRC
2020-10-22 01:24:14 +02:00
2020-11-05 15:34:58 +01:00
**** Test :noexport:
#+BEGIN_SRC C :tangle test_qmckl_memory.c
2020-11-05 15:27:25 +01:00
int *a;
a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int));
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);
2020-11-05 15:34:58 +01:00
#+END_SRC
2020-10-16 23:56:22 +02:00
2020-12-03 18:57:15 +01:00
*** ~qmckl_free~
2020-10-16 23:56:22 +02:00
2020-11-05 15:34:58 +01:00
#+BEGIN_SRC C :tangle qmckl.h
2020-10-16 23:56:22 +02:00
void qmckl_free(void *ptr);
2020-11-05 15:34:58 +01:00
#+END_SRC
2020-10-16 23:56:22 +02:00
2020-11-05 15:34:58 +01:00
#+BEGIN_SRC f90 :tangle qmckl_f.f90
2020-11-05 15:27:25 +01:00
interface
subroutine qmckl_free (ptr) bind(C)
use, intrinsic :: iso_c_binding
type (c_ptr), intent(in), value :: ptr
end subroutine qmckl_free
end interface
2020-11-05 15:34:58 +01:00
#+END_SRC
**** Source
#+BEGIN_SRC C :tangle qmckl_memory.c
2020-10-16 23:56:22 +02:00
void qmckl_free(void *ptr) {
free(ptr);
}
2020-11-05 15:34:58 +01:00
#+END_SRC
2020-10-22 01:24:14 +02:00
2020-11-05 15:34:58 +01:00
**** Test :noexport:
#+BEGIN_SRC C :tangle test_qmckl_memory.c
2020-11-05 15:27:25 +01:00
qmckl_free(a);
2020-11-05 15:34:58 +01:00
#+END_SRC
2020-10-16 23:56:22 +02:00
2020-11-05 15:34:58 +01:00
*** End of files :noexport:
2020-10-16 23:56:22 +02:00
2020-11-05 15:34:58 +01:00
**** Test
#+BEGIN_SRC C :comments org :tangle test_qmckl_memory.c
2020-10-17 01:10:54 +02:00
return MUNIT_OK;
2020-10-22 01:24:14 +02:00
}
2020-10-17 01:10:54 +02:00
2020-11-05 15:34:58 +01:00
#+END_SRC
2020-11-05 15:27:25 +01:00
2020-11-05 15:34:58 +01:00
# -*- mode: org -*-
# vim: syntax=c