CAMLprim value pcre_firsttable_stub(value v_rex) { const unsigned char *ftable; int ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_FIRSTTABLE, (void *) &ftable); if (ret != 0) raise_internal_error("pcre_firsttable_stub"); if (ftable == NULL) return None; else { value v_res, v_res_str; char *ptr; int i; Begin_roots1(v_rex); v_res_str = caml_alloc_string(32); End_roots(); ptr = String_val(v_res_str); for (i = 0; i <= 31; ++i) { *ptr = *ftable; ++ptr; ++ftable; } Begin_roots1(v_res_str); /* Allocates [Some string] from firsttable */ v_res = caml_alloc_small(1, 0); End_roots(); Field(v_res, 0) = v_res_str; return v_res; } }
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; }
static void uwork_cb(uv_work_t *req, int status) { REQ_CB_INIT(req); struct req * r = req->data; value param; if ( status != 0 ){ param = caml_alloc_small(1,Error_tag); Field(param,0) = Val_uwt_error(status); } else { param = r->c_cb((uv_req_t *)req); if ( r->buf_contains_ba == 1 ){ Begin_roots1(param); value t = caml_alloc_small(1,Ok_tag); Field(t,0) = param; param = t; End_roots(); } } if ( r->clean_cb != NULL ){ r->clean_cb(r->req); } REQ_CB_CALL(param); }
CAMLprim value bigstring_sendmsg_nonblocking_no_sigpipe_stub( value v_fd, value v_iovecs, value v_count) { int count = Int_val(v_count); size_t total_len = 0; struct iovec *iovecs = copy_iovecs(&total_len, v_iovecs, count); struct msghdr msghdr = { NULL, 0, NULL, 0, NULL, 0, 0 }; ssize_t ret; if (total_len > THREAD_IO_CUTOFF || contains_mmapped(v_iovecs, count)) { Begin_roots1(v_iovecs); caml_enter_blocking_section(); msghdr.msg_iov = iovecs; msghdr.msg_iovlen = count; ret = sendmsg(Int_val(v_fd), &msghdr, nonblocking_no_sigpipe_flag); free(iovecs); caml_leave_blocking_section(); End_roots(); } else { msghdr.msg_iov = iovecs; msghdr.msg_iovlen = count; ret = sendmsg(Int_val(v_fd), &msghdr, nonblocking_no_sigpipe_flag); free(iovecs); } if (ret == -1 && errno != EAGAIN && errno != EWOULDBLOCK) uerror("sendmsg_nonblocking_no_sigpipe", Nothing); return Val_long(ret); }
static st_retcode caml_threadstatus_wait (value wrapper) { st_event ts = Threadstatus_val(wrapper); st_retcode retcode; Begin_roots1(wrapper) /* prevent deallocation of ts */ enter_blocking_section(); retcode = st_event_wait(ts); leave_blocking_section(); End_roots(); return retcode; }
UWT_LOCAL void uwt__gr_register__(cb_t *a,value x) { if (unlikely( uwt__global_caml_root_n >= uwt__global_caml_root_size )){ Begin_roots1(x); uwt__gr_enlarge__(); End_roots(); } const cb_t pos = uwt__global_caml_root_free_pos[uwt__global_caml_root_n]; uwt__global_caml_root_n++; SET_CB_VAL(pos,x); *a = pos; }
static void mlresolv_error(int errcode) { value res; value err; err = alloc_small(1, 0); Field(err, 0) = Val_int(errcode); Begin_roots1(err); res = alloc_small(2, 0); Field(res, 0) = *mlresolv_error_exn; Field(res, 1) = err; End_roots(); mlraise(res); }
CAMLprim value bigstring_write_assume_fd_is_nonblocking_stub( value v_fd, value v_pos, value v_len, value v_bstr) { struct caml_ba_array *ba = Caml_ba_array_val(v_bstr); char *bstr = (char *) ba->data + Long_val(v_pos); size_t len = Long_val(v_len); ssize_t written; if ((len > THREAD_IO_CUTOFF) || (ba->flags & CAML_BA_MAPPED_FILE)) { Begin_roots1(v_bstr); caml_enter_blocking_section(); written = write(Int_val(v_fd), bstr, len); caml_leave_blocking_section(); End_roots(); } else written = write(Int_val(v_fd), bstr, len); if (written == -1) uerror("write_assume_fd_is_nonblocking", Nothing); return Val_long(written); }
static value lseek_cb(uv_req_t * req) { const struct req * r = req->data; value ret; const int64_t offset = voids_to_int64_t(&r->c); if ( offset == -1 ){ ret = caml_alloc_small(1,Error_tag); Field(ret,0) = Val_uwt_error(r->offset); } else { value p = caml_copy_int64(offset); Begin_roots1(p); ret = caml_alloc_small(1,Ok_tag); Field(ret,0) = p; End_roots(); } return ret; }
CAMLprim value pcre_exec_stub0( intnat v_opt, value v_rex, intnat v_pos, intnat v_subj_start, value v_subj, value v_ovec, value v_maybe_cof, value v_workspace) { int ret; int is_dfa = v_workspace != (value) NULL; long pos = v_pos, len = caml_string_length(v_subj), subj_start = v_subj_start; long ovec_len = Wosize_val(v_ovec); if (pos > len || pos < subj_start) caml_invalid_argument("Pcre.pcre_exec_stub: illegal position"); if (subj_start > len || subj_start < 0) caml_invalid_argument("Pcre.pcre_exec_stub: illegal subject start"); pos -= subj_start; len -= subj_start; { const pcre *code = get_rex(v_rex); /* Compiled pattern */ const pcre_extra *extra = get_extra(v_rex); /* Extra info */ const char *ocaml_subj = String_val(v_subj) + subj_start; /* Subject string */ const int opt = v_opt; /* Runtime options */ /* Special case when no callout functions specified */ if (v_maybe_cof == None) { int *ovec = (int *) &Field(v_ovec, 0); /* Performs the match */ if (is_dfa) ret = pcre_dfa_exec(code, extra, ocaml_subj, len, pos, opt, ovec, ovec_len, (int *) &Field(v_workspace, 0), Wosize_val(v_workspace)); else ret = pcre_exec(code, extra, ocaml_subj, len, pos, opt, ovec, ovec_len); if (ret < 0) handle_exec_error("pcre_exec_stub", ret); else handle_pcre_exec_result(ovec, v_ovec, ovec_len, subj_start, ret); } /* There are callout functions */ else { value v_cof = Field(v_maybe_cof, 0); value v_substrings; char *subj = caml_stat_alloc(sizeof(char) * len); int *ovec = caml_stat_alloc(sizeof(int) * ovec_len); int workspace_len; int *workspace; struct cod cod = { 0, (value *) NULL, (value *) NULL, (value) NULL }; struct pcre_extra new_extra = #ifdef PCRE_EXTRA_MATCH_LIMIT_RECURSION # ifdef PCRE_EXTRA_MARK # ifdef PCRE_EXTRA_EXECUTABLE_JIT { PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL, 0, NULL, NULL }; # else { PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL, 0, NULL }; # endif # else { PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL, 0 }; # endif #else { PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL }; #endif cod.subj_start = subj_start; memcpy(subj, ocaml_subj, len); Begin_roots4(v_rex, v_cof, v_substrings, v_ovec); Begin_roots1(v_subj); v_substrings = caml_alloc_small(2, 0); End_roots(); Field(v_substrings, 0) = v_subj; Field(v_substrings, 1) = v_ovec; cod.v_substrings_p = &v_substrings; cod.v_cof_p = &v_cof; new_extra.callout_data = &cod; if (extra != NULL) { new_extra.flags = PCRE_EXTRA_CALLOUT_DATA | extra->flags; new_extra.study_data = extra->study_data; new_extra.match_limit = extra->match_limit; new_extra.tables = extra->tables; #ifdef PCRE_EXTRA_MATCH_LIMIT_RECURSION new_extra.match_limit_recursion = extra->match_limit_recursion; #endif } if (is_dfa) { workspace_len = Wosize_val(v_workspace); workspace = caml_stat_alloc(sizeof(int) * workspace_len); ret = pcre_dfa_exec(code, extra, subj, len, pos, opt, ovec, ovec_len, (int *) &Field(v_workspace, 0), workspace_len); } else ret = pcre_exec(code, &new_extra, subj, len, pos, opt, ovec, ovec_len); caml_stat_free(subj); End_roots(); if (ret < 0) { if (is_dfa) caml_stat_free(workspace); caml_stat_free(ovec); if (ret == PCRE_ERROR_CALLOUT) caml_raise(cod.v_exn); else handle_exec_error("pcre_exec_stub(callout)", ret); } else { handle_pcre_exec_result(ovec, v_ovec, ovec_len, subj_start, ret); if (is_dfa) { caml_int_ptr ocaml_workspace_dst = (caml_int_ptr) &Field(v_workspace, 0); const int *workspace_src = workspace; const int *workspace_src_stop = workspace + workspace_len; while (workspace_src != workspace_src_stop) { *ocaml_workspace_dst = *workspace_src; ocaml_workspace_dst++; workspace_src++; } caml_stat_free(workspace); } caml_stat_free(ovec); } } } return Val_unit; } CAMLprim value pcre_exec_stub( intnat v_opt, value v_rex, intnat v_pos, intnat v_subj_start, value v_subj, value v_ovec, value v_maybe_cof) { return pcre_exec_stub0(v_opt, v_rex, v_pos, v_subj_start, v_subj, v_ovec, v_maybe_cof, (value) NULL); } /* Byte-code hook for pcre_exec_stub Needed, because there are more than 5 arguments */ CAMLprim value pcre_exec_stub_bc(value *argv, int __unused argn) { return pcre_exec_stub0( Int_val(argv[0]), argv[1], Int_val(argv[2]), Int_val(argv[3]), argv[4], argv[5], argv[6], (value) NULL); } /* Byte-code hook for pcre_dfa_exec_stub Needed, because there are more than 5 arguments */ CAMLprim value pcre_dfa_exec_stub_bc(value *argv, int __unused argn) { return pcre_exec_stub0( Int_val(argv[0]), argv[1], Int_val(argv[2]), Int_val(argv[3]), argv[4], argv[5], argv[6], argv[7]); } static struct custom_operations tables_ops = { "pcre_ocaml_tables", pcre_dealloc_tables, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default, custom_compare_ext_default }; /* Generates a new set of chartables for the current locale (see man page of PCRE */ CAMLprim value pcre_maketables_stub(value __unused v_unit) { /* GC will do a full cycle every 1_000_000 table set allocations (one table set consumes 864 bytes -> maximum of 864_000_000 bytes unreclaimed table sets) */ const value v_tables = caml_alloc_custom( &tables_ops, sizeof(struct pcre_ocaml_tables), 1, 1000000); set_tables(v_tables, pcre_maketables()); return v_tables; } /* Wraps around the isspace-function */ CAMLprim value pcre_isspace_stub(value v_c) { return Val_bool(isspace(Int_val(v_c))); } /* Returns number of substring associated with a name */ CAMLprim intnat pcre_get_stringnumber_stub(value v_rex, value v_name) { const int ret = pcre_get_stringnumber(get_rex(v_rex), String_val(v_name)); if (ret == PCRE_ERROR_NOSUBSTRING) caml_invalid_argument("Named string not found"); return ret; } CAMLprim value pcre_get_stringnumber_stub_bc(value v_rex, value v_name) { return Val_int(pcre_get_stringnumber_stub(v_rex, v_name)); } /* Returns array of names of named substrings in a regexp */ CAMLprim value pcre_names_stub(value v_rex) { CAMLparam0(); CAMLlocal1(v_res); int name_count; int entry_size; const char *tbl_ptr; int i; int ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMECOUNT, &name_count); if (ret != 0) raise_internal_error("pcre_names_stub: namecount"); ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMEENTRYSIZE, &entry_size); if (ret != 0) raise_internal_error("pcre_names_stub: nameentrysize"); ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMETABLE, &tbl_ptr); if (ret != 0) raise_internal_error("pcre_names_stub: nametable"); v_res = caml_alloc(name_count, 0); for (i = 0; i < name_count; ++i) { value v_name = caml_copy_string(tbl_ptr + 2); Store_field(v_res, i, v_name); tbl_ptr += entry_size; } CAMLreturn(v_res); } /* Generic stub for getting integer results from pcre_config */ static inline int pcre_config_int(int what) { int ret; pcre_config(what, (void *) &ret); return ret; } /* Generic stub for getting long integer results from pcre_config */ static inline int pcre_config_long(int what) { long ret; pcre_config(what, (void *) &ret); return ret; }