自学教程：C++ Double_val函数代码示例

static int shrink_block(value64 * source, value * dest, mlsize_t source_len, mlsize_t dest_len, color_t color){  value64 * p, * q;  value * d, * e;  header_t hd;  mlsize_t sz;  tag_t tag;  byteoffset_t * forward_addr;  byteoffset_t dest_ofs;  value v;  /* First pass: copy the objects and set up forwarding pointers.     The pointers contained inside blocks are not resolved. */  for (p = source, q = source + source_len, d = dest; p < q; /*nothing*/) {    hd = (header_t)(p->lsw);    p++;    sz = Wosize_hd(hd);    tag = Tag_hd(hd);    forward_addr = (byteoffset_t *) p;    dest_ofs = d + 1 - dest;    switch(tag) {    case String_tag:      { mlsize_t ofs_last_byte, len, new_sz;        ofs_last_byte = sz * sizeof(value64) - 1;        len = ofs_last_byte - Byte(p, ofs_last_byte);        new_sz = (len + sizeof(value)) / sizeof(value);        *d++ = Make_header(new_sz, String_tag, color);        Field(d, new_sz - 1) = 0;        bcopy(p, d, len);        ofs_last_byte = new_sz * sizeof(value) - 1;        Byte(d, ofs_last_byte) = ofs_last_byte - len;        p += sz;        d += new_sz;        break;      }    case Double_tag:      *d++ = Make_header(Double_wosize, Double_tag, color);      Store_double_val((value)d, Double_val((value)p));      p += sizeof(double) / sizeof(value64);      d += sizeof(double) / sizeof(value);      break;    default:      *d++ = Make_header(sz, tag, color);      for (/*nothing*/; sz > 0; sz--, p++, d++) {        value lsw = p->lsw;        value msw = p->msw;        if ((lsw & 1) == 0) {      /* If relative displacement: */          if (msw != 0) return -1; /* Check unsigned displacement fits in 32 */        } else {                   /* Otherwise, it's a signed integer */          if ((lsw >= 0 && msw != 0) || (lsw < 0 && msw != -1)) return -1;        }        *d = lsw;      }    }    *forward_addr = dest_ofs;   /* store the forwarding pointer */  }  assert(d == dest + dest_len);  /* Second pass: resolve pointers contained inside blocks,     replacing them by the corresponding forwarding pointer. */  for (d = dest, e = dest + dest_len; d < e; /*nothing*/) {    hd = (header_t) *d++;    sz = Wosize_hd(hd);    tag = Tag_hd(hd);    if (tag >= No_scan_tag) {      d += sz;    } else {      for (/*nothing*/; sz > 0; sz--, d++) {        v = *d;        switch(v & 3) {        case 0:                 /* 0: a block represented by its offset */          assert(v >= 0 && v < source_len * sizeof(value64) && (v & 7) == 0);          *d = (value) (dest + *((byteoffset_t *)((char *) source + v)));          break;        case 2:                 /* 2: an atom */          v = v >> 2;          assert(v >= 0 && v < 256);          *d = Atom(v);          break;        default:                /* 1 or 3: an integer */          break;        }      }    }  }  return 0;}

void print_value (value v, int pass, hash_table_t *ht){    int size, i, n, ret;    unsigned long key;    char buf[256];    addr_list_t* entry;    if (Is_long(v))    {        if (pass == PASS2)            printf("%ld ", Long_val(v));        return;    }    size=Wosize_val(v);    switch (Tag_val(v))    {        case Closure_tag:            print_closure (v, pass, ht);            break;        case String_tag:            print_string(v);            break;        case Double_tag:            if (pass == PASS2)                printf("%g ", Double_val(v));            break;        case Double_array_tag:            if (pass == PASS2)            {                printf("[| ");                n = size/Double_wosize;                for (i=0; i<n; i++)                {                    printf("%g", Double_field(v,i));                    if (i < (n-1))                        printf("; ");                    else                        printf(" ");                }                printf("|]");             }                        break;        case Abstract_tag:            if (pass == PASS2)                printf("(abstract) ");            break;        case Custom_tag:            if (pass == PASS2)                printf("(custom) ");            break;        default:            if (pass == PASS2 && Tag_val(v) >= No_scan_tag)            {                printf("(unknown) ");                break;            };            /*                For structured values, PASS1 gathers information about addresses and                PASS2 prints it. We use MINCYCCNT as a threshold for printing cyclic/shared                values. The name of the value is just its stringified address.            */            if (pass == PASS1)            {                key = (unsigned long)v;                entry = get(ht, key);                if ((entry == NULL) || (entry->count < MINCYCCNT))                {                    buf[0] = '/0';                    sprintf(buf,"var_%lx",key);                    put(ht, key, strdup(buf));                }                for (i=0; i<size; i++)                {                    key = (unsigned long)Field(v,i);                    entry = get(ht, key);                    if ((entry == NULL) || (entry->count < MINCYCCNT))                        print_value(Field(v,i), pass, ht);                }                 }            else if (pass == PASS2)            {                key = (unsigned long)v;                entry = get(ht, key);                if ((entry != NULL) && (entry->count >= MINCYCCNT))                {                    printf("(v=%s) ", entry->val);                    if (entry->printed == FALSE)                    {//.........这里部分代码省略.........

value geti(value v) {    dbl d;    d.d = (float)Double_val(v);    return copy_int32(d.i);}

CAMLprim value caml_ba_fill(value vb, value vinit){  struct caml_ba_array * b = Caml_ba_array_val(vb);  intnat num_elts = caml_ba_num_elts(b);  switch (b->flags & CAML_BA_KIND_MASK) {  default:    Assert(0);  case CAML_BA_FLOAT32: {    float init = Double_val(vinit);    float * p;    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;    break;  }  case CAML_BA_FLOAT64: {    double init = Double_val(vinit);    double * p;    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;    break;  }  case CAML_BA_SINT8:  case CAML_BA_UINT8: {    int init = Int_val(vinit);    char * p;    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;    break;  }  case CAML_BA_SINT16:  case CAML_BA_UINT16: {    int init = Int_val(vinit);    int16 * p;    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;    break;  }  case CAML_BA_INT32: {    int32 init = Int32_val(vinit);    int32 * p;    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;    break;  }  case CAML_BA_INT64: {    int64 init = Int64_val(vinit);    int64 * p;    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;    break;  }  case CAML_BA_NATIVE_INT: {    intnat init = Nativeint_val(vinit);    intnat * p;    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;    break;  }  case CAML_BA_CAML_INT: {    intnat init = Long_val(vinit);    intnat * p;    for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;    break;  }  case CAML_BA_COMPLEX32: {    float init0 = Double_field(vinit, 0);    float init1 = Double_field(vinit, 1);    float * p;    for (p = b->data; num_elts > 0; num_elts--) { *p++ = init0; *p++ = init1; }    break;  }  case CAML_BA_COMPLEX64: {    double init0 = Double_field(vinit, 0);    double init1 = Double_field(vinit, 1);    double * p;    for (p = b->data; num_elts > 0; num_elts--) { *p++ = init0; *p++ = init1; }    break;  }  }  return Val_unit;}

CAMLprim value caml_array_unsafe_set_float(value array,value index,value newval){  Store_double_field(array, Long_val(index), Double_val(newval));  return Val_unit;}

EXPORT(do_inf)(value vy, value vb){  /* noalloc */  I_VAL(vy) = interval(Double_val(vb), sup(I_VAL(vy)));  return(Val_unit);}

CAMLprim value math_nexttoward(value x, value y) {  CAMLparam2(x, y);  CAMLreturn(caml_copy_double(nexttoward(Double_val(x), Double_val(y))));}

CAMLprim value math_pow(value x, value y) {  CAMLparam2(x, y);  CAMLreturn(caml_copy_double(pow(Double_val(x), Double_val(y))));}

CAMLprim value math_lround(value x) {  CAMLparam1(x);  CAMLreturn(caml_copy_int32(lround(Double_val(x))));}

CAMLprim value math_nearbyint(value x) {  CAMLparam1(x);  CAMLreturn(caml_copy_double(nearbyint(Double_val(x))));}

CAMLprim value math_logb(value x) {  CAMLparam1(x);  CAMLreturn(caml_copy_double(logb(Double_val(x))));}

CAMLprim value math_llrint(value x) {  CAMLparam1(x);  CAMLreturn(caml_copy_int64(llrint(Double_val(x))));}

CAMLprim value math_ceil(value x) {  CAMLparam1(x);  CAMLreturn(caml_copy_double(ceil(Double_val(x))));}

CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout){  /* Event associated to handle */  DWORD   nEventsCount;  DWORD   nEventsMax;  HANDLE *lpEventsDone;  /* Data for all handles */  LPSELECTDATA lpSelectData;  LPSELECTDATA iterSelectData;  /* Iterator for results */  LPSELECTRESULT iterResult;  /* Iterator */  DWORD i;  /* Error status */  DWORD err;  /* Time to wait */  DWORD milliseconds;  /* Is there static select data */  BOOL  hasStaticData = FALSE;  /* Wait return */  DWORD waitRet;  /* Set of handle */  SELECTHANDLESET hds;  DWORD           hdsMax;  LPHANDLE        hdsData;  /* Length of each list */  DWORD readfds_len;  DWORD writefds_len;  DWORD exceptfds_len;  CAMLparam4 (readfds, writefds, exceptfds, timeout);  CAMLlocal5 (read_list, write_list, except_list, res, l);  CAMLlocal1 (fd);  fd_set read, write, except;  double tm;  struct timeval tv;  struct timeval * tvp;  DEBUG_PRINT("in select");  err = 0;  tm = Double_val(timeout);  if (readfds == Val_int(0) && writefds == Val_int(0) && exceptfds == Val_int(0)) {    DEBUG_PRINT("nothing to do");    if ( tm > 0.0 ) {      enter_blocking_section();      Sleep( (int)(tm * 1000));      leave_blocking_section();    }    read_list = write_list = except_list = Val_int(0);  } else {    if (fdlist_to_fdset(readfds, &read) && fdlist_to_fdset(writefds, &write) && fdlist_to_fdset(exceptfds, &except)) {      DEBUG_PRINT("only sockets to select on, using classic select");      if (tm < 0.0) {        tvp = (struct timeval *) NULL;      } else {        tv.tv_sec = (int) tm;        tv.tv_usec = (int) (1e6 * (tm - (int) tm));        tvp = &tv;      }      enter_blocking_section();      if (select(FD_SETSIZE, &read, &write, &except, tvp) == -1) {        err = WSAGetLastError();        DEBUG_PRINT("Error %ld occurred", err);      }      leave_blocking_section();      if (err) {        DEBUG_PRINT("Error %ld occurred", err);        win32_maperr(err);        uerror("select", Nothing);      }      read_list = fdset_to_fdlist(readfds, &read);      write_list = fdset_to_fdlist(writefds, &write);      except_list = fdset_to_fdlist(exceptfds, &except);    } else {      nEventsCount   = 0;      nEventsMax     = 0;      lpEventsDone   = NULL;      lpSelectData   = NULL;      iterSelectData = NULL;      iterResult     = NULL;      hasStaticData  = 0;      waitRet        = 0;      readfds_len    = caml_list_length(readfds);      writefds_len   = caml_list_length(writefds);      exceptfds_len  = caml_list_length(exceptfds);      hdsMax         = MAX(readfds_len, MAX(writefds_len, exceptfds_len));      hdsData = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * hdsMax);//.........这里部分代码省略.........

CAMLprim value math_remainder(value x, value y) {  CAMLparam2(x, y);  CAMLreturn(caml_copy_double(remainder(Double_val(x), Double_val(y))));}

CAMLprim value math_round(value x) {  CAMLparam1(x);  CAMLreturn(caml_copy_double(round(Double_val(x))));}

CAMLprim value math_scalbln(value x, value y) {  CAMLparam2(x, y);  CAMLreturn(caml_copy_double(scalbln(Double_val(x), Int64_val(y))));}

PREFIX value ml_evas_object_size_hint_align_set(value v_obj, value v_x, value v_y){        evas_object_size_hint_align_set((Evas_Object*) v_obj, Double_val(v_x),                Double_val(v_y));        return Val_unit;}

CAMLprim value math_scalbn(value x, value y) {  CAMLparam1(x);  CAMLreturn(caml_copy_double(scalbn(Double_val(x), Int_val(y))));}

CAMLextern_C valuecaml_sfWindow_setJoystickThreshold(value win, value threshold){    SfWindow_val(win)->setJoystickThreshold(Double_val(threshold));    return Val_unit;}

CAMLprim value math_signbit(value x) {  CAMLparam1(x);  CAMLreturn(Val_int(signbit(Double_val(x))));}

CAMLprim value ml_gsl_poly_eval(value c, value x){    int len = Double_array_length(c);    return copy_double(gsl_poly_eval(Double_array_val(c), len, Double_val(x)));}

CAMLprim value math_trunc(value x) {  CAMLparam1(x);  CAMLreturn(caml_copy_double(trunc(Double_val(x))));}

CAMLprim valueuint40_of_float(value v){  CAMLparam1(v);  CAMLreturn (copy_uint64(((uint64_t)Double_val(v)) << 24));}

CAMLprim value math_atanh(value x) {  CAMLparam1(x);  CAMLreturn(caml_copy_double(atanh(Double_val(x))));}

value caml_mpi_broadcast_float(value data, value root, value comm){  double d = Double_val(data);  MPI_Bcast(&d, 1, MPI_DOUBLE, Int_val(root), Comm_val(comm));  return copy_double(d);}

value getf(value v) {  dbl d;  d.f = Double_val(v);  return copy_int32(d.i[0]);}