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);
}
