diff --git a/src/qmckl_context.org b/src/qmckl_context.org index df721d5..fa0aea0 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -23,6 +23,7 @@ MunitResult test_<>() { #include #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_<>() { #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 diff --git a/src/qmckl_error.org b/src/qmckl_error.org index b1fc1dc..be4b293 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -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[<>]); +void qmckl_string_of_error_f(const qmckl_exit_code error, + char result[<>]); #+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: diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index 5016212..240b28b 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -15,12 +15,15 @@ optimized libraries to fine-tune the memory allocation. #+begin_src c :tangle (eval c) #include #include +#include #include #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_<>() { #+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 + #+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_<>() { 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;