CAMLprim value pcre_firstbyte_stub(value v_rex) { int firstbyte; const int ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_FIRSTBYTE, &firstbyte); if (ret != 0) caml_raise_with_string(*pcre_exc_InternalError, "pcre_firstbyte_stub"); switch (firstbyte) { case -1 : return var_Start_only; break; /* [`Start_only] */ case -2 : return var_ANCHORED; break; /* [`ANCHORED] */ default : if (firstbyte < 0 ) /* Should not happen */ caml_raise_with_string(*pcre_exc_InternalError, "pcre_firstbyte_stub"); else { value v_firstbyte; /* Allocates the non-constant constructor [`Char of char] and fills in the appropriate value */ v_firstbyte = caml_alloc_small(2, 0); Field(v_firstbyte, 0) = var_Char; Field(v_firstbyte, 1) = Val_int(firstbyte); return v_firstbyte; } } }
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) caml_raise_with_string(*pcre_exc_InternalError, "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; } }
CAMLexport void caml_invalid_argument (char const *msg) { if (caml_global_data == 0) { fprintf(stderr, "Fatal error: exception Invalid_argument(\"%s\")\n", msg); exit(2); } caml_raise_with_string(Field(caml_global_data, INVALID_EXN), msg); }
CAMLexport void caml_failwith (char const *msg) { if (caml_global_data == 0) { fprintf(stderr, "Fatal error: exception Failure(\"%s\")\n", msg); exit(2); } caml_raise_with_string(Field(caml_global_data, FAILURE_EXN), msg); }
CAMLprim value pcre_lastliteral_stub(value v_rex) { int lastliteral; const int ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_LASTLITERAL, &lastliteral); if (ret != 0) caml_raise_with_string(*pcre_exc_InternalError, "pcre_lastliteral_stub"); if (lastliteral == -1) return None; if (lastliteral < 0) caml_raise_with_string(*pcre_exc_InternalError, "pcre_lastliteral_stub"); else { /* Allocates [Some char] */ value v_res = caml_alloc_small(1, 0); Field(v_res, 0) = Val_int(lastliteral); return v_res; } }
static void raise_sqlite3_misuse_stmt(const char *fmt, ...) { char buf[1024]; va_list args; va_start(args, fmt); vsnprintf(buf, sizeof buf, fmt, args); va_end(args); caml_raise_with_string(*caml_sqlite3_Error, buf); }
static void RAISE(const char *error) { static value *exception_handler = NULL; if (exception_handler == NULL) { exception_handler = caml_named_value("kyotocabinet.error"); if (exception_handler == NULL) { caml_failwith(error); } } caml_raise_with_string(*exception_handler, error); }
static void failwith_xc(xc_interface *xch) { static char error_str[ERROR_STRLEN]; if (xch) { const xc_error *error = xc_get_last_error(xch); if (error->code == XC_ERROR_NONE) snprintf(error_str, ERROR_STRLEN, "%d: %s", errno, strerror(errno)); else snprintf(error_str, ERROR_STRLEN, "%d: %s: %s", error->code, xc_error_code_to_desc(error->code), error->message); } else { snprintf(error_str, ERROR_STRLEN, "Unable to open XC interface"); } caml_raise_with_string(*caml_named_value("xc.error"), error_str); }
CAMLexport void caml_failwith (char const *msg) { caml_raise_with_string(Field(caml_global_data, FAILURE_EXN), msg); }
void caml_invalid_argument (char const *msg) { caml_raise_with_string((value) caml_exn_Invalid_argument, msg); }
void caml_failwith (char const *msg) { caml_raise_with_string((value) caml_exn_Failure, msg); }
CAMLprim value stub_nvml_open(value unit) { CAMLparam1(unit); CAMLlocal1(ml_interface); nvmlInterface *interface; value *exn; interface = malloc(sizeof(nvmlInterface)); // Open the library. interface->handle = dlopen("libnvidia-ml.so.1", RTLD_LAZY); if (!interface->handle) { free(interface); exn = caml_named_value("Library_not_loaded"); if (exn) { caml_raise_with_string(*exn, dlerror()); } else { caml_failwith(dlerror()); } } // Load nvmlErrorString. interface->errorString = dlsym(interface->handle, "nvmlErrorString"); if (!interface->errorString) { goto SymbolError; } // Load nvmlInit. interface->init = dlsym(interface->handle, "nvmlInit"); if (!interface->init) { goto SymbolError; } // Load nvmlShutdown. interface->shutdown = dlsym(interface->handle, "nvmlShutdown"); if (!interface->shutdown) { goto SymbolError; } // Load nvmlDeviceGetCount. interface->deviceGetCount = dlsym(interface->handle, "nvmlDeviceGetCount"); if (!interface->deviceGetCount) { goto SymbolError; } // Load nvmlDeviceGetHandleByIndex. interface->deviceGetHandleByIndex = dlsym(interface->handle, "nvmlDeviceGetHandleByIndex"); if(!interface->deviceGetHandleByIndex) { goto SymbolError; } // Load nvmlDeviceGetMemoryInfo. interface->deviceGetMemoryInfo = dlsym(interface->handle, "nvmlDeviceGetMemoryInfo"); if(!interface->deviceGetMemoryInfo) { goto SymbolError; } // Load nvmlDeviceGetPciInfo. interface->deviceGetPciInfo = dlsym(interface->handle, "nvmlDeviceGetPciInfo"); if(!interface->deviceGetPciInfo) { goto SymbolError; } // Load nvmlDeviceGetPowerUsage. interface->deviceGetPowerUsage = dlsym(interface->handle, "nvmlDeviceGetPowerUsage"); if(!interface->deviceGetPowerUsage) { goto SymbolError; } // Load nvmlDeviceGetTemperature. interface->deviceGetTemperature = dlsym(interface->handle, "nvmlDeviceGetTemperature"); if(!interface->deviceGetTemperature) { goto SymbolError; } // Load nvmlDeviceGetUtilizationRates. interface->deviceGetUtilizationRates = dlsym(interface->handle, "nvmlDeviceGetUtilizationRates"); if(!interface->deviceGetUtilizationRates) { goto SymbolError; } ml_interface = (value)interface; CAMLreturn(ml_interface); SymbolError: free(interface); exn = caml_named_value("Symbol_not_loaded"); if (exn) { caml_raise_with_string(*exn, dlerror()); } else { caml_failwith(dlerror()); } }
static inline void raise_sqlite3_InternalError(char *msg) { caml_raise_with_string(*caml_sqlite3_InternalError, msg); }
void raise_error (char *msg) { caml_raise_with_string (*caml_named_value ("mpcap_exn"), msg); }
/* Executes a pattern match with runtime options, a regular expression, a string offset, a string length, a subject string, a number of subgroup offsets, an offset vector and an optional callout function */ CAMLprim value pcre_exec_stub(value v_opt, value v_rex, value v_ofs, value v_subj, value v_subgroups2, value v_ovec, value v_maybe_cof) { const int ofs = Int_val(v_ofs), len = caml_string_length(v_subj); if (ofs > len || ofs < 0) caml_invalid_argument("Pcre.pcre_exec_stub: illegal offset"); { const pcre *code = (pcre *) Field(v_rex, 1); /* Compiled pattern */ const pcre_extra *extra = (pcre_extra *) Field(v_rex, 2); /* Extra info */ const char *ocaml_subj = String_val(v_subj); /* Subject string */ const int opt = Int_val(v_opt); /* Runtime options */ int subgroups2 = Int_val(v_subgroups2); const int subgroups2_1 = subgroups2 - 1; const int subgroups3 = (subgroups2 >> 1) + subgroups2; /* Special case when no callout functions specified */ if (v_maybe_cof == None) { int *ovec = (int *) &Field(v_ovec, 0); /* Performs the match */ const int ret = pcre_exec(code, extra, ocaml_subj, len, ofs, opt, ovec, subgroups3); if (ret < 0) { switch(ret) { case PCRE_ERROR_NOMATCH : caml_raise_constant(*pcre_exc_Not_found); case PCRE_ERROR_PARTIAL : caml_raise_constant(*pcre_exc_Partial); case PCRE_ERROR_MATCHLIMIT : caml_raise_constant(*pcre_exc_MatchLimit); case PCRE_ERROR_BADPARTIAL : caml_raise_constant(*pcre_exc_BadPartial); case PCRE_ERROR_BADUTF8 : caml_raise_constant(*pcre_exc_BadUTF8); case PCRE_ERROR_BADUTF8_OFFSET : caml_raise_constant(*pcre_exc_BadUTF8Offset); default : caml_raise_with_string(*pcre_exc_InternalError, "pcre_exec_stub"); } } else { const int *ovec_src = ovec + subgroups2_1; long int *ovec_dst = (long int *) ovec + subgroups2_1; /* Converts offsets from C-integers to OCaml-Integers This is a bit tricky, because there are 32- and 64-bit platforms around and OCaml chooses the larger possibility for representing integers when available (also in arrays) - not so the PCRE */ while (subgroups2--) { *ovec_dst = Val_int(*ovec_src); --ovec_src; --ovec_dst; } } } /* 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) * subgroups3); int ret; struct cod cod = { (value *) NULL, (value *) NULL, (value) NULL }; struct pcre_extra new_extra = #ifdef PCRE_CONFIG_MATCH_LIMIT_RECURSION { PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL, 0 }; #else { PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL }; #endif memcpy(subj, ocaml_subj, len); Begin_roots3(v_rex, v_cof, v_substrings); Begin_roots2(v_subj, v_ovec); 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) { ret = pcre_exec(code, &new_extra, subj, len, ofs, opt, ovec, subgroups3); } else { 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_CONFIG_MATCH_LIMIT_RECURSION new_extra.match_limit_recursion = extra->match_limit_recursion; #endif ret = pcre_exec(code, &new_extra, subj, len, ofs, opt, ovec, subgroups3); } free(subj); End_roots(); if (ret < 0) { free(ovec); switch(ret) { case PCRE_ERROR_NOMATCH : caml_raise_constant(*pcre_exc_Not_found); case PCRE_ERROR_PARTIAL : caml_raise_constant(*pcre_exc_Partial); case PCRE_ERROR_MATCHLIMIT : caml_raise_constant(*pcre_exc_MatchLimit); case PCRE_ERROR_BADPARTIAL : caml_raise_constant(*pcre_exc_BadPartial); case PCRE_ERROR_BADUTF8 : caml_raise_constant(*pcre_exc_BadUTF8); case PCRE_ERROR_BADUTF8_OFFSET : caml_raise_constant(*pcre_exc_BadUTF8Offset); case PCRE_ERROR_CALLOUT : caml_raise(cod.v_exn); default : caml_raise_with_string(*pcre_exc_InternalError, "pcre_exec_stub"); } } else { int *ovec_src = ovec + subgroups2_1; long int *ovec_dst = &Field(v_ovec, 0) + subgroups2_1; while (subgroups2--) { *ovec_dst = Val_int(*ovec_src); --ovec_src; --ovec_dst; } free(ovec); } } } return Val_unit; } /* 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_stub(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } /* 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 100 table set allocations (one table set consumes 864 bytes -> maximum of 86400 bytes unreclaimed table sets) */ const value v_res = caml_alloc_final(2, pcre_dealloc_tables, 864, 86400); Field(v_res, 1) = (value) pcre_maketables(); return v_res; } /* 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 value pcre_get_stringnumber_stub(value v_rex, value v_name) { const int ret = pcre_get_stringnumber((pcre *) Field(v_rex, 1), String_val(v_name)); if (ret == PCRE_ERROR_NOSUBSTRING) caml_invalid_argument("Named string not found"); return Val_int(ret); } /* 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) caml_raise_with_string(*pcre_exc_InternalError, "pcre_names_stub"); ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMEENTRYSIZE, &entry_size); if (ret != 0) caml_raise_with_string(*pcre_exc_InternalError, "pcre_names_stub"); ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMETABLE, &tbl_ptr); if (ret != 0) caml_raise_with_string(*pcre_exc_InternalError, "pcre_names_stub"); 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); }
CAMLexport void caml_invalid_argument (char const *msg) { caml_raise_with_string(Field(caml_global_data, INVALID_EXN), msg); }
static void spf_error(const char *err) { caml_raise_with_string(*caml_named_value("Error"), err); }
void failwith_xl(char *fname, struct caml_logger *lg) { char *s; s = (lg) ? lg->log_buf : fname; caml_raise_with_string(*caml_named_value("xl.error"), s); }