コード例 #1
0
CAMLprim value ocaml_faad_mp4_metadata(value m)
{
  CAMLparam1(m);
  CAMLlocal2(ans,v);
  mp4_t *mp = Mp4_val(m);
  int i, n;
  char *tag, *item;

  caml_enter_blocking_section();
  n = mp4ff_meta_get_num_items(mp->ff);
  caml_leave_blocking_section();

  ans = caml_alloc_tuple(n);
  for (i = 0; i < n; i++)
  {
    tag = NULL;
    item = NULL;

    caml_enter_blocking_section();
    mp4ff_meta_get_by_index(mp->ff, i, &item, &tag);
    caml_leave_blocking_section();

    assert(item && tag);
    v = caml_alloc_tuple(2);
    Store_field(v, 0, caml_copy_string(item));
    Store_field(v, 1, caml_copy_string(tag));
    Store_field(ans, i, v);
    free(item);
    free(tag);
  }

  CAMLreturn(ans);
}
コード例 #2
0
ファイル: sqlite3_stubs.c プロジェクト: Moondee/caut-lib
static inline int exec_not_null_callback(
  void *cbx_, int num_columns, char **row, char **header)
{
  callback_with_exn *cbx = cbx_;
  value v_row, v_header, v_ret;

  caml_leave_blocking_section();

    v_row = copy_not_null_string_array((const char **) row, num_columns);

    if (v_row == (value) NULL) return 1;

    Begin_roots1(v_row);
      v_header = safe_copy_string_array((const char **) header, num_columns);
    End_roots();

    v_ret = caml_callback2_exn(*cbx->cbp, v_row, v_header);

    if (Is_exception_result(v_ret)) {
      *cbx->exn = Extract_exception(v_ret);
      caml_enter_blocking_section();
      return 1;
    }

  caml_enter_blocking_section();

  return 0;
}
コード例 #3
0
ファイル: digest_stubs.c プロジェクト: janestreet/jenga
/* Contrary to caml_md5_chan, this function releases the runtime lock.

   [fd] must be a file descriptor open for reading and not be
   nonblocking, otherwise the function might fail non-deterministically.
 */
CAMLprim value caml_md5_fd(value fd)
{
  CAMLparam1 (fd);
  value res;
  struct MD5Context ctx;
  caml_enter_blocking_section();
  {
    intnat bytes_read;
    char buffer[4096];

    caml_MD5Init(&ctx);
    while (1){
      bytes_read = read (Int_val(fd), buffer, sizeof(buffer));
      if (bytes_read < 0) {
        if (errno == EINTR) continue;
        caml_leave_blocking_section();
        uerror("caml_md5_fd", Nothing);
      }
      if (bytes_read == 0) break;
      caml_MD5Update (&ctx, (unsigned char *) buffer, bytes_read);
    }
  }
  caml_leave_blocking_section();
  res = caml_alloc_string(16);
  caml_MD5Final(&Byte_u(res, 0), &ctx);
  CAMLreturn (res);
}
コード例 #4
0
ファイル: ffmpeg-stubs.c プロジェクト: eras/webcamviewer
value
ffmpeg_close(value ctx)
{
  CAMLparam1(ctx);

  if (Context_val(ctx)->fmtCtx) {
    AVFormatContext* fmtCtx = Context_val(ctx)->fmtCtx;
    caml_enter_blocking_section();
    if (fmtCtx->pb) {
      av_write_trailer(fmtCtx);
    }
    //avcodec_close(Context_val(ctx)->avstream->codec); ??
    avformat_free_context(fmtCtx);

    if (!(fmtCtx->flags & AVFMT_NOFILE)) {
      int ret = avio_close(fmtCtx->pb);
      raise_and_leave_blocking_section_if_not(ret >= 0, ExnFileIO, ret);
    }

    caml_leave_blocking_section();
    Context_val(ctx)->fmtCtx = NULL;
    free(Context_val(ctx)->filename);
    Context_val(ctx)->filename = NULL;
  }
  
  CAMLreturn(Val_unit);
}
コード例 #5
0
ファイル: vec_sort.c プロジェクト: akabe/lacaml
CAMLprim value NAME(value vCMP, value vN,
                    value vOFSX, value vINCX, value vX)
{
  CAMLparam2(vCMP, vX);
#if defined(OCAML_SORT_CALLBACK)
  CAMLlocal2(va, vb);
#endif
  const size_t GET_INT(N);
  int GET_INT(INCX);
  VEC_PARAMS(X);

  NUMBER *const base_ptr = X_data;
  const size_t max_thresh = MAX_THRESH * sizeof(NUMBER) * INCX;

  if (N == 0) CAMLreturn(Val_unit);

#ifndef OCAML_SORT_CALLBACK
  caml_enter_blocking_section();  /* Allow other threads */
#endif

#define QUICKSORT_LT(a, b) OCAML_SORT_LT((*a), (*b))
  QUICKSORT(NUMBER, base_ptr, INCX, max_thresh);
#undef QUICKSORT_LT

#ifndef OCAML_SORT_CALLBACK
  caml_leave_blocking_section();  /* Disallow other threads */
#endif

  CAMLreturn(Val_unit);
}
コード例 #6
0
ファイル: mlptrace.c プロジェクト: bmeurer/ocamljitrun
value
mlptrace_peek (value pid_v, value adr_v)
{
  pid_t pid;
  long adr;
  long r;
  int savederrno = errno;
  CAMLparam2 (pid_v, adr_v);
  CAMLlocal1 (res_v);
  pid = Long_val (pid_v);
  adr = Nativeint_val (adr_v);
#ifndef NO_BLOCKING_SECTION
  caml_enter_blocking_section ();
#endif
  r = ptrace (PTRACE_PEEKDATA, pid, adr, 0);
#ifndef NO_BLOCKING_SECTION
  caml_leave_blocking_section ();
#endif
  if (r == -1 && errno)
    uerror ("Ptrace.peek", Nothing);
  if (savederrno)
    errno = savederrno;
  res_v = caml_copy_nativeint (r);
  CAMLreturn (res_v);
}
コード例 #7
0
ファイル: blit_stubs.c プロジェクト: camlspotter/ocaml-mingw
CAMLprim value bin_prot_blit_buf_stub(
  value v_src_pos, value v_src, value v_dst_pos, value v_dst, value v_len)
{
  struct caml_ba_array *ba_src = Caml_ba_array_val(v_src);
  struct caml_ba_array *ba_dst = Caml_ba_array_val(v_dst);
  char *src = (char *) ba_src->data + Long_val(v_src_pos);
  char *dst = (char *) ba_dst->data + Long_val(v_dst_pos);
  size_t len = (size_t) Long_val(v_len);
  if
    (
      unlikely(len > 65536)
      || unlikely(((ba_src->flags & CAML_BA_MAPPED_FILE) != 0))
      || unlikely(((ba_dst->flags & CAML_BA_MAPPED_FILE) != 0))
    )
  /* use [memmove] rather than [memcpy] because src and dst may overlap */
  {
    Begin_roots2(v_src, v_dst);
    caml_enter_blocking_section();
      memmove(dst, src, len);
    caml_leave_blocking_section();
    End_roots();
  }
  else memmove(dst, src, len);
  return Val_unit;
}
コード例 #8
0
ファイル: sqlite3_stubs.c プロジェクト: Moondee/caut-lib
CAMLprim value caml_sqlite3_exec(value v_db, value v_maybe_cb, value v_sql)
{
  CAMLparam1(v_db);
  CAMLlocal2(v_cb, v_exn);
  callback_with_exn cbx;
  db_wrap *dbw = Sqlite3_val(v_db);
  int len = caml_string_length(v_sql) + 1;
  char *sql;
  int rc;
  sqlite3_callback cb = NULL;

  check_db(dbw, "exec");
  sql = caml_stat_alloc(len);
  memcpy(sql, String_val(v_sql), len);
  cbx.cbp = &v_cb;
  cbx.exn = &v_exn;

  if (v_maybe_cb != Val_None) {
    v_cb = Field(v_maybe_cb, 0);
    cb = exec_callback;
  }

  caml_enter_blocking_section();
    rc = sqlite3_exec(dbw->db, sql, cb, (void *) &cbx, NULL);
    free(sql);
  caml_leave_blocking_section();

  if (rc == SQLITE_ABORT) caml_raise(*cbx.exn);

  CAMLreturn(Val_rc(rc));
}
コード例 #9
0
ファイル: sqlite3_stubs.c プロジェクト: Moondee/caut-lib
CAMLprim value caml_sqlite3_exec_not_null_no_headers(
  value v_db, value v_cb, value v_sql)
{
  CAMLparam2(v_db, v_cb);
  CAMLlocal1(v_exn);
  callback_with_exn cbx;
  db_wrap *dbw = Sqlite3_val(v_db);
  int len = caml_string_length(v_sql) + 1;
  char *sql;
  int rc;

  check_db(dbw, "exec_not_null_no_headers");
  sql = caml_stat_alloc(len);
  memcpy(sql, String_val(v_sql), len);
  cbx.cbp = &v_cb;
  cbx.exn = &v_exn;

  caml_enter_blocking_section();
    rc =
      sqlite3_exec(
        dbw->db, sql, exec_not_null_no_headers_callback, (void *) &cbx, NULL);
    free(sql);
  caml_leave_blocking_section();

  if (rc == SQLITE_ABORT) {
    if (*cbx.exn != 0) caml_raise(*cbx.exn);
    else raise_sqlite3_Error("Null element in row");
  }
  CAMLreturn(Val_rc(rc));
}
コード例 #10
0
ファイル: ocaml_io.c プロジェクト: joechenq/multi-script
static int do_write(int fd, char *p, int n)
{
  int retcode;
again:
  caml_enter_blocking_section();

  // Changed!!!
  if ((fd == 1/*stdout*/ || fd == 2/*stderr*/) && custom_ocaml_stdout_func)
  {
	  (*custom_ocaml_stdout_func)(fd, p, n);
	  retcode = n;
  }
  else
	  retcode = write(fd, p, n);

  caml_leave_blocking_section();
  if (retcode == -1) {
    if (errno == EINTR) goto again;
    if ((errno == EAGAIN || errno == EWOULDBLOCK) && n > 1) {
      /* We couldn't do a partial write here, probably because
         n <= PIPE_BUF and POSIX says that writes of less than
         PIPE_BUF characters must be atomic.
         We first try again with a partial write of 1 character.
         If that fails too, we'll raise Sys_blocked_io below. */
      n = 1; goto again;
    }
  }
  if (retcode == -1) caml_sys_io_error(NO_ARG);
  return retcode;
}
コード例 #11
0
ファイル: jack_stubs.c プロジェクト: savonet/ocaml-bjack
CAMLprim value caml_bjack_read(value device, value len)
{
    CAMLparam2(device,len);
    CAMLlocal1(ans);
    int n = Int_val(len) ;
    char* buf = malloc(n) ;
    jack_driver_t* drv = Bjack_drv_val(device);
    long ret;

    if (drv->num_input_channels > 0)
    {
        caml_enter_blocking_section();
        ret = JACK_Read(drv,(unsigned char *)buf,n);
        caml_leave_blocking_section();
    }
    else
    {
        caml_raise_constant(*caml_named_value("bio2jack_exn_too_many_input_channels"));
    }

    if (ret < 0) caml_failwith("jack_read");

    ans = caml_alloc_string(ret);
    memcpy(String_val(ans),buf,ret);
    free(buf);

    CAMLreturn(ans);
}
コード例 #12
0
CAMLprim value ocaml_faad_mp4_find_aac_track(value m)
{
  CAMLparam1(m);
  mp4_t *mp = Mp4_val(m);

  int i, rc;
  int num_tracks;

  caml_enter_blocking_section();
  num_tracks = mp4ff_total_tracks(mp->ff);
  for (i = 0; i < num_tracks; i++) {
    unsigned char *buff = NULL;
    unsigned int buff_size = 0;
    mp4AudioSpecificConfig mp4ASC;

    mp4ff_get_decoder_config(mp->ff, i, &buff, &buff_size);

    if (buff)
    {
      rc = NeAACDecAudioSpecificConfig(buff, buff_size, &mp4ASC);
      free(buff);
      if (rc < 0)
        continue;
      caml_leave_blocking_section();
      CAMLreturn(Val_int(i));
    }
  }

  caml_leave_blocking_section();
  caml_raise_constant(*caml_named_value("ocaml_faad_exn_failed"));
}
コード例 #13
0
CAMLprim value ocaml_faad_mp4_init(value m, value dh, value track)
{
  CAMLparam3(m, dh, track);
  CAMLlocal1(ans);
  mp4_t *mp = Mp4_val(m);
  int t = Int_val(track);
  int ret;
  long unsigned int samplerate;
  unsigned char channels;
  NeAACDecHandle dec = Dec_val(dh);

  unsigned char *mp4_buffer = NULL;
  unsigned int mp4_buffer_size = 0;

  caml_enter_blocking_section();
  mp4ff_get_decoder_config(mp->ff, t, &mp4_buffer, &mp4_buffer_size);
  ret = NeAACDecInit2(dec, mp4_buffer, mp4_buffer_size, &samplerate, &channels);
  caml_leave_blocking_section();

  free(mp4_buffer);
  check_err(ret);

  ans = caml_alloc_tuple(2);
  Store_field(ans, 0, Val_int(samplerate));
  Store_field(ans, 1, Val_int(channels));

  CAMLreturn(ans);
}
コード例 #14
0
CAMLprim value ocaml_faad_mp4_open_read_fd(value metaonly, value fd)
{
  CAMLparam2(metaonly, fd);
  CAMLlocal1(ans);

  mp4_t *mp = malloc(sizeof(mp4_t));
  mp->fd = GET_FD(fd);
  mp->ff_cb.read = read_cb;
  mp->read_cb = 0;
  mp->ff_cb.write = write_cb;
  mp->write_cb = 0;
  mp->ff_cb.seek = seek_cb;
  mp->seek_cb = 0;
  mp->ff_cb.truncate = trunc_cb;
  mp->trunc_cb = 0;
  mp->ff_cb.user_data = mp;

  caml_enter_blocking_section();
  if(Bool_val(metaonly))
    mp->ff = mp4ff_open_read_metaonly(&mp->ff_cb);
  else
    mp->ff = mp4ff_open_read(&mp->ff_cb);
  caml_leave_blocking_section();
  assert(mp->ff);

  ans = caml_alloc_custom(&mp4_ops, sizeof(mp4_t*), 1, 0);
  Mp4_val(ans) = mp;

  CAMLreturn(ans);
}
コード例 #15
0
CAMLprim value statvfs_stub (value v_path)
{
  CAMLparam1(v_path);
  CAMLlocal1(v_stat);
  struct statvfs s;
  int ret, len = caml_string_length(v_path) + 1;
  char *pathname = caml_stat_alloc(len);
  memcpy(pathname, String_val(v_path), len);
  caml_enter_blocking_section();
  ret = statvfs(pathname,&s);
  caml_leave_blocking_section();
  caml_stat_free(pathname);
  if (ret != 0) uerror("statvfs",v_path);
  v_stat = caml_alloc(11, 0);
  Store_field(v_stat, 0, Val_int(s.f_bsize));
  Store_field(v_stat, 1, Val_int(s.f_frsize));
  Store_field(v_stat, 2, Val_int(s.f_blocks));
  Store_field(v_stat, 3, Val_int(s.f_bfree));
  Store_field(v_stat, 4, Val_int(s.f_bavail));
  Store_field(v_stat, 5, Val_int(s.f_files));
  Store_field(v_stat, 6, Val_int(s.f_ffree));
  Store_field(v_stat, 7, Val_int(s.f_favail));
  Store_field(v_stat, 8, Val_int(s.f_fsid));
  Store_field(v_stat, 9, Val_int(s.f_flag));
  Store_field(v_stat,10, Val_int(s.f_namemax));
  CAMLreturn(v_stat);
}
コード例 #16
0
ファイル: vec_CZ_c.c プロジェクト: kkirstein/lacaml
CAMLprim value LFUN(linspace_stub)(value vY, value va, value vb, value vN)
{
  CAMLparam1(vY);
  integer i, GET_INT(N);
  REAL ar = Double_field(va, 0),
       ai = Double_field(va, 1),
       N1 = N - 1.,
       hr = (Double_field(vb, 0) - ar) / N1,
       hi = (Double_field(vb, 1) - ai) / N1,
       xr = ar,
       xi = ai;
  VEC_PARAMS1(Y);

  caml_enter_blocking_section();  /* Allow other threads */

  for (i = 1; i <= N; i++) {
    Y_data->r = xr;
    Y_data->i = xi;
    Y_data++;
    xr = ar + i * hr;
    xi = ai + i * hi;
  }

  caml_leave_blocking_section();  /* Disallow other threads */

  CAMLreturn(Val_unit);
}
コード例 #17
0
ファイル: vec_CZ_c.c プロジェクト: kkirstein/lacaml
CAMLprim value LFUN(sqr_nrm2_stub)(
  value vSTABLE, value vN, value vOFSX, value vINCX, value vX)
{
  CAMLparam1(vX);

  integer GET_INT(N), GET_INT(INCX);
  REAL res;

  VEC_PARAMS(X);

  caml_enter_blocking_section();  /* Allow other threads */
  if (Bool_val(vSTABLE)) {
#ifndef LACAML_DOUBLE
  res = scnrm2_(&N, X_data, &INCX);
#else
  res = dznrm2_(&N, X_data, &INCX);
#endif
  res *= res;
  } else {
    COMPLEX cres = FUN(dotc)(&N, X_data, &INCX, X_data, &INCX);
    res = cres.r;
  }
  caml_leave_blocking_section();  /* Disallow other threads */

  CAMLreturn(caml_copy_double(res));
}
コード例 #18
0
ファイル: ffmpeg-stubs.c プロジェクト: eras/webcamviewer
value
ffmpeg_stream_close(value stream)
{
  CAMLparam1(stream);

  if (Stream_context_direct_val(stream) != Val_int(0)) {
    if (Stream_context_val(stream)->fmtCtx &&
        Stream_aux_val(stream)->avstream->codec->flags & AV_CODEC_CAP_DELAY) {
      int gotIt;
      AVPacket packet = { 0 };
      caml_enter_blocking_section();
      do {
        int ret = avcodec_encode_video2(Stream_aux_val(stream)->avstream->codec, &packet, NULL, &gotIt);
        raise_and_leave_blocking_section_if_not(ret >= 0, ExnEncode, ret);
        if (gotIt) {
          packet.stream_index = 0;
          ret = av_interleaved_write_frame(Stream_context_val(stream)->fmtCtx, &packet);
          raise_and_leave_blocking_section_if_not(ret >= 0, ExnFileIO, ret);
        }
      } while (gotIt);
      caml_leave_blocking_section();
    }

    avcodec_close(Stream_aux_val(stream)->avstream->codec);
    if (Stream_aux_val(stream)->swsCtx) {
      sws_freeContext(Stream_aux_val(stream)->swsCtx);
    }
    Stream_context_direct_val(stream) = Val_int(0);
 } else {
    raise(ExnClosed, 0);
  }

  CAMLreturn(Val_unit);
}
コード例 #19
0
ファイル: jack_stubs.c プロジェクト: savonet/ocaml-bjack
CAMLprim value caml_bjack_write(value device, value data)
{
    CAMLparam2(device,data);
    int n = caml_string_length(data) ;
    jack_driver_t* drv = Bjack_drv_val(device);
    long ret;
    char* buf = malloc(n) ;
    memcpy(buf,String_val(data),n);

    if (drv->num_output_channels > 0)
    {
        caml_enter_blocking_section();
        ret = JACK_Write(drv,(unsigned char *)buf,n);
        caml_leave_blocking_section();
    }
    else
    {
        caml_raise_constant(*caml_named_value("bio2jack_exn_too_many_output_channels"));
    }

    if (ret < 0) caml_failwith("jack_write");

    free(buf);

    CAMLreturn(Val_long(ret));
}
コード例 #20
0
value caml_create_QQmlPropertyMap(value _func, value _unit) {
    CAMLparam2(_func, _unit);
    CAMLlocal1(_ans);

    value *fv = (value*) malloc(sizeof(_func));
    *fv = _func;
    caml_register_global_root(fv);
    
    CamlPropertyMap *propMap = new CamlPropertyMap();
    _ans = caml_alloc_custom(&camlpropertymap_ops, sizeof(CamlPropertyMap*), 0, 1);
    (*((CamlPropertyMap **) Data_custom_val(_ans))) = propMap;
    propMap->saveCallback(fv);

    QObject::connect(propMap, &CamlPropertyMap::valueChanged,
                     [fv](const QString& propName, const QVariant& var) {
                       caml_leave_blocking_section();

                       [&fv, &propName, &var]() {
                         CAMLparam0();
                         CAMLlocal2(_nameArg, _variantArg);
                         _nameArg = caml_copy_string( propName.toLocal8Bit().data() );
                         caml_callback2(*fv, _nameArg, Val_QVariant(_variantArg, var) );
                         CAMLreturn0;
                       }();

                       caml_enter_blocking_section();
                     } );

    CAMLreturn(_ans);
}
コード例 #21
0
void QSingleFunc::run()
{
    // call callback there
    caml_leave_blocking_section();
    caml_callback(_saved_callback, Val_unit);
    caml_enter_blocking_section();
}
コード例 #22
0
ファイル: sys.c プロジェクト: BrianMulhall/ocaml
CAMLprim value caml_sys_close(value fd)
{
  caml_enter_blocking_section();
  close(Int_val(fd));
  caml_leave_blocking_section();
  return Val_unit;
}
コード例 #23
0
ファイル: sys.c プロジェクト: BrianMulhall/ocaml
CAMLprim value caml_sys_is_directory(value name)
{
  CAMLparam1(name);
#ifdef _WIN32
  struct _stati64 st;
#else
  struct stat st;
#endif
  char * p;
  int ret;

  p = caml_strdup(String_val(name));
  caml_enter_blocking_section();
#ifdef _WIN32
  ret = _stati64(p, &st);
#else
  ret = stat(p, &st);
#endif
  caml_leave_blocking_section();
  caml_stat_free(p);

  if (ret == -1) caml_sys_error(name);
#ifdef S_ISDIR
  CAMLreturn(Val_bool(S_ISDIR(st.st_mode)));
#else
  CAMLreturn(Val_bool(st.st_mode & S_IFDIR));
#endif
}
コード例 #24
0
ファイル: natdynlink.c プロジェクト: bluddy/ocaml-multicore
CAMLprim value caml_natdynlink_run_toplevel(value filename, value symbol)
{
  CAMLparam2 (filename, symbol);
  CAMLlocal3 (res, v, handle_v);
  void *handle;
  char *p;

  /* TODO: dlclose in case of error... */

  p = caml_strdup(String_val(filename));
  caml_enter_blocking_section();
  handle = caml_dlopen(p, 1, 1);
  caml_leave_blocking_section();
  caml_stat_free(p);

  if (NULL == handle) {
    res = caml_alloc(1,1);
    v = caml_copy_string(caml_dlerror());
    Store_field(res, 0, v);
  } else {
    handle_v = Val_handle(handle);
    res = caml_alloc(1,0);
    v = caml_natdynlink_run(handle_v, symbol);
    Store_field(res, 0, v);
  }
  CAMLreturn(res);
}
コード例 #25
0
ファイル: mlptrace.c プロジェクト: bmeurer/ocamljitrun
value
mlptrace_cont (value pid_v, value signum_v)
{
  pid_t pid;
  int signum;
  int savederrno = errno;
  long l = 0;
  CAMLparam2 (pid_v, signum_v);
  pid = Long_val (pid_v);
  signum = Long_val (signum_v);
  if (signum < 0)
    signum = 0;
  errno = 0;
#ifndef NO_BLOCKING_SECTION
  caml_enter_blocking_section ();
#endif
  l = ptrace (PTRACE_CONT, pid, (void *) 0, (void *) 0);
#ifndef NO_BLOCKING_SECTION
  caml_leave_blocking_section ();
#endif
  if (l == -1 && errno)
    uerror ("Ptrace.cont", Nothing);
  if (savederrno)
    errno = savederrno;
  CAMLreturn (Val_unit);
}
コード例 #26
0
ファイル: natdynlink.c プロジェクト: bluddy/ocaml-multicore
CAMLprim value caml_natdynlink_open(value filename, value global)
{
  CAMLparam2 (filename, global);
  CAMLlocal3 (res, handle, header);
  void *sym;
  void *dlhandle;
  char *p;

  /* TODO: dlclose in case of error... */

  p = caml_strdup(String_val(filename));
  caml_enter_blocking_section();
  dlhandle = caml_dlopen(String_val(filename), 1, Int_val(global));
  caml_leave_blocking_section();
  caml_stat_free(p);

  if (NULL == dlhandle)
    caml_failwith(caml_dlerror());

  sym = caml_dlsym(dlhandle, "caml_plugin_header");
  if (NULL == sym)
    caml_failwith("not an OCaml plugin");

  handle = Val_handle(dlhandle);
  header = caml_input_value_from_malloc(sym, 0);

  res = caml_alloc_tuple(2);
  Init_field(res, 0, handle);
  Init_field(res, 1, header);
  CAMLreturn(res);
}
コード例 #27
0
ファイル: io.c プロジェクト: bobzhang/ocaml
CAMLprim value caml_ml_close_channel(value vchannel)
{
  int result;
  int do_syscall;
  int fd;

  /* For output channels, must have flushed before */
  struct channel * channel = Channel(vchannel);
  if (channel->fd != -1){
    fd = channel->fd;
    channel->fd = -1;
    do_syscall = 1;
  }else{
    do_syscall = 0;
    result = 0;
  }
  /* Ensure that every read or write on the channel will cause an
     immediate caml_flush_partial or caml_refill, thus raising a Sys_error
     exception */
  channel->curr = channel->max = channel->end;

  if (do_syscall) {
    caml_enter_blocking_section();
    result = close(fd);
    caml_leave_blocking_section();
  }

  if (result == -1) caml_sys_error (NO_ARG);
  return Val_unit;
}
コード例 #28
0
ファイル: wrap_xt.c プロジェクト: dmsh/ocaml-xlib
void ml_xt_callback( Widget w, XtPointer cb_index, XtPointer cb_data )
{
    caml_leave_blocking_section();
    caml_callback2( caml_xt_cb, (value) cb_index, (value) cb_data );
    //caml_callback( caml_xt_cb, (value) cb_index );
    caml_enter_blocking_section();
}
コード例 #29
0
ファイル: xenguest_stubs.c プロジェクト: JacobMulero/xen-api
CAMLprim value stub_xc_hvm_build_native(value xc_handle, value domid,
                                        value mem_max_mib, value mem_start_mib, value image_name, value store_evtchn, value console_evtchn)
{
    CAMLparam5(xc_handle, domid, mem_max_mib, mem_start_mib, image_name);
    CAMLxparam2(store_evtchn, console_evtchn);
    CAMLlocal1(result);

    char *image_name_c = strdup(String_val(image_name));
    char *error[256];
    xc_interface *xch;

    unsigned long store_mfn=0;
    unsigned long console_mfn=0;
    int r;
    struct flags f;
    /* The xenguest interface changed and was backported to XCP: */
#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
    struct xc_hvm_build_args args;
#endif
    get_flags(&f, _D(domid));

    xch = _H(xc_handle);
    configure_vcpus(xch, _D(domid), f);
    configure_tsc(xch, _D(domid), f);

#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
    args.mem_size = (uint64_t)Int_val(mem_max_mib) << 20;
    args.mem_target = (uint64_t)Int_val(mem_start_mib) << 20;
    args.mmio_size = f.mmio_size_mib << 20;
    args.image_file_name = image_name_c;
#endif

    caml_enter_blocking_section ();
#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
    r = xc_hvm_build(xch, _D(domid), &args);
#else
    r = xc_hvm_build_target_mem(xch, _D(domid),
                                Int_val(mem_max_mib),
                                Int_val(mem_start_mib),
                                image_name_c);
#endif
    caml_leave_blocking_section ();

    free(image_name_c);

    if (r)
        failwith_oss_xc(xch, "hvm_build");


    r = hvm_build_set_params(xch, _D(domid), Int_val(store_evtchn), &store_mfn,
                             Int_val(console_evtchn), &console_mfn, f);
    if (r)
        failwith_oss_xc(xch, "hvm_build_params");

    result = caml_alloc_tuple(2);
    Store_field(result, 0, caml_copy_nativeint(store_mfn));
    Store_field(result, 1, caml_copy_nativeint(console_mfn));

    CAMLreturn(result);
}
コード例 #30
0
ファイル: ffmpeg-stubs.c プロジェクト: eras/webcamviewer
value
ffmpeg_open_input(value filename_)
{
  CAMLparam1(filename_);
  CAMLlocal1(ctx);

  av_register_all(); // this is fast to redo

  ctx = caml_alloc_custom(&context_ops, sizeof(struct Context), 0, 1);
  Context_val(ctx)->filename = strdup((char*) filename_);

  int ret;
  AVFormatContext* fmtCtx;
  char* filename = Context_val(ctx)->filename;
  caml_enter_blocking_section();
  ret = avformat_open_input(&fmtCtx, filename, NULL, NULL);
  raise_and_leave_blocking_section_if_not(ret >= 0, ExnOpen, ret);

  ret = avformat_find_stream_info(fmtCtx, NULL);
  raise_and_leave_blocking_section_if_not(ret >= 0, ExnStreamInfo, ret);

  caml_leave_blocking_section();
  Context_val(ctx)->fmtCtx = fmtCtx;
  CAMLreturn(ctx);
}