#+TITLE: Context #+SETUPFILE: ../docs/theme.setup * 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_test) :noweb yes #include "qmckl.h" #include "munit.h" MunitResult test_<>() { #+end_src #+begin_src c :tangle (eval h_private_type) :noweb yes #ifndef QMCKL_CONTEXT_HPT #define QMCKL_CONTEXT_HPT #include #include #include "qmckl_error_private_type.h" #include "qmckl_numprec_private_type.h" #+end_src #+begin_src c :tangle (eval c) #include #include #include #include #include #include #include #include "qmckl_error_type.h" #include "qmckl_context_private_type.h" #include "qmckl_context_type.h" #include "qmckl_memory_func.h" #include "qmckl_context_func.h" static void init_lock(pthread_mutex_t* mutex); #+end_src * Context handling The context variable is a handle for the state of the library, and is stored in a data structure which can't be seen outside of the library. To simplify compatibility with other languages, the pointer to the internal data structure is converted into a 64-bit signed integer, defined in the ~qmckl_context~ type. A value of ~QMCKL_NULL_CONTEXT~ for the context is equivalent to a ~NULL~ pointer. #+NAME: qmckl_context #+begin_src c :comments org :tangle (eval h_type) typedef int64_t qmckl_context ; #define QMCKL_NULL_CONTEXT (qmckl_context) 0 #+end_src #+begin_src f90 :comments org :tangle (eval fh_type) :exports none integer , parameter :: qmckl_context = c_int64_t integer*8, parameter :: QMCKL_NULL_CONTEXT = 0 #+end_src An immutable context would have required to implement a garbage collector. To keep the library simple, we have chosen to implement the context as a mutable data structure, so it has to be handled with care. By convention, in this file ~context~ is a ~qmckl_context~ variable and ~ctx~ is a ~qmckl_context_struct*~ pointer. ** Data structure #+begin_src c :comments org :tangle (eval h_private_type) :noweb yes :exports none typedef struct qmckl_context_struct { /* -- State of the library -- */ /* Validity checking */ uint64_t tag; /* Numerical precision */ qmckl_numprec_struct numprec; /* Thread lock */ int lock_count; pthread_mutex_t mutex; /* Error handling */ qmckl_error_struct error; /* Memory allocation */ /* qmckl_memory_struct memory; ,*/ /* -- Molecular system -- */ /* To be implemented: qmckl_ao_basis_struct ao_basis; qmckl_nucleus_struct nucleus; qmckl_electron_struct electron; qmckl_mo_struct mo; qmckl_determinant_struct det; ,*/ } qmckl_context_struct; #+end_src When a new element is added to the context, the functions [[Creation][qmckl_context_create]], [[Destroy][qmckl_context_destroy]] and [[Copy][qmckl_context_copy]] should be updated inorder to make deep copies. A tag is used internally to check if the memory domain pointed by a pointer is a valid context. This allows to check that even if the pointer associated with a context is non-null, we can still verify that it points to the expected data structure. #+begin_src c :comments org :tangle (eval h_private_type) :noweb yes #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF #+end_src The ~qmckl_context_check~ function checks if the domain pointed by the pointer is a valid context. It returns the input ~qmckl_context~ if the context is valid, ~QMCKL_NULL_CONTEXT~ otherwise. #+begin_src c :comments org :tangle (eval h_func) :noexport qmckl_context qmckl_context_check(const qmckl_context context) ; #+end_src #+begin_src c :tangle (eval c) qmckl_context qmckl_context_check(const qmckl_context context) { if (context == QMCKL_NULL_CONTEXT) return QMCKL_NULL_CONTEXT; const qmckl_context_struct* const ctx = (const qmckl_context_struct* const) context; /* Try to access memory */ if (ctx->tag != VALID_TAG) { return QMCKL_NULL_CONTEXT; } return context; } #+end_src ** Creation To create a new context, ~qmckl_context_create()~ should be used. - Upon success, it returns a pointer to a new context with the ~qmckl_context~ type - It returns ~QMCKL_NULL_CONTEXT~ upon failure to allocate the internal data structure # Header #+begin_src c :comments org :tangle (eval h_func) :exports none qmckl_context qmckl_context_create(); #+end_src # Source #+begin_src c :tangle (eval c) qmckl_context qmckl_context_create() { qmckl_context_struct* const ctx = (qmckl_context_struct* const) malloc (sizeof(qmckl_context_struct)); if (ctx == NULL) { return QMCKL_NULL_CONTEXT; } /* Set all pointers to NULL */ memset(ctx, 0, sizeof(qmckl_context_struct)); /* Initialize lock */ init_lock(&(ctx->mutex)); /* Initialize data */ ctx->tag = VALID_TAG; const qmckl_context context = (const qmckl_context) ctx; assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT ); return context; } #+end_src # Fortran interface #+begin_src f90 :tangle (eval fh_func) :exports none interface integer (qmckl_context) function qmckl_context_create() bind(C) use, intrinsic :: iso_c_binding import end function qmckl_context_create end interface #+end_src # Test #+begin_src c :comments link :tangle (eval c_test) :exports none munit_assert_int64( qmckl_context_check(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); qmckl_context context = qmckl_context_create(); munit_assert_int64( context, !=, QMCKL_NULL_CONTEXT ); munit_assert_int64( qmckl_context_check(context), ==, context ); #+end_src ** Locking For thread safety, the context may be locked/unlocked. The lock is initialized with the ~PTHREAD_MUTEX_RECURSIVE~ attribute, and the number of times the thread has locked it is saved in the ~lock_count~ attribute. # Header #+begin_src c :comments org :tangle (eval h_func) :exports none void qmckl_lock (qmckl_context context); void qmckl_unlock(qmckl_context context); #+end_src # 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) { if (context == QMCKL_NULL_CONTEXT) return ; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; errno = 0; int rc = pthread_mutex_lock( &(ctx->mutex) ); if (rc != 0) { fprintf(stderr, "DEBUG qmckl_lock:%s\n", strerror(rc) ); fflush(stderr); } assert (rc == 0); ctx->lock_count += 1; /* printf(" lock : %d\n", ctx->lock_count); */ } void qmckl_unlock(const qmckl_context context) { qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; int rc = pthread_mutex_unlock( &(ctx->mutex) ); if (rc != 0) { fprintf(stderr, "DEBUG qmckl_unlock:%s\n", strerror(rc) ); fflush(stderr); } assert (rc == 0); 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_NULL_CONTEXT~ upon failure. # Header #+begin_src c :comments org :tangle (eval h_func) :exports none qmckl_context qmckl_context_copy(const qmckl_context context); #+end_src # Source #+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; } /* 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; } #+end_src # Fortran interface #+begin_src f90 :tangle (eval fh_func) :exports none interface integer (qmckl_context) function qmckl_context_copy(context) bind(C) use, intrinsic :: iso_c_binding import integer (qmckl_context), intent(in), value :: context end function qmckl_context_copy end interface #+end_src # 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 The context is destroyed with ~qmckl_context_destroy~, leaving the ancestors untouched. It frees the context, and returns the previous context. # Header #+begin_src c :comments org :tangle (eval h_func) :exports none qmckl_exit_code qmckl_context_destroy(const qmckl_context context); #+end_src # Source #+begin_src c :tangle (eval c) 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_unlock(context); const int rc_destroy = pthread_mutex_destroy( &(ctx->mutex) ); if (rc_destroy != 0) { 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); return QMCKL_SUCCESS; } #+end_src # Fortran interface #+begin_src f90 :tangle (eval fh_func) :exports none interface integer (qmckl_exit_code) function qmckl_context_destroy(context) bind(C) use, intrinsic :: iso_c_binding import integer (qmckl_context), intent(in), value :: context end function qmckl_context_destroy end interface #+end_src # 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); munit_assert_int32(qmckl_context_destroy(context), ==, QMCKL_SUCCESS); munit_assert_int32(qmckl_context_destroy(QMCKL_NULL_CONTEXT), ==, QMCKL_INVALID_CONTEXT); #+end_src * End of files :noexport: #+begin_src c :comments link :tangle (eval h_private_type) #endif #+end_src *** Test #+begin_src c :comments link :tangle (eval c_test) return MUNIT_OK; } #+end_src