C++ CAMLparam2函數代碼示例

CAMLprim value brlapiml_leaveRawMode(value handle, value unit)
{
  CAMLparam2(handle, unit);
  brlapi(leaveRawMode);
  CAMLreturn(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_remainder(value x, value y) {
  CAMLparam2(x, y);
  CAMLreturn(caml_copy_double(remainder(Double_val(x), Double_val(y))));
}

value hh_shared_init(
  value global_size_val,
  value heap_size_val
) {

  CAMLparam2(global_size_val, heap_size_val);

  global_size_b = Long_val(global_size_val);
  heap_size = Long_val(heap_size_val);

  char* shared_mem;

  size_t page_size = getpagesize();

  /* The total size of the shared memory.  Most of it is going to remain
   * virtual. */
  size_t shared_mem_size =
    global_size_b + 2 * DEP_SIZE_B + HASHTBL_SIZE_B +
    heap_size + page_size;

#ifdef _WIN32
  /*

     We create an anonymous memory file, whose `handle` might be
     inherited by slave processes.

     This memory file is tagged "reserved" but not "committed". This
     means that the memory space will be reserved in the virtual
     memory table but the pages will not be bound to any physical
     memory yet. Further calls to 'VirtualAlloc' will "commit" pages,
     meaning they will be bound to physical memory.

     This is behavior that should reflect the 'MAP_NORESERVE' flag of
     'mmap' on Unix. But, on Unix, the "commit" is implicit.

     Committing the whole shared heap at once would require the same
     amount of free space in memory (or in swap file).

  */
  HANDLE handle = CreateFileMapping(
    INVALID_HANDLE_VALUE,
    NULL,
    PAGE_READWRITE | SEC_RESERVE,
    shared_mem_size >> 32, shared_mem_size & ((1ll << 32) - 1),
    NULL);
  if (handle == NULL) {
    win32_maperr(GetLastError());
    uerror("CreateFileMapping", Nothing);
  }
  if (!SetHandleInformation(handle, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT)) {
    win32_maperr(GetLastError());
    uerror("SetHandleInformation", Nothing);
  }
  shared_mem = MapViewOfFileEx(
    handle,
    FILE_MAP_ALL_ACCESS,
    0, 0,
    0,
    (char *)SHARED_MEM_INIT);
  if (shared_mem != (char *)SHARED_MEM_INIT) {
    shared_mem = NULL;
    win32_maperr(GetLastError());
    uerror("MapViewOfFileEx", Nothing);
  }

#else /* _WIN32 */

  /* MAP_NORESERVE is because we want a lot more virtual memory than what
   * we are actually going to use.
   */
  int flags = MAP_SHARED | MAP_ANON | MAP_NORESERVE | MAP_FIXED;
  int prot  = PROT_READ  | PROT_WRITE;

  shared_mem =
    (char*)mmap((void*)SHARED_MEM_INIT,  shared_mem_size, prot,
                flags, 0, 0);
  if(shared_mem == MAP_FAILED) {
    printf("Error initializing: %s\n", strerror(errno));
    exit(2);
  }

#ifdef MADV_DONTDUMP
  // We are unlikely to get much useful information out of the shared heap in
  // a core file. Moreover, it can be HUGE, and the extensive work done dumping
  // it once for each CPU can mean that the user will reboot their machine
  // before the much more useful stack gets dumped!
  madvise(shared_mem, shared_mem_size, MADV_DONTDUMP);
#endif

  // Keeping the pids around to make asserts.
  master_pid = getpid();
  my_pid = master_pid;

#endif /* _WIN32 */

  char* bottom = shared_mem;
  init_shared_globals(shared_mem);

  // Checking that we did the maths correctly.
  assert(*heap + heap_size == bottom + shared_mem_size);
//.........這裏部分代碼省略.........

void hh_shared_init(
  value global_size_val,
  value heap_size_val
) {

  CAMLparam2(global_size_val, heap_size_val);

  global_size_b = Long_val(global_size_val);
  heap_size = Long_val(heap_size_val);

  /* MAP_NORESERVE is because we want a lot more virtual memory than what
   * we are actually going to use.
   */
  int flags = MAP_SHARED | MAP_ANON | MAP_NORESERVE | MAP_FIXED;
  int prot  = PROT_READ  | PROT_WRITE;

  int page_size = getpagesize();

  /* The total size of the shared memory.  Most of it is going to remain
   * virtual. */
  size_t shared_mem_size = global_size_b + 2 * DEP_SIZE_B + HASHTBL_SIZE_B +
      heap_size;

  char* shared_mem =
    (char*)mmap((void*)SHARED_MEM_INIT, page_size + shared_mem_size, prot,
                flags, 0, 0);

  if(shared_mem == MAP_FAILED) {
    printf("Error initializing: %s\n", strerror(errno));
    exit(2);
  }

#ifdef MADV_DONTDUMP
  // We are unlikely to get much useful information out of the shared heap in
  // a core file. Moreover, it can be HUGE, and the extensive work done dumping
  // it once for each CPU can mean that the user will reboot their machine
  // before the much more useful stack gets dumped!
  madvise(shared_mem, page_size + shared_mem_size, MADV_DONTDUMP);
#endif

  // Keeping the pids around to make asserts.
  master_pid = getpid();
  my_pid = master_pid;

  char* bottom = shared_mem;

  init_shared_globals(shared_mem);

  // Checking that we did the maths correctly.
  assert(*heap + heap_size == bottom + shared_mem_size + page_size);

  // Uninstall ocaml's segfault handler. It's supposed to throw an exception on
  // stack overflow, but we don't actually handle that exception, so what
  // happens in practice is we terminate at toplevel with an unhandled exception
  // and a useless ocaml backtrace. A core dump is actually more useful. Sigh.
  struct sigaction sigact;
  sigact.sa_handler = SIG_DFL;
  sigemptyset(&sigact.sa_mask);
  sigact.sa_flags = 0;
  sigaction(SIGSEGV, &sigact, NULL);

  set_priorities();

  CAMLreturn0;
}

CAMLprim value getsockopt_stub(value sock, value sockopt) {
    CAMLparam2 (sock, sockopt);
    CAMLlocal1 (result);
    int error = -1;
    int native_sockopt = Int_val(sockopt);
    struct wrap *socket = Socket_val(sock);
    
    switch (native_sockopt) {
        case ZMQ_SNDHWM:
        case ZMQ_RCVHWM:
        case ZMQ_RATE:
        case ZMQ_RECOVERY_IVL:
        case ZMQ_SNDBUF:
        case ZMQ_RCVBUF:
        case ZMQ_LINGER:
        case ZMQ_RECONNECT_IVL:
        case ZMQ_RECONNECT_IVL_MAX:
        case ZMQ_BACKLOG:
        case ZMQ_MULTICAST_HOPS:
        case ZMQ_RCVTIMEO:
        case ZMQ_SNDTIMEO:
        case ZMQ_RCVMORE:
        case ZMQ_RCVLABEL:
        case ZMQ_TYPE:
        {   
            int res;
            size_t size = sizeof(res);
            error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size);
            stub_raise_if (error == -1);            
            result = Val_int(res);
        }
        break;

        case ZMQ_AFFINITY:
        case ZMQ_MAXMSGSIZE:
        {
            int64 res;
            size_t size = sizeof(res);
            error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size);
            stub_raise_if (error == -1);
            result = caml_copy_int64(res);
        }
        break;

        case ZMQ_EVENTS:
        {
            int res;
            size_t size = sizeof(res);
            error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size);
            stub_raise_if (error == -1);            
            result = POOL_LIST_CACHE[res];
        }
        break;
        
        case ZMQ_IDENTITY:
        {
            char buffer[256];
            buffer[255] = '\0';
            size_t size = sizeof(buffer);
            error = zmq_getsockopt(socket->wrapped, native_sockopt, buffer, &size);
            stub_raise_if (error == -1);
            if (size == 0) {
                result = EMPTY_STRING;
            } else {
                result = caml_copy_string(buffer);
            }
        }
        break;            

        case ZMQ_FD:
        {
            #if defined(_WIN32) || defined(_WIN64)
            SOCKET fd;
            #else
            int fd;
            #endif
            size_t size = sizeof (fd);
            error = zmq_getsockopt (socket->wrapped, native_sockopt, (void *) (&fd), &size);
            stub_raise_if (error == -1);
            #if defined(_WIN32) || defined(_WIN64)
            result = win_alloc_socket(fd);
            #else
            result = Val_int(fd);
            #endif
        }
        break;

        default:
            caml_failwith("Bidings error");            

    }
    CAMLreturn (result);
}

CAMLprim value caml_mdb_dbi_close(value env,value dbi){
  CAMLparam2(env,dbi);
  mdb_dbi_close((MDB_env*)env,(MDB_dbi) Int_val(dbi));
  CAMLreturn0;
}

/*
 * Linear Solvers
 */
CAMLprim value sundials_ml_ida_dense(value ida_solver, value N) {
  CAMLparam2(ida_solver, N);
  const int ret = IDADense(IDA_MEM(ida_solver), Int_val(N));
  CAMLreturn(Val_int(ret));
}

CAMLprim value sundials_ml_ida_sptfqmr(value ida_solver, value maxl) {
  CAMLparam2(ida_solver, maxl);
  const int ret = IDASptfqmr(IDA_MEM(ida_solver), Int_val(maxl));
  CAMLreturn(Val_int(ret));
}

value caml_history_truncate_file(value name, value len) {

   CAMLparam2(name,len);
   CAMLreturn(Val_unit);

}

CAMLprim value sundials_ml_fvector_get(value a, value i) {
  CAMLparam2(a, i);
  double* d = Caml_ba_array_val(a)->data;
  CAMLreturn(caml_copy_double(d[Int_val(i)]));
}

static int compareHandle(value h1, value h2)
{
  CAMLparam2(h1, h2);
  CAMLreturn(memcmp(Data_custom_val(h1), Data_custom_val(h2), brlapi_getHandleSize()));
}

CAMLprim value brlapiml_resumeDriver(value handle, value unit)
{
  CAMLparam2(handle, unit);
  brlapi(resumeDriver);
  CAMLreturn(Val_unit);
}

CAMLprim value brlapiml_suspendDriver(value handle, value driverName)
{
  CAMLparam2(handle, driverName);
  brlapiCheckError(suspendDriver, String_val(driverName));
  CAMLreturn(Val_unit);
}

CAMLprim value sundials_ml_ida_set_constraints(value ida_solver, value constraints)  {
  CAMLparam2(ida_solver, constraints);
  BA_STACK_NVECTOR(constraints, nv_constraints);
  const int ret = IDASetConstraints(IDA_MEM(ida_solver), &nv_constraints);
  CAMLreturn(Val_int(ret));
}