1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-12-23 12:57:20 +01:00
qmckl/org/qmckl_context.org
2021-06-23 17:56:01 +05:30

490 lines
13 KiB
Org Mode

#+TITLE: Context
#+SETUPFILE: ../tools/theme.setup
#+INCLUDE: ../tools/lib.org
* Headers :noexport:
#+begin_src c :tangle (eval c_test) :noweb yes
#include "qmckl.h"
#include "assert.h"
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
int main() {
#+end_src
#+begin_src c :tangle (eval h_private_type) :noweb yes
#ifndef QMCKL_CONTEXT_HPT
#define QMCKL_CONTEXT_HPT
#ifdef HAVE_STDINT_H
#include <stdint.h>
#elif HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#include <pthread.h>
#include "qmckl_error_private_type.h"
#include "qmckl_memory_private_type.h"
#include "qmckl_numprec_private_type.h"
#include "qmckl_nucleus_private_type.h"
#include "qmckl_electron_private_type.h"
#include "qmckl_ao_private_type.h"
#include "qmckl_jastrow_private_type.h"
#include "qmckl_nucleus_private_func.h"
#include "qmckl_electron_private_func.h"
#include "qmckl_ao_private_func.h"
#+end_src
#+begin_src c :tangle (eval c)
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#ifdef HAVE_STDINT_H
#include <stdint.h>
#elif HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#include <assert.h>
#include <math.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <errno.h>
#include "qmckl.h"
#include "qmckl_context_private_type.h"
#include "qmckl_memory_private_func.h"
#+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;
/* Current date */
uint64_t date;
/* -- Molecular system -- */
qmckl_nucleus_struct nucleus;
qmckl_electron_struct electron;
qmckl_ao_basis_struct ao_basis;
qmckl_jastrow_struct jastrow;
/* To be implemented:
qmckl_mo_struct mo;
qmckl_determinant_struct det;
,*/
} qmckl_context_struct;
#+end_src
The context keeps a ``date'' that allows to check which data needs
to be recomputed. The date is incremented when the electron
coordinates are updated.
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
- A new context always has all its members initialized with a NULL value
# 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 and values to NULL */
{
memset(ctx, 0, sizeof(qmckl_context_struct));
}
/* Initialize lock */
{
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;
const qmckl_context context = (const qmckl_context) ctx;
assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT );
qmckl_exit_code rc;
ctx->numprec.precision = QMCKL_DEFAULT_PRECISION;
ctx->numprec.range = QMCKL_DEFAULT_RANGE;
rc = qmckl_init_electron(context);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_init_nucleus(context);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_init_ao_basis(context);
assert (rc == QMCKL_SUCCESS);
}
/* 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) {
free(ctx);
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
# 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
assert( qmckl_context_check(QMCKL_NULL_CONTEXT) == QMCKL_NULL_CONTEXT);
qmckl_context context = qmckl_context_create();
assert( context != QMCKL_NULL_CONTEXT );
assert( 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)
void qmckl_lock(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 deep 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) {
const qmckl_context checked_context = qmckl_context_check(context);
if (checked_context == QMCKL_NULL_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;
}
qmckl_unlock(context);
*/
return QMCKL_NULL_CONTEXT;
}
#+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_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL); /* Shouldn't be possible because the context is valid */
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();
}
free(ctx);
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
/* Destroy valid context */
assert(qmckl_context_check(context) == context);
assert(qmckl_context_destroy(context) == QMCKL_SUCCESS);
/* Check that context is destroyed */
assert(qmckl_context_check(context) != context);
assert(qmckl_context_check(context) == QMCKL_NULL_CONTEXT);
/* Destroy invalid context */
assert(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 0;
}
#+end_src