mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-12-22 12:23:56 +01:00
Memory management
This commit is contained in:
parent
fac7e9d74f
commit
93b5e48a6b
@ -23,6 +23,7 @@ MunitResult test_<<filename()>>() {
|
||||
#include <pthread.h>
|
||||
|
||||
#include "qmckl_error_private_type.h"
|
||||
#include "qmckl_memory_private_type.h"
|
||||
#include "qmckl_numprec_private_type.h"
|
||||
#+end_src
|
||||
|
||||
@ -39,10 +40,9 @@ MunitResult test_<<filename()>>() {
|
||||
#include "qmckl_context_private_type.h"
|
||||
#include "qmckl_context_type.h"
|
||||
|
||||
#include "qmckl_memory_func.h"
|
||||
#include "qmckl_memory_private_func.h"
|
||||
#include "qmckl_context_func.h"
|
||||
|
||||
static void init_lock(pthread_mutex_t* mutex);
|
||||
#+end_src
|
||||
|
||||
* Context handling
|
||||
@ -94,9 +94,7 @@ typedef struct qmckl_context_struct {
|
||||
qmckl_error_struct error;
|
||||
|
||||
/* Memory allocation */
|
||||
/*
|
||||
qmckl_memory_struct memory;
|
||||
,*/
|
||||
|
||||
/* -- Molecular system -- */
|
||||
/* To be implemented:
|
||||
@ -173,11 +171,26 @@ qmckl_context qmckl_context_create() {
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
}
|
||||
|
||||
/* Set all pointers to NULL */
|
||||
memset(ctx, 0, sizeof(qmckl_context_struct));
|
||||
/* Set all pointers and values to NULL */
|
||||
{
|
||||
memset(ctx, 0, sizeof(qmckl_context_struct));
|
||||
}
|
||||
|
||||
/* Initialize lock */
|
||||
init_lock(&(ctx->mutex));
|
||||
{
|
||||
pthread_mutexattr_t attr;
|
||||
int rc;
|
||||
|
||||
rc = pthread_mutexattr_init(&attr);
|
||||
assert (rc == 0);
|
||||
|
||||
(void) pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
|
||||
|
||||
rc = pthread_mutex_init ( &(ctx->mutex), &attr);
|
||||
assert (rc == 0);
|
||||
|
||||
(void) pthread_mutexattr_destroy(&attr);
|
||||
}
|
||||
|
||||
/* Initialize data */
|
||||
ctx->tag = VALID_TAG;
|
||||
@ -185,7 +198,21 @@ qmckl_context qmckl_context_create() {
|
||||
const qmckl_context context = (const qmckl_context) ctx;
|
||||
assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT );
|
||||
|
||||
return context;
|
||||
/* Allocate qmckl_memory_struct */
|
||||
{
|
||||
const size_t size = 128L;
|
||||
qmckl_memory_info_struct * new_array = calloc(size, sizeof(qmckl_memory_info_struct));
|
||||
if (new_array == NULL) {
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
}
|
||||
memset( &(new_array[0]), 0, size * sizeof(qmckl_memory_info_struct) );
|
||||
|
||||
ctx->memory.element = new_array;
|
||||
ctx->memory.array_size = size;
|
||||
ctx->memory.n_allocated = (size_t) 0;
|
||||
}
|
||||
|
||||
return (qmckl_context) ctx;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
@ -223,22 +250,7 @@ void qmckl_unlock(qmckl_context context);
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
static void init_lock(pthread_mutex_t* mutex) {
|
||||
pthread_mutexattr_t attr;
|
||||
int rc;
|
||||
|
||||
rc = pthread_mutexattr_init(&attr);
|
||||
assert (rc == 0);
|
||||
|
||||
(void) pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
|
||||
|
||||
rc = pthread_mutex_init ( mutex, &attr);
|
||||
assert (rc == 0);
|
||||
|
||||
(void)pthread_mutexattr_destroy(&attr);
|
||||
}
|
||||
|
||||
void qmckl_lock(const qmckl_context context) {
|
||||
void qmckl_lock(qmckl_context context) {
|
||||
if (context == QMCKL_NULL_CONTEXT)
|
||||
return ;
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
@ -252,7 +264,7 @@ void qmckl_lock(const qmckl_context context) {
|
||||
ctx->lock_count += 1;
|
||||
/*
|
||||
printf(" lock : %d\n", ctx->lock_count);
|
||||
*/
|
||||
,*/
|
||||
}
|
||||
|
||||
void qmckl_unlock(const qmckl_context context) {
|
||||
@ -266,13 +278,13 @@ void qmckl_unlock(const qmckl_context context) {
|
||||
ctx->lock_count -= 1;
|
||||
/*
|
||||
printf("unlock : %d\n", ctx->lock_count);
|
||||
*/
|
||||
,*/
|
||||
}
|
||||
#+end_src
|
||||
|
||||
** TODO Copy
|
||||
|
||||
~qmckl_context_copy~ makes a shallow copy of a context. It returns
|
||||
~qmckl_context_copy~ makes a deep copy of a context. It returns
|
||||
~QMCKL_NULL_CONTEXT~ upon failure.
|
||||
|
||||
# Header
|
||||
@ -285,36 +297,38 @@ qmckl_context qmckl_context_copy(const qmckl_context context);
|
||||
#+begin_src c :tangle (eval c)
|
||||
qmckl_context qmckl_context_copy(const qmckl_context context) {
|
||||
|
||||
qmckl_lock(context);
|
||||
|
||||
const qmckl_context checked_context = qmckl_context_check(context);
|
||||
|
||||
if (checked_context == QMCKL_NULL_CONTEXT) {
|
||||
qmckl_unlock(context);
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
}
|
||||
|
||||
|
||||
const qmckl_context_struct* const old_ctx =
|
||||
(qmckl_context_struct* const) checked_context;
|
||||
|
||||
qmckl_context_struct* const new_ctx =
|
||||
(qmckl_context_struct* const) qmckl_malloc (context, sizeof(qmckl_context_struct));
|
||||
|
||||
if (new_ctx == NULL) {
|
||||
qmckl_unlock(context);
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
/*
|
||||
qmckl_lock(context);
|
||||
{
|
||||
|
||||
const qmckl_context_struct* const old_ctx =
|
||||
(qmckl_context_struct* const) checked_context;
|
||||
|
||||
qmckl_context_struct* const new_ctx =
|
||||
(qmckl_context_struct* const) malloc (context, sizeof(qmckl_context_struct));
|
||||
|
||||
if (new_ctx == NULL) {
|
||||
qmckl_unlock(context);
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
}
|
||||
|
||||
* Copy the old context on the new one *
|
||||
* TODO Deep copies should be done here *
|
||||
memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct));
|
||||
|
||||
qmckl_unlock( (qmckl_context) new_ctx );
|
||||
|
||||
return (qmckl_context) new_ctx;
|
||||
}
|
||||
|
||||
/* Copy the old context on the new one */
|
||||
/* TODO Deep copies should be done here */
|
||||
memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct));
|
||||
|
||||
/* As the lock was copied, both need to be unlocked */
|
||||
qmckl_unlock( (qmckl_context) new_ctx );
|
||||
qmckl_unlock( (qmckl_context) old_ctx );
|
||||
|
||||
return (qmckl_context) new_ctx;
|
||||
qmckl_unlock(context);
|
||||
*/
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
}
|
||||
|
||||
#+end_src
|
||||
@ -332,10 +346,12 @@ qmckl_context qmckl_context_copy(const qmckl_context context) {
|
||||
|
||||
# Test
|
||||
#+begin_src c :comments link :tangle (eval c_test) :exports none
|
||||
/*
|
||||
qmckl_context new_context = qmckl_context_copy(context);
|
||||
munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT);
|
||||
munit_assert_int64(new_context, !=, context);
|
||||
munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
|
||||
*/
|
||||
#+end_src
|
||||
|
||||
** Destroy
|
||||
@ -355,28 +371,36 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) {
|
||||
const qmckl_context checked_context = qmckl_context_check(context);
|
||||
if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT;
|
||||
|
||||
qmckl_lock(context);
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
assert (ctx != NULL); /* Shouldn't be possible because the context is valid */
|
||||
|
||||
/* TODO Remove all allocated data */
|
||||
/*
|
||||
qmckl_memory_free_all(context);
|
||||
,*/
|
||||
|
||||
qmckl_lock(context);
|
||||
{
|
||||
/* Memory: Remove all allocated data */
|
||||
for (size_t pos = (size_t) 0 ; pos < ctx->memory.array_size ; ++pos) {
|
||||
if (ctx->memory.element[pos].pointer != NULL) {
|
||||
free(ctx->memory.element[pos].pointer);
|
||||
memset( &(ctx->memory.element[pos]), 0, sizeof(qmckl_memory_info_struct) );
|
||||
ctx->memory.n_allocated -= 1;
|
||||
}
|
||||
}
|
||||
assert (ctx->memory.n_allocated == (size_t) 0);
|
||||
free(ctx->memory.element);
|
||||
ctx->memory.element = NULL;
|
||||
ctx->memory.array_size = (size_t) 0;
|
||||
}
|
||||
qmckl_unlock(context);
|
||||
|
||||
ctx->tag = INVALID_TAG;
|
||||
|
||||
const int rc_destroy = pthread_mutex_destroy( &(ctx->mutex) );
|
||||
if (rc_destroy != 0) {
|
||||
/* DEBUG */
|
||||
fprintf(stderr, "qmckl_context_destroy: %s (count = %d)\n", strerror(rc_destroy), ctx->lock_count);
|
||||
abort();
|
||||
}
|
||||
|
||||
ctx->tag = INVALID_TAG;
|
||||
|
||||
const qmckl_exit_code rc = qmckl_free(context,ctx);
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
free(ctx);
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
@ -395,11 +419,15 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) {
|
||||
|
||||
# Test
|
||||
#+begin_src c :tangle (eval c_test) :exports none
|
||||
munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
|
||||
munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS);
|
||||
munit_assert_int64(qmckl_context_check(new_context), !=, new_context);
|
||||
munit_assert_int64(qmckl_context_check(new_context), ==, QMCKL_NULL_CONTEXT);
|
||||
/* Destroy valid context */
|
||||
munit_assert_int64(qmckl_context_check(context), ==, context);
|
||||
munit_assert_int32(qmckl_context_destroy(context), ==, QMCKL_SUCCESS);
|
||||
|
||||
/* Check that context is destroyed */
|
||||
munit_assert_int64(qmckl_context_check(context), !=, context);
|
||||
munit_assert_int64(qmckl_context_check(context), ==, QMCKL_NULL_CONTEXT);
|
||||
|
||||
/* Destroy invalid context */
|
||||
munit_assert_int32(qmckl_context_destroy(QMCKL_NULL_CONTEXT), ==, QMCKL_INVALID_CONTEXT);
|
||||
#+end_src
|
||||
|
||||
|
@ -154,16 +154,22 @@ return '\n'.join(result)
|
||||
#+end_src
|
||||
:end:
|
||||
|
||||
The ~qmckl_strerror~ converts an exit code into a string. The
|
||||
The ~qmckl_string_of_error~ converts an exit code into a string. The
|
||||
string is assumed to be large enough to contain the error message
|
||||
(typically 128 characters).
|
||||
|
||||
* Decoding errors
|
||||
|
||||
To decode the error messages, ~qmckl_string_of_error~ converts an
|
||||
error code into a string.
|
||||
|
||||
#+NAME: MAX_STRING_LENGTH
|
||||
: 128
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none :noweb yes
|
||||
const char* qmckl_string_of_error(const qmckl_exit_code error);
|
||||
void qmckl_string_of_error_f(const qmckl_exit_code error, char result[<<MAX_STRING_LENGTH()>>]);
|
||||
void qmckl_string_of_error_f(const qmckl_exit_code error,
|
||||
char result[<<MAX_STRING_LENGTH()>>]);
|
||||
#+end_src
|
||||
|
||||
The text strings are extracted from the previous table.
|
||||
@ -231,8 +237,7 @@ typedef struct qmckl_error_struct {
|
||||
|
||||
* Updating errors in the context
|
||||
|
||||
The error is updated in the context using
|
||||
~qmckl_set_error~.
|
||||
The error is updated in the context using ~qmckl_set_error~.
|
||||
When the error is set in the context, it is mandatory to specify
|
||||
from which function the error is triggered, and a message
|
||||
explaining the error. The exit code can't be ~QMCKL_SUCCESS~.
|
||||
@ -286,8 +291,11 @@ qmckl_set_error(qmckl_context context,
|
||||
To make a function fail, the ~qmckl_failwith~ function should be
|
||||
called, such that information about the failure is stored in
|
||||
the context. The desired exit code is given as an argument, as
|
||||
well as the name of the function and an error message. The return
|
||||
code of the function is the desired return code.
|
||||
well as the name of the function and an error message. If the
|
||||
message is ~NULL~, then the default message obtained by
|
||||
~qmckl_string_of_error~ is used. The return code of the function is
|
||||
the desired return code.
|
||||
Upon failure, a ~QMCKL_NULL_CONTEXT~ is returned.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none
|
||||
qmckl_exit_code qmckl_failwith(qmckl_context context,
|
||||
@ -305,17 +313,23 @@ qmckl_exit_code qmckl_failwith(qmckl_context context,
|
||||
assert (exit_code > 0);
|
||||
assert (exit_code < QMCKL_INVALID_EXIT_CODE);
|
||||
assert (function != NULL);
|
||||
assert (message != NULL);
|
||||
assert (strlen(function) < QMCKL_MAX_FUN_LEN);
|
||||
assert (strlen(message) < QMCKL_MAX_MSG_LEN);
|
||||
if (message != NULL) {
|
||||
assert (strlen(message) < QMCKL_MAX_MSG_LEN);
|
||||
}
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT)
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
return QMCKL_INVALID_CONTEXT;
|
||||
|
||||
const qmckl_exit_code rc =
|
||||
qmckl_set_error(context, exit_code, function, message);
|
||||
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
if (message == NULL) {
|
||||
qmckl_exit_code rc =
|
||||
qmckl_set_error(context, exit_code, function, qmckl_string_of_error(exit_code));
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
} else {
|
||||
qmckl_exit_code rc =
|
||||
qmckl_set_error(context, exit_code, function, message);
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
}
|
||||
|
||||
return exit_code;
|
||||
}
|
||||
@ -332,10 +346,6 @@ if (x < 0) {
|
||||
}
|
||||
#+end_src
|
||||
|
||||
* TODO Decoding errors
|
||||
|
||||
To decode the error messages, ~qmckl_strerror~ converts an
|
||||
error code into a string.
|
||||
|
||||
* End of files :noexport:
|
||||
|
||||
|
@ -15,12 +15,15 @@ optimized libraries to fine-tune the memory allocation.
|
||||
#+begin_src c :tangle (eval c)
|
||||
#include <stdint.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
|
||||
#include "qmckl_error_type.h"
|
||||
#include "qmckl_memory_private_type.h"
|
||||
#include "qmckl_context_type.h"
|
||||
#include "qmckl_context_private_type.h"
|
||||
|
||||
#include "qmckl_memory_private_func.h"
|
||||
#include "qmckl_memory_func.h"
|
||||
#include "qmckl_context_func.h"
|
||||
#include "qmckl_error_func.h"
|
||||
@ -29,13 +32,59 @@ optimized libraries to fine-tune the memory allocation.
|
||||
#+begin_src c :tangle (eval c_test) :noweb yes
|
||||
#include "qmckl.h"
|
||||
#include "munit.h"
|
||||
#include "qmckl_context_private_type.h"
|
||||
#include "qmckl_memory_private_func.h"
|
||||
MunitResult test_<<filename()>>() {
|
||||
#+end_src
|
||||
|
||||
*
|
||||
:PROPERTIES:
|
||||
:UNNUMBERED: t
|
||||
:END:
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type) :noweb yes
|
||||
#ifndef QMCKL_MEMORY_HPT
|
||||
#define QMCKL_MEMORY_HPT
|
||||
|
||||
#include <stdint.h>
|
||||
#+end_src
|
||||
|
||||
* Memory data structure for the context
|
||||
|
||||
Every time a new block of memory is allocated, the information
|
||||
relative to the allocation is stored in a new ~qmckl_memory_info_struct~.
|
||||
A ~qmckl_memory_info_struct~ contains the pointer to the memory block,
|
||||
its size in bytes, and extra implementation-specific information such as
|
||||
alignment, pinning, if the memory should be allocated on CPU or GPU
|
||||
/etc/.
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type) :noweb yes
|
||||
typedef struct qmckl_memory_info_struct {
|
||||
size_t size;
|
||||
void* pointer;
|
||||
} qmckl_memory_info_struct;
|
||||
|
||||
static const qmckl_memory_info_struct qmckl_memory_info_struct_zero =
|
||||
{
|
||||
.size = (size_t) 0,
|
||||
.pointer = NULL
|
||||
};
|
||||
#+end_src
|
||||
|
||||
The ~memory~ element of the context is a data structure which
|
||||
contains an array of ~qmckl_memory_info_struct~, the size of the
|
||||
array, and the number of allocated blocks.
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type) :noweb yes
|
||||
typedef struct qmckl_memory_struct {
|
||||
size_t n_allocated;
|
||||
size_t array_size;
|
||||
qmckl_memory_info_struct* element;
|
||||
} qmckl_memory_struct;
|
||||
#+end_src
|
||||
|
||||
* Passing info to allocation routines
|
||||
|
||||
Passing information to the allocation routine should be done by
|
||||
passing an instance of a ~qmckl_memory_info_struct~.
|
||||
|
||||
* Allocation/deallocation functions
|
||||
|
||||
Memory allocation inside the library should be done with
|
||||
~qmckl_malloc~. It lets the library choose how the memory will be
|
||||
@ -47,55 +96,88 @@ MunitResult test_<<filename()>>() {
|
||||
If the allocation failed, the ~NULL~ pointer is returned.
|
||||
|
||||
# Header
|
||||
#+begin_src c :tangle (eval h_func) :noexport
|
||||
#+begin_src c :tangle (eval h_private_func) :noexport
|
||||
void* qmckl_malloc(qmckl_context context,
|
||||
const size_t size);
|
||||
const qmckl_memory_info_struct info);
|
||||
#+end_src
|
||||
|
||||
In this implementation, we use ~calloc~ because it initializes the
|
||||
memory block to zero, so structs will have ~NULL~-initialized pointers.
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
void* qmckl_malloc(qmckl_context context, const size_t size) {
|
||||
void* qmckl_malloc(qmckl_context context, const qmckl_memory_info_struct info) {
|
||||
|
||||
assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT);
|
||||
void * pointer = calloc(size, (size_t) 1);
|
||||
|
||||
/*
|
||||
if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) {
|
||||
qmckl_exit_code rc;
|
||||
rc = qmckl_context_append_memory(context, pointer, size);
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
|
||||
/* Allocate memory and zero it */
|
||||
void * pointer = malloc(info.size);
|
||||
if (pointer == NULL) {
|
||||
return NULL;
|
||||
}
|
||||
*/
|
||||
memset(pointer, 0, info.size);
|
||||
|
||||
qmckl_lock(context);
|
||||
{
|
||||
/* If qmckl_memory_struct is full, reallocate a larger one */
|
||||
if (ctx->memory.n_allocated == ctx->memory.array_size) {
|
||||
const size_t old_size = ctx->memory.array_size;
|
||||
qmckl_memory_info_struct * new_array = reallocarray(ctx->memory.element,
|
||||
2L * old_size,
|
||||
sizeof(qmckl_memory_info_struct));
|
||||
if (new_array == NULL) {
|
||||
qmckl_unlock(context);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
memset( &(new_array[old_size]), 0, old_size * sizeof(qmckl_memory_info_struct) );
|
||||
ctx->memory.element = new_array;
|
||||
ctx->memory.array_size = 2L * old_size;
|
||||
}
|
||||
|
||||
/* Find first NULL entry */
|
||||
size_t pos = (size_t) 0;
|
||||
while ( pos < ctx->memory.array_size && ctx->memory.element[pos].size > (size_t) 0) {
|
||||
pos += (size_t) 1;
|
||||
}
|
||||
assert (ctx->memory.element[pos].size == (size_t) 0);
|
||||
|
||||
/* Copy info at the new location */
|
||||
ctx->memory.element[pos].size = info.size;
|
||||
ctx->memory.element[pos].pointer = pointer;
|
||||
ctx->memory.n_allocated += (size_t) 1;
|
||||
}
|
||||
qmckl_unlock(context);
|
||||
|
||||
return pointer;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
# Fortran interface
|
||||
#+begin_src f90 :tangle (eval fh_func) :noexport
|
||||
interface
|
||||
type (c_ptr) function qmckl_malloc (context, size) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
integer (qmckl_context), 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)
|
||||
/* Create a context */
|
||||
qmckl_context context = qmckl_context_create();
|
||||
|
||||
int *a = (int*) qmckl_malloc(context, 3*sizeof(int));
|
||||
munit_assert(a != NULL);
|
||||
qmckl_memory_info_struct info = qmckl_memory_info_struct_zero;
|
||||
info.size = (size_t) 3;
|
||||
|
||||
/* Allocate an array of ints */
|
||||
int *a = (int*) qmckl_malloc(context, info);
|
||||
|
||||
/* Check that array of ints is OK */
|
||||
munit_assert(a != NULL);
|
||||
a[0] = 1; munit_assert_int(a[0], ==, 1);
|
||||
a[1] = 2; munit_assert_int(a[1], ==, 2);
|
||||
a[2] = 3; munit_assert_int(a[2], ==, 3);
|
||||
|
||||
/* Allocate another array of ints */
|
||||
int *b = (int*) qmckl_malloc(context, info);
|
||||
|
||||
/* Check that array of ints is OK */
|
||||
munit_assert(b != NULL);
|
||||
b[0] = 1; munit_assert_int(b[0], ==, 1);
|
||||
b[1] = 2; munit_assert_int(b[1], ==, 2);
|
||||
b[2] = 3; munit_assert_int(b[2], ==, 3);
|
||||
#+end_src
|
||||
|
||||
When freeing the memory with ~qmckl_free~, the context is passed, in
|
||||
@ -104,40 +186,53 @@ a[2] = 3; munit_assert_int(a[2], ==, 3);
|
||||
|
||||
#+begin_src c :tangle (eval h_func)
|
||||
qmckl_exit_code qmckl_free(qmckl_context context,
|
||||
void *ptr);
|
||||
#+end_src
|
||||
|
||||
#+begin_src f90 :tangle (eval fh_func)
|
||||
interface
|
||||
integer (qmckl_exit_code) function qmckl_free (context, ptr) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
integer (qmckl_context), intent(in), value :: context
|
||||
type (c_ptr), intent(in), value :: ptr
|
||||
end function qmckl_free
|
||||
end interface
|
||||
void * const ptr);
|
||||
#+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) {
|
||||
qmckl_exit_code qmckl_free(qmckl_context context, void * const ptr) {
|
||||
|
||||
if (ptr == NULL) {
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
QMCKL_INVALID_CONTEXT,
|
||||
"qmckl_free",
|
||||
"NULL pointer");
|
||||
NULL);
|
||||
}
|
||||
|
||||
if (ptr == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_free",
|
||||
"NULL pointer");
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
|
||||
qmckl_lock(context);
|
||||
{
|
||||
/* Find pointer in array of saved pointers */
|
||||
size_t pos = (size_t) 0;
|
||||
while ( pos < ctx->memory.array_size && ctx->memory.element[pos].pointer != ptr) {
|
||||
pos += (size_t) 1;
|
||||
}
|
||||
|
||||
/*
|
||||
qmckl_exit_code rc;
|
||||
rc = qmckl_context_remove_memory(context, ptr);
|
||||
if (pos >= ctx->memory.array_size) {
|
||||
/* Not found */
|
||||
qmckl_unlock(context);
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_FAILURE,
|
||||
"qmckl_free",
|
||||
"Pointer not found in context");
|
||||
}
|
||||
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
*/
|
||||
free(ptr);
|
||||
|
||||
memset( &(ctx->memory.element[pos]), 0, sizeof(qmckl_memory_info_struct) );
|
||||
ctx->memory.n_allocated -= (size_t) 1;
|
||||
}
|
||||
free(ptr);
|
||||
qmckl_unlock(context);
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
@ -145,11 +240,27 @@ qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) {
|
||||
# Test
|
||||
#+begin_src c :tangle (eval c_test) :exports none
|
||||
qmckl_exit_code rc;
|
||||
|
||||
/* Assert that both arrays are allocated */
|
||||
munit_assert(a != NULL);
|
||||
munit_assert(b != NULL);
|
||||
|
||||
/* Free in NULL context */
|
||||
rc = qmckl_free(QMCKL_NULL_CONTEXT, a);
|
||||
munit_assert(rc == QMCKL_INVALID_CONTEXT);
|
||||
|
||||
/* Free NULL pointer */
|
||||
rc = qmckl_free(context, NULL);
|
||||
munit_assert(rc == QMCKL_INVALID_ARG_2);
|
||||
|
||||
/* Free for the first time */
|
||||
rc = qmckl_free(context, a);
|
||||
munit_assert(rc == QMCKL_SUCCESS);
|
||||
|
||||
/* Free again */
|
||||
rc = qmckl_free(context, a);
|
||||
munit_assert(rc == QMCKL_FAILURE);
|
||||
|
||||
/* Clean up */
|
||||
rc = qmckl_context_destroy(context);
|
||||
munit_assert(rc == QMCKL_SUCCESS);
|
||||
|
||||
@ -157,6 +268,10 @@ munit_assert(rc == QMCKL_SUCCESS);
|
||||
|
||||
* End of files :noexport:
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_type)
|
||||
#endif
|
||||
|
||||
#+end_src
|
||||
** Test
|
||||
#+begin_src c :comments org :tangle (eval c_test)
|
||||
return MUNIT_OK;
|
||||
|
Loading…
Reference in New Issue
Block a user