static value stat_aux(int use_64, struct stat *buf) { CAMLparam0(); CAMLlocal5(atime, mtime, ctime, offset, v); atime = copy_double((double) buf->st_atime); mtime = copy_double((double) buf->st_mtime); ctime = copy_double((double) buf->st_ctime); offset = use_64 ? Val_file_offset(buf->st_size) : Val_int (buf->st_size); v = alloc_small(12, 0); Field (v, 0) = Val_int (buf->st_dev); Field (v, 1) = Val_int (buf->st_ino); Field (v, 2) = cst_to_constr(buf->st_mode & S_IFMT, file_kind_table, sizeof(file_kind_table) / sizeof(int), 0); Field (v, 3) = Val_int (buf->st_mode & 07777); Field (v, 4) = Val_int (buf->st_nlink); Field (v, 5) = Val_int (buf->st_uid); Field (v, 6) = Val_int (buf->st_gid); Field (v, 7) = Val_int (buf->st_rdev); Field (v, 8) = offset; Field (v, 9) = atime; Field (v, 10) = mtime; Field (v, 11) = ctime; CAMLreturn(v); }
value simulation_get_pose2d_stub(value sim_val, value name_val) { CAMLparam2(sim_val, name_val); CAMLlocal1(result); playerc_simulation_t *sim = Simulation_val(sim_val); char *name = String_val(name_val); double x, y, a; DPRINTF("getting sim %p pose2d: name - %s\n", sim, name); if(playerc_simulation_get_pose2d(sim, name, &x, &y, &a)) exception_playerc_error(); DPRINTF("got sim %p pose2d: name - %s x = %f y = %f a = %f\n", sim, name, x, y, a); result = caml_alloc_tuple(3); Store_field(result, 0, copy_double(x)); Store_field(result, 1, copy_double(y)); Store_field(result, 2, copy_double(a)); CAMLreturn(result); }
CAMLprim value ml_gsl_poly_solve_cubic(value a, value b, value c) { double x0, x1, x2; int n ; n = gsl_poly_solve_cubic(Double_val(a), Double_val(b), Double_val(c), &x0, &x1, &x2); { CAMLparam0(); CAMLlocal1(r); r = Val_int(0); /* to silence compiler warnings */ switch(n) { case 0: break; case 1: r = alloc(1, 0); Store_field(r, 0, copy_double(x0)); break; case 3: r = alloc(3, 1); Store_field(r, 0, copy_double(x0)); Store_field(r, 1, copy_double(x1)); Store_field(r, 2, copy_double(x2)); } ; CAMLreturn(r); }; }
PREFIX value ml_evas_object_size_hint_align_get(value v_obj) { CAMLparam0(); CAMLlocal1(v); double x, y; evas_object_size_hint_align_get((Evas_Object*) v_obj, &x, &y); v = caml_alloc(2, 0); Store_field(v, 0, copy_double(x)); Store_field(v, 1, copy_double(y)); CAMLreturn(v); }
PREFIX value ml_Elm_Gesture_Zoom_Info_of_ptr(value v_ptr) { CAMLparam1(v_ptr); CAMLlocal1(v_info); Elm_Gesture_Zoom_Info* info = voidp_val(v_ptr); v_info = caml_alloc(4, 0); Store_field(v_info, 0, Val_int(info->y)); Store_field(v_info, 1, Val_int(info->radius)); Store_field(v_info, 2, copy_double(info->zoom)); Store_field(v_info, 3, copy_double(info->momentum)); CAMLreturn(v_info); }
static inline value val_of_result_e10(gsl_sf_result_e10 *result) { CAMLparam0(); CAMLlocal3(r, v, e) ; v = copy_double(result->val); e = copy_double(result->err); r = alloc_small(3, 0); Field(r, 0) = v; Field(r, 1) = e; Field(r, 2) = Val_int(result->e10); CAMLreturn(r); }
value sml_atan2(value f1, value f2) { double r, r1, r2; float_exn = SYS__EXN_DOMAIN; r1 = Double_val(f1); r2 = Double_val(f2); if (r1 == 0.0 && r2 == 0.0) return copy_double(0.0); r = atan2(r1, r2); CHECK_FLOAT(r); RAISE_FLOAT_IF( r != r ); return copy_double(r); }
CAMLprim value ml_gsl_monte_miser_get_params(value state) { CAMLparam0(); CAMLlocal1(r); gsl_monte_miser_state *s = GSLMISERSTATE_VAL(state); r=alloc_tuple(5); Store_field(r, 0, copy_double(s->estimate_frac)); Store_field(r, 1, Val_int(s->min_calls)); Store_field(r, 2, Val_int(s->min_calls_per_bisection)); Store_field(r, 3, copy_double(s->alpha)); Store_field(r, 4, copy_double(s->dither)); CAMLreturn(r); }
CAMLprim value unix_mktime(value t) { struct tm tm; time_t clock; value res; value tmval = Val_unit, clkval = Val_unit; Begin_roots2(tmval, clkval); tm.tm_sec = Int_val(Field(t, 0)); tm.tm_min = Int_val(Field(t, 1)); tm.tm_hour = Int_val(Field(t, 2)); tm.tm_mday = Int_val(Field(t, 3)); tm.tm_mon = Int_val(Field(t, 4)); tm.tm_year = Int_val(Field(t, 5)); tm.tm_wday = Int_val(Field(t, 6)); tm.tm_yday = Int_val(Field(t, 7)); tm.tm_isdst = -1; /* tm.tm_isdst = Bool_val(Field(t, 8)); */ clock = mktime(&tm); if (clock == (time_t) -1) unix_error(ERANGE, "mktime", Nothing); tmval = alloc_tm(&tm); clkval = copy_double((double) clock); res = alloc_small(2, 0); Field(res, 0) = clkval; Field(res, 1) = tmval; End_roots (); return res; }
CAMLprim value netcgi2_apache_request_request_time (value rv) { CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); CAMLreturn (copy_double ((double) r->request_time)); }
CAMLprim value ml_gsl_multimin_fdfminimizer_minimum(value ox, value odx, value og, value T) { gsl_multimin_fdfminimizer *t=GSLMULTIMINFDFMINIMIZER_VAL(T); if(Is_block(ox)) { value x=Unoption(ox); _DECLARE_VECTOR(x); _CONVERT_VECTOR(x); gsl_vector_memcpy(&v_x, gsl_multimin_fdfminimizer_x(t)); } if(Is_block(odx)) { value dx=Unoption(odx); _DECLARE_VECTOR(dx); _CONVERT_VECTOR(dx); gsl_vector_memcpy(&v_dx, gsl_multimin_fdfminimizer_dx(t)); } if(Is_block(og)) { value g=Unoption(og); _DECLARE_VECTOR(g); _CONVERT_VECTOR(g); gsl_vector_memcpy(&v_g, gsl_multimin_fdfminimizer_gradient(t)); } return copy_double(gsl_multimin_fdfminimizer_minimum(t)); }
static void push_vert(value root, double x, double y, double z) { CAMLparam1(root); CAMLlocal4(vert, xx, yy, zz); value cons; xx = copy_double(x); yy = copy_double(y); zz = copy_double(z); vert = alloc_tuple(3); Field(vert,0) = xx; Field(vert,1) = yy; Field(vert,2) = zz; cons = alloc_tuple(2); Field(cons, 0) = vert; Field(cons, 1) = Field(root,0); modify(&Field(root,0), cons); CAMLreturn0; }
value c_double_of_indexed_bytes(value s, value index) { CAMLparam2 (s, index); double *x = (double*)(String_val(s) + Int_val(index)); CAMLreturn (copy_double(*x)); }
/* $Id$ Copyright (C) 2004 Pascal Brisset, Antoine Drouin Ocaml low level conversions This file is part of paparazzi. paparazzi is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. paparazzi is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with paparazzi; see the file COPYING. If not, write to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #include <sys/types.h> #include <fcntl.h> #include <sys/termios.h> #include <stdio.h> #include <caml/mlvalues.h> #include <caml/alloc.h> #include <caml/memory.h> #include <inttypes.h> #ifdef ARCH_ALIGN_DOUBLE value c_float_of_indexed_bytes(value s, value index) { CAMLparam2 (s, index); char *x = (char *)(String_val(s) + Int_val(index)); //Assert(sizeof(float) == 4); union { char b[4]; float f; } buffer; buffer.b[0] = x[0]; buffer.b[1] = x[1]; buffer.b[2] = x[2]; buffer.b[3] = x[3]; CAMLreturn (copy_double((double)buffer.f)); } value c_double_of_indexed_bytes(value s, value index) { CAMLparam2 (s, index); char *x = (char *)(String_val(s) + Int_val(index)); //Assert(sizeof(double) == 8); union { char b[sizeof(double)]; double d; } buffer; int i; for (i=0; i < sizeof(double); i++) { buffer.b[i] = x[i]; } CAMLreturn (copy_double(buffer.d)); } #else /* no ARCH_ALIGN_DOUBLE */ value c_float_of_indexed_bytes(value s, value index) { CAMLparam2 (s, index); float *x = (float*)(String_val(s) + Int_val(index)); CAMLreturn (copy_double((double)(*x))); }
value sml_exp(value f) { double r; float_exn = SYS__EXN_OVERFLOW; r = exp(Double_val(f)); CHECK_FLOAT(r); return copy_double(r); }
CAMLprim value ml_gsl_multifit_linear_svd(value wo, value x, value y, value tol, value c, value cov, value ws) { size_t rank; double chisq; _DECLARE_MATRIX2(x,cov); _DECLARE_VECTOR2(y,c); _CONVERT_MATRIX2(x,cov); _CONVERT_VECTOR2(y,c); if(wo == Val_none) gsl_multifit_linear_svd(&m_x, &v_y, Double_val(tol), &rank, &v_c, &m_cov, &chisq, MultifitWS_val(ws)); else { value w=Field(wo, 0); _DECLARE_VECTOR(w); _CONVERT_VECTOR(w); gsl_multifit_wlinear_svd(&m_x, &v_w, &v_y, Double_val(tol), &rank, &v_c, &m_cov, &chisq, MultifitWS_val(ws)); } { CAMLparam0(); CAMLlocal2(r, v_chisq); v_chisq = copy_double (chisq); r = alloc_small (2, 0); Field (r, 0) = Val_long (rank); Field (r, 1) = v_chisq; CAMLreturn(r); } }
value sml_getrealtime(value UNUSED(v)) { struct timeval tp; gettimeofday(&tp, NULL); return copy_double(tp.tv_sec * 1000000.0 + (double)tp.tv_usec); }
value sml_modtime(value path) { struct stat buf; if (stat(String_val(path), &buf) == -1) failwith("stat"); return (copy_double ((double) (buf.st_mtime))); }
CAMLprim value ml_gsl_stats_quantile_from_sorted_data(value data, value f) { size_t len = Double_array_length(data); double r = gsl_stats_quantile_from_sorted_data(Double_array_val(data), 1, len, Double_val(f)); return copy_double(r); }
value float_of_string(value s) /* ML */ { #ifndef __MWERKS__ extern double atof(); #endif return copy_double(atof(String_val(s))); }
value caml_mpi_scan_float(value data, value op, value comm) { double d = Double_val(data), r; MPI_Scan(&d, &r, 1, MPI_DOUBLE, reduce_floatop[Int_val(op)], Comm_val(comm)); return copy_double(r); }
CAMLprim value unix_gettimeofday(value v_unit) { struct timeval tp; if (gettimeofday(&tp, NULL) == -1) caml_failwith("gettimeofday"); return copy_double((double) tp.tv_sec + (double) tp.tv_usec / 1e6); }
value caml_mpi_reduce_float(value data, value op, value root, value comm) { double d = Double_val(data); double r = 0.0; MPI_Reduce(&d, &r, 1, MPI_DOUBLE, reduce_floatop[Int_val(op)], Int_val(root), Comm_val(comm)); return copy_double(r); }
CAMLprim value unix_gettimeofday(value unit) { FILETIME ft; double tm; GetSystemTimeAsFileTime(&ft); tm = *(uint64_t *)&ft - epoch_ft; /* shift to Epoch-relative time */ return copy_double(tm * 1e-7); /* tm is in 100ns */ }
CAMLprim value ml_gsl_blas_sdot(value X, value Y) { float r; _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_sdot(&v_X, &v_Y, &r); return copy_double(r); }
value sml_cosh(value f) { double r; float_exn = SYS__EXN_OVERFLOW; r = Double_val(f); r = cosh(r); CHECK_FLOAT(r); return copy_double(r); }
double gslfun_callback_df(double x, void *params) { struct callback_params *p=params; value res; value v_x=copy_double(x); res=callback(Field(p->closure, 1), v_x); return Double_val(res); }
/* FDF CALLBACKS */ double gslfun_callback_indir(double x, void *params) { value res; value v_x = copy_double(x); value *closure = params; res=callback(*closure, v_x); return Double_val(res); }
value sml_cos(value f) { double r; r = Double_val(f); r = cos(r); if( r != r || r > 1.0 || r < -1.0 ) failwith("cos: argument too large"); return copy_double(r); }
value sml_acos(value f) { double r = Double_val(f); float_exn = SYS__EXN_DOMAIN; RAISE_FLOAT_IF( r < -1.0 || r > 1.0 ); r = acos(r); RAISE_FLOAT_IF( r != r ); return copy_double(r); }