CAMLprim value ocaml_ssl_ctx_init_ec_from_named_curve(value context, value curve_name)
{
CAMLparam2(context, curve_name);
caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error"));
CAMLreturn(Val_unit);
}
CAMLprim value ocaml_ssl_set_client_SNI_hostname(value socket, value vhostname)
{
CAMLparam2(socket, vhostname);
caml_raise_constant(*caml_named_value("ssl_exn_method_error"));
CAMLreturn(Val_unit);
}
static const SSL_METHOD *get_method(int protocol, int type)
{
const SSL_METHOD *method = NULL;
caml_enter_blocking_section();
switch (protocol)
{
case 0:
switch (type)
{
case 0:
method = SSLv23_client_method();
break;
case 1:
method = SSLv23_server_method();
break;
case 2:
method = SSLv23_method();
break;
}
break;
case 1:
switch (type)
{
case 0:
method = SSLv3_client_method();
break;
case 1:
method = SSLv3_server_method();
break;
case 2:
method = SSLv3_method();
break;
}
break;
case 2:
switch (type)
{
case 0:
method = TLSv1_client_method();
break;
case 1:
method = TLSv1_server_method();
break;
case 2:
method = TLSv1_method();
break;
}
break;
case 3:
#ifdef HAVE_TLS11
switch (type)
{
case 0:
method = TLSv1_1_client_method();
break;
case 1:
method = TLSv1_1_server_method();
break;
case 2:
method = TLSv1_1_method();
break;
}
#endif
break;
case 4:
#ifdef HAVE_TLS12
switch (type)
{
case 0:
method = TLSv1_2_client_method();
break;
case 1:
method = TLSv1_2_server_method();
break;
case 2:
method = TLSv1_2_method();
break;
}
#endif
break;
default:
caml_leave_blocking_section();
caml_invalid_argument("Unknown method (this should not have happened, please report).");
break;
}
caml_leave_blocking_section();
if (method == NULL)
caml_raise_constant(*caml_named_value("ssl_exn_method_error"));
return method;
}
/* Adapted from sundials-2.5.0/src/nvec_par/nvector_parallel.c:
N_VNewEmpty_Parallel */
CAMLprim value sunml_nvec_wrap_parallel(value payload, value checkfn)
{
CAMLparam2(payload, checkfn);
CAMLlocal2(vnvec, vlocalba);
N_Vector nv;
N_Vector_Ops ops;
N_VectorContent_Parallel content;
MPI_Comm comm;
sundials_ml_index local_length, global_length;
vlocalba = Field(payload, 0);
local_length = (Caml_ba_array_val(vlocalba))->dim[0];
global_length = Index_val(Field(payload, 1));
comm = Comm_val(Field(payload, 2));
#if SUNDIALS_ML_SAFE
{
/* Compute global length as sum of local lengths */
sundials_ml_index nsum;
sundials_ml_index n = local_length;
MPI_Allreduce(&n, &nsum, 1, PVEC_INTEGER_MPI_TYPE, MPI_SUM, comm);
if (nsum != global_length)
caml_raise_constant(NVECTOR_PARALLEL_EXN (IncorrectGlobalSize));
}
#endif
/* Create vector */
nv = sunml_alloc_cnvec(sizeof(struct _N_VectorContent_Parallel), payload);
if (nv == NULL) caml_raise_out_of_memory();
ops = (N_Vector_Ops) nv->ops;
content = (N_VectorContent_Parallel) nv->content;
/* Create vector operation structure */
ops->nvclone = clone_parallel; /* ours */
ops->nvcloneempty = NULL;
ops->nvdestroy = sunml_free_cnvec;
#if SUNDIALS_LIB_VERSION >= 270
ops->nvgetvectorid = N_VGetVectorID_Parallel;
#endif
ops->nvspace = N_VSpace_Parallel; /* theirs */
ops->nvgetarraypointer = N_VGetArrayPointer_Parallel;
ops->nvsetarraypointer = N_VSetArrayPointer_Parallel;
ops->nvlinearsum = N_VLinearSum_Parallel;
ops->nvconst = N_VConst_Parallel;
ops->nvprod = N_VProd_Parallel;
ops->nvdiv = N_VDiv_Parallel;
ops->nvscale = N_VScale_Parallel;
ops->nvabs = N_VAbs_Parallel;
ops->nvinv = N_VInv_Parallel;
ops->nvaddconst = N_VAddConst_Parallel;
ops->nvdotprod = N_VDotProd_Parallel;
ops->nvmaxnorm = N_VMaxNorm_Parallel;
ops->nvwrmsnormmask = N_VWrmsNormMask_Parallel;
ops->nvwrmsnorm = N_VWrmsNorm_Parallel;
ops->nvmin = N_VMin_Parallel;
ops->nvwl2norm = N_VWL2Norm_Parallel;
ops->nvl1norm = N_VL1Norm_Parallel;
ops->nvcompare = N_VCompare_Parallel;
ops->nvinvtest = N_VInvTest_Parallel;
ops->nvconstrmask = N_VConstrMask_Parallel;
ops->nvminquotient = N_VMinQuotient_Parallel;
/* Attach lengths and communicator */
content->local_length = local_length;
content->global_length = global_length;
content->comm = comm;
content->own_data = 0;
content->data = Caml_ba_data_val(vlocalba);
vnvec = caml_alloc_tuple(3);
Store_field(vnvec, 0, payload);
Store_field(vnvec, 1, sunml_alloc_caml_nvec(nv, sunml_finalize_caml_nvec));
Store_field(vnvec, 2, checkfn);
CAMLreturn(vnvec);
}
CAMLprim value sunml_lsolver_call_psetup(value vcptr)
{
CAMLparam1(vcptr);
caml_raise_constant(SUNDIALS_EXN(NotImplementedBySundialsVersion));
CAMLreturn(Val_unit);
}
CAMLprim value sunml_lsolver_call_atimes(value vcptr, value vv, value vz)
{
CAMLparam3(vcptr, vv, vz);
caml_raise_constant(SUNDIALS_EXN(NotImplementedBySundialsVersion));
CAMLreturn(Val_unit);
}
CAMLprim void sunml_lsolver_set_prec_type(value vcptr, value vsolver,
value vpretype, value vdocheck)
{
CAMLparam4(vcptr, vsolver, vpretype, vdocheck);
#if SUNDIALS_LIB_VERSION >= 300
int old_pretype = PREC_NONE;
int pretype = sunml_lsolver_precond_type(vpretype);
SUNLinearSolver lsolv = LSOLVER_VAL(vcptr);
if (Bool_val(vdocheck)) {
switch (Int_val(vsolver)) {
case VARIANT_LSOLVER_ITERATIVE_SOLVER_SPFGMR:
old_pretype =
((SUNLinearSolverContent_SPFGMR)(lsolv->content))->pretype;
break;
case VARIANT_LSOLVER_ITERATIVE_SOLVER_SPGMR:
old_pretype =
((SUNLinearSolverContent_SPGMR)(lsolv->content))->pretype;
break;
case VARIANT_LSOLVER_ITERATIVE_SOLVER_SPBCGS:
old_pretype =
((SUNLinearSolverContent_SPBCGS)(lsolv->content))->pretype;
break;
case VARIANT_LSOLVER_ITERATIVE_SOLVER_SPTFQMR:
old_pretype =
((SUNLinearSolverContent_SPTFQMR)(lsolv->content))->pretype;
break;
case VARIANT_LSOLVER_ITERATIVE_SOLVER_PCG:
old_pretype =
((SUNLinearSolverContent_PCG)(lsolv->content))->pretype;
break;
}
if ((old_pretype == PREC_NONE) && (pretype != PREC_NONE))
caml_raise_constant(LSOLVER_EXN(IllegalPrecType));
}
// ignore returned values
switch (Int_val(vsolver)) {
case VARIANT_LSOLVER_ITERATIVE_SOLVER_SPFGMR:
SUNSPFGMRSetPrecType(lsolv, pretype);
break;
case VARIANT_LSOLVER_ITERATIVE_SOLVER_SPGMR:
SUNSPGMRSetPrecType(lsolv, pretype);
break;
case VARIANT_LSOLVER_ITERATIVE_SOLVER_SPBCGS:
SUNSPBCGSSetPrecType(lsolv, pretype);
break;
case VARIANT_LSOLVER_ITERATIVE_SOLVER_SPTFQMR:
SUNSPTFQMRSetPrecType(lsolv, pretype);
break;
case VARIANT_LSOLVER_ITERATIVE_SOLVER_PCG:
SUNPCGSetPrecType(lsolv, pretype);
break;
}
#endif
CAMLreturn0;
}
