CAMLprim value PQparamtype_stub(value __unused v_res, value __unused v_field_num) { caml_failwith("Postgresql.paramtype: not supported"); return Val_unit; }
CAMLprim value malloc_trim_stub(value v_n) { int ret = malloc_trim(Int_val(v_n)); if (ret != 1) caml_failwith("malloc_trim"); return Val_unit; }
CAMLprim value PQnparams_stub(value __unused v_res) { caml_failwith("Postgresql.nparams: not supported"); return Val_unit; }
void hh_load_dep_table(value in_filename) { CAMLparam1(in_filename); caml_failwith("Program not linked with lz4, so loading is not supported!"); CAMLreturn0; }
CAMLprim value malloc_mallopt_stub(value v_opt, value v_n) { int ret = mallopt(options[Int_val(v_opt)], Int_val(v_n)); if (ret != 1) caml_failwith("mallopt"); return Val_unit; }
static inline value raise_invalid_hex_encoding() { caml_failwith("Postgresql.unescape_bytea_9x: invalid hex encoding"); return Val_unit; }
PREFIX value ml_edje_object_add(value v_evas) { Evas_Object* obj = edje_object_add((Evas*) v_evas); if(obj == NULL) caml_failwith("edje_object_add"); return (value) obj; }
static void check_bigstring_proxy(struct caml_ba_array *b) { if (b->proxy != NULL) caml_failwith("bigstring_destroy: bigstring has proxy"); }
PREFIX value ml_elm_gesture_layer_add(value v_parent) { Evas_Object* obj = elm_gesture_layer_add(Evas_Object_val(v_parent)); if(obj == NULL) caml_failwith("elm_gesture_layer_add"); return copy_Evas_Object(obj); }
CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, value vshared, value vdim, value vstart) { int fd, flags, major_dim, shared; intnat num_dims, i; intnat dim[CAML_BA_MAX_NUM_DIMS]; file_offset startpos, file_size, data_size; struct stat st; uintnat array_size, page, delta; void * addr; fd = Int_val(vfd); flags = Int_val(vkind) | Int_val(vlayout); startpos = File_offset_val(vstart); num_dims = Wosize_val(vdim); major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0; /* Extract dimensions from OCaml array */ num_dims = Wosize_val(vdim); if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS) caml_invalid_argument("Bigarray.mmap: bad number of dimensions"); for (i = 0; i < num_dims; i++) { dim[i] = Long_val(Field(vdim, i)); if (dim[i] == -1 && i == major_dim) continue; if (dim[i] < 0) caml_invalid_argument("Bigarray.create: negative dimension"); } /* Determine file size. We avoid lseek here because it is fragile, and because some mappable file types do not support it */ caml_enter_blocking_section(); if (fstat(fd, &st) == -1) { caml_leave_blocking_section(); caml_sys_error(NO_ARG); } file_size = st.st_size; /* Determine array size in bytes (or size of array without the major dimension if that dimension wasn't specified) */ array_size = caml_ba_element_size[flags & CAML_BA_KIND_MASK]; for (i = 0; i < num_dims; i++) if (dim[i] != -1) array_size *= dim[i]; /* Check if the major dimension is unknown */ if (dim[major_dim] == -1) { /* Determine major dimension from file size */ if (file_size < startpos) { caml_leave_blocking_section(); caml_failwith("Bigarray.mmap: file position exceeds file size"); } data_size = file_size - startpos; dim[major_dim] = (uintnat) (data_size / array_size); array_size = dim[major_dim] * array_size; if (array_size != data_size) { caml_leave_blocking_section(); caml_failwith("Bigarray.mmap: file size doesn't match array dimensions"); } } else { /* Check that file is large enough, and grow it otherwise */ if (file_size < startpos + array_size) { if (caml_grow_file(fd, startpos + array_size) == -1) { /* PR#5543 */ caml_leave_blocking_section(); caml_sys_error(NO_ARG); } } } /* Determine offset so that the mapping starts at the given file pos */ page = getpagesize(); delta = (uintnat) startpos % page; /* Do the mmap */ shared = Bool_val(vshared) ? MAP_SHARED : MAP_PRIVATE; if (array_size > 0) addr = mmap(NULL, array_size + delta, PROT_READ | PROT_WRITE, shared, fd, startpos - delta); else addr = NULL; /* PR#5463 - mmap fails on empty region */ caml_leave_blocking_section(); if (addr == (void *) MAP_FAILED) caml_sys_error(NO_ARG); addr = (void *) ((uintnat) addr + delta); /* Build and return the OCaml bigarray */ return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim); }
CAMLprim value ml_text_recode_string(value enc_src, value enc_dst, value str) { CAMLparam3(str, enc_src, enc_dst); CAMLlocal1(result); iconv_t cd = iconv_open(String_val(enc_dst), String_val(enc_src)); if (cd == (iconv_t)-1) caml_failwith("Encoding.recode_string: invalid encoding"); /* Length of the output buffer. It is initialised to the length of the input string, which should be a good approximation: */ size_t len = caml_string_length(str); /* Pointer to the beginning of the output buffer. The +1 is for the NULL terminating byte. */ char *dst_buffer = malloc(len + 1); if (dst_buffer == NULL) caml_failwith("Encoding.recode_string: out of memory"); /* iconv arguments */ char *src_bytes = String_val(str); char *dst_bytes = dst_buffer; size_t src_remaining = len; size_t dst_remaining = len; while (src_remaining) { size_t count = iconv (cd, &src_bytes, &src_remaining, &dst_bytes, &dst_remaining); if (count == (size_t) -1) { switch (errno) { case EILSEQ: free(dst_buffer); iconv_close(cd); caml_failwith("Encoding.recode_string: invalid multibyte sequence found in the input"); case EINVAL: free(dst_buffer); iconv_close(cd); caml_failwith("Encoding.recode_string: incomplete multibyte sequence found in the input"); case E2BIG: { /* Ouput offest relative to the beginning of the destination buffer: */ size_t offset = dst_bytes - dst_buffer; /* Try with a buffer 2 times bigger: */ len *= 2; dst_buffer = realloc(dst_buffer, len + 1); if (dst_buffer == NULL) caml_failwith("Encoding.recode_string: out of memory"); dst_bytes = dst_buffer + offset; dst_remaining += len; break; } default: free(dst_buffer); iconv_close(cd); caml_failwith("Encoding.recode_string: unknown error"); } } }; *dst_bytes = 0; result = caml_alloc_string(dst_bytes - dst_buffer); memcpy(String_val(result), dst_buffer, dst_bytes - dst_buffer); /* Clean-up */ free(dst_buffer); iconv_close(cd); CAMLreturn(result); }
void ocamlcc_dynlink_error(void) { caml_failwith("OCamlCC: dynlink not implemented"); }
CAMLprim value caml_new_lex_engine(struct lexing_table *tbl, value start_state, struct lexer_buffer *lexbuf) { int state, base, backtrk, c, pstate ; state = Int_val(start_state); if (state >= 0) { /* First entry */ lexbuf->lex_last_pos = lexbuf->lex_start_pos = lexbuf->lex_curr_pos; lexbuf->lex_last_action = Val_int(-1); } else { /* Reentry after refill */ state = -state - 1; } while(1) { /* Lookup base address or action number for current state */ base = Short(tbl->lex_base, state); if (base < 0) { int pc_off = Short(tbl->lex_base_code, state) ; run_tag(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem); /* fprintf(stderr,"Perform: %d\n",-base-1) ; */ return Val_int(-base-1); } /* See if it's a backtrack point */ backtrk = Short(tbl->lex_backtrk, state); if (backtrk >= 0) { int pc_off = Short(tbl->lex_backtrk_code, state); run_tag(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem); lexbuf->lex_last_pos = lexbuf->lex_curr_pos; lexbuf->lex_last_action = Val_int(backtrk); } /* See if we need a refill */ if (lexbuf->lex_curr_pos >= lexbuf->lex_buffer_len){ if (lexbuf->lex_eof_reached == Val_bool (0)){ return Val_int(-state - 1); }else{ c = 256; } }else{ /* Read next input char */ c = Byte_u(lexbuf->lex_buffer, Long_val(lexbuf->lex_curr_pos)); lexbuf->lex_curr_pos += 2; } /* Determine next state */ pstate=state ; if (Short(tbl->lex_check, base + c) == state) state = Short(tbl->lex_trans, base + c); else state = Short(tbl->lex_default, state); /* If no transition on this char, return to last backtrack point */ if (state < 0) { lexbuf->lex_curr_pos = lexbuf->lex_last_pos; if (lexbuf->lex_last_action == Val_int(-1)) { caml_failwith("lexing: empty token"); } else { return lexbuf->lex_last_action; } }else{ /* If some transition, get and perform memory moves */ int base_code = Short(tbl->lex_base_code, pstate) ; int pc_off ; if (Short(tbl->lex_check_code, base_code + c) == pstate) pc_off = Short(tbl->lex_trans_code, base_code + c) ; else pc_off = Short(tbl->lex_default_code, pstate) ; if (pc_off > 0) run_mem(Bp_val(tbl->lex_code) + pc_off, lexbuf->lex_mem, lexbuf->lex_curr_pos) ; /* Erase the EOF condition only if the EOF pseudo-character was consumed by the automaton (i.e. there was no backtrack above) */ if (c == 256) lexbuf->lex_eof_reached = Val_bool (0); } } }
void hh_load(value in_filename) { CAMLparam1(in_filename); FILE* fp = fopen(String_val(in_filename), "rb"); if (fp == NULL) { caml_failwith("Failed to open file"); } uint64_t magic = 0; read_all(fileno(fp), (void*)&magic, sizeof magic); assert(magic == MAGIC_CONSTANT); size_t revlen = 0; read_all(fileno(fp), (void*)&revlen, sizeof revlen); char revision[revlen]; read_all(fileno(fp), (void*)revision, revlen * sizeof(char)); assert(strncmp(revision, BuildInfo_kRevision, revlen) == 0); read_all(fileno(fp), (void*)&heap_init_size, sizeof heap_init_size); int compressed_size = 0; read_all(fileno(fp), (void*)&compressed_size, sizeof compressed_size); char* chunk_start = (char*)SAVE_START; pthread_attr_t attr; pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); pthread_t thread; decompress_args args; int thread_started = 0; // see hh_save for a description of what we are parsing here. while (compressed_size > 0) { char* compressed = malloc(compressed_size * sizeof(char)); assert(compressed != NULL); uintptr_t chunk_size = 0; read_all(fileno(fp), (void*)&chunk_size, sizeof chunk_size); read_all(fileno(fp), compressed, compressed_size * sizeof(char)); if (thread_started) { intptr_t success = 0; int rc = pthread_join(thread, (void*)&success); free(args.compressed); assert(rc == 0); assert(success); } args.compressed = compressed; args.compressed_size = compressed_size; args.decompress_start = chunk_start; args.decompressed_size = chunk_size; pthread_create(&thread, &attr, (void* (*)(void*))decompress, &args); thread_started = 1; chunk_start += chunk_size; read_all(fileno(fp), (void*)&compressed_size, sizeof compressed_size); } if (thread_started) { int success; int rc = pthread_join(thread, (void*)&success); free(args.compressed); assert(rc == 0); assert(success); } fclose(fp); CAMLreturn0; }
CAMLprim value PQsendDescribePortal_stub(value __unused v_conn, value __unused v_portal_name) { caml_failwith("Postgresql.send_describe_portal: not supported"); return Val_unit; }
static void extern_failwith(char *msg) { extern_replay_trail(); free_extern_output(); caml_failwith(msg); }
CAMLprim value PQsetSingleRowMode_stub(value __unused conn) { caml_failwith("Postgresql.set_single_row_mode: not supported"); return Val_unit; }
void hh_save_dep_table(value out_filename) { CAMLparam1(out_filename); caml_failwith("Program not linked with lz4, so saving is not supported!"); CAMLreturn0; }
CAMLprim value caml_SDL_RenderCopyEx( value renderer, value texture, value _srcrect, value _dstrect, value angle, value _center, value flip, value unit) { SDL_Rect srcrect; SDL_Rect *srcrect_; SDL_Rect dstrect; SDL_Rect *dstrect_; SDL_Point center; SDL_Point *center_; double angle_; SDL_RendererFlip flip_; if (_srcrect == Val_none) { srcrect_ = NULL; } else { SDL_Rect_val(&srcrect, Some_val(_srcrect)); srcrect_ = &srcrect; } if (_dstrect == Val_none) { dstrect_ = NULL; } else { SDL_Rect_val(&dstrect, Some_val(_dstrect)); dstrect_ = &dstrect; } if (_center == Val_none) { center_ = NULL; } else { SDL_Point_val(¢er, Some_val(_center)); center_ = ¢er; } angle_ = (angle == Val_none ? 0.0 : Double_val(Some_val(angle)) ); flip_ = (flip == Val_none ? SDL_FLIP_NONE : SDL_RendererFlip_val(Some_val(flip)) ); int r = SDL_RenderCopyEx( SDL_Renderer_val(renderer), SDL_Texture_val(texture), srcrect_, dstrect_, angle_, center_, flip_); if (r) caml_failwith("Sdlrender.copyEx"); return Val_unit; }
PREFIX value ml_elm_win_inwin_add(value v_parent) { Evas_Object* obj = elm_win_inwin_add((Evas_Object*) v_parent); if(obj == NULL) caml_failwith("elm_win_inwin_add"); return (value) obj; }