diff options
Diffstat (limited to 'test/monniaux/ocaml')
-rw-r--r-- | test/monniaux/ocaml/Makefile | 32 | ||||
-rw-r--r-- | test/monniaux/ocaml/byterun/caml/finalise.h | 2 | ||||
-rw-r--r-- | test/monniaux/ocaml/byterun/caml/jumptbl.h | 40 | ||||
-rw-r--r-- | test/monniaux/ocaml/byterun/caml/opnames.h | 48 | ||||
-rw-r--r-- | test/monniaux/ocaml/byterun/caml/version.h | 6 | ||||
-rw-r--r-- | test/monniaux/ocaml/byterun/compact.c | 1 | ||||
-rw-r--r-- | test/monniaux/ocaml/byterun/main.c | 13 | ||||
-rw-r--r-- | test/monniaux/ocaml/byterun/prims.c | 1153 | ||||
-rw-r--r-- | test/monniaux/ocaml/byterun/win32.c | 1019 |
9 files changed, 1289 insertions, 1025 deletions
diff --git a/test/monniaux/ocaml/Makefile b/test/monniaux/ocaml/Makefile index 46ce8994..0ae7c22f 100644 --- a/test/monniaux/ocaml/Makefile +++ b/test/monniaux/ocaml/Makefile @@ -1,7 +1,29 @@ -test: byterun/ocamlrun - k1-cluster --syscall=libstd_scalls.so -- byterun/ocamlrun examples/quicksort +ALL_CFLAGS=-Ibyterun +EXECUTE_ARGS=examples/quicksort -byterun/ocamlrun: - (cd byterun ; $(MAKE)) +include ../rules.mk -.PHONY: test +ALL_CCOMPFLAGS= +LDLIBS=-lm + +CFILES=$(wildcard byterun/*.c) + +CCOMP_K1C_S=$(patsubst %.c,%.ccomp.k1c.s,$(CFILES)) +CCOMP_HOST_S=$(patsubst %.c,%.ccomp.host.s,$(CFILES)) + +GCC_K1C_S=$(patsubst %.c,%.gcc.k1c.s,$(CFILES)) +GCC_HOST_S=$(patsubst %.c,%.gcc.host.s,$(CFILES)) + +all: $(CCOMP_K1C_S) $(GCC_K1C_S) ocamlrun.ccomp.k1c.out ocamlrun.gcc.k1c.out + +ocamlrun.ccomp.k1c : $(CCOMP_K1C_S) ../clock.gcc.k1c.o + $(K1C_CCOMP) $(K1C_CCOMPFLAGS) $+ -o $@ $(LDLIBS) + +ocamlrun.ccomp.host : $(CCOMP_HOST_S) ../clock.gcc.host.o + $(CCOMP) $(CCOMPFLAGS) $+ -o $@ $(LDLIBS) + +ocamlrun.gcc.k1c : $(GCC_K1C_S) ../clock.gcc.k1c.o + $(K1C_CC) $(K1C_CFLAGS) $+ -o $@ $(LDLIBS) + +ocamlrun.gcc.host : $(GCC_HOST_S) ../clock.gcc.host.o + $(CC) $(CFLAGS) $+ -o $@ $(LDLIBS) diff --git a/test/monniaux/ocaml/byterun/caml/finalise.h b/test/monniaux/ocaml/byterun/caml/finalise.h index 5315ac21..b2052c21 100644 --- a/test/monniaux/ocaml/byterun/caml/finalise.h +++ b/test/monniaux/ocaml/byterun/caml/finalise.h @@ -25,7 +25,7 @@ void caml_final_update_clean_phase (void); void caml_final_do_calls (void); void caml_final_do_roots (scanning_action f); void caml_final_invert_finalisable_values (); -void caml_final_oldify_young_roots (); +void caml_final_oldify_young_roots (void); void caml_final_empty_young (void); void caml_final_update_minor_roots(void); value caml_final_register (value f, value v); diff --git a/test/monniaux/ocaml/byterun/caml/jumptbl.h b/test/monniaux/ocaml/byterun/caml/jumptbl.h new file mode 100644 index 00000000..30588756 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/jumptbl.h @@ -0,0 +1,40 @@ + &&lbl_ACC0, &&lbl_ACC1, &&lbl_ACC2, &&lbl_ACC3, &&lbl_ACC4, &&lbl_ACC5, &&lbl_ACC6, &&lbl_ACC7, + &&lbl_ACC, &&lbl_PUSH, + &&lbl_PUSHACC0, &&lbl_PUSHACC1, &&lbl_PUSHACC2, &&lbl_PUSHACC3, + &&lbl_PUSHACC4, &&lbl_PUSHACC5, &&lbl_PUSHACC6, &&lbl_PUSHACC7, + &&lbl_PUSHACC, &&lbl_POP, &&lbl_ASSIGN, + &&lbl_ENVACC1, &&lbl_ENVACC2, &&lbl_ENVACC3, &&lbl_ENVACC4, &&lbl_ENVACC, + &&lbl_PUSHENVACC1, &&lbl_PUSHENVACC2, &&lbl_PUSHENVACC3, &&lbl_PUSHENVACC4, &&lbl_PUSHENVACC, + &&lbl_PUSH_RETADDR, &&lbl_APPLY, &&lbl_APPLY1, &&lbl_APPLY2, &&lbl_APPLY3, + &&lbl_APPTERM, &&lbl_APPTERM1, &&lbl_APPTERM2, &&lbl_APPTERM3, + &&lbl_RETURN, &&lbl_RESTART, &&lbl_GRAB, + &&lbl_CLOSURE, &&lbl_CLOSUREREC, + &&lbl_OFFSETCLOSUREM2, &&lbl_OFFSETCLOSURE0, &&lbl_OFFSETCLOSURE2, &&lbl_OFFSETCLOSURE, + &&lbl_PUSHOFFSETCLOSUREM2, &&lbl_PUSHOFFSETCLOSURE0, + &&lbl_PUSHOFFSETCLOSURE2, &&lbl_PUSHOFFSETCLOSURE, + &&lbl_GETGLOBAL, &&lbl_PUSHGETGLOBAL, &&lbl_GETGLOBALFIELD, &&lbl_PUSHGETGLOBALFIELD, &&lbl_SETGLOBAL, + &&lbl_ATOM0, &&lbl_ATOM, &&lbl_PUSHATOM0, &&lbl_PUSHATOM, + &&lbl_MAKEBLOCK, &&lbl_MAKEBLOCK1, &&lbl_MAKEBLOCK2, &&lbl_MAKEBLOCK3, &&lbl_MAKEFLOATBLOCK, + &&lbl_GETFIELD0, &&lbl_GETFIELD1, &&lbl_GETFIELD2, &&lbl_GETFIELD3, &&lbl_GETFIELD, &&lbl_GETFLOATFIELD, + &&lbl_SETFIELD0, &&lbl_SETFIELD1, &&lbl_SETFIELD2, &&lbl_SETFIELD3, &&lbl_SETFIELD, &&lbl_SETFLOATFIELD, + &&lbl_VECTLENGTH, &&lbl_GETVECTITEM, &&lbl_SETVECTITEM, + &&lbl_GETBYTESCHAR, &&lbl_SETBYTESCHAR, + &&lbl_BRANCH, &&lbl_BRANCHIF, &&lbl_BRANCHIFNOT, &&lbl_SWITCH, &&lbl_BOOLNOT, + &&lbl_PUSHTRAP, &&lbl_POPTRAP, &&lbl_RAISE, + &&lbl_CHECK_SIGNALS, + &&lbl_C_CALL1, &&lbl_C_CALL2, &&lbl_C_CALL3, &&lbl_C_CALL4, &&lbl_C_CALL5, &&lbl_C_CALLN, + &&lbl_CONST0, &&lbl_CONST1, &&lbl_CONST2, &&lbl_CONST3, &&lbl_CONSTINT, + &&lbl_PUSHCONST0, &&lbl_PUSHCONST1, &&lbl_PUSHCONST2, &&lbl_PUSHCONST3, &&lbl_PUSHCONSTINT, + &&lbl_NEGINT, &&lbl_ADDINT, &&lbl_SUBINT, &&lbl_MULINT, &&lbl_DIVINT, &&lbl_MODINT, + &&lbl_ANDINT, &&lbl_ORINT, &&lbl_XORINT, &&lbl_LSLINT, &&lbl_LSRINT, &&lbl_ASRINT, + &&lbl_EQ, &&lbl_NEQ, &&lbl_LTINT, &&lbl_LEINT, &&lbl_GTINT, &&lbl_GEINT, + &&lbl_OFFSETINT, &&lbl_OFFSETREF, &&lbl_ISINT, + &&lbl_GETMETHOD, + &&lbl_BEQ, &&lbl_BNEQ, &&lbl_BLTINT, &&lbl_BLEINT, &&lbl_BGTINT, &&lbl_BGEINT, + &&lbl_ULTINT, &&lbl_UGEINT, + &&lbl_BULTINT, &&lbl_BUGEINT, + &&lbl_GETPUBMET, &&lbl_GETDYNMET, + &&lbl_STOP, + &&lbl_EVENT, &&lbl_BREAK, + &&lbl_RERAISE, &&lbl_RAISE_NOTRACE, + &&lbl_GETSTRINGCHAR, diff --git a/test/monniaux/ocaml/byterun/caml/opnames.h b/test/monniaux/ocaml/byterun/caml/opnames.h new file mode 100644 index 00000000..bf6144cf --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/opnames.h @@ -0,0 +1,48 @@ + + + + +char * names_of_instructions [] = { + "ACC0", "ACC1", "ACC2", "ACC3", "ACC4", "ACC5", "ACC6", "ACC7", + "ACC", "PUSH", + "PUSHACC0", "PUSHACC1", "PUSHACC2", "PUSHACC3", + "PUSHACC4", "PUSHACC5", "PUSHACC6", "PUSHACC7", + "PUSHACC", "POP", "ASSIGN", + "ENVACC1", "ENVACC2", "ENVACC3", "ENVACC4", "ENVACC", + "PUSHENVACC1", "PUSHENVACC2", "PUSHENVACC3", "PUSHENVACC4", "PUSHENVACC", + "PUSH_RETADDR", "APPLY", "APPLY1", "APPLY2", "APPLY3", + "APPTERM", "APPTERM1", "APPTERM2", "APPTERM3", + "RETURN", "RESTART", "GRAB", + "CLOSURE", "CLOSUREREC", + "OFFSETCLOSUREM2", "OFFSETCLOSURE0", "OFFSETCLOSURE2", "OFFSETCLOSURE", + "PUSHOFFSETCLOSUREM2", "PUSHOFFSETCLOSURE0", + "PUSHOFFSETCLOSURE2", "PUSHOFFSETCLOSURE", + "GETGLOBAL", "PUSHGETGLOBAL", "GETGLOBALFIELD", "PUSHGETGLOBALFIELD", "SETGLOBAL", + "ATOM0", "ATOM", "PUSHATOM0", "PUSHATOM", + "MAKEBLOCK", "MAKEBLOCK1", "MAKEBLOCK2", "MAKEBLOCK3", "MAKEFLOATBLOCK", + "GETFIELD0", "GETFIELD1", "GETFIELD2", "GETFIELD3", "GETFIELD", "GETFLOATFIELD", + "SETFIELD0", "SETFIELD1", "SETFIELD2", "SETFIELD3", "SETFIELD", "SETFLOATFIELD", + "VECTLENGTH", "GETVECTITEM", "SETVECTITEM", + "GETBYTESCHAR", "SETBYTESCHAR", + "BRANCH", "BRANCHIF", "BRANCHIFNOT", "SWITCH", "BOOLNOT", + "PUSHTRAP", "POPTRAP", "RAISE", + "CHECK_SIGNALS", + "C_CALL1", "C_CALL2", "C_CALL3", "C_CALL4", "C_CALL5", "C_CALLN", + "CONST0", "CONST1", "CONST2", "CONST3", "CONSTINT", + "PUSHCONST0", "PUSHCONST1", "PUSHCONST2", "PUSHCONST3", "PUSHCONSTINT", + "NEGINT", "ADDINT", "SUBINT", "MULINT", "DIVINT", "MODINT", + "ANDINT", "ORINT", "XORINT", "LSLINT", "LSRINT", "ASRINT", + "EQ", "NEQ", "LTINT", "LEINT", "GTINT", "GEINT", + "OFFSETINT", "OFFSETREF", "ISINT", + "GETMETHOD", + "BEQ", "BNEQ", "BLTINT", "BLEINT", "BGTINT", "BGEINT", + "ULTINT", "UGEINT", + "BULTINT", "BUGEINT", + "GETPUBMET", "GETDYNMET", + "STOP", + "EVENT", "BREAK", + "RERAISE", "RAISE_NOTRACE", + "GETSTRINGCHAR", +"FIRST_UNIMPLEMENTED_OP"}; + + diff --git a/test/monniaux/ocaml/byterun/caml/version.h b/test/monniaux/ocaml/byterun/caml/version.h new file mode 100644 index 00000000..68d7000e --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/version.h @@ -0,0 +1,6 @@ +#define OCAML_VERSION_MAJOR 4 +#define OCAML_VERSION_MINOR 7 +#define OCAML_VERSION_PATCHLEVEL 1 +#undef OCAML_VERSION_ADDITIONAL +#define OCAML_VERSION 40701 +#define OCAML_VERSION_STRING "4.07.1" diff --git a/test/monniaux/ocaml/byterun/compact.c b/test/monniaux/ocaml/byterun/compact.c index 7b7188ab..83e7ed0a 100644 --- a/test/monniaux/ocaml/byterun/compact.c +++ b/test/monniaux/ocaml/byterun/compact.c @@ -32,6 +32,7 @@ extern uintnat caml_percent_free; /* major_gc.c */ extern void caml_shrink_heap (char *); /* memory.c */ +extern void caml_final_invert_finalisable_values (void); /* Encoded headers: the color is stored in the 2 least significant bits. (For pointer inversion, we need to distinguish headers from pointers.) diff --git a/test/monniaux/ocaml/byterun/main.c b/test/monniaux/ocaml/byterun/main.c index 5e5839ff..498f3d18 100644 --- a/test/monniaux/ocaml/byterun/main.c +++ b/test/monniaux/ocaml/byterun/main.c @@ -13,6 +13,7 @@ /* */ /**************************************************************************/ +#define VERIMAG_MEASUREMENTS #define CAML_INTERNALS /* Main entry point (can be overridden by a user-provided main() @@ -26,6 +27,10 @@ #include <windows.h> #endif +#ifdef VERIMAG_MEASUREMENTS +#include "../../clock.h" +#endif + CAMLextern void caml_main (char_os **); #ifdef _WIN32 @@ -41,7 +46,15 @@ int main(int argc, char **argv) caml_expand_command_line(&argc, &argv); #endif +#ifdef VERIMAG_MEASUREMENTS + clock_prepare(); + clock_start(); +#endif caml_main(argv); +#ifdef VERIMAG_MEASUREMENTS + clock_stop(); + print_total_clock(); +#endif caml_sys_exit(Val_int(0)); return 0; /* not reached */ } diff --git a/test/monniaux/ocaml/byterun/prims.c b/test/monniaux/ocaml/byterun/prims.c new file mode 100644 index 00000000..15ebf593 --- /dev/null +++ b/test/monniaux/ocaml/byterun/prims.c @@ -0,0 +1,1153 @@ +#define CAML_INTERNALS +#include "caml/mlvalues.h" +#include "caml/prims.h" +extern value caml_abs_float(); +extern value caml_acos_float(); +extern value caml_add_debug_info(); +extern value caml_add_float(); +extern value caml_alloc_dummy(); +extern value caml_alloc_dummy_float(); +extern value caml_alloc_dummy_function(); +extern value caml_array_append(); +extern value caml_array_blit(); +extern value caml_array_concat(); +extern value caml_array_get(); +extern value caml_array_get_addr(); +extern value caml_array_get_float(); +extern value caml_array_set(); +extern value caml_array_set_addr(); +extern value caml_array_set_float(); +extern value caml_array_sub(); +extern value caml_array_unsafe_get(); +extern value caml_array_unsafe_get_float(); +extern value caml_array_unsafe_set(); +extern value caml_array_unsafe_set_addr(); +extern value caml_array_unsafe_set_float(); +extern value caml_asin_float(); +extern value caml_atan2_float(); +extern value caml_atan_float(); +extern value caml_ba_blit(); +extern value caml_ba_change_layout(); +extern value caml_ba_create(); +extern value caml_ba_dim(); +extern value caml_ba_dim_1(); +extern value caml_ba_dim_2(); +extern value caml_ba_dim_3(); +extern value caml_ba_fill(); +extern value caml_ba_get_1(); +extern value caml_ba_get_2(); +extern value caml_ba_get_3(); +extern value caml_ba_get_generic(); +extern value caml_ba_kind(); +extern value caml_ba_layout(); +extern value caml_ba_num_dims(); +extern value caml_ba_reshape(); +extern value caml_ba_set_1(); +extern value caml_ba_set_2(); +extern value caml_ba_set_3(); +extern value caml_ba_set_generic(); +extern value caml_ba_slice(); +extern value caml_ba_sub(); +extern value caml_ba_uint8_get16(); +extern value caml_ba_uint8_get32(); +extern value caml_ba_uint8_get64(); +extern value caml_ba_uint8_set16(); +extern value caml_ba_uint8_set32(); +extern value caml_ba_uint8_set64(); +extern value caml_backtrace_status(); +extern value caml_blit_bytes(); +extern value caml_blit_string(); +extern value caml_bswap16(); +extern value caml_bytes_compare(); +extern value caml_bytes_equal(); +extern value caml_bytes_get(); +extern value caml_bytes_get16(); +extern value caml_bytes_get32(); +extern value caml_bytes_get64(); +extern value caml_bytes_greaterequal(); +extern value caml_bytes_greaterthan(); +extern value caml_bytes_lessequal(); +extern value caml_bytes_lessthan(); +extern value caml_bytes_notequal(); +extern value caml_bytes_of_string(); +extern value caml_bytes_set(); +extern value caml_bytes_set16(); +extern value caml_bytes_set32(); +extern value caml_bytes_set64(); +extern value caml_ceil_float(); +extern value caml_channel_descriptor(); +extern value caml_classify_float(); +extern value caml_compare(); +extern value caml_convert_raw_backtrace(); +extern value caml_convert_raw_backtrace_slot(); +extern value caml_copysign_float(); +extern value caml_cos_float(); +extern value caml_cosh_float(); +extern value caml_create_bytes(); +extern value caml_create_string(); +extern value caml_div_float(); +extern value caml_dynlink_add_primitive(); +extern value caml_dynlink_close_lib(); +extern value caml_dynlink_get_current_libs(); +extern value caml_dynlink_lookup_symbol(); +extern value caml_dynlink_open_lib(); +extern value caml_ensure_stack_capacity(); +extern value caml_ephe_blit_data(); +extern value caml_ephe_blit_key(); +extern value caml_ephe_check_data(); +extern value caml_ephe_check_key(); +extern value caml_ephe_create(); +extern value caml_ephe_get_data(); +extern value caml_ephe_get_data_copy(); +extern value caml_ephe_get_key(); +extern value caml_ephe_get_key_copy(); +extern value caml_ephe_set_data(); +extern value caml_ephe_set_key(); +extern value caml_ephe_unset_data(); +extern value caml_ephe_unset_key(); +extern value caml_eq_float(); +extern value caml_equal(); +extern value caml_exp_float(); +extern value caml_expm1_float(); +extern value caml_fill_bytes(); +extern value caml_fill_string(); +extern value caml_final_register(); +extern value caml_final_register_called_without_value(); +extern value caml_final_release(); +extern value caml_float_compare(); +extern value caml_float_of_int(); +extern value caml_float_of_string(); +extern value caml_floatarray_create(); +extern value caml_floatarray_get(); +extern value caml_floatarray_set(); +extern value caml_floatarray_unsafe_get(); +extern value caml_floatarray_unsafe_set(); +extern value caml_floor_float(); +extern value caml_fmod_float(); +extern value caml_format_float(); +extern value caml_format_int(); +extern value caml_fresh_oo_id(); +extern value caml_frexp_float(); +extern value caml_gc_compaction(); +extern value caml_gc_counters(); +extern value caml_gc_full_major(); +extern value caml_gc_get(); +extern value caml_gc_huge_fallback_count(); +extern value caml_gc_major(); +extern value caml_gc_major_slice(); +extern value caml_gc_minor(); +extern value caml_gc_minor_words(); +extern value caml_gc_quick_stat(); +extern value caml_gc_set(); +extern value caml_gc_stat(); +extern value caml_ge_float(); +extern value caml_get_current_callstack(); +extern value caml_get_current_environment(); +extern value caml_get_exception_backtrace(); +extern value caml_get_exception_raw_backtrace(); +extern value caml_get_global_data(); +extern value caml_get_major_bucket(); +extern value caml_get_major_credit(); +extern value caml_get_minor_free(); +extern value caml_get_public_method(); +extern value caml_get_section_table(); +extern value caml_greaterequal(); +extern value caml_greaterthan(); +extern value caml_gt_float(); +extern value caml_hash(); +extern value caml_hash_univ_param(); +extern value caml_hexstring_of_float(); +extern value caml_hypot_float(); +extern value caml_input_value(); +extern value caml_input_value_from_bytes(); +extern value caml_input_value_from_string(); +extern value caml_input_value_to_outside_heap(); +extern value caml_install_signal_handler(); +extern value caml_int32_add(); +extern value caml_int32_and(); +extern value caml_int32_bits_of_float(); +extern value caml_int32_bswap(); +extern value caml_int32_compare(); +extern value caml_int32_div(); +extern value caml_int32_float_of_bits(); +extern value caml_int32_format(); +extern value caml_int32_mod(); +extern value caml_int32_mul(); +extern value caml_int32_neg(); +extern value caml_int32_of_float(); +extern value caml_int32_of_int(); +extern value caml_int32_of_string(); +extern value caml_int32_or(); +extern value caml_int32_shift_left(); +extern value caml_int32_shift_right(); +extern value caml_int32_shift_right_unsigned(); +extern value caml_int32_sub(); +extern value caml_int32_to_float(); +extern value caml_int32_to_int(); +extern value caml_int32_xor(); +extern value caml_int64_add(); +extern value caml_int64_and(); +extern value caml_int64_bits_of_float(); +extern value caml_int64_bswap(); +extern value caml_int64_compare(); +extern value caml_int64_div(); +extern value caml_int64_float_of_bits(); +extern value caml_int64_format(); +extern value caml_int64_mod(); +extern value caml_int64_mul(); +extern value caml_int64_neg(); +extern value caml_int64_of_float(); +extern value caml_int64_of_int(); +extern value caml_int64_of_int32(); +extern value caml_int64_of_nativeint(); +extern value caml_int64_of_string(); +extern value caml_int64_or(); +extern value caml_int64_shift_left(); +extern value caml_int64_shift_right(); +extern value caml_int64_shift_right_unsigned(); +extern value caml_int64_sub(); +extern value caml_int64_to_float(); +extern value caml_int64_to_int(); +extern value caml_int64_to_int32(); +extern value caml_int64_to_nativeint(); +extern value caml_int64_xor(); +extern value caml_int_as_pointer(); +extern value caml_int_compare(); +extern value caml_int_of_float(); +extern value caml_int_of_string(); +extern value caml_invoke_traced_function(); +extern value caml_lazy_follow_forward(); +extern value caml_lazy_make_forward(); +extern value caml_ldexp_float(); +extern value caml_le_float(); +extern value caml_lessequal(); +extern value caml_lessthan(); +extern value caml_lex_engine(); +extern value caml_log10_float(); +extern value caml_log1p_float(); +extern value caml_log_float(); +extern value caml_lt_float(); +extern value caml_make_array(); +extern value caml_make_float_vect(); +extern value caml_make_vect(); +extern value caml_marshal_data_size(); +extern value caml_md5_chan(); +extern value caml_md5_string(); +extern value caml_ml_bytes_length(); +extern value caml_ml_channel_size(); +extern value caml_ml_channel_size_64(); +extern value caml_ml_close_channel(); +extern value caml_ml_enable_runtime_warnings(); +extern value caml_ml_flush(); +extern value caml_ml_flush_partial(); +extern value caml_ml_input(); +extern value caml_ml_input_char(); +extern value caml_ml_input_int(); +extern value caml_ml_input_scan_line(); +extern value caml_ml_open_descriptor_in(); +extern value caml_ml_open_descriptor_out(); +extern value caml_ml_out_channels_list(); +extern value caml_ml_output(); +extern value caml_ml_output_bytes(); +extern value caml_ml_output_char(); +extern value caml_ml_output_int(); +extern value caml_ml_output_partial(); +extern value caml_ml_pos_in(); +extern value caml_ml_pos_in_64(); +extern value caml_ml_pos_out(); +extern value caml_ml_pos_out_64(); +extern value caml_ml_runtime_warnings_enabled(); +extern value caml_ml_seek_in(); +extern value caml_ml_seek_in_64(); +extern value caml_ml_seek_out(); +extern value caml_ml_seek_out_64(); +extern value caml_ml_set_binary_mode(); +extern value caml_ml_set_channel_name(); +extern value caml_ml_string_length(); +extern value caml_modf_float(); +extern value caml_mul_float(); +extern value caml_nativeint_add(); +extern value caml_nativeint_and(); +extern value caml_nativeint_bswap(); +extern value caml_nativeint_compare(); +extern value caml_nativeint_div(); +extern value caml_nativeint_format(); +extern value caml_nativeint_mod(); +extern value caml_nativeint_mul(); +extern value caml_nativeint_neg(); +extern value caml_nativeint_of_float(); +extern value caml_nativeint_of_int(); +extern value caml_nativeint_of_int32(); +extern value caml_nativeint_of_string(); +extern value caml_nativeint_or(); +extern value caml_nativeint_shift_left(); +extern value caml_nativeint_shift_right(); +extern value caml_nativeint_shift_right_unsigned(); +extern value caml_nativeint_sub(); +extern value caml_nativeint_to_float(); +extern value caml_nativeint_to_int(); +extern value caml_nativeint_to_int32(); +extern value caml_nativeint_xor(); +extern value caml_neg_float(); +extern value caml_neq_float(); +extern value caml_new_lex_engine(); +extern value caml_notequal(); +extern value caml_obj_add_offset(); +extern value caml_obj_block(); +extern value caml_obj_dup(); +extern value caml_obj_is_block(); +extern value caml_obj_reachable_words(); +extern value caml_obj_set_tag(); +extern value caml_obj_tag(); +extern value caml_obj_truncate(); +extern value caml_output_value(); +extern value caml_output_value_to_buffer(); +extern value caml_output_value_to_bytes(); +extern value caml_output_value_to_string(); +extern value caml_parse_engine(); +extern value caml_power_float(); +extern value caml_raw_backtrace_length(); +extern value caml_raw_backtrace_next_slot(); +extern value caml_raw_backtrace_slot(); +extern value caml_realloc_global(); +extern value caml_record_backtrace(); +extern value caml_register_channel_for_spacetime(); +extern value caml_register_code_fragment(); +extern value caml_register_named_value(); +extern value caml_reify_bytecode(); +extern value caml_remove_debug_info(); +extern value caml_reset_afl_instrumentation(); +extern value caml_restore_raw_backtrace(); +extern value caml_runtime_parameters(); +extern value caml_runtime_variant(); +extern value caml_set_oo_id(); +extern value caml_set_parser_trace(); +extern value caml_setup_afl(); +extern value caml_sin_float(); +extern value caml_sinh_float(); +extern value caml_spacetime_enabled(); +extern value caml_spacetime_only_works_for_native_code(); +extern value caml_sqrt_float(); +extern value caml_static_alloc(); +extern value caml_static_free(); +extern value caml_static_release_bytecode(); +extern value caml_static_resize(); +extern value caml_string_compare(); +extern value caml_string_equal(); +extern value caml_string_get(); +extern value caml_string_get16(); +extern value caml_string_get32(); +extern value caml_string_get64(); +extern value caml_string_greaterequal(); +extern value caml_string_greaterthan(); +extern value caml_string_lessequal(); +extern value caml_string_lessthan(); +extern value caml_string_notequal(); +extern value caml_string_of_bytes(); +extern value caml_string_set(); +extern value caml_sub_float(); +extern value caml_sys_chdir(); +extern value caml_sys_close(); +extern value caml_sys_const_backend_type(); +extern value caml_sys_const_big_endian(); +extern value caml_sys_const_int_size(); +extern value caml_sys_const_max_wosize(); +extern value caml_sys_const_ostype_cygwin(); +extern value caml_sys_const_ostype_unix(); +extern value caml_sys_const_ostype_win32(); +extern value caml_sys_const_word_size(); +extern value caml_sys_exit(); +extern value caml_sys_file_exists(); +extern value caml_sys_get_argv(); +extern value caml_sys_get_config(); +extern value caml_sys_getcwd(); +extern value caml_sys_getenv(); +extern value caml_sys_is_directory(); +extern value caml_sys_isatty(); +extern value caml_sys_open(); +extern value caml_sys_random_seed(); +extern value caml_sys_read_directory(); +extern value caml_sys_remove(); +extern value caml_sys_rename(); +extern value caml_sys_system_command(); +extern value caml_sys_time(); +extern value caml_sys_time_include_children(); +extern value caml_sys_unsafe_getenv(); +extern value caml_tan_float(); +extern value caml_tanh_float(); +extern value caml_terminfo_rows(); +extern value caml_update_dummy(); +extern value caml_weak_blit(); +extern value caml_weak_check(); +extern value caml_weak_create(); +extern value caml_weak_get(); +extern value caml_weak_get_copy(); +extern value caml_weak_set(); +c_primitive caml_builtin_cprim[] = { + caml_abs_float, + caml_acos_float, + caml_add_debug_info, + caml_add_float, + caml_alloc_dummy, + caml_alloc_dummy_float, + caml_alloc_dummy_function, + caml_array_append, + caml_array_blit, + caml_array_concat, + caml_array_get, + caml_array_get_addr, + caml_array_get_float, + caml_array_set, + caml_array_set_addr, + caml_array_set_float, + caml_array_sub, + caml_array_unsafe_get, + caml_array_unsafe_get_float, + caml_array_unsafe_set, + caml_array_unsafe_set_addr, + caml_array_unsafe_set_float, + caml_asin_float, + caml_atan2_float, + caml_atan_float, + caml_ba_blit, + caml_ba_change_layout, + caml_ba_create, + caml_ba_dim, + caml_ba_dim_1, + caml_ba_dim_2, + caml_ba_dim_3, + caml_ba_fill, + caml_ba_get_1, + caml_ba_get_2, + caml_ba_get_3, + caml_ba_get_generic, + caml_ba_kind, + caml_ba_layout, + caml_ba_num_dims, + caml_ba_reshape, + caml_ba_set_1, + caml_ba_set_2, + caml_ba_set_3, + caml_ba_set_generic, + caml_ba_slice, + caml_ba_sub, + caml_ba_uint8_get16, + caml_ba_uint8_get32, + caml_ba_uint8_get64, + caml_ba_uint8_set16, + caml_ba_uint8_set32, + caml_ba_uint8_set64, + caml_backtrace_status, + caml_blit_bytes, + caml_blit_string, + caml_bswap16, + caml_bytes_compare, + caml_bytes_equal, + caml_bytes_get, + caml_bytes_get16, + caml_bytes_get32, + caml_bytes_get64, + caml_bytes_greaterequal, + caml_bytes_greaterthan, + caml_bytes_lessequal, + caml_bytes_lessthan, + caml_bytes_notequal, + caml_bytes_of_string, + caml_bytes_set, + caml_bytes_set16, + caml_bytes_set32, + caml_bytes_set64, + caml_ceil_float, + caml_channel_descriptor, + caml_classify_float, + caml_compare, + caml_convert_raw_backtrace, + caml_convert_raw_backtrace_slot, + caml_copysign_float, + caml_cos_float, + caml_cosh_float, + caml_create_bytes, + caml_create_string, + caml_div_float, + caml_dynlink_add_primitive, + caml_dynlink_close_lib, + caml_dynlink_get_current_libs, + caml_dynlink_lookup_symbol, + caml_dynlink_open_lib, + caml_ensure_stack_capacity, + caml_ephe_blit_data, + caml_ephe_blit_key, + caml_ephe_check_data, + caml_ephe_check_key, + caml_ephe_create, + caml_ephe_get_data, + caml_ephe_get_data_copy, + caml_ephe_get_key, + caml_ephe_get_key_copy, + caml_ephe_set_data, + caml_ephe_set_key, + caml_ephe_unset_data, + caml_ephe_unset_key, + caml_eq_float, + caml_equal, + caml_exp_float, + caml_expm1_float, + caml_fill_bytes, + caml_fill_string, + caml_final_register, + caml_final_register_called_without_value, + caml_final_release, + caml_float_compare, + caml_float_of_int, + caml_float_of_string, + caml_floatarray_create, + caml_floatarray_get, + caml_floatarray_set, + caml_floatarray_unsafe_get, + caml_floatarray_unsafe_set, + caml_floor_float, + caml_fmod_float, + caml_format_float, + caml_format_int, + caml_fresh_oo_id, + caml_frexp_float, + caml_gc_compaction, + caml_gc_counters, + caml_gc_full_major, + caml_gc_get, + caml_gc_huge_fallback_count, + caml_gc_major, + caml_gc_major_slice, + caml_gc_minor, + caml_gc_minor_words, + caml_gc_quick_stat, + caml_gc_set, + caml_gc_stat, + caml_ge_float, + caml_get_current_callstack, + caml_get_current_environment, + caml_get_exception_backtrace, + caml_get_exception_raw_backtrace, + caml_get_global_data, + caml_get_major_bucket, + caml_get_major_credit, + caml_get_minor_free, + caml_get_public_method, + caml_get_section_table, + caml_greaterequal, + caml_greaterthan, + caml_gt_float, + caml_hash, + caml_hash_univ_param, + caml_hexstring_of_float, + caml_hypot_float, + caml_input_value, + caml_input_value_from_bytes, + caml_input_value_from_string, + caml_input_value_to_outside_heap, + caml_install_signal_handler, + caml_int32_add, + caml_int32_and, + caml_int32_bits_of_float, + caml_int32_bswap, + caml_int32_compare, + caml_int32_div, + caml_int32_float_of_bits, + caml_int32_format, + caml_int32_mod, + caml_int32_mul, + caml_int32_neg, + caml_int32_of_float, + caml_int32_of_int, + caml_int32_of_string, + caml_int32_or, + caml_int32_shift_left, + caml_int32_shift_right, + caml_int32_shift_right_unsigned, + caml_int32_sub, + caml_int32_to_float, + caml_int32_to_int, + caml_int32_xor, + caml_int64_add, + caml_int64_and, + caml_int64_bits_of_float, + caml_int64_bswap, + caml_int64_compare, + caml_int64_div, + caml_int64_float_of_bits, + caml_int64_format, + caml_int64_mod, + caml_int64_mul, + caml_int64_neg, + caml_int64_of_float, + caml_int64_of_int, + caml_int64_of_int32, + caml_int64_of_nativeint, + caml_int64_of_string, + caml_int64_or, + caml_int64_shift_left, + caml_int64_shift_right, + caml_int64_shift_right_unsigned, + caml_int64_sub, + caml_int64_to_float, + caml_int64_to_int, + caml_int64_to_int32, + caml_int64_to_nativeint, + caml_int64_xor, + caml_int_as_pointer, + caml_int_compare, + caml_int_of_float, + caml_int_of_string, + caml_invoke_traced_function, + caml_lazy_follow_forward, + caml_lazy_make_forward, + caml_ldexp_float, + caml_le_float, + caml_lessequal, + caml_lessthan, + caml_lex_engine, + caml_log10_float, + caml_log1p_float, + caml_log_float, + caml_lt_float, + caml_make_array, + caml_make_float_vect, + caml_make_vect, + caml_marshal_data_size, + caml_md5_chan, + caml_md5_string, + caml_ml_bytes_length, + caml_ml_channel_size, + caml_ml_channel_size_64, + caml_ml_close_channel, + caml_ml_enable_runtime_warnings, + caml_ml_flush, + caml_ml_flush_partial, + caml_ml_input, + caml_ml_input_char, + caml_ml_input_int, + caml_ml_input_scan_line, + caml_ml_open_descriptor_in, + caml_ml_open_descriptor_out, + caml_ml_out_channels_list, + caml_ml_output, + caml_ml_output_bytes, + caml_ml_output_char, + caml_ml_output_int, + caml_ml_output_partial, + caml_ml_pos_in, + caml_ml_pos_in_64, + caml_ml_pos_out, + caml_ml_pos_out_64, + caml_ml_runtime_warnings_enabled, + caml_ml_seek_in, + caml_ml_seek_in_64, + caml_ml_seek_out, + caml_ml_seek_out_64, + caml_ml_set_binary_mode, + caml_ml_set_channel_name, + caml_ml_string_length, + caml_modf_float, + caml_mul_float, + caml_nativeint_add, + caml_nativeint_and, + caml_nativeint_bswap, + caml_nativeint_compare, + caml_nativeint_div, + caml_nativeint_format, + caml_nativeint_mod, + caml_nativeint_mul, + caml_nativeint_neg, + caml_nativeint_of_float, + caml_nativeint_of_int, + caml_nativeint_of_int32, + caml_nativeint_of_string, + caml_nativeint_or, + caml_nativeint_shift_left, + caml_nativeint_shift_right, + caml_nativeint_shift_right_unsigned, + caml_nativeint_sub, + caml_nativeint_to_float, + caml_nativeint_to_int, + caml_nativeint_to_int32, + caml_nativeint_xor, + caml_neg_float, + caml_neq_float, + caml_new_lex_engine, + caml_notequal, + caml_obj_add_offset, + caml_obj_block, + caml_obj_dup, + caml_obj_is_block, + caml_obj_reachable_words, + caml_obj_set_tag, + caml_obj_tag, + caml_obj_truncate, + caml_output_value, + caml_output_value_to_buffer, + caml_output_value_to_bytes, + caml_output_value_to_string, + caml_parse_engine, + caml_power_float, + caml_raw_backtrace_length, + caml_raw_backtrace_next_slot, + caml_raw_backtrace_slot, + caml_realloc_global, + caml_record_backtrace, + caml_register_channel_for_spacetime, + caml_register_code_fragment, + caml_register_named_value, + caml_reify_bytecode, + caml_remove_debug_info, + caml_reset_afl_instrumentation, + caml_restore_raw_backtrace, + caml_runtime_parameters, + caml_runtime_variant, + caml_set_oo_id, + caml_set_parser_trace, + caml_setup_afl, + caml_sin_float, + caml_sinh_float, + caml_spacetime_enabled, + caml_spacetime_only_works_for_native_code, + caml_sqrt_float, + caml_static_alloc, + caml_static_free, + caml_static_release_bytecode, + caml_static_resize, + caml_string_compare, + caml_string_equal, + caml_string_get, + caml_string_get16, + caml_string_get32, + caml_string_get64, + caml_string_greaterequal, + caml_string_greaterthan, + caml_string_lessequal, + caml_string_lessthan, + caml_string_notequal, + caml_string_of_bytes, + caml_string_set, + caml_sub_float, + caml_sys_chdir, + caml_sys_close, + caml_sys_const_backend_type, + caml_sys_const_big_endian, + caml_sys_const_int_size, + caml_sys_const_max_wosize, + caml_sys_const_ostype_cygwin, + caml_sys_const_ostype_unix, + caml_sys_const_ostype_win32, + caml_sys_const_word_size, + caml_sys_exit, + caml_sys_file_exists, + caml_sys_get_argv, + caml_sys_get_config, + caml_sys_getcwd, + caml_sys_getenv, + caml_sys_is_directory, + caml_sys_isatty, + caml_sys_open, + caml_sys_random_seed, + caml_sys_read_directory, + caml_sys_remove, + caml_sys_rename, + caml_sys_system_command, + caml_sys_time, + caml_sys_time_include_children, + caml_sys_unsafe_getenv, + caml_tan_float, + caml_tanh_float, + caml_terminfo_rows, + caml_update_dummy, + caml_weak_blit, + caml_weak_check, + caml_weak_create, + caml_weak_get, + caml_weak_get_copy, + caml_weak_set, + 0 }; +char * caml_names_of_builtin_cprim[] = { + "caml_abs_float", + "caml_acos_float", + "caml_add_debug_info", + "caml_add_float", + "caml_alloc_dummy", + "caml_alloc_dummy_float", + "caml_alloc_dummy_function", + "caml_array_append", + "caml_array_blit", + "caml_array_concat", + "caml_array_get", + "caml_array_get_addr", + "caml_array_get_float", + "caml_array_set", + "caml_array_set_addr", + "caml_array_set_float", + "caml_array_sub", + "caml_array_unsafe_get", + "caml_array_unsafe_get_float", + "caml_array_unsafe_set", + "caml_array_unsafe_set_addr", + "caml_array_unsafe_set_float", + "caml_asin_float", + "caml_atan2_float", + "caml_atan_float", + "caml_ba_blit", + "caml_ba_change_layout", + "caml_ba_create", + "caml_ba_dim", + "caml_ba_dim_1", + "caml_ba_dim_2", + "caml_ba_dim_3", + "caml_ba_fill", + "caml_ba_get_1", + "caml_ba_get_2", + "caml_ba_get_3", + "caml_ba_get_generic", + "caml_ba_kind", + "caml_ba_layout", + "caml_ba_num_dims", + "caml_ba_reshape", + "caml_ba_set_1", + "caml_ba_set_2", + "caml_ba_set_3", + "caml_ba_set_generic", + "caml_ba_slice", + "caml_ba_sub", + "caml_ba_uint8_get16", + "caml_ba_uint8_get32", + "caml_ba_uint8_get64", + "caml_ba_uint8_set16", + "caml_ba_uint8_set32", + "caml_ba_uint8_set64", + "caml_backtrace_status", + "caml_blit_bytes", + "caml_blit_string", + "caml_bswap16", + "caml_bytes_compare", + "caml_bytes_equal", + "caml_bytes_get", + "caml_bytes_get16", + "caml_bytes_get32", + "caml_bytes_get64", + "caml_bytes_greaterequal", + "caml_bytes_greaterthan", + "caml_bytes_lessequal", + "caml_bytes_lessthan", + "caml_bytes_notequal", + "caml_bytes_of_string", + "caml_bytes_set", + "caml_bytes_set16", + "caml_bytes_set32", + "caml_bytes_set64", + "caml_ceil_float", + "caml_channel_descriptor", + "caml_classify_float", + "caml_compare", + "caml_convert_raw_backtrace", + "caml_convert_raw_backtrace_slot", + "caml_copysign_float", + "caml_cos_float", + "caml_cosh_float", + "caml_create_bytes", + "caml_create_string", + "caml_div_float", + "caml_dynlink_add_primitive", + "caml_dynlink_close_lib", + "caml_dynlink_get_current_libs", + "caml_dynlink_lookup_symbol", + "caml_dynlink_open_lib", + "caml_ensure_stack_capacity", + "caml_ephe_blit_data", + "caml_ephe_blit_key", + "caml_ephe_check_data", + "caml_ephe_check_key", + "caml_ephe_create", + "caml_ephe_get_data", + "caml_ephe_get_data_copy", + "caml_ephe_get_key", + "caml_ephe_get_key_copy", + "caml_ephe_set_data", + "caml_ephe_set_key", + "caml_ephe_unset_data", + "caml_ephe_unset_key", + "caml_eq_float", + "caml_equal", + "caml_exp_float", + "caml_expm1_float", + "caml_fill_bytes", + "caml_fill_string", + "caml_final_register", + "caml_final_register_called_without_value", + "caml_final_release", + "caml_float_compare", + "caml_float_of_int", + "caml_float_of_string", + "caml_floatarray_create", + "caml_floatarray_get", + "caml_floatarray_set", + "caml_floatarray_unsafe_get", + "caml_floatarray_unsafe_set", + "caml_floor_float", + "caml_fmod_float", + "caml_format_float", + "caml_format_int", + "caml_fresh_oo_id", + "caml_frexp_float", + "caml_gc_compaction", + "caml_gc_counters", + "caml_gc_full_major", + "caml_gc_get", + "caml_gc_huge_fallback_count", + "caml_gc_major", + "caml_gc_major_slice", + "caml_gc_minor", + "caml_gc_minor_words", + "caml_gc_quick_stat", + "caml_gc_set", + "caml_gc_stat", + "caml_ge_float", + "caml_get_current_callstack", + "caml_get_current_environment", + "caml_get_exception_backtrace", + "caml_get_exception_raw_backtrace", + "caml_get_global_data", + "caml_get_major_bucket", + "caml_get_major_credit", + "caml_get_minor_free", + "caml_get_public_method", + "caml_get_section_table", + "caml_greaterequal", + "caml_greaterthan", + "caml_gt_float", + "caml_hash", + "caml_hash_univ_param", + "caml_hexstring_of_float", + "caml_hypot_float", + "caml_input_value", + "caml_input_value_from_bytes", + "caml_input_value_from_string", + "caml_input_value_to_outside_heap", + "caml_install_signal_handler", + "caml_int32_add", + "caml_int32_and", + "caml_int32_bits_of_float", + "caml_int32_bswap", + "caml_int32_compare", + "caml_int32_div", + "caml_int32_float_of_bits", + "caml_int32_format", + "caml_int32_mod", + "caml_int32_mul", + "caml_int32_neg", + "caml_int32_of_float", + "caml_int32_of_int", + "caml_int32_of_string", + "caml_int32_or", + "caml_int32_shift_left", + "caml_int32_shift_right", + "caml_int32_shift_right_unsigned", + "caml_int32_sub", + "caml_int32_to_float", + "caml_int32_to_int", + "caml_int32_xor", + "caml_int64_add", + "caml_int64_and", + "caml_int64_bits_of_float", + "caml_int64_bswap", + "caml_int64_compare", + "caml_int64_div", + "caml_int64_float_of_bits", + "caml_int64_format", + "caml_int64_mod", + "caml_int64_mul", + "caml_int64_neg", + "caml_int64_of_float", + "caml_int64_of_int", + "caml_int64_of_int32", + "caml_int64_of_nativeint", + "caml_int64_of_string", + "caml_int64_or", + "caml_int64_shift_left", + "caml_int64_shift_right", + "caml_int64_shift_right_unsigned", + "caml_int64_sub", + "caml_int64_to_float", + "caml_int64_to_int", + "caml_int64_to_int32", + "caml_int64_to_nativeint", + "caml_int64_xor", + "caml_int_as_pointer", + "caml_int_compare", + "caml_int_of_float", + "caml_int_of_string", + "caml_invoke_traced_function", + "caml_lazy_follow_forward", + "caml_lazy_make_forward", + "caml_ldexp_float", + "caml_le_float", + "caml_lessequal", + "caml_lessthan", + "caml_lex_engine", + "caml_log10_float", + "caml_log1p_float", + "caml_log_float", + "caml_lt_float", + "caml_make_array", + "caml_make_float_vect", + "caml_make_vect", + "caml_marshal_data_size", + "caml_md5_chan", + "caml_md5_string", + "caml_ml_bytes_length", + "caml_ml_channel_size", + "caml_ml_channel_size_64", + "caml_ml_close_channel", + "caml_ml_enable_runtime_warnings", + "caml_ml_flush", + "caml_ml_flush_partial", + "caml_ml_input", + "caml_ml_input_char", + "caml_ml_input_int", + "caml_ml_input_scan_line", + "caml_ml_open_descriptor_in", + "caml_ml_open_descriptor_out", + "caml_ml_out_channels_list", + "caml_ml_output", + "caml_ml_output_bytes", + "caml_ml_output_char", + "caml_ml_output_int", + "caml_ml_output_partial", + "caml_ml_pos_in", + "caml_ml_pos_in_64", + "caml_ml_pos_out", + "caml_ml_pos_out_64", + "caml_ml_runtime_warnings_enabled", + "caml_ml_seek_in", + "caml_ml_seek_in_64", + "caml_ml_seek_out", + "caml_ml_seek_out_64", + "caml_ml_set_binary_mode", + "caml_ml_set_channel_name", + "caml_ml_string_length", + "caml_modf_float", + "caml_mul_float", + "caml_nativeint_add", + "caml_nativeint_and", + "caml_nativeint_bswap", + "caml_nativeint_compare", + "caml_nativeint_div", + "caml_nativeint_format", + "caml_nativeint_mod", + "caml_nativeint_mul", + "caml_nativeint_neg", + "caml_nativeint_of_float", + "caml_nativeint_of_int", + "caml_nativeint_of_int32", + "caml_nativeint_of_string", + "caml_nativeint_or", + "caml_nativeint_shift_left", + "caml_nativeint_shift_right", + "caml_nativeint_shift_right_unsigned", + "caml_nativeint_sub", + "caml_nativeint_to_float", + "caml_nativeint_to_int", + "caml_nativeint_to_int32", + "caml_nativeint_xor", + "caml_neg_float", + "caml_neq_float", + "caml_new_lex_engine", + "caml_notequal", + "caml_obj_add_offset", + "caml_obj_block", + "caml_obj_dup", + "caml_obj_is_block", + "caml_obj_reachable_words", + "caml_obj_set_tag", + "caml_obj_tag", + "caml_obj_truncate", + "caml_output_value", + "caml_output_value_to_buffer", + "caml_output_value_to_bytes", + "caml_output_value_to_string", + "caml_parse_engine", + "caml_power_float", + "caml_raw_backtrace_length", + "caml_raw_backtrace_next_slot", + "caml_raw_backtrace_slot", + "caml_realloc_global", + "caml_record_backtrace", + "caml_register_channel_for_spacetime", + "caml_register_code_fragment", + "caml_register_named_value", + "caml_reify_bytecode", + "caml_remove_debug_info", + "caml_reset_afl_instrumentation", + "caml_restore_raw_backtrace", + "caml_runtime_parameters", + "caml_runtime_variant", + "caml_set_oo_id", + "caml_set_parser_trace", + "caml_setup_afl", + "caml_sin_float", + "caml_sinh_float", + "caml_spacetime_enabled", + "caml_spacetime_only_works_for_native_code", + "caml_sqrt_float", + "caml_static_alloc", + "caml_static_free", + "caml_static_release_bytecode", + "caml_static_resize", + "caml_string_compare", + "caml_string_equal", + "caml_string_get", + "caml_string_get16", + "caml_string_get32", + "caml_string_get64", + "caml_string_greaterequal", + "caml_string_greaterthan", + "caml_string_lessequal", + "caml_string_lessthan", + "caml_string_notequal", + "caml_string_of_bytes", + "caml_string_set", + "caml_sub_float", + "caml_sys_chdir", + "caml_sys_close", + "caml_sys_const_backend_type", + "caml_sys_const_big_endian", + "caml_sys_const_int_size", + "caml_sys_const_max_wosize", + "caml_sys_const_ostype_cygwin", + "caml_sys_const_ostype_unix", + "caml_sys_const_ostype_win32", + "caml_sys_const_word_size", + "caml_sys_exit", + "caml_sys_file_exists", + "caml_sys_get_argv", + "caml_sys_get_config", + "caml_sys_getcwd", + "caml_sys_getenv", + "caml_sys_is_directory", + "caml_sys_isatty", + "caml_sys_open", + "caml_sys_random_seed", + "caml_sys_read_directory", + "caml_sys_remove", + "caml_sys_rename", + "caml_sys_system_command", + "caml_sys_time", + "caml_sys_time_include_children", + "caml_sys_unsafe_getenv", + "caml_tan_float", + "caml_tanh_float", + "caml_terminfo_rows", + "caml_update_dummy", + "caml_weak_blit", + "caml_weak_check", + "caml_weak_create", + "caml_weak_get", + "caml_weak_get_copy", + "caml_weak_set", + 0 }; diff --git a/test/monniaux/ocaml/byterun/win32.c b/test/monniaux/ocaml/byterun/win32.c deleted file mode 100644 index 1ce8ad5e..00000000 --- a/test/monniaux/ocaml/byterun/win32.c +++ /dev/null @@ -1,1019 +0,0 @@ -/**************************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/**************************************************************************/ - -#define CAML_INTERNALS - -/* Win32-specific stuff */ - -/* FILE_INFO_BY_HANDLE_CLASS and FILE_NAME_INFO are only available from Windows - Vista onwards */ -#undef _WIN32_WINNT -#define _WIN32_WINNT 0x0600 - -#define WIN32_LEAN_AND_MEAN -#include <wtypes.h> -#include <winbase.h> -#include <winsock2.h> -#include <stdlib.h> -#include <stdio.h> -#include <stdarg.h> -#include <io.h> -#include <fcntl.h> -#include <sys/types.h> -#include <sys/stat.h> -#include <ctype.h> -#include <errno.h> -#include <string.h> -#include <signal.h> -#include "caml/alloc.h" -#include "caml/address_class.h" -#include "caml/fail.h" -#include "caml/io.h" -#include "caml/memory.h" -#include "caml/misc.h" -#include "caml/osdeps.h" -#include "caml/signals.h" -#include "caml/sys.h" - -#include "caml/config.h" -#ifdef SUPPORT_DYNAMIC_LINKING -#include <flexdll.h> -#endif - -#ifndef S_ISREG -#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG) -#endif - -unsigned short caml_win32_major = 0; -unsigned short caml_win32_minor = 0; -unsigned short caml_win32_build = 0; -unsigned short caml_win32_revision = 0; - -CAMLnoreturn_start -static void caml_win32_sys_error (int errnum) -CAMLnoreturn_end; - -static void caml_win32_sys_error(int errnum) -{ - wchar_t buffer[512]; - value msg; - if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, - NULL, - errnum, - 0, - buffer, - sizeof(buffer)/sizeof(wchar_t), - NULL)) { - msg = caml_copy_string_of_utf16(buffer); - } else { - msg = caml_alloc_sprintf("unknown error #%d", errnum); - } - caml_raise_sys_error(msg); -} - -int caml_read_fd(int fd, int flags, void * buf, int n) -{ - int retcode; - if ((flags & CHANNEL_FLAG_FROM_SOCKET) == 0) { - caml_enter_blocking_section(); - retcode = read(fd, buf, n); - /* Large reads from console can fail with ENOMEM. Reduce requested size - and try again. */ - if (retcode == -1 && errno == ENOMEM && n > 16384) { - retcode = read(fd, buf, 16384); - } - caml_leave_blocking_section(); - if (retcode == -1) caml_sys_io_error(NO_ARG); - } else { - caml_enter_blocking_section(); - retcode = recv((SOCKET) _get_osfhandle(fd), buf, n, 0); - caml_leave_blocking_section(); - if (retcode == -1) caml_win32_sys_error(WSAGetLastError()); - } - return retcode; -} - -int caml_write_fd(int fd, int flags, void * buf, int n) -{ - int retcode; - if ((flags & CHANNEL_FLAG_FROM_SOCKET) == 0) { -#if defined(NATIVE_CODE) && defined(WITH_SPACETIME) - if (flags & CHANNEL_FLAG_BLOCKING_WRITE) { - retcode = write(fd, buf, n); - } else { -#endif - caml_enter_blocking_section(); - retcode = write(fd, buf, n); - caml_leave_blocking_section(); -#if defined(NATIVE_CODE) && defined(WITH_SPACETIME) - } -#endif - if (retcode == -1) caml_sys_io_error(NO_ARG); - } else { - caml_enter_blocking_section(); - retcode = send((SOCKET) _get_osfhandle(fd), buf, n, 0); - caml_leave_blocking_section(); - if (retcode == -1) caml_win32_sys_error(WSAGetLastError()); - } - CAMLassert (retcode > 0); - return retcode; -} - -wchar_t * caml_decompose_path(struct ext_table * tbl, wchar_t * path) -{ - wchar_t * p, * q; - int n; - - if (path == NULL) return NULL; - p = caml_stat_wcsdup(path); - q = p; - while (1) { - for (n = 0; q[n] != 0 && q[n] != L';'; n++) /*nothing*/; - caml_ext_table_add(tbl, q); - q = q + n; - if (*q == 0) break; - *q = 0; - q += 1; - } - return p; -} - -wchar_t * caml_search_in_path(struct ext_table * path, const wchar_t * name) -{ - wchar_t * dir, * fullname; - char * u8; - const wchar_t * p; - int i; - struct _stati64 st; - - for (p = name; *p != 0; p++) { - if (*p == '/' || *p == '\\') goto not_found; - } - for (i = 0; i < path->size; i++) { - dir = path->contents[i]; - if (dir[0] == 0) continue; - /* not sure what empty path components mean under Windows */ - fullname = caml_stat_wcsconcat(3, dir, L"\\", name); - u8 = caml_stat_strdup_of_utf16(fullname); - caml_gc_message(0x100, "Searching %s\n", u8); - caml_stat_free(u8); - if (_wstati64(fullname, &st) == 0 && S_ISREG(st.st_mode)) - return fullname; - caml_stat_free(fullname); - } - not_found: - u8 = caml_stat_strdup_of_utf16(name); - caml_gc_message(0x100, "%s not found in search path\n", u8); - caml_stat_free(u8); - return caml_stat_wcsdup(name); -} - -CAMLexport wchar_t * caml_search_exe_in_path(const wchar_t * name) -{ - wchar_t * fullname, * filepart; - char * u8; - size_t fullnamelen; - DWORD retcode; - - fullnamelen = wcslen(name) + 1; - if (fullnamelen < 256) fullnamelen = 256; - while (1) { - fullname = caml_stat_alloc(fullnamelen*sizeof(wchar_t)); - retcode = SearchPath(NULL, /* use system search path */ - name, - L".exe", /* add .exe extension if needed */ - fullnamelen, - fullname, - &filepart); - if (retcode == 0) { - u8 = caml_stat_strdup_of_utf16(name); - caml_gc_message(0x100, "%s not found in search path\n", u8); - caml_stat_free(u8); - caml_stat_free(fullname); - return caml_stat_strdup_os(name); - } - if (retcode < fullnamelen) - return fullname; - caml_stat_free(fullname); - fullnamelen = retcode + 1; - } -} - -wchar_t * caml_search_dll_in_path(struct ext_table * path, const wchar_t * name) -{ - wchar_t * dllname; - wchar_t * res; - - dllname = caml_stat_wcsconcat(2, name, L".dll"); - res = caml_search_in_path(path, dllname); - caml_stat_free(dllname); - return res; -} - -#ifdef SUPPORT_DYNAMIC_LINKING - -void * caml_dlopen(wchar_t * libname, int for_execution, int global) -{ - void *handle; - int flags = (global ? FLEXDLL_RTLD_GLOBAL : 0); - if (!for_execution) flags |= FLEXDLL_RTLD_NOEXEC; - handle = flexdll_wdlopen(libname, flags); - if ((handle != NULL) && ((caml_verb_gc & 0x100) != 0)) { - flexdll_dump_exports(handle); - fflush(stdout); - } - return handle; -} - -void caml_dlclose(void * handle) -{ - flexdll_dlclose(handle); -} - -void * caml_dlsym(void * handle, const char * name) -{ - return flexdll_dlsym(handle, name); -} - -void * caml_globalsym(const char * name) -{ - return flexdll_dlsym(flexdll_dlopen(NULL,0), name); -} - -char * caml_dlerror(void) -{ - return flexdll_dlerror(); -} - -#else - -void * caml_dlopen(wchar_t * libname, int for_execution, int global) -{ - return NULL; -} - -void caml_dlclose(void * handle) -{ -} - -void * caml_dlsym(void * handle, const char * name) -{ - return NULL; -} - -void * caml_globalsym(const char * name) -{ - return NULL; -} - -char * caml_dlerror(void) -{ - return "dynamic loading not supported on this platform"; -} - -#endif - -/* Proper emulation of signal(), including ctrl-C and ctrl-break */ - -typedef void (*sighandler)(int sig); -static int ctrl_handler_installed = 0; -static volatile sighandler ctrl_handler_action = SIG_DFL; - -static BOOL WINAPI ctrl_handler(DWORD event) -{ - /* Only ctrl-C and ctrl-Break are handled */ - if (event != CTRL_C_EVENT && event != CTRL_BREAK_EVENT) return FALSE; - /* Default behavior is to exit, which we get by not handling the event */ - if (ctrl_handler_action == SIG_DFL) return FALSE; - /* Ignore behavior is to do nothing, which we get by claiming that we - have handled the event */ - if (ctrl_handler_action == SIG_IGN) return TRUE; - /* Win32 doesn't like it when we do a longjmp() at this point - (it looks like we're running in a different thread than - the main program!). So, just record the signal. */ - caml_record_signal(SIGINT); - /* We have handled the event */ - return TRUE; -} - -sighandler caml_win32_signal(int sig, sighandler action) -{ - sighandler oldaction; - - if (sig != SIGINT) return signal(sig, action); - if (! ctrl_handler_installed) { - SetConsoleCtrlHandler(ctrl_handler, TRUE); - ctrl_handler_installed = 1; - } - oldaction = ctrl_handler_action; - ctrl_handler_action = action; - return oldaction; -} - -/* Expansion of @responsefile and *? file patterns in the command line */ - -static int argc; -static wchar_t ** argv; -static int argvsize; - -static void store_argument(wchar_t * arg); -static void expand_argument(wchar_t * arg); -static void expand_pattern(wchar_t * arg); - -static void out_of_memory(void) -{ - fprintf(stderr, "Out of memory while expanding command line\n"); - exit(2); -} - -static void store_argument(wchar_t * arg) -{ - if (argc + 1 >= argvsize) { - argvsize *= 2; - argv = (wchar_t **) caml_stat_resize_noexc(argv, argvsize * sizeof(wchar_t *)); - if (argv == NULL) out_of_memory(); - } - argv[argc++] = arg; -} - -static void expand_argument(wchar_t * arg) -{ - wchar_t * p; - - for (p = arg; *p != 0; p++) { - if (*p == L'*' || *p == L'?') { - expand_pattern(arg); - return; - } - } - store_argument(arg); -} - -static void expand_pattern(wchar_t * pat) -{ - wchar_t * prefix, * p, * name; - intptr_t handle; - struct _wfinddata_t ffblk; - size_t i; - - handle = _wfindfirst(pat, &ffblk); - if (handle == -1) { - store_argument(pat); /* a la Bourne shell */ - return; - } - prefix = caml_stat_wcsdup(pat); - /* We need to stop at the first directory or drive boundary, because the - * _findata_t structure contains the filename, not the leading directory. */ - for (i = wcslen(prefix); i > 0; i--) { - wchar_t c = prefix[i - 1]; - if (c == L'\\' || c == L'/' || c == L':') { prefix[i] = 0; break; } - } - /* No separator was found, it's a filename pattern without a leading directory. */ - if (i == 0) - prefix[0] = 0; - do { - name = caml_stat_wcsconcat(2, prefix, ffblk.name); - store_argument(name); - } while (_wfindnext(handle, &ffblk) != -1); - _findclose(handle); - caml_stat_free(prefix); -} - - -CAMLexport void caml_expand_command_line(int * argcp, wchar_t *** argvp) -{ - int i; - argc = 0; - argvsize = 16; - argv = (wchar_t **) caml_stat_alloc_noexc(argvsize * sizeof(wchar_t *)); - if (argv == NULL) out_of_memory(); - for (i = 0; i < *argcp; i++) expand_argument((*argvp)[i]); - argv[argc] = NULL; - *argcp = argc; - *argvp = argv; -} - -/* Add to [contents] the (short) names of the files contained in - the directory named [dirname]. No entries are added for [.] and [..]. - Return 0 on success, -1 on error; set errno in the case of error. */ - -int caml_read_directory(wchar_t * dirname, struct ext_table * contents) -{ - size_t dirnamelen; - wchar_t * template; - intptr_t h; - struct _wfinddata_t fileinfo; - - dirnamelen = wcslen(dirname); - if (dirnamelen > 0 && - (dirname[dirnamelen - 1] == L'/' - || dirname[dirnamelen - 1] == L'\\' - || dirname[dirnamelen - 1] == L':')) - template = caml_stat_wcsconcat(2, dirname, L"*.*"); - else - template = caml_stat_wcsconcat(2, dirname, L"\\*.*"); - h = _wfindfirst(template, &fileinfo); - if (h == -1) { - caml_stat_free(template); - return errno == ENOENT ? 0 : -1; - } - do { - if (wcscmp(fileinfo.name, L".") != 0 && wcscmp(fileinfo.name, L"..") != 0) { - caml_ext_table_add(contents, caml_stat_strdup_of_utf16(fileinfo.name)); - } - } while (_wfindnext(h, &fileinfo) == 0); - _findclose(h); - caml_stat_free(template); - return 0; -} - -#ifndef NATIVE_CODE - -/* Set up a new thread for control-C emulation and termination */ - -void caml_signal_thread(void * lpParam) -{ - wchar_t *endptr; - HANDLE h; - /* Get an hexa-code raw handle through the environment */ - h = (HANDLE) (uintptr_t) - wcstol(caml_secure_getenv(_T("CAMLSIGPIPE")), &endptr, 16); - while (1) { - DWORD numread; - BOOL ret; - char iobuf[2]; - /* This shall always return a single character */ - ret = ReadFile(h, iobuf, 1, &numread, NULL); - if (!ret || numread != 1) caml_sys_exit(Val_int(2)); - switch (iobuf[0]) { - case 'C': - caml_record_signal(SIGINT); - break; - case 'T': - raise(SIGTERM); - return; - } - } -} - -#endif /* NATIVE_CODE */ - -#if defined(NATIVE_CODE) - -/* Handling of system stack overflow. - * Based on code provided by Olivier Andrieu. - - * An EXCEPTION_STACK_OVERFLOW is signaled when the guard page at the - * end of the stack has been accessed. Windows clears the PAGE_GUARD - * protection (making it a regular PAGE_READWRITE) and then calls our - * exception handler. This means that although we're handling an "out - * of stack" condition, there is a bit of stack available to call - * functions and allocate temporaries. - * - * PAGE_GUARD is a one-shot access protection mechanism: we need to - * restore the PAGE_GUARD protection on this page otherwise the next - * stack overflow won't be detected and the program will abruptly exit - * with STATUS_ACCESS_VIOLATION. - * - * Visual Studio 2003 and later (_MSC_VER >= 1300) have a - * _resetstkoflw() function that resets this protection. - * Unfortunately, it cannot work when called directly from the - * exception handler because at this point we are using the page that - * is to be protected. - * - * A solution is to use an alternate stack when restoring the - * protection. However it's not possible to use _resetstkoflw() then - * since it determines the stack pointer by calling alloca(): it would - * try to protect the alternate stack. - * - * Finally, we call caml_raise_stack_overflow; it will either call - * caml_raise_exception which switches back to the normal stack, or - * call caml_fatal_uncaught_exception which terminates the program - * quickly. - */ - -static uintnat win32_alt_stack[0x100]; - -static void caml_reset_stack (void *faulting_address) -{ - SYSTEM_INFO si; - DWORD page_size; - MEMORY_BASIC_INFORMATION mbi; - DWORD oldprot; - - /* get the system's page size. */ - GetSystemInfo (&si); - page_size = si.dwPageSize; - - /* get some information on the page the fault occurred */ - if (! VirtualQuery (faulting_address, &mbi, sizeof mbi)) - goto failed; - - VirtualProtect (mbi.BaseAddress, page_size, - mbi.Protect | PAGE_GUARD, &oldprot); - - failed: - caml_raise_stack_overflow(); -} - - -#ifndef _WIN64 -static LONG CALLBACK - caml_stack_overflow_VEH (EXCEPTION_POINTERS* exn_info) -{ - DWORD code = exn_info->ExceptionRecord->ExceptionCode; - CONTEXT *ctx = exn_info->ContextRecord; - DWORD *ctx_ip = &(ctx->Eip); - DWORD *ctx_sp = &(ctx->Esp); - - if (code == EXCEPTION_STACK_OVERFLOW && Is_in_code_area (*ctx_ip)) - { - uintnat faulting_address; - uintnat * alt_esp; - - /* grab the address that caused the fault */ - faulting_address = exn_info->ExceptionRecord->ExceptionInformation[1]; - - /* call caml_reset_stack(faulting_address) using the alternate stack */ - alt_esp = win32_alt_stack + sizeof(win32_alt_stack) / sizeof(uintnat); - *--alt_esp = faulting_address; - *ctx_sp = (uintnat) (alt_esp - 1); - *ctx_ip = (uintnat) &caml_reset_stack; - - return EXCEPTION_CONTINUE_EXECUTION; - } - - return EXCEPTION_CONTINUE_SEARCH; -} - -#else -extern char *caml_exception_pointer; -extern value *caml_young_ptr; - -/* Do not use the macro from address_class.h here. */ -#undef Is_in_code_area -#define Is_in_code_area(pc) \ - ( ((char *)(pc) >= caml_code_area_start && \ - (char *)(pc) <= caml_code_area_end) \ -|| ((char *)(pc) >= &caml_system__code_begin && \ - (char *)(pc) <= &caml_system__code_end) \ -|| (Classify_addr(pc) & In_code_area) ) -extern char caml_system__code_begin, caml_system__code_end; - - -static LONG CALLBACK - caml_stack_overflow_VEH (EXCEPTION_POINTERS* exn_info) -{ - DWORD code = exn_info->ExceptionRecord->ExceptionCode; - CONTEXT *ctx = exn_info->ContextRecord; - - if (code == EXCEPTION_STACK_OVERFLOW && Is_in_code_area (ctx->Rip)) - { - uintnat faulting_address; - uintnat * alt_rsp; - - /* grab the address that caused the fault */ - faulting_address = exn_info->ExceptionRecord->ExceptionInformation[1]; - - /* refresh runtime parameters from registers */ - caml_exception_pointer = (char *) ctx->R14; - caml_young_ptr = (value *) ctx->R15; - - /* call caml_reset_stack(faulting_address) using the alternate stack */ - alt_rsp = win32_alt_stack + sizeof(win32_alt_stack) / sizeof(uintnat); - ctx->Rcx = faulting_address; - ctx->Rsp = (uintnat) (alt_rsp - 4 - 1); - ctx->Rip = (uintnat) &caml_reset_stack; - - return EXCEPTION_CONTINUE_EXECUTION; - } - - return EXCEPTION_CONTINUE_SEARCH; -} -#endif /* _WIN64 */ - -void caml_win32_overflow_detection(void) -{ - AddVectoredExceptionHandler(1, caml_stack_overflow_VEH); -} - -#endif /* NATIVE_CODE */ - -/* Seeding of pseudo-random number generators */ - -int caml_win32_random_seed (intnat data[16]) -{ - /* For better randomness, consider: - http://msdn.microsoft.com/library/en-us/seccrypto/security/rtlgenrandom.asp - http://blogs.msdn.com/b/michael_howard/archive/2005/01/14/353379.aspx - */ - FILETIME t; - LARGE_INTEGER pc; - GetSystemTimeAsFileTime(&t); - QueryPerformanceCounter(&pc); /* PR#6032 */ - data[0] = t.dwLowDateTime; - data[1] = t.dwHighDateTime; - data[2] = GetCurrentProcessId(); - data[3] = pc.LowPart; - data[4] = pc.HighPart; - return 5; -} - - -#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L - -static void invalid_parameter_handler(const wchar_t* expression, - const wchar_t* function, - const wchar_t* file, - unsigned int line, - uintptr_t pReserved) -{ - /* no crash box */ -} - - -void caml_install_invalid_parameter_handler() -{ - _set_invalid_parameter_handler(invalid_parameter_handler); -} - -#endif - - -/* Recover executable name */ - -wchar_t * caml_executable_name(void) -{ - wchar_t * name; - DWORD namelen, ret; - - namelen = 256; - while (1) { - name = caml_stat_alloc(namelen*sizeof(wchar_t)); - ret = GetModuleFileName(NULL, name, namelen); - if (ret == 0) { caml_stat_free(name); return NULL; } - if (ret < namelen) break; - caml_stat_free(name); - if (namelen >= 1024*1024) return NULL; /* avoid runaway and overflow */ - namelen *= 2; - } - return name; -} - -/* snprintf emulation */ - -#ifdef LACKS_VSCPRINTF -/* No _vscprintf until Visual Studio .NET 2002 and sadly no version number - in the CRT headers until Visual Studio 2005 so forced to predicate this - on the compiler version instead */ -int _vscprintf(const char * format, va_list args) -{ - int n; - int sz = 5; - char* buf = (char*)malloc(sz); - n = _vsnprintf(buf, sz, format, args); - while (n < 0 || n > sz) { - sz += 512; - buf = (char*)realloc(buf, sz); - n = _vsnprintf(buf, sz, format, args); - } - free(buf); - return n; -} -#endif - -#if defined(_WIN32) && !defined(_UCRT) -int caml_snprintf(char * buf, size_t size, const char * format, ...) -{ - int len; - va_list args; - - if (size > 0) { - va_start(args, format); - len = _vsnprintf(buf, size, format, args); - va_end(args); - if (len >= 0 && len < size) { - /* [len] characters were stored in [buf], - a null-terminator was appended. */ - return len; - } - /* [size] characters were stored in [buf], without null termination. - Put a null terminator, truncating the output. */ - buf[size - 1] = 0; - } - /* Compute the actual length of output, excluding null terminator */ - va_start(args, format); - len = _vscprintf(format, args); - va_end(args); - return len; -} -#endif - -wchar_t *caml_secure_getenv (wchar_t const *var) -{ - /* Win32 doesn't have a notion of setuid bit, so getenv is safe. */ - return _wgetenv(var); -} - -/* caml_win32_getenv is used to implement Sys.getenv and Unix.getenv in such a - way that they get direct access to the Win32 environment rather than to the - copy that is cached by the C runtime system. The result of caml_win32_getenv - is dynamically allocated and must be explicitly deallocated. - - In contrast, the OCaml runtime system still calls _wgetenv from the C runtime - system, via caml_secure_getenv. The result is statically allocated and needs - no deallocation. */ -CAMLexport wchar_t *caml_win32_getenv(wchar_t const *lpName) -{ - wchar_t * lpBuffer; - DWORD nSize = 256, res; - - lpBuffer = caml_stat_alloc_noexc(nSize * sizeof(wchar_t)); - - if (lpBuffer == NULL) - return NULL; - - res = GetEnvironmentVariable(lpName, lpBuffer, nSize); - - if (res == 0) { - caml_stat_free(lpBuffer); - return NULL; - } - - if (res < nSize) - return lpBuffer; - - nSize = res; - lpBuffer = caml_stat_resize_noexc(lpBuffer, nSize * sizeof(wchar_t)); - - if (lpBuffer == NULL) - return NULL; - - res = GetEnvironmentVariable(lpName, lpBuffer, nSize); - - if (res == 0 || res >= nSize) { - caml_stat_free(lpBuffer); - return NULL; - } - - return lpBuffer; -} - -/* The rename() implementation in MSVC's CRT is based on MoveFile() - and therefore fails if the new name exists. This is inconsistent - with POSIX and a problem in practice. Here we reimplement - rename() using MoveFileEx() to make it more POSIX-like. - There are no official guarantee that the rename operation is atomic, - but it is widely believed to be atomic on NTFS. */ - -int caml_win32_rename(const wchar_t * oldpath, const wchar_t * newpath) -{ - /* MOVEFILE_REPLACE_EXISTING: to be closer to POSIX - MOVEFILE_COPY_ALLOWED: MoveFile performs a copy if old and new - paths are on different devices, so we do the same here for - compatibility with the old rename()-based implementation. - MOVEFILE_WRITE_THROUGH: not sure it's useful; affects only - the case where a copy is done. */ - if (MoveFileEx(oldpath, newpath, - MOVEFILE_REPLACE_EXISTING | MOVEFILE_WRITE_THROUGH | - MOVEFILE_COPY_ALLOWED)) { - return 0; - } - /* Modest attempt at mapping Win32 error codes to POSIX error codes. - The __dosmaperr() function from the CRT does a better job but is - generally not accessible. */ - switch (GetLastError()) { - case ERROR_FILE_NOT_FOUND: case ERROR_PATH_NOT_FOUND: - errno = ENOENT; break; - case ERROR_ACCESS_DENIED: case ERROR_WRITE_PROTECT: case ERROR_CANNOT_MAKE: - errno = EACCES; break; - case ERROR_CURRENT_DIRECTORY: case ERROR_BUSY: - errno = EBUSY; break; - case ERROR_NOT_SAME_DEVICE: - errno = EXDEV; break; - case ERROR_ALREADY_EXISTS: - errno = EEXIST; break; - default: - errno = EINVAL; - } - return -1; -} - -/* Windows Unicode support */ -static uintnat windows_unicode_enabled = WINDOWS_UNICODE; - -/* If [windows_unicode_strict] is non-zero, then illegal UTF-8 characters (on - the OCaml side) or illegal UTF-16 characters (on the Windows side) cause an - error to be signaled. What happens then depends on the variable - [windows_unicode_fallback]. - - If [windows_unicode_strict] is zero, then illegal characters are silently - dropped. */ -static uintnat windows_unicode_strict = 1; - -/* If [windows_unicode_fallback] is non-zero, then if an error is signaled when - translating to UTF-16, the translation is re-done under the assumption that - the argument string is encoded in the local codepage. */ -static uintnat windows_unicode_fallback = 1; - -CAMLexport int win_multi_byte_to_wide_char(const char *s, int slen, wchar_t *out, int outlen) -{ - int retcode; - - CAMLassert (s != NULL); - - if (slen == 0) - return 0; - - if (windows_unicode_enabled != 0) { - retcode = MultiByteToWideChar(CP_UTF8, windows_unicode_strict ? MB_ERR_INVALID_CHARS : 0, s, slen, out, outlen); - if (retcode == 0 && windows_unicode_fallback != 0) - retcode = MultiByteToWideChar(CP_THREAD_ACP, 0, s, slen, out, outlen); - } else { - retcode = MultiByteToWideChar(CP_THREAD_ACP, 0, s, slen, out, outlen); - } - - if (retcode == 0) - caml_win32_sys_error(GetLastError()); - - return retcode; -} - -#ifndef WC_ERR_INVALID_CHARS /* For old versions of Windows we simply ignore the flag */ -#define WC_ERR_INVALID_CHARS 0 -#endif - -CAMLexport int win_wide_char_to_multi_byte(const wchar_t *s, int slen, char *out, int outlen) -{ - int retcode; - - CAMLassert(s != NULL); - - if (slen == 0) - return 0; - - if (windows_unicode_enabled != 0) - retcode = WideCharToMultiByte(CP_UTF8, windows_unicode_strict ? WC_ERR_INVALID_CHARS : 0, s, slen, out, outlen, NULL, NULL); - else - retcode = WideCharToMultiByte(CP_THREAD_ACP, 0, s, slen, out, outlen, NULL, NULL); - - if (retcode == 0) - caml_win32_sys_error(GetLastError()); - - return retcode; -} - -CAMLexport value caml_copy_string_of_utf16(const wchar_t *s) -{ - int retcode, slen; - value v; - - slen = wcslen(s); - retcode = win_wide_char_to_multi_byte(s, slen, NULL, 0); /* Do not include final NULL */ - v = caml_alloc_string(retcode); - win_wide_char_to_multi_byte(s, slen, String_val(v), retcode); - - return v; -} - -CAMLexport inline wchar_t* caml_stat_strdup_to_utf16(const char *s) -{ - wchar_t * ws; - int retcode; - - retcode = win_multi_byte_to_wide_char(s, -1, NULL, 0); - ws = malloc(retcode * sizeof(*ws)); - win_multi_byte_to_wide_char(s, -1, ws, retcode); - - return ws; -} - -CAMLexport caml_stat_string caml_stat_strdup_of_utf16(const wchar_t *s) -{ - caml_stat_string out; - int retcode; - - retcode = win_wide_char_to_multi_byte(s, -1, NULL, 0); - out = caml_stat_alloc(retcode); - win_wide_char_to_multi_byte(s, -1, out, retcode); - - return out; -} - -void caml_probe_win32_version(void) -{ - /* Determine the version of Windows we're running, and cache it */ - WCHAR fileName[MAX_PATH]; - DWORD size = - GetModuleFileName(GetModuleHandle(L"kernel32"), fileName, MAX_PATH); - DWORD dwHandle = 0; - BYTE* versionInfo; - fileName[size] = 0; - size = GetFileVersionInfoSize(fileName, &dwHandle); - versionInfo = (BYTE*)malloc(size * sizeof(BYTE)); - if (GetFileVersionInfo(fileName, 0, size, versionInfo)) { - UINT len = 0; - VS_FIXEDFILEINFO* vsfi = NULL; - VerQueryValue(versionInfo, L"\\", (void**)&vsfi, &len); - caml_win32_major = HIWORD(vsfi->dwProductVersionMS); - caml_win32_minor = LOWORD(vsfi->dwProductVersionMS); - caml_win32_build = HIWORD(vsfi->dwProductVersionLS); - caml_win32_revision = LOWORD(vsfi->dwProductVersionLS); - } - free(versionInfo); -} - -static UINT startup_codepage = 0; - -void caml_setup_win32_terminal(void) -{ - if (caml_win32_major >= 10) { - startup_codepage = GetConsoleOutputCP(); - if (startup_codepage != CP_UTF8) - SetConsoleOutputCP(CP_UTF8); - } -} - -void caml_restore_win32_terminal(void) -{ - if (startup_codepage != 0) - SetConsoleOutputCP(startup_codepage); -} - -/* Detect if a named pipe corresponds to a Cygwin/MSYS pty: see - https://github.com/mirror/newlib-cygwin/blob/00e9bf2/winsup/cygwin/dtable.cc#L932 -*/ -typedef -BOOL (WINAPI *tGetFileInformationByHandleEx)(HANDLE, FILE_INFO_BY_HANDLE_CLASS, - LPVOID, DWORD); - -static int caml_win32_is_cygwin_pty(HANDLE hFile) -{ - char buffer[1024]; - FILE_NAME_INFO * nameinfo = (FILE_NAME_INFO *) buffer; - static tGetFileInformationByHandleEx pGetFileInformationByHandleEx = INVALID_HANDLE_VALUE; - - if (pGetFileInformationByHandleEx == INVALID_HANDLE_VALUE) - pGetFileInformationByHandleEx = - (tGetFileInformationByHandleEx)GetProcAddress(GetModuleHandle(L"KERNEL32.DLL"), - "GetFileInformationByHandleEx"); - - if (pGetFileInformationByHandleEx == NULL) - return 0; - - /* Get pipe name. GetFileInformationByHandleEx does not NULL-terminate the string, so reduce - the buffer size to allow for adding one. */ - if (! pGetFileInformationByHandleEx(hFile, FileNameInfo, buffer, sizeof(buffer) - sizeof(WCHAR))) - return 0; - - nameinfo->FileName[nameinfo->FileNameLength / sizeof(WCHAR)] = L'\0'; - - /* check if this could be a msys pty pipe ('msys-XXXX-ptyN-XX') - or a cygwin pty pipe ('cygwin-XXXX-ptyN-XX') */ - if ((wcsstr(nameinfo->FileName, L"msys-") || - wcsstr(nameinfo->FileName, L"cygwin-")) && wcsstr(nameinfo->FileName, L"-pty")) - return 1; - - return 0; -} - -CAMLexport int caml_win32_isatty(int fd) -{ - DWORD lpMode; - HANDLE hFile = (HANDLE)_get_osfhandle(fd); - - if (hFile == INVALID_HANDLE_VALUE) - return 0; - - switch (GetFileType(hFile)) { - case FILE_TYPE_CHAR: - /* Both console handles and the NUL device are FILE_TYPE_CHAR. The NUL - device returns FALSE for a GetConsoleMode call. _isatty incorrectly - only uses GetFileType (see GPR#1321). */ - return GetConsoleMode(hFile, &lpMode); - case FILE_TYPE_PIPE: - /* Cygwin PTYs are implemented using named pipes */ - return caml_win32_is_cygwin_pty(hFile); - default: - break; - } - - return 0; -} - -int caml_num_rows_fd(int fd) -{ - return -1; -} |