diff options
Diffstat (limited to 'test/monniaux/ocaml/byterun/caml')
54 files changed, 6184 insertions, 0 deletions
diff --git a/test/monniaux/ocaml/byterun/caml/address_class.h b/test/monniaux/ocaml/byterun/caml/address_class.h new file mode 100644 index 00000000..85e22d32 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/address_class.h @@ -0,0 +1,85 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, 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. */ +/* */ +/**************************************************************************/ + +/* Classification of addresses for GC and runtime purposes. */ + +#ifndef CAML_ADDRESS_CLASS_H +#define CAML_ADDRESS_CLASS_H + +#include "config.h" +#include "misc.h" +#include "mlvalues.h" + +/* Use the following macros to test an address for the different classes + it might belong to. */ + +#define Is_young(val) \ + (CAMLassert (Is_block (val)), \ + (addr)(val) < (addr)caml_young_end && (addr)(val) > (addr)caml_young_start) + +#define Is_in_heap(a) (Classify_addr(a) & In_heap) + +#define Is_in_heap_or_young(a) (Classify_addr(a) & (In_heap | In_young)) + +#define Is_in_value_area(a) \ + (Classify_addr(a) & (In_heap | In_young | In_static_data)) + +#define Is_in_code_area(pc) \ + ( ((char *)(pc) >= caml_code_area_start && \ + (char *)(pc) <= caml_code_area_end) \ + || (Classify_addr(pc) & In_code_area) ) + +#define Is_in_static_data(a) (Classify_addr(a) & In_static_data) + +/***********************************************************************/ +/* The rest of this file is private and may change without notice. */ + +extern value *caml_young_start, *caml_young_end; +extern char * caml_code_area_start, * caml_code_area_end; + +#define Not_in_heap 0 +#define In_heap 1 +#define In_young 2 +#define In_static_data 4 +#define In_code_area 8 + +#ifdef ARCH_SIXTYFOUR + +/* 64 bits: Represent page table as a sparse hash table */ +int caml_page_table_lookup(void * addr); +#define Classify_addr(a) (caml_page_table_lookup((void *)(a))) + +#else + +/* 32 bits: Represent page table as a 2-level array */ +#define Pagetable2_log 11 +#define Pagetable2_size (1 << Pagetable2_log) +#define Pagetable1_log (Page_log + Pagetable2_log) +#define Pagetable1_size (1 << (32 - Pagetable1_log)) +CAMLextern unsigned char * caml_page_table[Pagetable1_size]; + +#define Pagetable_index1(a) (((uintnat)(a)) >> Pagetable1_log) +#define Pagetable_index2(a) \ + ((((uintnat)(a)) >> Page_log) & (Pagetable2_size - 1)) +#define Classify_addr(a) \ + caml_page_table[Pagetable_index1(a)][Pagetable_index2(a)] + +#endif + +int caml_page_table_add(int kind, void * start, void * end); +int caml_page_table_remove(int kind, void * start, void * end); +int caml_page_table_initialize(mlsize_t bytesize); + +#endif /* CAML_ADDRESS_CLASS_H */ diff --git a/test/monniaux/ocaml/byterun/caml/alloc.h b/test/monniaux/ocaml/byterun/caml/alloc.h new file mode 100644 index 00000000..81fff858 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/alloc.h @@ -0,0 +1,82 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy and Damien Doligez, 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_ALLOC_H +#define CAML_ALLOC_H + + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "misc.h" +#include "mlvalues.h" + +#ifdef __cplusplus +extern "C" { +#endif + +CAMLextern value caml_alloc (mlsize_t wosize, tag_t); +CAMLextern value caml_alloc_small (mlsize_t wosize, tag_t); +CAMLextern value caml_alloc_tuple (mlsize_t wosize); +CAMLextern value caml_alloc_float_array (mlsize_t len); +CAMLextern value caml_alloc_string (mlsize_t len); /* len in bytes (chars) */ +CAMLextern value caml_alloc_initialized_string (mlsize_t len, const char *); +CAMLextern value caml_copy_string (char const *); +CAMLextern value caml_copy_string_array (char const **); +CAMLextern value caml_copy_double (double); +CAMLextern value caml_copy_int32 (int32_t); /* defined in [ints.c] */ +CAMLextern value caml_copy_int64 (int64_t); /* defined in [ints.c] */ +CAMLextern value caml_copy_nativeint (intnat); /* defined in [ints.c] */ +CAMLextern value caml_alloc_array (value (*funct) (char const *), + char const ** array); +CAMLextern value caml_alloc_sprintf(const char * format, ...) +#ifdef __GNUC__ + __attribute__ ((format (printf, 1, 2))) +#endif +; + +CAMLextern value caml_alloc_with_profinfo (mlsize_t, tag_t, intnat); +CAMLextern value caml_alloc_small_with_my_or_given_profinfo ( + mlsize_t, tag_t, uintnat); +CAMLextern value caml_alloc_small_with_profinfo (mlsize_t, tag_t, intnat); + +typedef void (*final_fun)(value); +CAMLextern value caml_alloc_final (mlsize_t wosize, + final_fun, /*finalization function*/ + mlsize_t, /*resources consumed*/ + mlsize_t /*max resources*/); + +CAMLextern int caml_convert_flag_list (value, int *); + +/* Convenience functions to deal with unboxable types. */ +static inline value caml_alloc_unboxed (value arg) { return arg; } +static inline value caml_alloc_boxed (value arg) { + value result = caml_alloc_small (1, 0); + Field (result, 0) = arg; + return result; +} +static inline value caml_field_unboxed (value arg) { return arg; } +static inline value caml_field_boxed (value arg) { return Field (arg, 0); } + +/* Unannotated unboxable types are boxed by default. (may change in the + future) */ +#define caml_alloc_unboxable caml_alloc_boxed +#define caml_field_unboxable caml_field_boxed + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_ALLOC_H */ diff --git a/test/monniaux/ocaml/byterun/caml/backtrace.h b/test/monniaux/ocaml/byterun/caml/backtrace.h new file mode 100644 index 00000000..fc0baf2d --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/backtrace.h @@ -0,0 +1,136 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2001 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_BACKTRACE_H +#define CAML_BACKTRACE_H + +#ifdef CAML_INTERNALS + +#include "mlvalues.h" +#include "exec.h" + +/* Runtime support for backtrace generation. + * + * It has two kind of users: + * - high-level API to capture and decode backtraces; + * - low-level runtime routines, to introspect machine state and determine + * whether a backtrace should be generated when using "raise". + * + * Backtrace generation is split in multiple steps. + * The lowest-level one, done by [backtrace_prim.c] just fills the + * [caml_backtrace_buffer] variable each time a frame is unwinded. + * At that point, we don't know whether the backtrace will be useful or not so + * this code should be as fast as possible. + * + * If the backtrace happens to be useful, later passes will read + * [caml_backtrace_buffer] and turn it into a [raw_backtrace] and then a + * [backtrace]. + * This is done in [backtrace.c] and [stdlib/printexc.ml]. + * + * Content of buffers + * ------------------ + * + * [caml_backtrace_buffer] (really cheap) + * Backend and process image dependent, abstracted by C-type backtrace_slot. + * [raw_backtrace] (cheap) + * OCaml values of abstract type [Printexc.raw_backtrace_slot], + * still backend and process image dependent (unsafe to marshal). + * [backtrace] (more expensive) + * OCaml values of algebraic data-type [Printexc.backtrace_slot] + */ + +/* Non zero iff backtraces are recorded. + * One should use to change this variable [caml_record_backtrace]. + */ +CAMLextern int caml_backtrace_active; + +/* The [backtrace_slot] type represents values stored in the + * [caml_backtrace_buffer]. In bytecode, it is the same as a + * [code_t], in native code it as a [frame_descr *]. The difference + * doesn't matter for code outside [backtrace_prim.c], so it is just + * exposed as a [backtrace_slot]. + */ +typedef void * backtrace_slot; + +/* The [caml_backtrace_buffer] and [caml_backtrace_last_exn] + * variables are valid only if [caml_backtrace_active != 0]. + * + * They are part of the state specific to each thread, and threading libraries + * are responsible for copying them on context switch. + * See [otherlibs/systhreads/st_stubs.c] and [otherlibs/threads/scheduler.c]. + */ + +/* [caml_backtrace_buffer] is filled by runtime when unwinding stack. + * It is an array ranging from [0] to [caml_backtrace_pos - 1]. + * [caml_backtrace_pos] is always zero if [!caml_backtrace_active]. + * + * Its maximum size is determined by [BACKTRACE_BUFFER_SIZE] from + * [backtrace_prim.h], but this shouldn't affect users. + */ +CAMLextern backtrace_slot * caml_backtrace_buffer; +CAMLextern int caml_backtrace_pos; + +/* [caml_backtrace_last_exn] stores the last exception value that was raised, + * iff [caml_backtrace_active != 0]. + * It is tested for equality to determine whether a raise is a re-raise of the + * same exception. + * + * FIXME: this shouldn't matter anymore. Since OCaml 4.02, non-parameterized + * exceptions are constant, so physical equality is no longer appropriate. + * raise and re-raise are distinguished by: + * - passing reraise = 1 to [caml_stash_backtrace] (see below) in the bytecode + * interpreter; + * - directly resetting [caml_backtrace_pos] to 0 in native runtimes for raise. + */ +CAMLextern value caml_backtrace_last_exn; + +/* [caml_record_backtrace] toggle backtrace recording on and off. + * This function can be called at runtime by user-code, or during + * initialization if backtraces were requested. + * + * It might be called before GC initialization, so it shouldn't do OCaml + * allocation. + */ +CAMLprim value caml_record_backtrace(value vflag); + + +#ifndef NATIVE_CODE + +/* Path to the file containing debug information, if any, or NULL. */ +CAMLextern char_os * caml_cds_file; + +/* Primitive called _only_ by runtime to record unwinded frames to + * backtrace. A similar primitive exists for native code, but with a + * different prototype. */ +extern void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise); + +#endif + + +/* Default (C-level) printer for backtraces. It is called if an + * exception causes a termination of the program or of a thread. + * + * [Printexc] provide a higher-level printer mimicking its output but making + * use of registered exception printers, and is used when possible in place of + * this function after [Printexc] initialization. + */ +CAMLextern void caml_print_exception_backtrace(void); + +void caml_init_backtrace(void); +CAMLexport void caml_init_debug_info(void); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_BACKTRACE_H */ diff --git a/test/monniaux/ocaml/byterun/caml/backtrace_prim.h b/test/monniaux/ocaml/byterun/caml/backtrace_prim.h new file mode 100644 index 00000000..2484b294 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/backtrace_prim.h @@ -0,0 +1,91 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2001 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_BACKTRACE_PRIM_H +#define CAML_BACKTRACE_PRIM_H + +#ifdef CAML_INTERNALS + +#include "backtrace.h" + +/* Backtrace generation is split in [backtrace.c] and [backtrace_prim.c]. + * + * [backtrace_prim.c] contains all backend-specific code, and has two different + * implementations in [byterun/backtrace_prim.c] and [asmrun/backtrace_prim.c]. + * + * [backtrace.c] has a unique implementation, and expose a uniform + * higher level API above [backtrace_prim.c]. + */ + +/* Extract location information for the given raw_backtrace_slot */ + +struct caml_loc_info { + int loc_valid; + int loc_is_raise; + char * loc_filename; + int loc_lnum; + int loc_startchr; + int loc_endchr; + int loc_is_inlined; +}; + +/* When compiling with -g, backtrace slots have debug info associated. + * When a call is inlined in native mode, debuginfos form a linked list. + */ +typedef void * debuginfo; + +/* Check availability of debug information before extracting a trace. + * Relevant for bytecode, always true for native code. */ +int caml_debug_info_available(void); + +/* Return debuginfo associated to a slot or NULL. */ +debuginfo caml_debuginfo_extract(backtrace_slot slot); + +/* In case of an inlined call return next debuginfo or NULL otherwise. */ +debuginfo caml_debuginfo_next(debuginfo dbg); + +/* Extract locations from backtrace_slot */ +void caml_debuginfo_location(debuginfo dbg, /*out*/ struct caml_loc_info * li); + +/* In order to prevent the GC from walking through the debug + information (which have no headers), we transform slots to 31/63 bits + ocaml integers by shifting them by 1 to the right. We do not lose + information as slots are aligned. + + In particular, we do not need to use [caml_modify] when setting + an array element with such a value. + */ +#define Val_backtrace_slot(bslot) (Val_long(((uintnat)(bslot))>>1)) +#define Backtrace_slot_val(vslot) ((backtrace_slot)(Long_val(vslot) << 1)) + +/* Allocate the caml_backtrace_buffer. Returns 0 on success, -1 otherwise */ +int caml_alloc_backtrace_buffer(void); + +#define BACKTRACE_BUFFER_SIZE 1024 + +/* Besides decoding backtrace info, [backtrace_prim] has two other + * responsibilities: + * + * It defines the [caml_stash_backtrace] function, which is called to quickly + * fill the backtrace buffer by walking the stack when an exception is raised. + * + * It also defines the [caml_get_current_callstack] OCaml primitive, which also + * walks the stack but directly turns it into a [raw_backtrace] and is called + * explicitly. + */ + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_BACKTRACE_PRIM_H */ diff --git a/test/monniaux/ocaml/byterun/caml/bigarray.h b/test/monniaux/ocaml/byterun/caml/bigarray.h new file mode 100644 index 00000000..fc1fb145 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/bigarray.h @@ -0,0 +1,134 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Manuel Serrano and Xavier Leroy, INRIA Rocquencourt */ +/* */ +/* Copyright 2000 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_BIGARRAY_H +#define CAML_BIGARRAY_H + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "config.h" +#include "mlvalues.h" + +typedef signed char caml_ba_int8; +typedef unsigned char caml_ba_uint8; +#if defined(HAS_STDINT_H) +typedef int16_t caml_ba_int16; +typedef uint16_t caml_ba_uint16; +#elif SIZEOF_SHORT == 2 +typedef short caml_ba_int16; +typedef unsigned short caml_ba_uint16; +#else +#error "No 16-bit integer type available" +#endif + +#define CAML_BA_MAX_NUM_DIMS 16 + +enum caml_ba_kind { + CAML_BA_FLOAT32, /* Single-precision floats */ + CAML_BA_FLOAT64, /* Double-precision floats */ + CAML_BA_SINT8, /* Signed 8-bit integers */ + CAML_BA_UINT8, /* Unsigned 8-bit integers */ + CAML_BA_SINT16, /* Signed 16-bit integers */ + CAML_BA_UINT16, /* Unsigned 16-bit integers */ + CAML_BA_INT32, /* Signed 32-bit integers */ + CAML_BA_INT64, /* Signed 64-bit integers */ + CAML_BA_CAML_INT, /* OCaml-style integers (signed 31 or 63 bits) */ + CAML_BA_NATIVE_INT, /* Platform-native long integers (32 or 64 bits) */ + CAML_BA_COMPLEX32, /* Single-precision complex */ + CAML_BA_COMPLEX64, /* Double-precision complex */ + CAML_BA_CHAR, /* Characters */ + CAML_BA_KIND_MASK = 0xFF /* Mask for kind in flags field */ +}; + +#define Caml_ba_kind_val(v) Int_val(v) + +#define Val_caml_ba_kind(k) Val_int(k) + +enum caml_ba_layout { + CAML_BA_C_LAYOUT = 0, /* Row major, indices start at 0 */ + CAML_BA_FORTRAN_LAYOUT = 0x100, /* Column major, indices start at 1 */ + CAML_BA_LAYOUT_MASK = 0x100, /* Mask for layout in flags field */ + CAML_BA_LAYOUT_SHIFT = 8 /* Bit offset of layout flag */ +}; + +#define Caml_ba_layout_val(v) (Int_val(v) << CAML_BA_LAYOUT_SHIFT) + +#define Val_caml_ba_layout(l) Val_int(l >> CAML_BA_LAYOUT_SHIFT) + +enum caml_ba_managed { + CAML_BA_EXTERNAL = 0, /* Data is not allocated by OCaml */ + CAML_BA_MANAGED = 0x200, /* Data is allocated by OCaml */ + CAML_BA_MAPPED_FILE = 0x400, /* Data is a memory mapped file */ + CAML_BA_MANAGED_MASK = 0x600 /* Mask for "managed" bits in flags field */ +}; + +struct caml_ba_proxy { + intnat refcount; /* Reference count */ + void * data; /* Pointer to base of actual data */ + uintnat size; /* Size of data in bytes (if mapped file) */ +}; + +struct caml_ba_array { + void * data; /* Pointer to raw data */ + intnat num_dims; /* Number of dimensions */ + intnat flags; /* Kind of element array + memory layout + allocation status */ + struct caml_ba_proxy * proxy; /* The proxy for sub-arrays, or NULL */ + /* PR#5516: use C99's flexible array types if possible */ +#if (__STDC_VERSION__ >= 199901L) + intnat dim[] /*[num_dims]*/; /* Size in each dimension */ +#else + intnat dim[1] /*[num_dims]*/; /* Size in each dimension */ +#endif +}; + +/* Size of struct caml_ba_array, in bytes, without dummy first dimension */ +#if (__STDC_VERSION__ >= 199901L) +#define SIZEOF_BA_ARRAY sizeof(struct caml_ba_array) +#else +#define SIZEOF_BA_ARRAY (sizeof(struct caml_ba_array) - sizeof(intnat)) +#endif + +#define Caml_ba_array_val(v) ((struct caml_ba_array *) Data_custom_val(v)) + +#define Caml_ba_data_val(v) (Caml_ba_array_val(v)->data) + +#ifdef __cplusplus +extern "C" { +#endif + +CAMLextern value + caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim); +CAMLextern value caml_ba_alloc_dims(int flags, int num_dims, void * data, + ... /*dimensions, with type intnat */); +CAMLextern uintnat caml_ba_byte_size(struct caml_ba_array * b); +CAMLextern uintnat caml_ba_num_elts(struct caml_ba_array * b); + +#ifdef __cplusplus +} +#endif + +#ifdef CAML_INTERNALS + +CAMLextern int caml_ba_element_size[]; +CAMLextern void caml_ba_finalize(value v); +CAMLextern int caml_ba_compare(value v1, value v2); +CAMLextern intnat caml_ba_hash(value v); +CAMLextern void caml_ba_serialize(value, uintnat *, uintnat *); +CAMLextern uintnat caml_ba_deserialize(void * dst); + +#endif + +#endif /* CAML_BIGARRAY_H */ diff --git a/test/monniaux/ocaml/byterun/caml/callback.h b/test/monniaux/ocaml/byterun/caml/callback.h new file mode 100644 index 00000000..93208b7a --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/callback.h @@ -0,0 +1,63 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Callbacks from C to OCaml */ + +#ifndef CAML_CALLBACK_H +#define CAML_CALLBACK_H + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "mlvalues.h" + +#ifdef __cplusplus +extern "C" { +#endif + +CAMLextern value caml_callback (value closure, value arg); +CAMLextern value caml_callback2 (value closure, value arg1, value arg2); +CAMLextern value caml_callback3 (value closure, value arg1, value arg2, + value arg3); +CAMLextern value caml_callbackN (value closure, int narg, value args[]); + +CAMLextern value caml_callback_exn (value closure, value arg); +CAMLextern value caml_callback2_exn (value closure, value arg1, value arg2); +CAMLextern value caml_callback3_exn (value closure, + value arg1, value arg2, value arg3); +CAMLextern value caml_callbackN_exn (value closure, int narg, value args[]); + +#define Make_exception_result(v) ((v) | 2) +#define Is_exception_result(v) (((v) & 3) == 2) +#define Extract_exception(v) ((v) & ~3) + +CAMLextern value * caml_named_value (char const * name); +typedef void (*caml_named_action) (value*, char *); +CAMLextern void caml_iterate_named_values(caml_named_action f); + +CAMLextern void caml_main (char_os ** argv); +CAMLextern void caml_startup (char_os ** argv); +CAMLextern value caml_startup_exn (char_os ** argv); +CAMLextern void caml_startup_pooled (char_os ** argv); +CAMLextern value caml_startup_pooled_exn (char_os ** argv); +CAMLextern void caml_shutdown (void); + +CAMLextern int caml_callback_depth; + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/test/monniaux/ocaml/byterun/caml/compact.h b/test/monniaux/ocaml/byterun/caml/compact.h new file mode 100644 index 00000000..e29d0e86 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/compact.h @@ -0,0 +1,31 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_COMPACT_H +#define CAML_COMPACT_H + +#ifdef CAML_INTERNALS + +#include "config.h" +#include "misc.h" +#include "mlvalues.h" + +void caml_compact_heap (void); +void caml_compact_heap_maybe (void); +void caml_invert_root (value v, value *p); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_COMPACT_H */ diff --git a/test/monniaux/ocaml/byterun/caml/compare.h b/test/monniaux/ocaml/byterun/caml/compare.h new file mode 100644 index 00000000..54b71581 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/compare.h @@ -0,0 +1,25 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, Projet Moscova, INRIA Rocquencourt */ +/* */ +/* Copyright 2003 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_COMPARE_H +#define CAML_COMPARE_H + +#ifdef CAML_INTERNALS + +CAMLextern int caml_compare_unordered; + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_COMPARE_H */ diff --git a/test/monniaux/ocaml/byterun/caml/compatibility.h b/test/monniaux/ocaml/byterun/caml/compatibility.h new file mode 100644 index 00000000..082943c6 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/compatibility.h @@ -0,0 +1,375 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Moscova, INRIA Rocquencourt */ +/* */ +/* Copyright 2003 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. */ +/* */ +/**************************************************************************/ + +/* definitions for compatibility with old identifiers */ + +#ifndef CAML_COMPATIBILITY_H +#define CAML_COMPATIBILITY_H + +/* internal global variables renamed between 4.02.1 and 4.03.0 */ +#define caml_stat_top_heap_size Bsize_wsize(caml_stat_top_heap_wsz) +#define caml_stat_heap_size Bsize_wsize(caml_stat_heap_wsz) + +#ifndef CAML_NAME_SPACE + +/* + #define --> CAMLextern (defined with CAMLexport or CAMLprim) + (rien) --> CAMLprim + g --> global C identifier + x --> special case + + SP* signals the special cases: + - when the identifier was not simply prefixed with [caml_] + - when the [caml_] version was already used for something else, and + was renamed out of the way (watch out for [caml_alloc] and + [caml_array_bound_error] in *.s) +*/ + +/* a faire: + - ui_* (reverifier que win32.c n'en depend pas) +*/ + + +/* **** alloc.c */ +#define alloc caml_alloc /*SP*/ +#define alloc_small caml_alloc_small +#define alloc_tuple caml_alloc_tuple +#define alloc_string caml_alloc_string +#define alloc_final caml_alloc_final +#define copy_string caml_copy_string +#define alloc_array caml_alloc_array +#define copy_string_array caml_copy_string_array +#define convert_flag_list caml_convert_flag_list + +/* **** array.c */ + +/* **** backtrace.c */ +#define backtrace_active caml_backtrace_active +#define backtrace_pos caml_backtrace_pos +#define backtrace_buffer caml_backtrace_buffer +#define backtrace_last_exn caml_backtrace_last_exn +#define print_exception_backtrace caml_print_exception_backtrace + +/* **** callback.c */ +#define callback_depth caml_callback_depth +#define callbackN_exn caml_callbackN_exn +#define callback_exn caml_callback_exn +#define callback2_exn caml_callback2_exn +#define callback3_exn caml_callback3_exn +#define callback caml_callback +#define callback2 caml_callback2 +#define callback3 caml_callback3 +#define callbackN caml_callbackN + +/* **** compact.c */ + +/* **** compare.c */ +#define compare_unordered caml_compare_unordered + +/* **** custom.c */ +#define alloc_custom caml_alloc_custom +#define register_custom_operations caml_register_custom_operations + +/* **** debugger.c */ + +/* **** dynlink.c */ + +/* **** extern.c */ +#define output_val caml_output_val +#define output_value_to_malloc caml_output_value_to_malloc +#define output_value_to_block caml_output_value_to_block +#define serialize_int_1 caml_serialize_int_1 +#define serialize_int_2 caml_serialize_int_2 +#define serialize_int_4 caml_serialize_int_4 +#define serialize_int_8 caml_serialize_int_8 +#define serialize_float_4 caml_serialize_float_4 +#define serialize_float_8 caml_serialize_float_8 +#define serialize_block_1 caml_serialize_block_1 +#define serialize_block_2 caml_serialize_block_2 +#define serialize_block_4 caml_serialize_block_4 +#define serialize_block_8 caml_serialize_block_8 +#define serialize_block_float_8 caml_serialize_block_float_8 + +/* **** fail.c */ +#define external_raise caml_external_raise +#define mlraise caml_raise /*SP*/ +#define raise_constant caml_raise_constant +#define raise_with_arg caml_raise_with_arg +#define raise_with_string caml_raise_with_string +#define failwith caml_failwith +#define invalid_argument caml_invalid_argument +#define array_bound_error caml_array_bound_error /*SP*/ +#define raise_out_of_memory caml_raise_out_of_memory +#define raise_stack_overflow caml_raise_stack_overflow +#define raise_sys_error caml_raise_sys_error +#define raise_end_of_file caml_raise_end_of_file +#define raise_zero_divide caml_raise_zero_divide +#define raise_not_found caml_raise_not_found +#define raise_sys_blocked_io caml_raise_sys_blocked_io +/* **** asmrun/fail.c */ +/* **** asmrun/<arch>.s */ + +/* **** finalise.c */ + +/* **** fix_code.c */ + +/* **** floats.c */ +/*#define Double_val caml_Double_val done in mlvalues.h as needed */ +/*#define Store_double_val caml_Store_double_val done in mlvalues.h as needed */ +#define copy_double caml_copy_double + +/* **** freelist.c */ + +/* **** gc_ctrl.c */ + +/* **** globroots.c */ +#define register_global_root caml_register_global_root +#define remove_global_root caml_remove_global_root + +/* **** hash.c */ +#define hash_variant caml_hash_variant + +/* **** instrtrace.c */ + +/* **** intern.c */ +#define input_val caml_input_val +#define input_val_from_string caml_input_val_from_string +#define input_value_from_malloc caml_input_value_from_malloc +#define input_value_from_block caml_input_value_from_block +#define deserialize_uint_1 caml_deserialize_uint_1 +#define deserialize_sint_1 caml_deserialize_sint_1 +#define deserialize_uint_2 caml_deserialize_uint_2 +#define deserialize_sint_2 caml_deserialize_sint_2 +#define deserialize_uint_4 caml_deserialize_uint_4 +#define deserialize_sint_4 caml_deserialize_sint_4 +#define deserialize_uint_8 caml_deserialize_uint_8 +#define deserialize_sint_8 caml_deserialize_sint_8 +#define deserialize_float_4 caml_deserialize_float_4 +#define deserialize_float_8 caml_deserialize_float_8 +#define deserialize_block_1 caml_deserialize_block_1 +#define deserialize_block_2 caml_deserialize_block_2 +#define deserialize_block_4 caml_deserialize_block_4 +#define deserialize_block_8 caml_deserialize_block_8 +#define deserialize_block_float_8 caml_deserialize_block_float_8 +#define deserialize_error caml_deserialize_error + +/* **** interp.c */ + +/* **** ints.c */ +#define int32_ops caml_int32_ops +#define copy_int32 caml_copy_int32 +/*#define Int64_val caml_Int64_val *** done in mlvalues.h as needed */ +#define int64_ops caml_int64_ops +#define copy_int64 caml_copy_int64 +#define nativeint_ops caml_nativeint_ops +#define copy_nativeint caml_copy_nativeint + +/* **** io.c */ +#define channel_mutex_free caml_channel_mutex_free +#define channel_mutex_lock caml_channel_mutex_lock +#define channel_mutex_unlock caml_channel_mutex_unlock +#define channel_mutex_unlock_exn caml_channel_mutex_unlock_exn +#define all_opened_channels caml_all_opened_channels +#define open_descriptor_in caml_open_descriptor_in /*SP*/ +#define open_descriptor_out caml_open_descriptor_out /*SP*/ +#define close_channel caml_close_channel /*SP*/ +#define channel_size caml_channel_size /*SP*/ +#define channel_binary_mode caml_channel_binary_mode +#define flush_partial caml_flush_partial /*SP*/ +#define flush caml_flush /*SP*/ +#define putword caml_putword +#define putblock caml_putblock +#define really_putblock caml_really_putblock +#define seek_out caml_seek_out /*SP*/ +#define pos_out caml_pos_out /*SP*/ +#define do_read caml_do_read +#define refill caml_refill +#define getword caml_getword +#define getblock caml_getblock +#define really_getblock caml_really_getblock +#define seek_in caml_seek_in /*SP*/ +#define pos_in caml_pos_in /*SP*/ +#define input_scan_line caml_input_scan_line /*SP*/ +#define finalize_channel caml_finalize_channel +#define alloc_channel caml_alloc_channel +/*#define Val_file_offset caml_Val_file_offset *** done in io.h as needed */ +/*#define File_offset_val caml_File_offset_val *** done in io.h as needed */ + +/* **** lexing.c */ + +/* **** main.c */ +/* *** no change */ + +/* **** major_gc.c */ +#define heap_start caml_heap_start +#define page_table caml_page_table + +/* **** md5.c */ +#define md5_string caml_md5_string +#define md5_chan caml_md5_chan +#define MD5Init caml_MD5Init +#define MD5Update caml_MD5Update +#define MD5Final caml_MD5Final +#define MD5Transform caml_MD5Transform + +/* **** memory.c */ +#define alloc_shr caml_alloc_shr +#define initialize caml_initialize +#define modify caml_modify +#define stat_alloc caml_stat_alloc +#define stat_free caml_stat_free +#define stat_resize caml_stat_resize + +/* **** meta.c */ + +/* **** minor_gc.c */ +#define young_start caml_young_start +#define young_end caml_young_end +#define young_ptr caml_young_ptr +#define young_limit caml_young_limit +#define ref_table caml_ref_table +#define minor_collection caml_minor_collection +#define check_urgent_gc caml_check_urgent_gc + +/* **** misc.c */ + +/* **** obj.c */ + +/* **** parsing.c */ + +/* **** prims.c */ + +/* **** printexc.c */ +#define format_caml_exception caml_format_exception /*SP*/ + +/* **** roots.c */ +#define local_roots caml_local_roots +#define scan_roots_hook caml_scan_roots_hook +#define do_local_roots caml_do_local_roots + +/* **** signals.c */ +#define pending_signals caml_pending_signals +#define something_to_do caml_something_to_do +#define enter_blocking_section_hook caml_enter_blocking_section_hook +#define leave_blocking_section_hook caml_leave_blocking_section_hook +#define try_leave_blocking_section_hook caml_try_leave_blocking_section_hook +#define async_action_hook caml_async_action_hook +#define enter_blocking_section caml_enter_blocking_section +#define leave_blocking_section caml_leave_blocking_section +#define convert_signal_number caml_convert_signal_number +/* **** asmrun/signals.c */ +#define garbage_collection caml_garbage_collection + +/* **** stacks.c */ +#define stack_low caml_stack_low +#define stack_high caml_stack_high +#define stack_threshold caml_stack_threshold +#define extern_sp caml_extern_sp +#define trapsp caml_trapsp +#define trap_barrier caml_trap_barrier + +/* **** startup.c */ +#define atom_table caml_atom_table +/* **** asmrun/startup.c */ +#define static_data_start caml_static_data_start +#define static_data_end caml_static_data_end + +/* **** str.c */ +#define string_length caml_string_length + +/* **** sys.c */ +#define sys_error caml_sys_error +#define sys_exit caml_sys_exit + +/* **** terminfo.c */ + +/* **** unix.c & win32.c */ +#define search_exe_in_path caml_search_exe_in_path + +/* **** weak.c */ + +/* **** asmcomp/asmlink.ml */ + +/* **** asmcomp/cmmgen.ml */ + +/* **** asmcomp/asmlink.ml, asmcomp/cmmgen.ml, asmcomp/compilenv.ml */ + +/* ************************************************************* */ + +/* **** otherlibs/bigarray */ +#define int8 caml_ba_int8 +#define uint8 caml_ba_uint8 +#define int16 caml_ba_int16 +#define uint16 caml_ba_uint16 +#define MAX_NUM_DIMS CAML_BA_MAX_NUM_DIMS +#define caml_bigarray_kind caml_ba_kind +#define BIGARRAY_FLOAT32 CAML_BA_FLOAT32 +#define BIGARRAY_FLOAT64 CAML_BA_FLOAT64 +#define BIGARRAY_SINT8 CAML_BA_SINT8 +#define BIGARRAY_UINT8 CAML_BA_UINT8 +#define BIGARRAY_SINT16 CAML_BA_SINT16 +#define BIGARRAY_UINT16 CAML_BA_UINT16 +#define BIGARRAY_INT32 CAML_BA_INT32 +#define BIGARRAY_INT64 CAML_BA_INT64 +#define BIGARRAY_CAML_INT CAML_BA_CAML_INT +#define BIGARRAY_NATIVE_INT CAML_BA_NATIVE_INT +#define BIGARRAY_COMPLEX32 CAML_BA_COMPLEX32 +#define BIGARRAY_COMPLEX64 CAML_BA_COMPLEX64 +#define BIGARRAY_KIND_MASK CAML_BA_KIND_MASK +#define caml_bigarray_layout caml_ba_layout +#define BIGARRAY_C_LAYOUT CAML_BA_C_LAYOUT +#define BIGARRAY_FORTRAN_LAYOUT CAML_BA_FORTRAN_LAYOUT +#define BIGARRAY_LAYOUT_MASK CAML_BA_LAYOUT_MASK +#define caml_bigarray_managed caml_ba_managed +#define BIGARRAY_EXTERNAL CAML_BA_EXTERNAL +#define BIGARRAY_MANAGED CAML_BA_MANAGED +#define BIGARRAY_MAPPED_FILE CAML_BA_MAPPED_FILE +#define BIGARRAY_MANAGED_MASK CAML_BA_MANAGED_MASK +#define caml_bigarray_proxy caml_ba_proxy +#define caml_bigarray caml_ba_array +#define Bigarray_val Caml_ba_array_val +#define Data_bigarray_val Caml_ba_data_val +#define alloc_bigarray caml_ba_alloc +#define alloc_bigarray_dims caml_ba_alloc_dims +#define bigarray_map_file caml_ba_map_file +#define bigarray_unmap_file caml_ba_unmap_file +#define bigarray_element_size caml_ba_element_size +#define bigarray_byte_size caml_ba_byte_size +#define bigarray_deserialize caml_ba_deserialize +#define MAX_BIGARRAY_MEMORY CAML_BA_MAX_MEMORY +#define bigarray_create caml_ba_create +#define bigarray_get_N caml_ba_get_N +#define bigarray_get_1 caml_ba_get_1 +#define bigarray_get_2 caml_ba_get_2 +#define bigarray_get_3 caml_ba_get_3 +#define bigarray_get_generic caml_ba_get_generic +#define bigarray_set_1 caml_ba_set_1 +#define bigarray_set_2 caml_ba_set_2 +#define bigarray_set_3 caml_ba_set_3 +#define bigarray_set_N caml_ba_set_N +#define bigarray_set_generic caml_ba_set_generic +#define bigarray_num_dims caml_ba_num_dims +#define bigarray_dim caml_ba_dim +#define bigarray_kind caml_ba_kind +#define bigarray_layout caml_ba_layout +#define bigarray_slice caml_ba_slice +#define bigarray_sub caml_ba_sub +#define bigarray_blit caml_ba_blit +#define bigarray_fill caml_ba_fill +#define bigarray_reshape caml_ba_reshape +#define bigarray_init caml_ba_init + +#endif /* CAML_NAME_SPACE */ +#endif /* CAML_COMPATIBILITY_H */ diff --git a/test/monniaux/ocaml/byterun/caml/config.h b/test/monniaux/ocaml/byterun/caml/config.h new file mode 100644 index 00000000..06d8d368 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/config.h @@ -0,0 +1,208 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy and Damien Doligez, 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_CONFIG_H +#define CAML_CONFIG_H + +/* <include m.h> */ +/* <include s.h> */ +/* <private> */ +#include "m.h" +#include "s.h" +#ifdef BOOTSTRAPPING_FLEXLINK +#undef SUPPORT_DYNAMIC_LINKING +#endif + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif + +#include <stddef.h> + +#ifdef HAS_STDINT_H +#include <stdint.h> +#endif + +#ifndef ARCH_SIZET_PRINTF_FORMAT +#define ARCH_SIZET_PRINTF_FORMAT "z" +#endif + +/* Types for 32-bit integers, 64-bit integers, and + native integers (as wide as a pointer type) */ + +#ifndef ARCH_INT32_TYPE +#if SIZEOF_INT == 4 +#define ARCH_INT32_TYPE int +#define ARCH_UINT32_TYPE unsigned int +#define ARCH_INT32_PRINTF_FORMAT "" +#elif SIZEOF_LONG == 4 +#define ARCH_INT32_TYPE long +#define ARCH_UINT32_TYPE unsigned long +#define ARCH_INT32_PRINTF_FORMAT "l" +#elif SIZEOF_SHORT == 4 +#define ARCH_INT32_TYPE short +#define ARCH_UINT32_TYPE unsigned short +#define ARCH_INT32_PRINTF_FORMAT "" +#else +#error "No 32-bit integer type available" +#endif +#endif + +#ifndef ARCH_INT64_TYPE +#if SIZEOF_LONG == 8 +#define ARCH_INT64_TYPE long +#define ARCH_UINT64_TYPE unsigned long +#define ARCH_INT64_PRINTF_FORMAT "l" +#elif SIZEOF_LONGLONG == 8 +#define ARCH_INT64_TYPE long long +#define ARCH_UINT64_TYPE unsigned long long +#define ARCH_INT64_PRINTF_FORMAT "ll" +#else +#error "No 64-bit integer type available" +#endif +#endif + +#ifndef HAS_STDINT_H +/* Not a C99 compiler, typically MSVC. Define the C99 types we use. */ +typedef ARCH_INT32_TYPE int32_t; +typedef ARCH_UINT32_TYPE uint32_t; +typedef ARCH_INT64_TYPE int64_t; +typedef ARCH_UINT64_TYPE uint64_t; +#if SIZEOF_SHORT == 2 +typedef short int16_t; +typedef unsigned short uint16_t; +#else +#error "No 16-bit integer type available" +#endif +#endif + +#if SIZEOF_PTR == SIZEOF_LONG +/* Standard models: ILP32 or I32LP64 */ +typedef long intnat; +typedef unsigned long uintnat; +#define ARCH_INTNAT_PRINTF_FORMAT "l" +#elif SIZEOF_PTR == SIZEOF_INT +/* Hypothetical IP32L64 model */ +typedef int intnat; +typedef unsigned int uintnat; +#define ARCH_INTNAT_PRINTF_FORMAT "" +#elif SIZEOF_PTR == 8 +/* Win64 model: IL32P64 */ +typedef int64_t intnat; +typedef uint64_t uintnat; +#define ARCH_INTNAT_PRINTF_FORMAT ARCH_INT64_PRINTF_FORMAT +#else +#error "No integer type available to represent pointers" +#endif + +/* Endianness of floats */ + +/* ARCH_FLOAT_ENDIANNESS encodes the byte order of doubles as follows: + the value [0xabcdefgh] means that the least significant byte of the + float is at byte offset [a], the next lsb at [b], ..., and the + most significant byte at [h]. */ + +#if defined(__arm__) && !defined(__ARM_EABI__) +#define ARCH_FLOAT_ENDIANNESS 0x45670123 +#elif defined(ARCH_BIG_ENDIAN) +#define ARCH_FLOAT_ENDIANNESS 0x76543210 +#else +#define ARCH_FLOAT_ENDIANNESS 0x01234567 +#endif + + +/* We use threaded code interpretation if the compiler provides labels + as first-class values (GCC 2.x). */ + +#if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) \ + && !defined (SHRINKED_GNUC) && !defined(CAML_JIT) +#define THREADED_CODE +#endif + + +/* Memory model parameters */ + +/* The size of a page for memory management (in bytes) is [1 << Page_log]. + [Page_size] must be a multiple of [sizeof (value)]. + [Page_log] must be be >= 8 and <= 20. + Do not change the definition of [Page_size]. */ +#define Page_log 12 /* A page is 4 kilobytes. */ +#define Page_size (1 << Page_log) + +/* Initial size of stack (bytes). */ +#define Stack_size (4096 * sizeof(value)) + +/* Minimum free size of stack (bytes); below that, it is reallocated. */ +#define Stack_threshold (256 * sizeof(value)) + +/* Default maximum size of the stack (words). */ +#define Max_stack_def (1024 * 1024) + + +/* Maximum size of a block allocated in the young generation (words). */ +/* Must be > 4 */ +#define Max_young_wosize 256 +#define Max_young_whsize (Whsize_wosize (Max_young_wosize)) + + +/* Minimum size of the minor zone (words). + This must be at least [2 * Max_young_whsize]. */ +#define Minor_heap_min 4096 + +/* Maximum size of the minor zone (words). + Must be greater than or equal to [Minor_heap_min]. +*/ +#define Minor_heap_max (1 << 28) + +/* Default size of the minor zone. (words) */ +#define Minor_heap_def 16384 + + +/* Minimum size increment when growing the heap (words). + Must be a multiple of [Page_size / sizeof (value)]. */ +#define Heap_chunk_min (15 * Page_size) + +/* Default size increment when growing the heap. + If this is <= 1000, it's a percentage of the current heap size. + If it is > 1000, it's a number of words. */ +#define Heap_chunk_def 15 + +/* Default initial size of the major heap (words); + Must be a multiple of [Page_size / sizeof (value)]. */ +#define Init_heap_def (4 * Page_size) +/* (about 512 kB for a 32-bit platform, 1 MB for a 64-bit platform.) */ + + +/* Default speed setting for the major GC. The heap will grow until + the dead objects and the free list represent this percentage of the + total size of live objects. */ +#define Percent_free_def 80 + +/* Default setting for the compacter: 500% + (i.e. trigger the compacter when 5/6 of the heap is free or garbage) + This can be set quite high because the overhead is over-estimated + when fragmentation occurs. + */ +#define Max_percent_free_def 500 + +/* Default setting for the major GC slice smoothing window: 1 + (i.e. no smoothing) +*/ +#define Major_window_def 1 + +/* Maximum size of the major GC slice smoothing window. */ +#define Max_major_window 50 + +#endif /* CAML_CONFIG_H */ diff --git a/test/monniaux/ocaml/byterun/caml/custom.h b/test/monniaux/ocaml/byterun/caml/custom.h new file mode 100644 index 00000000..6bc3aa95 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/custom.h @@ -0,0 +1,73 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Manuel Serrano and Xavier Leroy, INRIA Rocquencourt */ +/* */ +/* Copyright 2000 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_CUSTOM_H +#define CAML_CUSTOM_H + + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "mlvalues.h" + +struct custom_operations { + char *identifier; + void (*finalize)(value v); + int (*compare)(value v1, value v2); + intnat (*hash)(value v); + void (*serialize)(value v, + /*out*/ uintnat * bsize_32 /*size in bytes*/, + /*out*/ uintnat * bsize_64 /*size in bytes*/); + uintnat (*deserialize)(void * dst); + int (*compare_ext)(value v1, value v2); +}; + +#define custom_finalize_default NULL +#define custom_compare_default NULL +#define custom_hash_default NULL +#define custom_serialize_default NULL +#define custom_deserialize_default NULL +#define custom_compare_ext_default NULL + +#define Custom_ops_val(v) (*((struct custom_operations **) (v))) + +#ifdef __cplusplus +extern "C" { +#endif + + +CAMLextern value caml_alloc_custom(struct custom_operations * ops, + uintnat size, /*size in bytes*/ + mlsize_t mem, /*resources consumed*/ + mlsize_t max /*max resources*/); + +CAMLextern void caml_register_custom_operations(struct custom_operations * ops); + +CAMLextern int caml_compare_unordered; + /* Used by custom comparison to report unordered NaN-like cases. */ + +#ifdef CAML_INTERNALS +extern struct custom_operations * caml_find_custom_operations(char * ident); +extern struct custom_operations * + caml_final_custom_operations(void (*fn)(value)); + +extern void caml_init_custom_operations(void); +#endif /* CAML_INTERNALS */ + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_CUSTOM_H */ diff --git a/test/monniaux/ocaml/byterun/caml/debugger.h b/test/monniaux/ocaml/byterun/caml/debugger.h new file mode 100644 index 00000000..c98f35a8 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/debugger.h @@ -0,0 +1,117 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Interface with the debugger */ + +#ifndef CAML_DEBUGGER_H +#define CAML_DEBUGGER_H + +#ifdef CAML_INTERNALS + +#include "misc.h" +#include "mlvalues.h" + +CAMLextern int caml_debugger_in_use; +CAMLextern int caml_debugger_fork_mode; /* non-zero for parent */ +extern uintnat caml_event_count; + +enum event_kind { + EVENT_COUNT, BREAKPOINT, PROGRAM_START, PROGRAM_EXIT, + TRAP_BARRIER, UNCAUGHT_EXC +}; + +void caml_debugger_init (void); +void caml_debugger (enum event_kind event); +void caml_debugger_cleanup_fork (void); + +/* Communication protocol */ + +/* Requests from the debugger to the runtime system */ + +enum debugger_request { + REQ_SET_EVENT = 'e', /* uint32_t pos */ + /* Set an event on the instruction at position pos */ + REQ_SET_BREAKPOINT = 'B', /* uint32_t pos, (char k) */ + /* Set a breakpoint at position pos */ + /* In profiling mode, the breakpoint kind is set to k */ + REQ_RESET_INSTR = 'i', /* uint32_t pos */ + /* Clear an event or breapoint at position pos, restores initial instr. */ + REQ_CHECKPOINT = 'c', /* no args */ + /* Checkpoint the runtime system by forking a child process. + Reply is pid of child process or -1 if checkpoint failed. */ + REQ_GO = 'g', /* uint32_t n */ + /* Run the program for n events. + Reply is one of debugger_reply described below. */ + REQ_STOP = 's', /* no args */ + /* Terminate the runtime system */ + REQ_WAIT = 'w', /* no args */ + /* Reap one dead child (a discarded checkpoint). */ + REQ_INITIAL_FRAME = '0', /* no args */ + /* Set current frame to bottom frame (the one currently executing). + Reply is stack offset and current pc. */ + REQ_GET_FRAME = 'f', /* no args */ + /* Return current frame location (stack offset + current pc). */ + REQ_SET_FRAME = 'S', /* uint32_t stack_offset */ + /* Set current frame to given stack offset. No reply. */ + REQ_UP_FRAME = 'U', /* uint32_t n */ + /* Move one frame up. Argument n is size of current frame (in words). + Reply is stack offset and current pc, or -1 if top of stack reached. */ + REQ_SET_TRAP_BARRIER = 'b', /* uint32_t offset */ + /* Set the trap barrier at the given offset. */ + REQ_GET_LOCAL = 'L', /* uint32_t slot_number */ + /* Return the local variable at the given slot in the current frame. + Reply is one value. */ + REQ_GET_ENVIRONMENT = 'E', /* uint32_t slot_number */ + /* Return the local variable at the given slot in the heap environment + of the current frame. Reply is one value. */ + REQ_GET_GLOBAL = 'G', /* uint32_t global_number */ + /* Return the specified global variable. Reply is one value. */ + REQ_GET_ACCU = 'A', /* no args */ + /* Return the current contents of the accumulator. Reply is one value. */ + REQ_GET_HEADER = 'H', /* mlvalue v */ + /* As REQ_GET_OBJ, but sends only the header. */ + REQ_GET_FIELD = 'F', /* mlvalue v, uint32_t fieldnum */ + /* As REQ_GET_OBJ, but sends only one field. */ + REQ_MARSHAL_OBJ = 'M', /* mlvalue v */ + /* Send a copy of the data structure rooted at v, using the same + format as [caml_output_value]. */ + REQ_GET_CLOSURE_CODE = 'C', /* mlvalue v */ + /* Send the code address of the given closure. + Reply is one uint32_t. */ + REQ_SET_FORK_MODE = 'K' /* uint32_t m */ + /* Set whether to follow the child (m=0) or the parent on fork. */ +}; + +/* Replies to a REQ_GO request. All replies are followed by three uint32_t: + - the value of the event counter + - the position of the stack + - the current pc. */ + +enum debugger_reply { + REP_EVENT = 'e', + /* Event counter reached 0. */ + REP_BREAKPOINT = 'b', + /* Breakpoint hit. */ + REP_EXITED = 'x', + /* Program exited by calling exit or reaching the end of the source. */ + REP_TRAP = 's', + /* Trap barrier crossed. */ + REP_UNCAUGHT_EXC = 'u' + /* Program exited due to a stray exception. */ +}; + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_DEBUGGER_H */ diff --git a/test/monniaux/ocaml/byterun/caml/dynlink.h b/test/monniaux/ocaml/byterun/caml/dynlink.h new file mode 100644 index 00000000..92f4e235 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/dynlink.h @@ -0,0 +1,46 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2000 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. */ +/* */ +/**************************************************************************/ + +/* Dynamic loading of C primitives. */ + +#ifndef CAML_DYNLINK_H +#define CAML_DYNLINK_H + +#ifdef CAML_INTERNALS + +#include "misc.h" + +/* Build the table of primitives, given a search path, a list + of shared libraries, and a list of primitive names + (all three 0-separated in char arrays). + Abort the runtime system on error. + Calling this frees caml_shared_libs_path (not touching its contents). */ +extern void caml_build_primitive_table(char_os * lib_path, + char_os * libs, + char * req_prims); + +/* The search path for shared libraries */ +extern struct ext_table caml_shared_libs_path; + +/* Build the table of primitives as a copy of the builtin primitive table. + Used for executables generated by ocamlc -output-obj. */ +extern void caml_build_primitive_table_builtin(void); + +/* Unload all the previously loaded shared libraries */ +extern void caml_free_shared_libs(void); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_DYNLINK_H */ diff --git a/test/monniaux/ocaml/byterun/caml/exec.h b/test/monniaux/ocaml/byterun/caml/exec.h new file mode 100644 index 00000000..38ab7ae8 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/exec.h @@ -0,0 +1,65 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* exec.h : format of executable bytecode files */ + +#ifndef CAML_EXEC_H +#define CAML_EXEC_H + +#ifdef CAML_INTERNALS + +/* Executable bytecode files are composed of a number of sections, + identified by 4-character names. A table of contents at the + end of the file lists the section names along with their sizes, + in the order in which they appear in the file: + + offset 0 ---> initial junk + data for section 1 + data for section 2 + ... + data for section N + table of contents: + descriptor for section 1 + ... + descriptor for section N + trailer + end of file ---> +*/ + +/* Structure of t.o.c. entries + Numerical quantities are 32-bit unsigned integers, big endian */ + +struct section_descriptor { + char name[4]; /* Section name */ + uint32_t len; /* Length of data in bytes */ +}; + +/* Structure of the trailer. */ + +struct exec_trailer { + uint32_t num_sections; /* Number of sections */ + char magic[12]; /* The magic number */ + struct section_descriptor * section; /* Not part of file */ +}; + +#define TRAILER_SIZE (4+12) + +/* Magic number for this release */ + +#define EXEC_MAGIC "Caml1999X023" + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_EXEC_H */ diff --git a/test/monniaux/ocaml/byterun/caml/fail.h b/test/monniaux/ocaml/byterun/caml/fail.h new file mode 100644 index 00000000..54907e42 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/fail.h @@ -0,0 +1,144 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_FAIL_H +#define CAML_FAIL_H + +#ifdef CAML_INTERNALS +#include <setjmp.h> +#endif /* CAML_INTERNALS */ + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "misc.h" +#include "mlvalues.h" + +#ifdef CAML_INTERNALS +#define OUT_OF_MEMORY_EXN 0 /* "Out_of_memory" */ +#define SYS_ERROR_EXN 1 /* "Sys_error" */ +#define FAILURE_EXN 2 /* "Failure" */ +#define INVALID_EXN 3 /* "Invalid_argument" */ +#define END_OF_FILE_EXN 4 /* "End_of_file" */ +#define ZERO_DIVIDE_EXN 5 /* "Division_by_zero" */ +#define NOT_FOUND_EXN 6 /* "Not_found" */ +#define MATCH_FAILURE_EXN 7 /* "Match_failure" */ +#define STACK_OVERFLOW_EXN 8 /* "Stack_overflow" */ +#define SYS_BLOCKED_IO 9 /* "Sys_blocked_io" */ +#define ASSERT_FAILURE_EXN 10 /* "Assert_failure" */ +#define UNDEFINED_RECURSIVE_MODULE_EXN 11 /* "Undefined_recursive_module" */ + +#ifdef POSIX_SIGNALS +struct longjmp_buffer { + sigjmp_buf buf; +}; +#elif defined(__MINGW64__) && defined(__GNUC__) && __GNUC__ >= 4 +/* MPR#7638: issues with setjmp/longjmp in Mingw64, use GCC builtins instead */ +struct longjmp_buffer { + intptr_t buf[5]; +}; +#define sigsetjmp(buf,save) __builtin_setjmp(buf) +#define siglongjmp(buf,val) __builtin_longjmp(buf,val) +#else +struct longjmp_buffer { + jmp_buf buf; +}; +#define sigsetjmp(buf,save) setjmp(buf) +#define siglongjmp(buf,val) longjmp(buf,val) +#endif + +CAMLextern struct longjmp_buffer * caml_external_raise; +extern value caml_exn_bucket; +int caml_is_special_exception(value exn); + +#endif /* CAML_INTERNALS */ + +#ifdef __cplusplus +extern "C" { +#endif + +CAMLnoreturn_start +CAMLextern void caml_raise (value bucket) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_constant (value tag) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_with_arg (value tag, value arg) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_with_args (value tag, int nargs, value arg[]) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_with_string (value tag, char const * msg) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_failwith (char const *msg) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_failwith_value (value msg) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_invalid_argument (char const *msg) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_invalid_argument_value (value msg) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_out_of_memory (void) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_stack_overflow (void) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_sys_error (value) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_end_of_file (void) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_zero_divide (void) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_not_found (void) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_array_bound_error (void) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_raise_sys_blocked_io (void) +CAMLnoreturn_end; + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_FAIL_H */ diff --git a/test/monniaux/ocaml/byterun/caml/finalise.h b/test/monniaux/ocaml/byterun/caml/finalise.h new file mode 100644 index 00000000..5315ac21 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/finalise.h @@ -0,0 +1,36 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Moscova, INRIA Rocquencourt */ +/* */ +/* Copyright 2000 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_FINALISE_H +#define CAML_FINALISE_H + +#ifdef CAML_INTERNALS + +#include "roots.h" + +void caml_final_update_mark_phase (void); +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_empty_young (void); +void caml_final_update_minor_roots(void); +value caml_final_register (value f, value v); +void caml_final_invariant_check(void); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_FINALISE_H */ diff --git a/test/monniaux/ocaml/byterun/caml/fix_code.h b/test/monniaux/ocaml/byterun/caml/fix_code.h new file mode 100644 index 00000000..7e5633d6 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/fix_code.h @@ -0,0 +1,45 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Handling of blocks of bytecode (endianness switch, threading). */ + +#ifndef CAML_FIX_CODE_H +#define CAML_FIX_CODE_H + +#ifdef CAML_INTERNALS + +#include "config.h" +#include "misc.h" +#include "mlvalues.h" + +extern code_t caml_start_code; +extern asize_t caml_code_size; +extern unsigned char * caml_saved_code; + +void caml_init_code_fragments(void); +void caml_load_code (int fd, asize_t len); +void caml_fixup_endianness (code_t code, asize_t len); +void caml_set_instruction (code_t pos, opcode_t instr); +int caml_is_instruction (opcode_t instr1, opcode_t instr2); + +#ifdef THREADED_CODE +extern char ** caml_instr_table; +extern char * caml_instr_base; +void caml_thread_code (code_t code, asize_t len); +#endif + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_FIX_CODE_H */ diff --git a/test/monniaux/ocaml/byterun/caml/freelist.h b/test/monniaux/ocaml/byterun/caml/freelist.h new file mode 100644 index 00000000..54e0e822 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/freelist.h @@ -0,0 +1,38 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, 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. */ +/* */ +/**************************************************************************/ + +/* Free lists of heap blocks. */ + +#ifndef CAML_FREELIST_H +#define CAML_FREELIST_H + +#ifdef CAML_INTERNALS + +#include "misc.h" +#include "mlvalues.h" + +extern asize_t caml_fl_cur_wsz; + +header_t *caml_fl_allocate (mlsize_t wo_sz); +void caml_fl_init_merge (void); +void caml_fl_reset (void); +header_t *caml_fl_merge_block (value); +void caml_fl_add_blocks (value); +void caml_make_free_blocks (value *, mlsize_t wsz, int, int); +void caml_set_allocation_policy (uintnat); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_FREELIST_H */ diff --git a/test/monniaux/ocaml/byterun/caml/gc.h b/test/monniaux/ocaml/byterun/caml/gc.h new file mode 100644 index 00000000..a646a756 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/gc.h @@ -0,0 +1,79 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_GC_H +#define CAML_GC_H + + +#include "mlvalues.h" + +#define Caml_white (0 << 8) +#define Caml_gray (1 << 8) +#define Caml_blue (2 << 8) +#define Caml_black (3 << 8) + +#define Color_hd(hd) ((color_t) ((hd) & Caml_black)) +#define Color_hp(hp) (Color_hd (Hd_hp (hp))) +#define Color_val(val) (Color_hd (Hd_val (val))) + +#define Is_white_hd(hd) (Color_hd (hd) == Caml_white) +#define Is_gray_hd(hd) (Color_hd (hd) == Caml_gray) +#define Is_blue_hd(hd) (Color_hd (hd) == Caml_blue) +#define Is_black_hd(hd) (Color_hd (hd) == Caml_black) + +#define Whitehd_hd(hd) (((hd) & ~Caml_black)/*| Caml_white*/) +#define Grayhd_hd(hd) (((hd) & ~Caml_black) | Caml_gray) +#define Blackhd_hd(hd) (((hd)/*& ~Caml_black*/)| Caml_black) +#define Bluehd_hd(hd) (((hd) & ~Caml_black) | Caml_blue) + +/* This depends on the layout of the header. See [mlvalues.h]. */ +#define Make_header(wosize, tag, color) \ + (/*CAMLassert ((wosize) <= Max_wosize),*/ \ + ((header_t) (((header_t) (wosize) << 10) \ + + (color) \ + + (tag_t) (tag))) \ + ) + +#ifdef WITH_PROFINFO +#define Make_header_with_profinfo(wosize, tag, color, profinfo) \ + (Make_header(wosize, tag, color) \ + | ((((intnat) profinfo) & PROFINFO_MASK) << PROFINFO_SHIFT) \ + ) +#else +#define Make_header_with_profinfo(wosize, tag, color, profinfo) \ + Make_header(wosize, tag, color) +#endif + +#ifdef WITH_SPACETIME +struct ext_table; +extern uintnat caml_spacetime_my_profinfo(struct ext_table**, uintnat); +#define Make_header_allocated_here(wosize, tag, color) \ + (Make_header_with_profinfo(wosize, tag, color, \ + caml_spacetime_my_profinfo(NULL, wosize)) \ + ) +#else +#define Make_header_allocated_here Make_header +#endif + +#define Is_white_val(val) (Color_val(val) == Caml_white) +#define Is_gray_val(val) (Color_val(val) == Caml_gray) +#define Is_blue_val(val) (Color_val(val) == Caml_blue) +#define Is_black_val(val) (Color_val(val) == Caml_black) + +/* For extern.c */ +#define Colornum_hd(hd) ((color_t) (((hd) >> 8) & 3)) +#define Coloredhd_hd(hd,colnum) (((hd) & ~Caml_black) | ((colnum) << 8)) + +#endif /* CAML_GC_H */ diff --git a/test/monniaux/ocaml/byterun/caml/gc_ctrl.h b/test/monniaux/ocaml/byterun/caml/gc_ctrl.h new file mode 100644 index 00000000..ebf1a40b --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/gc_ctrl.h @@ -0,0 +1,58 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_GC_CTRL_H +#define CAML_GC_CTRL_H + +#ifdef CAML_INTERNALS + +#include "misc.h" + +extern double + caml_stat_minor_words, + caml_stat_promoted_words, + caml_stat_major_words; + +extern intnat + caml_stat_minor_collections, + caml_stat_major_collections, + caml_stat_heap_wsz, + caml_stat_top_heap_wsz, + caml_stat_compactions, + caml_stat_heap_chunks; + +uintnat caml_normalize_heap_increment (uintnat); + +/* + minor_size: cf. minor_heap_size in gc.mli + major_size: Size in words of the initial major heap + major_incr: cf. major_heap_increment in gc.mli + percent_fr: cf. space_overhead in gc.mli + percent_m : cf. max_overhead in gc.mli + window : cf. window_size in gc.mli +*/ +void caml_init_gc (uintnat minor_size, uintnat major_size, uintnat major_incr, + uintnat percent_fr, uintnat percent_m, uintnat window); + + +CAMLextern value caml_gc_stat(value v); + +#ifdef DEBUG +void caml_heap_check (void); +#endif + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_GC_CTRL_H */ diff --git a/test/monniaux/ocaml/byterun/caml/globroots.h b/test/monniaux/ocaml/byterun/caml/globroots.h new file mode 100644 index 00000000..10fe66f5 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/globroots.h @@ -0,0 +1,31 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2001 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. */ +/* */ +/**************************************************************************/ + +/* Registration of global memory roots */ + +#ifndef CAML_GLOBROOTS_H +#define CAML_GLOBROOTS_H + +#ifdef CAML_INTERNALS + +#include "mlvalues.h" +#include "roots.h" + +void caml_scan_global_roots(scanning_action f); +void caml_scan_global_young_roots(scanning_action f); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_GLOBROOTS_H */ diff --git a/test/monniaux/ocaml/byterun/caml/hash.h b/test/monniaux/ocaml/byterun/caml/hash.h new file mode 100644 index 00000000..fcc7589f --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/hash.h @@ -0,0 +1,39 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ +/* */ +/* Copyright 2011 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. */ +/* */ +/**************************************************************************/ + +/* Auxiliary functions for custom hash functions */ + +#ifndef CAML_HASH_H +#define CAML_HASH_H + +#include "mlvalues.h" + +#ifdef __cplusplus +extern "C" { +#endif + +CAMLextern uint32_t caml_hash_mix_uint32(uint32_t h, uint32_t d); +CAMLextern uint32_t caml_hash_mix_intnat(uint32_t h, intnat d); +CAMLextern uint32_t caml_hash_mix_int64(uint32_t h, int64_t d); +CAMLextern uint32_t caml_hash_mix_double(uint32_t h, double d); +CAMLextern uint32_t caml_hash_mix_float(uint32_t h, float d); +CAMLextern uint32_t caml_hash_mix_string(uint32_t h, value s); + +#ifdef __cplusplus +} +#endif + + +#endif /* CAML_HASH_H */ diff --git a/test/monniaux/ocaml/byterun/caml/hooks.h b/test/monniaux/ocaml/byterun/caml/hooks.h new file mode 100644 index 00000000..5877dd25 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/hooks.h @@ -0,0 +1,42 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Fabrice Le Fessant, INRIA de Paris */ +/* */ +/* Copyright 2016 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_HOOKS_H +#define CAML_HOOKS_H + +#include "misc.h" +#include "memory.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef CAML_INTERNALS + +#ifdef NATIVE_CODE + +/* executed just before calling the entry point of a dynamically + loaded native code module. */ +CAMLextern void (*caml_natdynlink_hook)(void* handle, const char* unit); + +#endif /* NATIVE_CODE */ + +#endif /* CAML_INTERNALS */ + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_HOOKS_H */ diff --git a/test/monniaux/ocaml/byterun/caml/instrtrace.h b/test/monniaux/ocaml/byterun/caml/instrtrace.h new file mode 100644 index 00000000..2e42a80a --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/instrtrace.h @@ -0,0 +1,35 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Trace the instructions executed */ + +#ifndef _instrtrace_ +#define _instrtrace_ + +#ifdef CAML_INTERNALS + +#include "mlvalues.h" +#include "misc.h" + +extern intnat caml_icount; +void caml_stop_here (void); +void caml_disasm_instr (code_t pc); +void caml_trace_value_file (value v, code_t prog, int proglen, FILE * f); +void caml_trace_accu_sp_file(value accu, value * sp, code_t prog, int proglen, + FILE * f); + +#endif /* CAML_INTERNALS */ + +#endif diff --git a/test/monniaux/ocaml/byterun/caml/instruct.h b/test/monniaux/ocaml/byterun/caml/instruct.h new file mode 100644 index 00000000..5c10df4f --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/instruct.h @@ -0,0 +1,68 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* The instruction set. */ + +#ifndef CAML_INSTRUCT_H +#define CAML_INSTRUCT_H + +#ifdef CAML_INTERNALS + +enum 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}; + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_INSTRUCT_H */ diff --git a/test/monniaux/ocaml/byterun/caml/int64_emul.h b/test/monniaux/ocaml/byterun/caml/int64_emul.h new file mode 100644 index 00000000..c1cddcc0 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/int64_emul.h @@ -0,0 +1,293 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 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. */ +/* */ +/**************************************************************************/ + +/* Software emulation of 64-bit integer arithmetic, for C compilers + that do not support it. */ + +#ifndef CAML_INT64_EMUL_H +#define CAML_INT64_EMUL_H + +#ifdef CAML_INTERNALS + +#include <math.h> + +#ifdef ARCH_BIG_ENDIAN +#define I64_literal(hi,lo) { hi, lo } +#else +#define I64_literal(hi,lo) { lo, hi } +#endif + +#define I64_split(x,hi,lo) (hi = (x).h, lo = (x).l) + +/* Unsigned comparison */ +static int I64_ucompare(uint64_t x, uint64_t y) +{ + if (x.h > y.h) return 1; + if (x.h < y.h) return -1; + if (x.l > y.l) return 1; + if (x.l < y.l) return -1; + return 0; +} + +#define I64_ult(x, y) (I64_ucompare(x, y) < 0) + +/* Signed comparison */ +static int I64_compare(int64_t x, int64_t y) +{ + if ((int32_t)x.h > (int32_t)y.h) return 1; + if ((int32_t)x.h < (int32_t)y.h) return -1; + if (x.l > y.l) return 1; + if (x.l < y.l) return -1; + return 0; +} + +/* Negation */ +static int64_t I64_neg(int64_t x) +{ + int64_t res; + res.l = -x.l; + res.h = ~x.h; + if (res.l == 0) res.h++; + return res; +} + +/* Addition */ +static int64_t I64_add(int64_t x, int64_t y) +{ + int64_t res; + res.l = x.l + y.l; + res.h = x.h + y.h; + if (res.l < x.l) res.h++; + return res; +} + +/* Subtraction */ +static int64_t I64_sub(int64_t x, int64_t y) +{ + int64_t res; + res.l = x.l - y.l; + res.h = x.h - y.h; + if (x.l < y.l) res.h--; + return res; +} + +/* Multiplication */ +static int64_t I64_mul(int64_t x, int64_t y) +{ + int64_t res; + uint32_t prod00 = (x.l & 0xFFFF) * (y.l & 0xFFFF); + uint32_t prod10 = (x.l >> 16) * (y.l & 0xFFFF); + uint32_t prod01 = (x.l & 0xFFFF) * (y.l >> 16); + uint32_t prod11 = (x.l >> 16) * (y.l >> 16); + res.l = prod00; + res.h = prod11 + (prod01 >> 16) + (prod10 >> 16); + prod01 = prod01 << 16; res.l += prod01; if (res.l < prod01) res.h++; + prod10 = prod10 << 16; res.l += prod10; if (res.l < prod10) res.h++; + res.h += x.l * y.h + x.h * y.l; + return res; +} + +#define I64_is_zero(x) (((x).l | (x).h) == 0) +#define I64_is_negative(x) ((int32_t) (x).h < 0) +#define I64_is_min_int(x) ((x).l == 0 && (x).h == 0x80000000U) +#define I64_is_minus_one(x) (((x).l & (x).h) == 0xFFFFFFFFU) + +/* Bitwise operations */ +static int64_t I64_and(int64_t x, int64_t y) +{ + int64_t res; + res.l = x.l & y.l; + res.h = x.h & y.h; + return res; +} + +static int64_t I64_or(int64_t x, int64_t y) +{ + int64_t res; + res.l = x.l | y.l; + res.h = x.h | y.h; + return res; +} + +static int64_t I64_xor(int64_t x, int64_t y) +{ + int64_t res; + res.l = x.l ^ y.l; + res.h = x.h ^ y.h; + return res; +} + +/* Shifts */ +static int64_t I64_lsl(int64_t x, int s) +{ + int64_t res; + s = s & 63; + if (s == 0) return x; + if (s < 32) { + res.l = x.l << s; + res.h = (x.h << s) | (x.l >> (32 - s)); + } else { + res.l = 0; + res.h = x.l << (s - 32); + } + return res; +} + +static int64_t I64_lsr(int64_t x, int s) +{ + int64_t res; + s = s & 63; + if (s == 0) return x; + if (s < 32) { + res.l = (x.l >> s) | (x.h << (32 - s)); + res.h = x.h >> s; + } else { + res.l = x.h >> (s - 32); + res.h = 0; + } + return res; +} + +static int64_t I64_asr(int64_t x, int s) +{ + int64_t res; + s = s & 63; + if (s == 0) return x; + if (s < 32) { + res.l = (x.l >> s) | (x.h << (32 - s)); + res.h = (int32_t) x.h >> s; + } else { + res.l = (int32_t) x.h >> (s - 32); + res.h = (int32_t) x.h >> 31; + } + return res; +} + +/* Division and modulus */ + +#define I64_SHL1(x) x.h = (x.h << 1) | (x.l >> 31); x.l <<= 1 +#define I64_SHR1(x) x.l = (x.l >> 1) | (x.h << 31); x.h >>= 1 + +static void I64_udivmod(uint64_t modulus, uint64_t divisor, + uint64_t * quo, uint64_t * mod) +{ + int64_t quotient, mask; + int cmp; + + quotient.h = 0; quotient.l = 0; + mask.h = 0; mask.l = 1; + while ((int32_t) divisor.h >= 0) { + cmp = I64_ucompare(divisor, modulus); + I64_SHL1(divisor); + I64_SHL1(mask); + if (cmp >= 0) break; + } + while (mask.l | mask.h) { + if (I64_ucompare(modulus, divisor) >= 0) { + quotient.h |= mask.h; quotient.l |= mask.l; + modulus = I64_sub(modulus, divisor); + } + I64_SHR1(mask); + I64_SHR1(divisor); + } + *quo = quotient; + *mod = modulus; +} + +static int64_t I64_div(int64_t x, int64_t y) +{ + int64_t q, r; + int32_t sign; + + sign = x.h ^ y.h; + if ((int32_t) x.h < 0) x = I64_neg(x); + if ((int32_t) y.h < 0) y = I64_neg(y); + I64_udivmod(x, y, &q, &r); + if (sign < 0) q = I64_neg(q); + return q; +} + +static int64_t I64_mod(int64_t x, int64_t y) +{ + int64_t q, r; + int32_t sign; + + sign = x.h; + if ((int32_t) x.h < 0) x = I64_neg(x); + if ((int32_t) y.h < 0) y = I64_neg(y); + I64_udivmod(x, y, &q, &r); + if (sign < 0) r = I64_neg(r); + return r; +} + +/* Coercions */ + +static int64_t I64_of_int32(int32_t x) +{ + int64_t res; + res.l = x; + res.h = x >> 31; + return res; +} + +#define I64_to_int32(x) ((int32_t) (x).l) + +/* Note: we assume sizeof(intnat) = 4 here, which is true otherwise + autoconfiguration would have selected native 64-bit integers */ +#define I64_of_intnat I64_of_int32 +#define I64_to_intnat I64_to_int32 + +static double I64_to_double(int64_t x) +{ + double res; + int32_t sign = x.h; + if (sign < 0) x = I64_neg(x); + res = ldexp((double) x.h, 32) + x.l; + if (sign < 0) res = -res; + return res; +} + +static int64_t I64_of_double(double f) +{ + int64_t res; + double frac, integ; + int neg; + + neg = (f < 0); + f = fabs(f); + frac = modf(ldexp(f, -32), &integ); + res.h = (uint32_t) integ; + res.l = (uint32_t) ldexp(frac, 32); + if (neg) res = I64_neg(res); + return res; +} + +static int64_t I64_bswap(int64_t x) +{ + int64_t res; + res.h = (((x.l & 0x000000FF) << 24) | + ((x.l & 0x0000FF00) << 8) | + ((x.l & 0x00FF0000) >> 8) | + ((x.l & 0xFF000000) >> 24)); + res.l = (((x.h & 0x000000FF) << 24) | + ((x.h & 0x0000FF00) << 8) | + ((x.h & 0x00FF0000) >> 8) | + ((x.h & 0xFF000000) >> 24)); + return res; +} + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_INT64_EMUL_H */ diff --git a/test/monniaux/ocaml/byterun/caml/int64_format.h b/test/monniaux/ocaml/byterun/caml/int64_format.h new file mode 100644 index 00000000..40250ed9 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/int64_format.h @@ -0,0 +1,111 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 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. */ +/* */ +/**************************************************************************/ + +/* printf-like formatting of 64-bit integers, in case the C library + printf() function does not support them. */ + +#ifndef CAML_INT64_FORMAT_H +#define CAML_INT64_FORMAT_H + +#ifdef CAML_INTERNALS + +static void I64_format(char * buffer, char * fmt, int64_t x) +{ + static char conv_lower[] = "0123456789abcdef"; + static char conv_upper[] = "0123456789ABCDEF"; + char rawbuffer[24]; + char justify, signstyle, filler, alternate, signedconv; + int base, width, sign, i, rawlen; + char * cvtbl; + char * p, * r; + int64_t wbase, digit; + + /* Parsing of format */ + justify = '+'; + signstyle = '-'; + filler = ' '; + alternate = 0; + base = 0; + signedconv = 0; + width = 0; + cvtbl = conv_lower; + for (p = fmt; *p != 0; p++) { + switch (*p) { + case '-': + justify = '-'; break; + case '+': case ' ': + signstyle = *p; break; + case '0': + filler = '0'; break; + case '#': + alternate = 1; break; + case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + width = atoi(p); + while (p[1] >= '0' && p[1] <= '9') p++; + break; + case 'd': case 'i': + signedconv = 1; /* fallthrough */ + case 'u': + base = 10; break; + case 'x': + base = 16; break; + case 'X': + base = 16; cvtbl = conv_upper; break; + case 'o': + base = 8; break; + } + } + if (base == 0) { buffer[0] = 0; return; } + /* Do the conversion */ + sign = 1; + if (signedconv && I64_is_negative(x)) { sign = -1; x = I64_neg(x); } + r = rawbuffer + sizeof(rawbuffer); + wbase = I64_of_int32(base); + do { + I64_udivmod(x, wbase, &x, &digit); + *--r = cvtbl[I64_to_int32(digit)]; + } while (! I64_is_zero(x)); + rawlen = rawbuffer + sizeof(rawbuffer) - r; + /* Adjust rawlen to reflect additional chars (sign, etc) */ + if (signedconv && (sign < 0 || signstyle != '-')) rawlen++; + if (alternate) { + if (base == 8) rawlen += 1; + if (base == 16) rawlen += 2; + } + /* Do the formatting */ + p = buffer; + if (justify == '+' && filler == ' ') { + for (i = rawlen; i < width; i++) *p++ = ' '; + } + if (signedconv) { + if (sign < 0) *p++ = '-'; + else if (signstyle != '-') *p++ = signstyle; + } + if (alternate && base == 8) *p++ = '0'; + if (alternate && base == 16) { *p++ = '0'; *p++ = 'x'; } + if (justify == '+' && filler == '0') { + for (i = rawlen; i < width; i++) *p++ = '0'; + } + while (r < rawbuffer + sizeof(rawbuffer)) *p++ = *r++; + if (justify == '-') { + for (i = rawlen; i < width; i++) *p++ = ' '; + } + *p = 0; +} + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_INT64_FORMAT_H */ diff --git a/test/monniaux/ocaml/byterun/caml/int64_native.h b/test/monniaux/ocaml/byterun/caml/int64_native.h new file mode 100644 index 00000000..7df66511 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/int64_native.h @@ -0,0 +1,67 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 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. */ +/* */ +/**************************************************************************/ + +/* Wrapper macros around native 64-bit integer arithmetic, + so that it has the same interface as the software emulation + provided in int64_emul.h */ + +#ifndef CAML_INT64_NATIVE_H +#define CAML_INT64_NATIVE_H + +#ifdef CAML_INTERNALS + +#define I64_literal(hi,lo) ((int64_t)(hi) << 32 | (lo)) +#define I64_split(x,hi,lo) (hi = (uint32_t)((x)>>32), lo = (uint32_t)(x)) +#define I64_compare(x,y) (((x) > (y)) - ((x) < (y))) +#define I64_ult(x,y) ((uint64_t)(x) < (uint64_t)(y)) +#define I64_neg(x) (-(x)) +#define I64_add(x,y) ((x) + (y)) +#define I64_sub(x,y) ((x) - (y)) +#define I64_mul(x,y) ((x) * (y)) +#define I64_is_zero(x) ((x) == 0) +#define I64_is_negative(x) ((x) < 0) +#define I64_is_min_int(x) ((x) == ((int64_t)1 << 63)) +#define I64_is_minus_one(x) ((x) == -1) + +#define I64_div(x,y) ((x) / (y)) +#define I64_mod(x,y) ((x) % (y)) +#define I64_udivmod(x,y,quo,rem) \ + (*(rem) = (uint64_t)(x) % (uint64_t)(y), \ + *(quo) = (uint64_t)(x) / (uint64_t)(y)) +#define I64_and(x,y) ((x) & (y)) +#define I64_or(x,y) ((x) | (y)) +#define I64_xor(x,y) ((x) ^ (y)) +#define I64_lsl(x,y) ((x) << (y)) +#define I64_asr(x,y) ((x) >> (y)) +#define I64_lsr(x,y) ((uint64_t)(x) >> (y)) +#define I64_to_intnat(x) ((intnat) (x)) +#define I64_of_intnat(x) ((intnat) (x)) +#define I64_to_int32(x) ((int32_t) (x)) +#define I64_of_int32(x) ((int64_t) (x)) +#define I64_to_double(x) ((double)(x)) +#define I64_of_double(x) ((int64_t)(x)) + +#define I64_bswap(x) ((((x) & 0x00000000000000FFULL) << 56) | \ + (((x) & 0x000000000000FF00ULL) << 40) | \ + (((x) & 0x0000000000FF0000ULL) << 24) | \ + (((x) & 0x00000000FF000000ULL) << 8) | \ + (((x) & 0x000000FF00000000ULL) >> 8) | \ + (((x) & 0x0000FF0000000000ULL) >> 24) | \ + (((x) & 0x00FF000000000000ULL) >> 40) | \ + (((x) & 0xFF00000000000000ULL) >> 56)) + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_INT64_NATIVE_H */ diff --git a/test/monniaux/ocaml/byterun/caml/interp.h b/test/monniaux/ocaml/byterun/caml/interp.h new file mode 100644 index 00000000..d1ebdc01 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/interp.h @@ -0,0 +1,37 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* The bytecode interpreter */ + +#ifndef CAML_INTERP_H +#define CAML_INTERP_H + +#ifdef CAML_INTERNALS + +#include "misc.h" +#include "mlvalues.h" + +/* interpret a bytecode */ +value caml_interprete (code_t prog, asize_t prog_size); + +/* tell the runtime that a bytecode program might be needed */ +void caml_prepare_bytecode(code_t prog, asize_t prog_size); + +/* tell the runtime that a bytecode program is no more needed */ +void caml_release_bytecode(code_t prog, asize_t prog_size); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_INTERP_H */ diff --git a/test/monniaux/ocaml/byterun/caml/intext.h b/test/monniaux/ocaml/byterun/caml/intext.h new file mode 100644 index 00000000..f67c98b5 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/intext.h @@ -0,0 +1,207 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Structured input/output */ + +#ifndef CAML_INTEXT_H +#define CAML_INTEXT_H + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "misc.h" +#include "mlvalues.h" + +#ifdef CAML_INTERNALS +#include "io.h" + +/* Magic number */ + +#define Intext_magic_number_small 0x8495A6BE +#define Intext_magic_number_big 0x8495A6BF + +/* Header format for the "small" model: 20 bytes + 0 "small" magic number + 4 length of marshaled data, in bytes + 8 number of shared blocks + 12 size in words when read on a 32-bit platform + 16 size in words when read on a 64-bit platform + The 4 numbers are 32 bits each, in big endian. + + Header format for the "big" model: 32 bytes + 0 "big" magic number + 4 four reserved bytes, currently set to 0 + 8 length of marshaled data, in bytes + 16 number of shared blocks + 24 size in words when read on a 64-bit platform + The 3 numbers are 64 bits each, in big endian. +*/ + +/* Codes for the compact format */ + +#define PREFIX_SMALL_BLOCK 0x80 +#define PREFIX_SMALL_INT 0x40 +#define PREFIX_SMALL_STRING 0x20 +#define CODE_INT8 0x0 +#define CODE_INT16 0x1 +#define CODE_INT32 0x2 +#define CODE_INT64 0x3 +#define CODE_SHARED8 0x4 +#define CODE_SHARED16 0x5 +#define CODE_SHARED32 0x6 +#define CODE_SHARED64 0x14 +#define CODE_BLOCK32 0x8 +#define CODE_BLOCK64 0x13 +#define CODE_STRING8 0x9 +#define CODE_STRING32 0xA +#define CODE_STRING64 0x15 +#define CODE_DOUBLE_BIG 0xB +#define CODE_DOUBLE_LITTLE 0xC +#define CODE_DOUBLE_ARRAY8_BIG 0xD +#define CODE_DOUBLE_ARRAY8_LITTLE 0xE +#define CODE_DOUBLE_ARRAY32_BIG 0xF +#define CODE_DOUBLE_ARRAY32_LITTLE 0x7 +#define CODE_DOUBLE_ARRAY64_BIG 0x16 +#define CODE_DOUBLE_ARRAY64_LITTLE 0x17 +#define CODE_CODEPOINTER 0x10 +#define CODE_INFIXPOINTER 0x11 +#define CODE_CUSTOM 0x12 + +#if ARCH_FLOAT_ENDIANNESS == 0x76543210 +#define CODE_DOUBLE_NATIVE CODE_DOUBLE_BIG +#define CODE_DOUBLE_ARRAY8_NATIVE CODE_DOUBLE_ARRAY8_BIG +#define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_BIG +#define CODE_DOUBLE_ARRAY64_NATIVE CODE_DOUBLE_ARRAY64_BIG +#else +#define CODE_DOUBLE_NATIVE CODE_DOUBLE_LITTLE +#define CODE_DOUBLE_ARRAY8_NATIVE CODE_DOUBLE_ARRAY8_LITTLE +#define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_LITTLE +#define CODE_DOUBLE_ARRAY64_NATIVE CODE_DOUBLE_ARRAY64_LITTLE +#endif + +/* Size-ing data structures for extern. Chosen so that + sizeof(struct trail_block) and sizeof(struct output_block) + are slightly below 8Kb. */ + +#define ENTRIES_PER_TRAIL_BLOCK 1025 +#define SIZE_EXTERN_OUTPUT_BLOCK 8100 + +/* The entry points */ + +void caml_output_val (struct channel * chan, value v, value flags); + /* Output [v] with flags [flags] on the channel [chan]. */ + +#endif /* CAML_INTERNALS */ + +#ifdef __cplusplus +extern "C" { +#endif + +CAMLextern void caml_output_value_to_malloc(value v, value flags, + /*out*/ char ** buf, + /*out*/ intnat * len); + /* Output [v] with flags [flags] to a memory buffer allocated with + malloc. On return, [*buf] points to the buffer and [*len] + contains the number of bytes in buffer. */ +CAMLextern intnat caml_output_value_to_block(value v, value flags, + char * data, intnat len); + /* Output [v] with flags [flags] to a user-provided memory buffer. + [data] points to the start of this buffer, and [len] is its size + in bytes. Return the number of bytes actually written in buffer. + Raise [Failure] if buffer is too short. */ + +#ifdef CAML_INTERNALS +value caml_input_val (struct channel * chan); + /* Read a structured value from the channel [chan]. */ + +extern value caml_input_value_to_outside_heap (value channel); + /* As for [caml_input_value], but the value is unmarshalled into + malloc blocks that are not added to the heap. Not for the + casual user. */ + +extern int caml_extern_allow_out_of_heap; + /* Permit the marshaller to traverse structures that look like OCaml + values but do not live in the OCaml heap. */ + +extern value caml_output_value(value vchan, value v, value flags); +#endif /* CAML_INTERNALS */ + +CAMLextern value caml_input_val_from_string (value str, intnat ofs); + /* Read a structured value from the OCaml string [str], starting + at offset [ofs]. */ +CAMLextern value caml_input_value_from_malloc(char * data, intnat ofs); + /* Read a structured value from a malloced buffer. [data] points + to the beginning of the buffer, and [ofs] is the offset of the + beginning of the externed data in this buffer. The buffer is + deallocated with [free] on return, or if an exception is raised. */ +CAMLextern value caml_input_value_from_block(char * data, intnat len); + /* Read a structured value from a user-provided buffer. [data] points + to the beginning of the externed data in this buffer, + and [len] is the length in bytes of valid data in this buffer. + The buffer is never deallocated by this routine. */ + +/* Functions for writing user-defined marshallers */ + +CAMLextern void caml_serialize_int_1(int i); +CAMLextern void caml_serialize_int_2(int i); +CAMLextern void caml_serialize_int_4(int32_t i); +CAMLextern void caml_serialize_int_8(int64_t i); +CAMLextern void caml_serialize_float_4(float f); +CAMLextern void caml_serialize_float_8(double f); +CAMLextern void caml_serialize_block_1(void * data, intnat len); +CAMLextern void caml_serialize_block_2(void * data, intnat len); +CAMLextern void caml_serialize_block_4(void * data, intnat len); +CAMLextern void caml_serialize_block_8(void * data, intnat len); +CAMLextern void caml_serialize_block_float_8(void * data, intnat len); + +CAMLextern int caml_deserialize_uint_1(void); +CAMLextern int caml_deserialize_sint_1(void); +CAMLextern int caml_deserialize_uint_2(void); +CAMLextern int caml_deserialize_sint_2(void); +CAMLextern uint32_t caml_deserialize_uint_4(void); +CAMLextern int32_t caml_deserialize_sint_4(void); +CAMLextern uint64_t caml_deserialize_uint_8(void); +CAMLextern int64_t caml_deserialize_sint_8(void); +CAMLextern float caml_deserialize_float_4(void); +CAMLextern double caml_deserialize_float_8(void); +CAMLextern void caml_deserialize_block_1(void * data, intnat len); +CAMLextern void caml_deserialize_block_2(void * data, intnat len); +CAMLextern void caml_deserialize_block_4(void * data, intnat len); +CAMLextern void caml_deserialize_block_8(void * data, intnat len); +CAMLextern void caml_deserialize_block_float_8(void * data, intnat len); +CAMLextern void caml_deserialize_error(char * msg); + +#ifdef CAML_INTERNALS + +/* Auxiliary stuff for sending code pointers */ + +struct code_fragment { + char * code_start; + char * code_end; + unsigned char digest[16]; + char digest_computed; +}; + +CAMLextern struct code_fragment * caml_extern_find_code(char *addr); + +extern struct ext_table caml_code_fragments_table; + +#endif /* CAML_INTERNALS */ + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_INTEXT_H */ diff --git a/test/monniaux/ocaml/byterun/caml/io.h b/test/monniaux/ocaml/byterun/caml/io.h new file mode 100644 index 00000000..87de679e --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/io.h @@ -0,0 +1,126 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Buffered input/output */ + +#ifndef CAML_IO_H +#define CAML_IO_H + +#ifdef CAML_INTERNALS + +#include "misc.h" +#include "mlvalues.h" + +#ifndef IO_BUFFER_SIZE +#define IO_BUFFER_SIZE 65536 +#endif + +#if defined(_WIN32) +typedef __int64 file_offset; +#elif defined(HAS_OFF_T) +#include <sys/types.h> +typedef off_t file_offset; +#else +typedef long file_offset; +#endif + +struct channel { + int fd; /* Unix file descriptor */ + file_offset offset; /* Absolute position of fd in the file */ + char * end; /* Physical end of the buffer */ + char * curr; /* Current position in the buffer */ + char * max; /* Logical end of the buffer (for input) */ + void * mutex; /* Placeholder for mutex (for systhreads) */ + struct channel * next, * prev;/* Double chaining of channels (flush_all) */ + int revealed; /* For Cash only */ + int old_revealed; /* For Cash only */ + int refcount; /* For flush_all and for Cash */ + int flags; /* Bitfield */ + char buff[IO_BUFFER_SIZE]; /* The buffer itself */ + char * name; /* Optional name (to report fd leaks) */ +}; + +enum { + CHANNEL_FLAG_FROM_SOCKET = 1, /* For Windows */ +#if defined(NATIVE_CODE) && defined(WITH_SPACETIME) + CHANNEL_FLAG_BLOCKING_WRITE = 2, /* Don't release master lock when writing */ +#endif + CHANNEL_FLAG_MANAGED_BY_GC = 4, /* Free and close using GC finalization */ +}; + +/* For an output channel: + [offset] is the absolute position of the beginning of the buffer [buff]. + For an input channel: + [offset] is the absolute position of the logical end of the buffer, [max]. +*/ + +/* Functions and macros that can be called from C. Take arguments of + type struct channel *. No locking is performed. */ + +#define caml_putch(channel, ch) do{ \ + if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \ + *((channel)->curr)++ = (ch); \ +}while(0) + +#define caml_getch(channel) \ + ((channel)->curr >= (channel)->max \ + ? caml_refill(channel) \ + : (unsigned char) *((channel)->curr)++) + +CAMLextern struct channel * caml_open_descriptor_in (int); +CAMLextern struct channel * caml_open_descriptor_out (int); +CAMLextern void caml_close_channel (struct channel *); +CAMLextern int caml_channel_binary_mode (struct channel *); +CAMLextern value caml_alloc_channel(struct channel *chan); + +CAMLextern int caml_flush_partial (struct channel *); +CAMLextern void caml_flush (struct channel *); +CAMLextern void caml_putword (struct channel *, uint32_t); +CAMLextern int caml_putblock (struct channel *, char *, intnat); +CAMLextern void caml_really_putblock (struct channel *, char *, intnat); + +CAMLextern unsigned char caml_refill (struct channel *); +CAMLextern uint32_t caml_getword (struct channel *); +CAMLextern int caml_getblock (struct channel *, char *, intnat); +CAMLextern intnat caml_really_getblock (struct channel *, char *, intnat); + +/* Extract a struct channel * from the heap object representing it */ + +#define Channel(v) (*((struct channel **) (Data_custom_val(v)))) + +/* The locking machinery */ + +CAMLextern void (*caml_channel_mutex_free) (struct channel *); +CAMLextern void (*caml_channel_mutex_lock) (struct channel *); +CAMLextern void (*caml_channel_mutex_unlock) (struct channel *); +CAMLextern void (*caml_channel_mutex_unlock_exn) (void); + +CAMLextern struct channel * caml_all_opened_channels; + +#define Lock(channel) \ + if (caml_channel_mutex_lock != NULL) (*caml_channel_mutex_lock)(channel) +#define Unlock(channel) \ + if (caml_channel_mutex_unlock != NULL) (*caml_channel_mutex_unlock)(channel) +#define Unlock_exn() \ + if (caml_channel_mutex_unlock_exn != NULL) (*caml_channel_mutex_unlock_exn)() + +/* Conversion between file_offset and int64_t */ + +#define Val_file_offset(fofs) caml_copy_int64(fofs) +#define File_offset_val(v) ((file_offset) Int64_val(v)) + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_IO_H */ diff --git a/test/monniaux/ocaml/byterun/caml/m.h b/test/monniaux/ocaml/byterun/caml/m.h new file mode 100644 index 00000000..c54b4f0d --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/m.h @@ -0,0 +1,86 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Processor dependencies */ + +#define ARCH_SIXTYFOUR + +/* Define ARCH_SIXTYFOUR if the processor has a natural word size of 64 bits. + That is, sizeof(char *) = 8. + Otherwise, leave ARCH_SIXTYFOUR undefined. + This assumes sizeof(char *) = 4. */ + +/* #define ARCH_BIG_ENDIAN */ + +/* Define ARCH_BIG_ENDIAN if the processor is big endian (the most + significant byte of an integer stored in memory comes first). + Leave ARCH_BIG_ENDIAN undefined if the processor is little-endian + (the least significant byte comes first). +*/ + +#define ARCH_ALIGN_DOUBLE + +/* Define ARCH_ALIGN_DOUBLE if the processor requires doubles to be + doubleword-aligned. Leave ARCH_ALIGN_DOUBLE undefined if the processor + supports word-aligned doubles. */ + +#undef ARCH_CODE32 + +/* Define ARCH_CODE32 if, on a 64-bit machine, code pointers fit in 32 bits, + i.e. the code segment resides in the low 4G of the addressing space. + ARCH_CODE32 is ignored on 32-bit machines. */ + +#define SIZEOF_INT 4 +#define SIZEOF_LONG 8 +#define SIZEOF_PTR 8 +#define SIZEOF_SHORT 2 + +/* Define SIZEOF_INT, SIZEOF_LONG, SIZEOF_PTR and SIZEOF_SHORT + to the sizes in bytes of the C types "int", "long", "char *" and "short", + respectively. */ + +#define ARCH_INT64_TYPE long long +#define ARCH_UINT64_TYPE unsigned long long + +/* Define ARCH_INT64_TYPE and ARCH_UINT64_TYPE to 64-bit integer types, + typically "long long" and "unsigned long long" on 32-bit platforms, + and "long" and "unsigned long" on 64-bit platforms. + If the C compiler doesn't support any 64-bit integer type, + leave both ARCH_INT64_TYPE and ARCH_UINT64_TYPE undefined. */ + +#define ARCH_INT64_PRINTF_FORMAT "ll" + +/* Define ARCH_INT64_PRINTF_FORMAT to the printf format used for formatting + values of type ARCH_INT64_TYPE. This is usually "ll" on 32-bit + platforms and "l" on 64-bit platforms. + Leave undefined if ARCH_INT64_TYPE is undefined. */ + +#define ARCH_ALIGN_INT64 + +/* Define ARCH_ALIGN_INT64 if the processor requires 64-bit integers to be + doubleword-aligned. Leave ARCH_ALIGN_INT64 undefined if the processor + supports word-aligned 64-bit integers. Leave undefined if + 64-bit integers are not supported. */ + +#undef NONSTANDARD_DIV_MOD + +/* Leave NONSTANDARD_DIV_MOD undefined if the C operators / and % implement + round-towards-zero semantics, as specified by ISO C 9x and implemented + by most contemporary processors. Otherwise, or if you don't know, + define NONSTANDARD_DIV_MOD: this will select a slower but correct + software emulation of division and modulus. */ + +#define PROFINFO_WIDTH 0 +#define INT64_LITERAL(s) s ## LL diff --git a/test/monniaux/ocaml/byterun/caml/major_gc.h b/test/monniaux/ocaml/byterun/caml/major_gc.h new file mode 100644 index 00000000..813f8a78 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/major_gc.h @@ -0,0 +1,95 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_MAJOR_GC_H +#define CAML_MAJOR_GC_H + +#ifdef CAML_INTERNALS + +#include "freelist.h" +#include "misc.h" + +typedef struct { + void *block; /* address of the malloced block this chunk lives in */ + asize_t alloc; /* in bytes, used for compaction */ + asize_t size; /* in bytes */ + char *next; +} heap_chunk_head; + +#define Chunk_size(c) (((heap_chunk_head *) (c)) [-1]).size +#define Chunk_alloc(c) (((heap_chunk_head *) (c)) [-1]).alloc +#define Chunk_next(c) (((heap_chunk_head *) (c)) [-1]).next +#define Chunk_block(c) (((heap_chunk_head *) (c)) [-1]).block + +extern int caml_gc_phase; +extern int caml_gc_subphase; +extern uintnat caml_allocated_words; +extern double caml_extra_heap_resources; +extern uintnat caml_dependent_size, caml_dependent_allocated; +extern uintnat caml_fl_wsz_at_phase_change; + +#define Phase_mark 0 +#define Phase_clean 1 +#define Phase_sweep 2 +#define Phase_idle 3 + +/* Subphase of mark */ +#define Subphase_mark_roots 10 +/* Subphase_mark_roots: At the end of this subphase all the global + roots are marked. */ +#define Subphase_mark_main 11 +/* Subphase_mark_main: At the end of this subphase all the value alive at + the start of this subphase and created during it are marked. */ +#define Subphase_mark_final 12 +/* Subphase_mark_final: At the start of this subphase register which + value with an ocaml finalizer are not marked, the associated + finalizer will be run later. So we mark now these values as alive, + since they must be available for their finalizer. + */ + +CAMLextern char *caml_heap_start; +extern uintnat total_heap_size; +extern char *caml_gc_sweep_hp; + +extern int caml_major_window; +extern double caml_major_ring[Max_major_window]; +extern int caml_major_ring_index; +extern double caml_major_work_credit; +extern double caml_gc_clock; + +/* [caml_major_gc_hook] is called just between the end of the mark + phase and the beginning of the sweep phase of the major GC */ +CAMLextern void (*caml_major_gc_hook)(void); + +void caml_init_major_heap (asize_t); /* size in bytes */ +asize_t caml_clip_heap_chunk_wsz (asize_t wsz); +void caml_darken (value, value *); +void caml_major_collection_slice (intnat); +void major_collection (void); +void caml_finish_major_cycle (void); +void caml_set_major_window (int); + +/* Forces finalisation of all heap-allocated values, + disregarding both local and global roots. + + Warning: finalisation is performed by means of forced sweeping, which may + result in pointers referencing nonexistent values; therefore the function + should only be used on runtime shutdown. +*/ +void caml_finalise_heap (void); + +#endif /* CAML_INTERNALiS */ + +#endif /* CAML_MAJOR_GC_H */ diff --git a/test/monniaux/ocaml/byterun/caml/md5.h b/test/monniaux/ocaml/byterun/caml/md5.h new file mode 100644 index 00000000..e83c16cd --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/md5.h @@ -0,0 +1,47 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1999 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. */ +/* */ +/**************************************************************************/ + +/* MD5 message digest */ + +#ifndef CAML_MD5_H +#define CAML_MD5_H + +#ifdef CAML_INTERNALS + +#include "mlvalues.h" +#include "io.h" + +CAMLextern value caml_md5_string (value str, value ofs, value len); +CAMLextern value caml_md5_chan (value vchan, value len); +CAMLextern void caml_md5_block(unsigned char digest[16], + void * data, uintnat len); + +CAMLextern value caml_md5_channel(struct channel *chan, intnat toread); + +struct MD5Context { + uint32_t buf[4]; + uint32_t bits[2]; + unsigned char in[64]; +}; + +CAMLextern void caml_MD5Init (struct MD5Context *context); +CAMLextern void caml_MD5Update (struct MD5Context *context, unsigned char *buf, + uintnat len); +CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx); +CAMLextern void caml_MD5Transform (uint32_t *buf, uint32_t *in); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_MD5_H */ diff --git a/test/monniaux/ocaml/byterun/caml/memory.h b/test/monniaux/ocaml/byterun/caml/memory.h new file mode 100644 index 00000000..1ba489b2 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/memory.h @@ -0,0 +1,595 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, 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. */ +/* */ +/**************************************************************************/ + +/* Allocation macros and functions */ + +#ifndef CAML_MEMORY_H +#define CAML_MEMORY_H + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "config.h" +#ifdef CAML_INTERNALS +#include "gc.h" +#include "major_gc.h" +#include "minor_gc.h" +#endif /* CAML_INTERNALS */ +#include "misc.h" +#include "mlvalues.h" + +#ifdef __cplusplus +extern "C" { +#endif + + +CAMLextern value caml_alloc_shr (mlsize_t wosize, tag_t); +#ifdef WITH_PROFINFO +CAMLextern value caml_alloc_shr_with_profinfo (mlsize_t, tag_t, intnat); +CAMLextern value caml_alloc_shr_preserving_profinfo (mlsize_t, tag_t, + header_t); +#else +#define caml_alloc_shr_with_profinfo(size, tag, profinfo) \ + caml_alloc_shr(size, tag) +#define caml_alloc_shr_preserving_profinfo(size, tag, header) \ + caml_alloc_shr(size, tag) +#endif /* WITH_PROFINFO */ +CAMLextern value caml_alloc_shr_no_raise (mlsize_t wosize, tag_t); +CAMLextern void caml_adjust_gc_speed (mlsize_t, mlsize_t); +CAMLextern void caml_alloc_dependent_memory (mlsize_t bsz); +CAMLextern void caml_free_dependent_memory (mlsize_t bsz); +CAMLextern void caml_modify (value *, value); +CAMLextern void caml_initialize (value *, value); +CAMLextern value caml_check_urgent_gc (value); +CAMLextern int caml_init_alloc_for_heap (void); +CAMLextern char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */ +CAMLextern void caml_free_for_heap (char *mem); +CAMLextern void caml_disown_for_heap (char *mem); +CAMLextern int caml_add_to_heap (char *mem); +CAMLextern color_t caml_allocation_color (void *hp); + +CAMLextern int caml_huge_fallback_count; + + +/* [caml_stat_*] functions below provide an interface to the static memory + manager built into the runtime, which can be used for managing static + (that is, non-moving) blocks of heap memory. + + Function arguments that have type [caml_stat_block] must always be pointers + to blocks returned by the [caml_stat_*] functions below. Attempting to use + these functions on memory blocks allocated by a different memory manager + (e.g. the one from the C runtime) will cause undefined behaviour. +*/ +typedef void* caml_stat_block; + +#ifdef CAML_INTERNALS + +/* The pool must be initialized with a call to [caml_stat_create_pool] + before it is possible to use any of the [caml_stat_*] functions below. + + If the pool is not initialized, [caml_stat_*] functions will still work in + backward compatibility mode, becoming thin wrappers around [malloc] family + of functions. In this case, calling [caml_stat_destroy_pool] will not free + the claimed heap memory, resulting in leaks. +*/ +CAMLextern void caml_stat_create_pool(void); + +/* [caml_stat_destroy_pool] frees all the heap memory claimed by the pool. + + Once the pool is destroyed, [caml_stat_*] functions will continue to work + in backward compatibility mode, becoming thin wrappers around [malloc] + family of functions. +*/ +CAMLextern void caml_stat_destroy_pool(void); + +#endif /* CAML_INTERNALS */ + +/* [caml_stat_alloc(size)] allocates a memory block of the requested [size] + (in bytes) and returns a pointer to it. It throws an OCaml exception in case + the request fails, and so requires the runtime lock to be held. +*/ +CAMLextern caml_stat_block caml_stat_alloc(asize_t); + +/* [caml_stat_alloc_noexc(size)] allocates a memory block of the requested [size] + (in bytes) and returns a pointer to it, or NULL in case the request fails. +*/ +CAMLextern caml_stat_block caml_stat_alloc_noexc(asize_t); + +/* [caml_stat_alloc_aligned(size, modulo, block*)] allocates a memory block of + the requested [size] (in bytes), the starting address of which is aligned to + the provided [modulo] value. The function returns the aligned address, as + well as the unaligned [block] (as an output parameter). It throws an OCaml + exception in case the request fails, and so requires the runtime lock. +*/ +CAMLextern void* caml_stat_alloc_aligned(asize_t, int modulo, caml_stat_block*); + +/* [caml_stat_alloc_aligned_noexc] is a variant of [caml_stat_alloc_aligned] + that returns NULL in case the request fails, and doesn't require the runtime + lock to be held. +*/ +CAMLextern void* caml_stat_alloc_aligned_noexc(asize_t, int modulo, + caml_stat_block*); + +/* [caml_stat_calloc_noexc(num, size)] allocates a block of memory for an array + of [num] elements, each of them [size] bytes long, and initializes all its + bits to zero, effectively allocating a zero-initialized memory block of + [num * size] bytes. It returns NULL in case the request fails. +*/ +CAMLextern caml_stat_block caml_stat_calloc_noexc(asize_t, asize_t); + +/* [caml_stat_free(block)] deallocates the provided [block]. */ +CAMLextern void caml_stat_free(caml_stat_block); + +/* [caml_stat_resize(block, size)] changes the size of the provided [block] to + [size] bytes. The function may move the memory block to a new location (whose + address is returned by the function). The content of the [block] is preserved + up to the smaller of the new and old sizes, even if the block is moved to a + new location. If the new size is larger, the value of the newly allocated + portion is indeterminate. The function throws an OCaml exception in case the + request fails, and so requires the runtime lock to be held. +*/ +CAMLextern caml_stat_block caml_stat_resize(caml_stat_block, asize_t); + +/* [caml_stat_resize_noexc] is a variant of [caml_stat_resize] that returns NULL + in case the request fails, and doesn't require the runtime lock. +*/ +CAMLextern caml_stat_block caml_stat_resize_noexc(caml_stat_block, asize_t); + + +/* A [caml_stat_block] containing a NULL-terminated string */ +typedef char* caml_stat_string; + +/* [caml_stat_strdup(s)] returns a pointer to a heap-allocated string which is a + copy of the NULL-terminated string [s]. It throws an OCaml exception in case + the request fails, and so requires the runtime lock to be held. +*/ +CAMLextern caml_stat_string caml_stat_strdup(const char *s); +#ifdef _WIN32 +CAMLextern wchar_t* caml_stat_wcsdup(const wchar_t *s); +#endif + +/* [caml_stat_strdup_noexc] is a variant of [caml_stat_strdup] that returns NULL + in case the request fails, and doesn't require the runtime lock. +*/ +CAMLextern caml_stat_string caml_stat_strdup_noexc(const char *s); + +/* [caml_stat_strconcat(nargs, strings)] concatenates NULL-terminated [strings] + (an array of [char*] of size [nargs]) into a new string, dropping all NULLs, + except for the very last one. It throws an OCaml exception in case the + request fails, and so requires the runtime lock to be held. +*/ +CAMLextern caml_stat_string caml_stat_strconcat(int n, ...); +#ifdef _WIN32 +CAMLextern wchar_t* caml_stat_wcsconcat(int n, ...); +#endif + + +/* void caml_shrink_heap (char *); Only used in compact.c */ + +#ifdef CAML_INTERNALS + +extern uintnat caml_use_huge_pages; + +#ifdef HAS_HUGE_PAGES +#include <sys/mman.h> +#define Heap_page_size HUGE_PAGE_SIZE +#define Round_mmap_size(x) \ + (((x) + (Heap_page_size - 1)) & ~ (Heap_page_size - 1)) +#endif + + +int caml_page_table_add(int kind, void * start, void * end); +int caml_page_table_remove(int kind, void * start, void * end); +int caml_page_table_initialize(mlsize_t bytesize); + +#ifdef DEBUG +#define DEBUG_clear(result, wosize) do{ \ + uintnat caml__DEBUG_i; \ + for (caml__DEBUG_i = 0; caml__DEBUG_i < (wosize); ++ caml__DEBUG_i){ \ + Field ((result), caml__DEBUG_i) = Debug_uninit_minor; \ + } \ +}while(0) +#else +#define DEBUG_clear(result, wosize) +#endif + +#define Alloc_small_with_profinfo(result, wosize, tag, profinfo) do { \ + CAMLassert ((wosize) >= 1); \ + CAMLassert ((tag_t) (tag) < 256); \ + CAMLassert ((wosize) <= Max_young_wosize); \ + caml_young_ptr -= Whsize_wosize (wosize); \ + if (caml_young_ptr < caml_young_trigger){ \ + caml_young_ptr += Whsize_wosize (wosize); \ + CAML_INSTR_INT ("force_minor/alloc_small@", 1); \ + Setup_for_gc; \ + caml_gc_dispatch (); \ + Restore_after_gc; \ + caml_young_ptr -= Whsize_wosize (wosize); \ + } \ + Hd_hp (caml_young_ptr) = \ + Make_header_with_profinfo ((wosize), (tag), Caml_black, profinfo); \ + (result) = Val_hp (caml_young_ptr); \ + DEBUG_clear ((result), (wosize)); \ +}while(0) + +#if defined(NATIVE_CODE) && defined(WITH_SPACETIME) +extern uintnat caml_spacetime_my_profinfo(struct ext_table**, uintnat); +#define Alloc_small(result, wosize, tag) \ + Alloc_small_with_profinfo(result, wosize, tag, \ + caml_spacetime_my_profinfo(NULL, wosize)) +#else +#define Alloc_small(result, wosize, tag) \ + Alloc_small_with_profinfo(result, wosize, tag, (uintnat) 0) +#endif + +/* Deprecated alias for [caml_modify] */ + +#define Modify(fp,val) caml_modify((fp), (val)) + +#endif /* CAML_INTERNALS */ + +struct caml__roots_block { + struct caml__roots_block *next; + intnat ntables; + intnat nitems; + value *tables [5]; +}; + +CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ + +/* The following macros are used to declare C local variables and + function parameters of type [value]. + + The function body must start with one of the [CAMLparam] macros. + If the function has no parameter of type [value], use [CAMLparam0]. + If the function has 1 to 5 [value] parameters, use the corresponding + [CAMLparam] with the parameters as arguments. + If the function has more than 5 [value] parameters, use [CAMLparam5] + for the first 5 parameters, and one or more calls to the [CAMLxparam] + macros for the others. + If the function takes an array of [value]s as argument, use + [CAMLparamN] to declare it (or [CAMLxparamN] if you already have a + call to [CAMLparam] for some other arguments). + + If you need local variables of type [value], declare them with one + or more calls to the [CAMLlocal] macros at the beginning of the + function, after the call to CAMLparam. Use [CAMLlocalN] (at the + beginning of the function) to declare an array of [value]s. + + Your function may raise an exception or return a [value] with the + [CAMLreturn] macro. Its argument is simply the [value] returned by + your function. Do NOT directly return a [value] with the [return] + keyword. If your function returns void, use [CAMLreturn0]. If you + un-register the local roots (i.e. undo the effects of the [CAMLparam*] + and [CAMLlocal] macros) without returning immediately, use [CAMLdrop]. + + All the identifiers beginning with "caml__" are reserved by OCaml. + Do not use them for anything (local or global variables, struct or + union tags, macros, etc.) +*/ + +#define CAMLparam0() \ + struct caml__roots_block *caml__frame = caml_local_roots + +#define CAMLparam1(x) \ + CAMLparam0 (); \ + CAMLxparam1 (x) + +#define CAMLparam2(x, y) \ + CAMLparam0 (); \ + CAMLxparam2 (x, y) + +#define CAMLparam3(x, y, z) \ + CAMLparam0 (); \ + CAMLxparam3 (x, y, z) + +#define CAMLparam4(x, y, z, t) \ + CAMLparam0 (); \ + CAMLxparam4 (x, y, z, t) + +#define CAMLparam5(x, y, z, t, u) \ + CAMLparam0 (); \ + CAMLxparam5 (x, y, z, t, u) + +#define CAMLparamN(x, size) \ + CAMLparam0 (); \ + CAMLxparamN (x, (size)) + +/* CAMLunused is preserved for compatibility reasons. + Instead of the legacy GCC/Clang-only + CAMLunused foo; + you should prefer + CAMLunused_start foo CAMLunused_end; + which supports both GCC/Clang and MSVC. +*/ +#if defined(__GNUC__) && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ > 7)) + #define CAMLunused_start __attribute__ ((unused)) + #define CAMLunused_end + #define CAMLunused __attribute__ ((unused)) +#elif _MSC_VER >= 1500 + #define CAMLunused_start __pragma( warning (push) ) \ + __pragma( warning (disable:4189 ) ) + #define CAMLunused_end __pragma( warning (pop)) + #define CAMLunused +#else + #define CAMLunused_start + #define CAMLunused_end + #define CAMLunused +#endif + +#define CAMLxparam1(x) \ + struct caml__roots_block caml__roots_##x; \ + CAMLunused_start int caml__dummy_##x = ( \ + (void) caml__frame, \ + (caml__roots_##x.next = caml_local_roots), \ + (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.nitems = 1), \ + (caml__roots_##x.ntables = 1), \ + (caml__roots_##x.tables [0] = &x), \ + 0) \ + CAMLunused_end + +#define CAMLxparam2(x, y) \ + struct caml__roots_block caml__roots_##x; \ + CAMLunused_start int caml__dummy_##x = ( \ + (void) caml__frame, \ + (caml__roots_##x.next = caml_local_roots), \ + (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.nitems = 1), \ + (caml__roots_##x.ntables = 2), \ + (caml__roots_##x.tables [0] = &x), \ + (caml__roots_##x.tables [1] = &y), \ + 0) \ + CAMLunused_end + +#define CAMLxparam3(x, y, z) \ + struct caml__roots_block caml__roots_##x; \ + CAMLunused_start int caml__dummy_##x = ( \ + (void) caml__frame, \ + (caml__roots_##x.next = caml_local_roots), \ + (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.nitems = 1), \ + (caml__roots_##x.ntables = 3), \ + (caml__roots_##x.tables [0] = &x), \ + (caml__roots_##x.tables [1] = &y), \ + (caml__roots_##x.tables [2] = &z), \ + 0) \ + CAMLunused_end + +#define CAMLxparam4(x, y, z, t) \ + struct caml__roots_block caml__roots_##x; \ + CAMLunused_start int caml__dummy_##x = ( \ + (void) caml__frame, \ + (caml__roots_##x.next = caml_local_roots), \ + (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.nitems = 1), \ + (caml__roots_##x.ntables = 4), \ + (caml__roots_##x.tables [0] = &x), \ + (caml__roots_##x.tables [1] = &y), \ + (caml__roots_##x.tables [2] = &z), \ + (caml__roots_##x.tables [3] = &t), \ + 0) \ + CAMLunused_end + +#define CAMLxparam5(x, y, z, t, u) \ + struct caml__roots_block caml__roots_##x; \ + CAMLunused_start int caml__dummy_##x = ( \ + (void) caml__frame, \ + (caml__roots_##x.next = caml_local_roots), \ + (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.nitems = 1), \ + (caml__roots_##x.ntables = 5), \ + (caml__roots_##x.tables [0] = &x), \ + (caml__roots_##x.tables [1] = &y), \ + (caml__roots_##x.tables [2] = &z), \ + (caml__roots_##x.tables [3] = &t), \ + (caml__roots_##x.tables [4] = &u), \ + 0) \ + CAMLunused_end + +#define CAMLxparamN(x, size) \ + struct caml__roots_block caml__roots_##x; \ + CAMLunused_start int caml__dummy_##x = ( \ + (void) caml__frame, \ + (caml__roots_##x.next = caml_local_roots), \ + (caml_local_roots = &caml__roots_##x), \ + (caml__roots_##x.nitems = (size)), \ + (caml__roots_##x.ntables = 1), \ + (caml__roots_##x.tables[0] = &(x[0])), \ + 0) \ + CAMLunused_end + +#define CAMLlocal1(x) \ + value x = Val_unit; \ + CAMLxparam1 (x) + +#define CAMLlocal2(x, y) \ + value x = Val_unit, y = Val_unit; \ + CAMLxparam2 (x, y) + +#define CAMLlocal3(x, y, z) \ + value x = Val_unit, y = Val_unit, z = Val_unit; \ + CAMLxparam3 (x, y, z) + +#define CAMLlocal4(x, y, z, t) \ + value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit; \ + CAMLxparam4 (x, y, z, t) + +#define CAMLlocal5(x, y, z, t, u) \ + value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit, u = Val_unit; \ + CAMLxparam5 (x, y, z, t, u) + +#define CAMLlocalN(x, size) \ + value x [(size)]; \ + int caml__i_##x; \ + for (caml__i_##x = 0; caml__i_##x < size; caml__i_##x ++) { \ + x[caml__i_##x] = Val_unit; \ + } \ + CAMLxparamN (x, (size)) + + +#define CAMLdrop caml_local_roots = caml__frame + +#define CAMLreturn0 do{ \ + CAMLdrop; \ + return; \ +}while (0) + +#define CAMLreturnT(type, result) do{ \ + type caml__temp_result = (result); \ + CAMLdrop; \ + return caml__temp_result; \ +}while(0) + +#define CAMLreturn(result) CAMLreturnT(value, result) + +#define CAMLnoreturn ((void) caml__frame) + + +/* convenience macro */ +#define Store_field(block, offset, val) do{ \ + mlsize_t caml__temp_offset = (offset); \ + value caml__temp_val = (val); \ + caml_modify (&Field ((block), caml__temp_offset), caml__temp_val); \ +}while(0) + +/* + NOTE: [Begin_roots] and [End_roots] are superseded by [CAMLparam]*, + [CAMLxparam]*, [CAMLlocal]*, [CAMLreturn]. + + [Begin_roots] and [End_roots] are used for C variables that are GC roots. + It must contain all values in C local variables and function parameters + at the time the minor GC is called. + Usage: + After initialising your local variables to legal OCaml values, but before + calling allocation functions, insert [Begin_roots_n(v1, ... vn)], where + v1 ... vn are your variables of type [value] that you want to be updated + across allocations. + At the end, insert [End_roots()]. + + Note that [Begin_roots] opens a new block, and [End_roots] closes it. + Thus they must occur in matching pairs at the same brace nesting level. + + You can use [Val_unit] as a dummy initial value for your variables. +*/ + +#define Begin_root Begin_roots1 + +#define Begin_roots1(r0) { \ + struct caml__roots_block caml__roots_block; \ + caml__roots_block.next = caml_local_roots; \ + caml_local_roots = &caml__roots_block; \ + caml__roots_block.nitems = 1; \ + caml__roots_block.ntables = 1; \ + caml__roots_block.tables[0] = &(r0); + +#define Begin_roots2(r0, r1) { \ + struct caml__roots_block caml__roots_block; \ + caml__roots_block.next = caml_local_roots; \ + caml_local_roots = &caml__roots_block; \ + caml__roots_block.nitems = 1; \ + caml__roots_block.ntables = 2; \ + caml__roots_block.tables[0] = &(r0); \ + caml__roots_block.tables[1] = &(r1); + +#define Begin_roots3(r0, r1, r2) { \ + struct caml__roots_block caml__roots_block; \ + caml__roots_block.next = caml_local_roots; \ + caml_local_roots = &caml__roots_block; \ + caml__roots_block.nitems = 1; \ + caml__roots_block.ntables = 3; \ + caml__roots_block.tables[0] = &(r0); \ + caml__roots_block.tables[1] = &(r1); \ + caml__roots_block.tables[2] = &(r2); + +#define Begin_roots4(r0, r1, r2, r3) { \ + struct caml__roots_block caml__roots_block; \ + caml__roots_block.next = caml_local_roots; \ + caml_local_roots = &caml__roots_block; \ + caml__roots_block.nitems = 1; \ + caml__roots_block.ntables = 4; \ + caml__roots_block.tables[0] = &(r0); \ + caml__roots_block.tables[1] = &(r1); \ + caml__roots_block.tables[2] = &(r2); \ + caml__roots_block.tables[3] = &(r3); + +#define Begin_roots5(r0, r1, r2, r3, r4) { \ + struct caml__roots_block caml__roots_block; \ + caml__roots_block.next = caml_local_roots; \ + caml_local_roots = &caml__roots_block; \ + caml__roots_block.nitems = 1; \ + caml__roots_block.ntables = 5; \ + caml__roots_block.tables[0] = &(r0); \ + caml__roots_block.tables[1] = &(r1); \ + caml__roots_block.tables[2] = &(r2); \ + caml__roots_block.tables[3] = &(r3); \ + caml__roots_block.tables[4] = &(r4); + +#define Begin_roots_block(table, size) { \ + struct caml__roots_block caml__roots_block; \ + caml__roots_block.next = caml_local_roots; \ + caml_local_roots = &caml__roots_block; \ + caml__roots_block.nitems = (size); \ + caml__roots_block.ntables = 1; \ + caml__roots_block.tables[0] = (table); + +#define End_roots() caml_local_roots = caml__roots_block.next; } + + +/* [caml_register_global_root] registers a global C variable as a memory root + for the duration of the program, or until [caml_remove_global_root] is + called. */ + +CAMLextern void caml_register_global_root (value *); + +/* [caml_remove_global_root] removes a memory root registered on a global C + variable with [caml_register_global_root]. */ + +CAMLextern void caml_remove_global_root (value *); + +/* [caml_register_generational_global_root] registers a global C + variable as a memory root for the duration of the program, or until + [caml_remove_generational_global_root] is called. + The program guarantees that the value contained in this variable + will not be assigned directly. If the program needs to change + the value of this variable, it must do so by calling + [caml_modify_generational_global_root]. The [value *] pointer + passed to [caml_register_generational_global_root] must contain + a valid OCaml value before the call. + In return for these constraints, scanning of memory roots during + minor collection is made more efficient. */ + +CAMLextern void caml_register_generational_global_root (value *); + +/* [caml_remove_generational_global_root] removes a memory root + registered on a global C variable with + [caml_register_generational_global_root]. */ + +CAMLextern void caml_remove_generational_global_root (value *); + +/* [caml_modify_generational_global_root(r, newval)] + modifies the value contained in [r], storing [newval] inside. + In other words, the assignment [*r = newval] is performed, + but in a way that is compatible with the optimized scanning of + generational global roots. [r] must be a global memory root + previously registered with [caml_register_generational_global_root]. */ + +CAMLextern void caml_modify_generational_global_root(value *r, value newval); + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_MEMORY_H */ diff --git a/test/monniaux/ocaml/byterun/caml/minor_gc.h b/test/monniaux/ocaml/byterun/caml/minor_gc.h new file mode 100644 index 00000000..6c48c761 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/minor_gc.h @@ -0,0 +1,120 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_MINOR_GC_H +#define CAML_MINOR_GC_H + + +#include "address_class.h" +#include "config.h" + +CAMLextern value *caml_young_start, *caml_young_end; +CAMLextern value *caml_young_alloc_start, *caml_young_alloc_end; +CAMLextern value *caml_young_ptr, *caml_young_limit; +CAMLextern value *caml_young_trigger; +extern asize_t caml_minor_heap_wsz; +extern int caml_in_minor_collection; +extern double caml_extra_heap_resources_minor; + +#define CAML_TABLE_STRUCT(t) { \ + t *base; \ + t *end; \ + t *threshold; \ + t *ptr; \ + t *limit; \ + asize_t size; \ + asize_t reserve; \ +} + +struct caml_ref_table CAML_TABLE_STRUCT(value *); +CAMLextern struct caml_ref_table caml_ref_table; + +struct caml_ephe_ref_elt { + value ephe; /* an ephemeron in major heap */ + mlsize_t offset; /* the offset that points in the minor heap */ +}; + +struct caml_ephe_ref_table CAML_TABLE_STRUCT(struct caml_ephe_ref_elt); +CAMLextern struct caml_ephe_ref_table caml_ephe_ref_table; + +struct caml_custom_elt { + value block; /* The finalized block in the minor heap. */ + mlsize_t mem; /* The parameters for adjusting GC speed. */ + mlsize_t max; +}; + +struct caml_custom_table CAML_TABLE_STRUCT(struct caml_custom_elt); +CAMLextern struct caml_custom_table caml_custom_table; + +extern void caml_set_minor_heap_size (asize_t); /* size in bytes */ +extern void caml_empty_minor_heap (void); +CAMLextern void caml_gc_dispatch (void); +CAMLextern void garbage_collection (void); /* def in asmrun/signals_asm.c */ +extern void caml_realloc_ref_table (struct caml_ref_table *); +extern void caml_alloc_table (struct caml_ref_table *, asize_t, asize_t); +extern void caml_realloc_ephe_ref_table (struct caml_ephe_ref_table *); +extern void caml_alloc_ephe_table (struct caml_ephe_ref_table *, + asize_t, asize_t); +extern void caml_realloc_custom_table (struct caml_custom_table *); +extern void caml_alloc_custom_table (struct caml_custom_table *, + asize_t, asize_t); +extern void caml_oldify_one (value, value *); +extern void caml_oldify_mopup (void); + +#define Oldify(p) do{ \ + value __oldify__v__ = *p; \ + if (Is_block (__oldify__v__) && Is_young (__oldify__v__)){ \ + caml_oldify_one (__oldify__v__, (p)); \ + } \ + }while(0) + +static inline void add_to_ref_table (struct caml_ref_table *tbl, value *p) +{ + if (tbl->ptr >= tbl->limit){ + CAMLassert (tbl->ptr == tbl->limit); + caml_realloc_ref_table (tbl); + } + *tbl->ptr++ = p; +} + +static inline void add_to_ephe_ref_table (struct caml_ephe_ref_table *tbl, + value ar, mlsize_t offset) +{ + struct caml_ephe_ref_elt *ephe_ref; + if (tbl->ptr >= tbl->limit){ + CAMLassert (tbl->ptr == tbl->limit); + caml_realloc_ephe_ref_table (tbl); + } + ephe_ref = tbl->ptr++; + ephe_ref->ephe = ar; + ephe_ref->offset = offset; + CAMLassert(ephe_ref->offset < Wosize_val(ephe_ref->ephe)); +} + +static inline void add_to_custom_table (struct caml_custom_table *tbl, value v, + mlsize_t mem, mlsize_t max) +{ + struct caml_custom_elt *elt; + if (tbl->ptr >= tbl->limit){ + CAMLassert (tbl->ptr == tbl->limit); + caml_realloc_custom_table (tbl); + } + elt = tbl->ptr++; + elt->block = v; + elt->mem = mem; + elt->max = max; +} + +#endif /* CAML_MINOR_GC_H */ diff --git a/test/monniaux/ocaml/byterun/caml/misc.h b/test/monniaux/ocaml/byterun/caml/misc.h new file mode 100644 index 00000000..5d668e56 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/misc.h @@ -0,0 +1,525 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy and Damien Doligez, 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. */ +/* */ +/**************************************************************************/ + +/* Miscellaneous macros and variables. */ + +#ifndef CAML_MISC_H +#define CAML_MISC_H + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "config.h" + +/* Standard definitions */ + +#include <stddef.h> +#include <stdlib.h> + +/* Basic types and constants */ + +typedef size_t asize_t; + +#ifndef NULL +#define NULL 0 +#endif + +#ifdef CAML_INTERNALS +typedef char * addr; +#endif /* CAML_INTERNALS */ + +/* Noreturn is preserved for compatibility reasons. + Instead of the legacy GCC/Clang-only + foo Noreturn; + you should prefer + CAMLnoreturn_start foo CAMLnoreturn_end; + which supports both GCC/Clang and MSVC. + + Note: CAMLnoreturn is a different macro defined in memory.h, + to be used in function bodies rather than as a prototype attribute. +*/ +#ifdef __GNUC__ + /* Works only in GCC 2.5 and later */ + #define CAMLnoreturn_start + #define CAMLnoreturn_end __attribute__ ((noreturn)) + #define Noreturn __attribute__ ((noreturn)) +#elif _MSC_VER >= 1500 + #define CAMLnoreturn_start __declspec(noreturn) + #define CAMLnoreturn_end + #define Noreturn +#else + #define CAMLnoreturn_start + #define CAMLnoreturn_end + #define Noreturn +#endif + + + +/* Export control (to mark primitives and to handle Windows DLL) */ + +#define CAMLexport +#define CAMLprim +#define CAMLextern extern + +/* Weak function definitions that can be overridden by external libs */ +/* Conservatively restricted to ELF and MacOSX platforms */ +#if defined(__GNUC__) && (defined (__ELF__) || defined(__APPLE__)) +#define CAMLweakdef __attribute__((weak)) +#else +#define CAMLweakdef +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +/* GC timing hooks. These can be assigned by the user. + [caml_minor_gc_begin_hook] must not allocate nor change any heap value. + The others can allocate and even call back to OCaml code. +*/ +typedef void (*caml_timing_hook) (void); +extern caml_timing_hook caml_major_slice_begin_hook, caml_major_slice_end_hook; +extern caml_timing_hook caml_minor_gc_begin_hook, caml_minor_gc_end_hook; +extern caml_timing_hook caml_finalise_begin_hook, caml_finalise_end_hook; + +/* Assertions */ + +#ifdef DEBUG +#define CAMLassert(x) \ + ((x) ? (void) 0 : (void) caml_failed_assert ( #x , __FILE__, __LINE__)) +CAMLnoreturn_start +CAMLextern int caml_failed_assert (char *, char *, int) +CAMLnoreturn_end; +#else +#define CAMLassert(x) ((void) 0) +#endif + +CAMLnoreturn_start +CAMLextern void caml_fatal_error (char *msg) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_fatal_error_arg (char *fmt, char *arg) +CAMLnoreturn_end; + +CAMLnoreturn_start +CAMLextern void caml_fatal_error_arg2 (char *fmt1, char *arg1, + char *fmt2, char *arg2) +CAMLnoreturn_end; + +/* Detection of available C built-in functions, the Clang way. */ + +#ifdef __has_builtin +#define Caml_has_builtin(x) __has_builtin(x) +#else +#define Caml_has_builtin(x) 0 +#endif + +/* Integer arithmetic with overflow detection. + The functions return 0 if no overflow, 1 if overflow. + The result of the operation is always stored at [*res]. + If no overflow is reported, this is the exact result. + If overflow is reported, this is the exact result modulo 2 to the word size. +*/ + +static inline int caml_uadd_overflow(uintnat a, uintnat b, uintnat * res) +{ +#if __GNUC__ >= 5 || Caml_has_builtin(__builtin_add_overflow) + return __builtin_add_overflow(a, b, res); +#else + uintnat c = a + b; + *res = c; + return c < a; +#endif +} + +static inline int caml_usub_overflow(uintnat a, uintnat b, uintnat * res) +{ +#if __GNUC__ >= 5 || Caml_has_builtin(__builtin_sub_overflow) + return __builtin_sub_overflow(a, b, res); +#else + uintnat c = a - b; + *res = c; + return a < b; +#endif +} + +#if __GNUC__ >= 5 || Caml_has_builtin(__builtin_mul_overflow) +static inline int caml_umul_overflow(uintnat a, uintnat b, uintnat * res) +{ + return __builtin_mul_overflow(a, b, res); +} +#else +extern int caml_umul_overflow(uintnat a, uintnat b, uintnat * res); +#endif + +/* Windows Unicode support */ + +#ifdef _WIN32 + +typedef wchar_t char_os; + +#define _T(x) L ## x + +#define access_os _waccess +#define open_os _wopen +#define stat_os _wstati64 +#define unlink_os _wunlink +#define rename_os caml_win32_rename +#define chdir_os _wchdir +#define getcwd_os _wgetcwd +#define system_os _wsystem +#define rmdir_os _wrmdir +#define putenv_os _wputenv +#define chmod_os _wchmod +#define execv_os _wexecv +#define execve_os _wexecve +#define execvp_os _wexecvp +#define execvpe_os _wexecvpe +#define strcmp_os wcscmp +#define strlen_os wcslen +#define sscanf_os swscanf + +#define caml_stat_strdup_os caml_stat_wcsdup +#define caml_stat_strconcat_os caml_stat_wcsconcat + +#define caml_stat_strdup_to_os caml_stat_strdup_to_utf16 +#define caml_stat_strdup_of_os caml_stat_strdup_of_utf16 +#define caml_copy_string_of_os caml_copy_string_of_utf16 + +#else /* _WIN32 */ + +typedef char char_os; + +#define _T(x) x + +#define access_os access +#define open_os open +#define stat_os stat +#define unlink_os unlink +#define rename_os rename +#define chdir_os chdir +#define getcwd_os getcwd +#define system_os system +#define rmdir_os rmdir +#define putenv_os putenv +#define chmod_os chmod +#define execv_os execv +#define execve_os execve +#define execvp_os execvp +#define execvpe_os execvpe +#define strcmp_os strcmp +#define strlen_os strlen +#define sscanf_os sscanf + +#define caml_stat_strdup_os caml_stat_strdup +#define caml_stat_strconcat_os caml_stat_strconcat + +#define caml_stat_strdup_to_os caml_stat_strdup +#define caml_stat_strdup_of_os caml_stat_strdup +#define caml_copy_string_of_os caml_copy_string + +#endif /* _WIN32 */ + + +/* Use macros for some system calls being called from OCaml itself. + These calls can be either traced for security reasons, or changed to + virtualize the program. */ + + +#ifndef CAML_WITH_CPLUGINS + +#define CAML_SYS_EXIT(retcode) exit(retcode) +#define CAML_SYS_OPEN(filename,flags,perm) open_os(filename,flags,perm) +#define CAML_SYS_CLOSE(fd) close(fd) +#define CAML_SYS_STAT(filename,st) stat_os(filename,st) +#define CAML_SYS_UNLINK(filename) unlink_os(filename) +#define CAML_SYS_RENAME(old_name,new_name) rename_os(old_name, new_name) +#define CAML_SYS_CHDIR(dirname) chdir_os(dirname) +#define CAML_SYS_GETENV(varname) getenv(varname) +#define CAML_SYS_SYSTEM(command) system_os(command) +#define CAML_SYS_READ_DIRECTORY(dirname,tbl) caml_read_directory(dirname,tbl) + +#else + + +#define CAML_CPLUGINS_EXIT 0 +#define CAML_CPLUGINS_OPEN 1 +#define CAML_CPLUGINS_CLOSE 2 +#define CAML_CPLUGINS_STAT 3 +#define CAML_CPLUGINS_UNLINK 4 +#define CAML_CPLUGINS_RENAME 5 +#define CAML_CPLUGINS_CHDIR 6 +#define CAML_CPLUGINS_GETENV 7 +#define CAML_CPLUGINS_SYSTEM 8 +#define CAML_CPLUGINS_READ_DIRECTORY 9 +#define CAML_CPLUGINS_PRIMS_MAX 9 + +#define CAML_CPLUGINS_PRIMS_BITMAP ((1 << CAML_CPLUGINS_PRIMS_MAX)-1) + +extern intnat (*caml_cplugins_prim)(int,intnat,intnat,intnat); + +#define CAML_SYS_PRIM_1(code,prim,arg1) \ + (caml_cplugins_prim == NULL) ? prim(arg1) : \ + caml_cplugins_prim(code,(intnat) (arg1),0,0) +#define CAML_SYS_STRING_PRIM_1(code,prim,arg1) \ + (caml_cplugins_prim == NULL) ? prim(arg1) : \ + (char_os*)caml_cplugins_prim(code,(intnat) (arg1),0,0) +#define CAML_SYS_VOID_PRIM_1(code,prim,arg1) \ + (caml_cplugins_prim == NULL) ? prim(arg1) : \ + (void)caml_cplugins_prim(code,(intnat) (arg1),0,0) +#define CAML_SYS_PRIM_2(code,prim,arg1,arg2) \ + (caml_cplugins_prim == NULL) ? prim(arg1,arg2) : \ + caml_cplugins_prim(code,(intnat) (arg1), (intnat) (arg2),0) +#define CAML_SYS_PRIM_3(code,prim,arg1,arg2,arg3) \ + (caml_cplugins_prim == NULL) ? prim(arg1,arg2,arg3) : \ + caml_cplugins_prim(code,(intnat) (arg1), (intnat) (arg2),(intnat) (arg3)) + +#define CAML_SYS_EXIT(retcode) \ + CAML_SYS_VOID_PRIM_1(CAML_CPLUGINS_EXIT,exit,retcode) +#define CAML_SYS_OPEN(filename,flags,perm) \ + CAML_SYS_PRIM_3(CAML_CPLUGINS_OPEN,open_os,filename,flags,perm) +#define CAML_SYS_CLOSE(fd) \ + CAML_SYS_PRIM_1(CAML_CPLUGINS_CLOSE,close,fd) +#define CAML_SYS_STAT(filename,st) \ + CAML_SYS_PRIM_2(CAML_CPLUGINS_STAT,stat_os,filename,st) +#define CAML_SYS_UNLINK(filename) \ + CAML_SYS_PRIM_1(CAML_CPLUGINS_UNLINK,unlink_os,filename) +#define CAML_SYS_RENAME(old_name,new_name) \ + CAML_SYS_PRIM_2(CAML_CPLUGINS_RENAME,rename_os,old_name,new_name) +#define CAML_SYS_CHDIR(dirname) \ + CAML_SYS_PRIM_1(CAML_CPLUGINS_CHDIR,chdir_os,dirname) +#define CAML_SYS_GETENV(varname) \ + CAML_SYS_STRING_PRIM_1(CAML_CPLUGINS_GETENV,getenv,varname) +#define CAML_SYS_SYSTEM(command) \ + CAML_SYS_PRIM_1(CAML_CPLUGINS_SYSTEM,system_os,command) +#define CAML_SYS_READ_DIRECTORY(dirname,tbl) \ + CAML_SYS_PRIM_2(CAML_CPLUGINS_READ_DIRECTORY,caml_read_directory, \ + dirname,tbl) + +#define CAML_CPLUGIN_CONTEXT_API 0 + +struct cplugin_context { + int api_version; + int prims_bitmap; + char_os *exe_name; + char_os** argv; + char_os *plugin; /* absolute filename of plugin, do a copy if you need it ! */ + char *ocaml_version; +/* end of CAML_CPLUGIN_CONTEXT_API version 0 */ +}; + +extern void caml_cplugins_init(char_os * exe_name, char_os **argv); + +/* A plugin MUST define a symbol "caml_cplugin_init" with the prototype: + +void caml_cplugin_init(struct cplugin_context *ctx) +*/ + +/* to write plugins for CAML_SYS_READ_DIRECTORY, we will need the + definition of struct ext_table to be public. */ + +#endif /* CAML_WITH_CPLUGINS */ + +/* Data structures */ + +struct ext_table { + int size; + int capacity; + void ** contents; +}; + +extern void caml_ext_table_init(struct ext_table * tbl, int init_capa); +extern int caml_ext_table_add(struct ext_table * tbl, void * data); +extern void caml_ext_table_remove(struct ext_table * tbl, void * data); +extern void caml_ext_table_free(struct ext_table * tbl, int free_entries); +extern void caml_ext_table_clear(struct ext_table * tbl, int free_entries); + +CAMLextern int caml_read_directory(char_os * dirname, struct ext_table * contents); + +/* Deprecated aliases */ +#define caml_aligned_malloc caml_stat_alloc_aligned_noexc +#define caml_strdup caml_stat_strdup +#define caml_strconcat caml_stat_strconcat + +#ifdef CAML_INTERNALS + +/* GC flags and messages */ + +extern uintnat caml_verb_gc; +void caml_gc_message (int, char *, ...) +#ifdef __GNUC__ + __attribute__ ((format (printf, 2, 3))) +#endif +; + +/* Runtime warnings */ +extern uintnat caml_runtime_warnings; +int caml_runtime_warnings_active(void); + +#ifdef DEBUG +#ifdef ARCH_SIXTYFOUR +#define Debug_tag(x) (0xD700D7D7D700D6D7ul \ + | ((uintnat) (x) << 16) \ + | ((uintnat) (x) << 48)) +#else +#define Debug_tag(x) (0xD700D6D7ul | ((uintnat) (x) << 16)) +#endif /* ARCH_SIXTYFOUR */ + +/* + 00 -> free words in minor heap + 01 -> fields of free list blocks in major heap + 03 -> heap chunks deallocated by heap shrinking + 04 -> fields deallocated by [caml_obj_truncate] + 10 -> uninitialised fields of minor objects + 11 -> uninitialised fields of major objects + 15 -> uninitialised words of [caml_stat_alloc_aligned] blocks + 85 -> filler bytes of [caml_stat_alloc_aligned] + 99 -> the magic prefix of a memory block allocated by [caml_stat_alloc] + + special case (byte by byte): + D7 -> uninitialised words of [caml_stat_alloc] blocks +*/ +#define Debug_free_minor Debug_tag (0x00) +#define Debug_free_major Debug_tag (0x01) +#define Debug_free_shrink Debug_tag (0x03) +#define Debug_free_truncate Debug_tag (0x04) +#define Debug_uninit_minor Debug_tag (0x10) +#define Debug_uninit_major Debug_tag (0x11) +#define Debug_uninit_align Debug_tag (0x15) +#define Debug_filler_align Debug_tag (0x85) +#define Debug_pool_magic Debug_tag (0x99) + +#define Debug_uninit_stat 0xD7 + +/* Note: the first argument is in fact a [value] but we don't have this + type available yet because we can't include [mlvalues.h] in this file. +*/ +extern void caml_set_fields (intnat v, unsigned long, unsigned long); +#endif /* DEBUG */ + + +/* snprintf emulation for Win32 */ + +#if defined(_WIN32) && !defined(_UCRT) +extern int caml_snprintf(char * buf, size_t size, const char * format, ...); +#define snprintf caml_snprintf +#endif + +#ifdef CAML_INSTR +/* Timers and counters for GC latency profiling (Linux-only) */ + +#include <time.h> +#include <stdio.h> + +extern intnat caml_stat_minor_collections; +extern intnat CAML_INSTR_STARTTIME, CAML_INSTR_STOPTIME; + +struct CAML_INSTR_BLOCK { + struct timespec ts[10]; + char *tag[10]; + int index; + struct CAML_INSTR_BLOCK *next; +}; + +extern struct CAML_INSTR_BLOCK *CAML_INSTR_LOG; + +/* Declare a timer/counter name. [t] must be a new variable name. */ +#define CAML_INSTR_DECLARE(t) \ + struct CAML_INSTR_BLOCK *t = NULL + +/* Allocate the data block for a given name. + [t] must have been declared with [CAML_INSTR_DECLARE]. */ +#define CAML_INSTR_ALLOC(t) do{ \ + if (caml_stat_minor_collections >= CAML_INSTR_STARTTIME \ + && caml_stat_minor_collections < CAML_INSTR_STOPTIME){ \ + t = caml_stat_alloc_noexc (sizeof (struct CAML_INSTR_BLOCK)); \ + t->index = 0; \ + t->tag[0] = ""; \ + t->next = CAML_INSTR_LOG; \ + CAML_INSTR_LOG = t; \ + } \ + }while(0) + +/* Allocate the data block and start the timer. + [t] must have been declared with [CAML_INSTR_DECLARE] + and allocated with [CAML_INSTR_ALLOC]. */ +#define CAML_INSTR_START(t, msg) do{ \ + if (t != NULL){ \ + t->tag[0] = msg; \ + clock_gettime (CLOCK_REALTIME, &(t->ts[0])); \ + } \ + }while(0) + +/* Declare a timer, allocate its data, and start it. + [t] must be a new variable name. */ +#define CAML_INSTR_SETUP(t, msg) \ + CAML_INSTR_DECLARE (t); \ + CAML_INSTR_ALLOC (t); \ + CAML_INSTR_START (t, msg) + +/* Record an intermediate time within a given timer. + [t] must have been declared, allocated, and started. */ +#define CAML_INSTR_TIME(t, msg) do{ \ + if (t != NULL){ \ + ++ t->index; \ + t->tag[t->index] = (msg); \ + clock_gettime (CLOCK_REALTIME, &(t->ts[t->index])); \ + } \ + }while(0) + +/* Record an integer data point. + If [msg] ends with # it will be interpreted as an integer-valued event. + If it ends with @ it will be interpreted as an event counter. +*/ +#define CAML_INSTR_INT(msg, data) do{ \ + CAML_INSTR_SETUP (__caml_tmp, ""); \ + if (__caml_tmp != NULL){ \ + __caml_tmp->index = 1; \ + __caml_tmp->tag[1] = msg; \ + __caml_tmp->ts[1].tv_sec = 0; \ + __caml_tmp->ts[1].tv_nsec = (data); \ + } \ + }while(0) + +/* This function is called at the start of the program to set up + the data for the above macros. +*/ +extern void CAML_INSTR_INIT (void); + +/* This function is automatically called by the runtime to output + the collected data to the dump file. */ +extern void CAML_INSTR_ATEXIT (void); + +#else /* CAML_INSTR */ + +#define CAML_INSTR_DECLARE(t) /**/ +#define CAML_INSTR_ALLOC(t) /**/ +#define CAML_INSTR_START(t, name) /**/ +#define CAML_INSTR_SETUP(t, name) /**/ +#define CAML_INSTR_TIME(t, msg) /**/ +#define CAML_INSTR_INT(msg, c) /**/ +#define CAML_INSTR_INIT() /**/ +#define CAML_INSTR_ATEXIT() /**/ + +#endif /* CAML_INSTR */ + +#endif /* CAML_INTERNALS */ + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_MISC_H */ diff --git a/test/monniaux/ocaml/byterun/caml/mlvalues.h b/test/monniaux/ocaml/byterun/caml/mlvalues.h new file mode 100644 index 00000000..ec30b20a --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/mlvalues.h @@ -0,0 +1,377 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy and Damien Doligez, 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_MLVALUES_H +#define CAML_MLVALUES_H + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "config.h" +#include "misc.h" + +#ifdef __cplusplus +extern "C" { +#endif + +/* Definitions + + word: Four bytes on 32 and 16 bit architectures, + eight bytes on 64 bit architectures. + long: A C integer having the same number of bytes as a word. + val: The ML representation of something. A long or a block or a pointer + outside the heap. If it is a block, it is the (encoded) address + of an object. If it is a long, it is encoded as well. + block: Something allocated. It always has a header and some + fields or some number of bytes (a multiple of the word size). + field: A word-sized val which is part of a block. + bp: Pointer to the first byte of a block. (a char *) + op: Pointer to the first field of a block. (a value *) + hp: Pointer to the header of a block. (a char *) + int32_t: Four bytes on all architectures. + int64_t: Eight bytes on all architectures. + + Remark: A block size is always a multiple of the word size, and at least + one word plus the header. + + bosize: Size (in bytes) of the "bytes" part. + wosize: Size (in words) of the "fields" part. + bhsize: Size (in bytes) of the block with its header. + whsize: Size (in words) of the block with its header. + + hd: A header. + tag: The value of the tag field of the header. + color: The value of the color field of the header. + This is for use only by the GC. +*/ + +typedef intnat value; +typedef uintnat header_t; +typedef uintnat mlsize_t; +typedef unsigned int tag_t; /* Actually, an unsigned char */ +typedef uintnat color_t; +typedef uintnat mark_t; + +/* Longs vs blocks. */ +#define Is_long(x) (((x) & 1) != 0) +#define Is_block(x) (((x) & 1) == 0) + +/* Conversion macro names are always of the form "to_from". */ +/* Example: Val_long as in "Val from long" or "Val of long". */ +#define Val_long(x) ((intnat) (((uintnat)(x) << 1)) + 1) +#define Long_val(x) ((x) >> 1) +#define Max_long (((intnat)1 << (8 * sizeof(value) - 2)) - 1) +#define Min_long (-((intnat)1 << (8 * sizeof(value) - 2))) +#define Val_int(x) Val_long(x) +#define Int_val(x) ((int) Long_val(x)) +#define Unsigned_long_val(x) ((uintnat)(x) >> 1) +#define Unsigned_int_val(x) ((int) Unsigned_long_val(x)) + +/* Structure of the header: + +For 16-bit and 32-bit architectures: + +--------+-------+-----+ + | wosize | color | tag | + +--------+-------+-----+ +bits 31 10 9 8 7 0 + +For 64-bit architectures: + + +--------+-------+-----+ + | wosize | color | tag | + +--------+-------+-----+ +bits 63 10 9 8 7 0 + +For x86-64 with Spacetime profiling: + P = PROFINFO_WIDTH (as set by "configure", currently 26 bits, giving a + maximum block size of just under 4Gb) + +----------------+----------------+-------------+ + | profiling info | wosize | color | tag | + +----------------+----------------+-------------+ +bits 63 (64-P) (63-P) 10 9 8 7 0 + +*/ + +#define Tag_hd(hd) ((tag_t) ((hd) & 0xFF)) + +#define Gen_profinfo_shift(width) (64 - (width)) +#define Gen_profinfo_mask(width) ((1ull << (width)) - 1ull) +#define Gen_profinfo_hd(width, hd) \ + (((mlsize_t) ((hd) >> (Gen_profinfo_shift(width)))) \ + & (Gen_profinfo_mask(width))) + +#ifdef WITH_PROFINFO +#define PROFINFO_SHIFT (Gen_profinfo_shift(PROFINFO_WIDTH)) +#define PROFINFO_MASK (Gen_profinfo_mask(PROFINFO_WIDTH)) +#define Hd_no_profinfo(hd) ((hd) & ~(PROFINFO_MASK << PROFINFO_SHIFT)) +#define Wosize_hd(hd) ((mlsize_t) ((Hd_no_profinfo(hd)) >> 10)) +#define Profinfo_hd(hd) (Gen_profinfo_hd(PROFINFO_WIDTH, hd)) +#else +#define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10)) +#endif /* WITH_PROFINFO */ + +#define Hd_val(val) (((header_t *) (val)) [-1]) /* Also an l-value. */ +#define Hd_op(op) (Hd_val (op)) /* Also an l-value. */ +#define Hd_bp(bp) (Hd_val (bp)) /* Also an l-value. */ +#define Hd_hp(hp) (* ((header_t *) (hp))) /* Also an l-value. */ +#define Hp_val(val) (((header_t *) (val)) - 1) +#define Hp_op(op) (Hp_val (op)) +#define Hp_bp(bp) (Hp_val (bp)) +#define Val_op(op) ((value) (op)) +#define Val_hp(hp) ((value) (((header_t *) (hp)) + 1)) +#define Op_hp(hp) ((value *) Val_hp (hp)) +#define Bp_hp(hp) ((char *) Val_hp (hp)) + +#define Num_tags (1 << 8) +#ifdef ARCH_SIXTYFOUR +#define Max_wosize (((intnat)1 << (54-PROFINFO_WIDTH)) - 1) +#else +#define Max_wosize ((1 << 22) - 1) +#endif /* ARCH_SIXTYFOUR */ + +#define Wosize_val(val) (Wosize_hd (Hd_val (val))) +#define Wosize_op(op) (Wosize_val (op)) +#define Wosize_bp(bp) (Wosize_val (bp)) +#define Wosize_hp(hp) (Wosize_hd (Hd_hp (hp))) +#define Whsize_wosize(sz) ((sz) + 1) +#define Wosize_whsize(sz) ((sz) - 1) +#define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1) +#define Bsize_wsize(sz) ((sz) * sizeof (value)) +#define Wsize_bsize(sz) ((sz) / sizeof (value)) +#define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz))) +#define Bhsize_bosize(sz) ((sz) + sizeof (header_t)) +#define Bosize_val(val) (Bsize_wsize (Wosize_val (val))) +#define Bosize_op(op) (Bosize_val (Val_op (op))) +#define Bosize_bp(bp) (Bosize_val (Val_bp (bp))) +#define Bosize_hd(hd) (Bsize_wsize (Wosize_hd (hd))) +#define Whsize_hp(hp) (Whsize_wosize (Wosize_hp (hp))) +#define Whsize_val(val) (Whsize_hp (Hp_val (val))) +#define Whsize_bp(bp) (Whsize_val (Val_bp (bp))) +#define Whsize_hd(hd) (Whsize_wosize (Wosize_hd (hd))) +#define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp))) +#define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd))) + +#define Profinfo_val(val) (Profinfo_hd (Hd_val (val))) + +#ifdef ARCH_BIG_ENDIAN +#define Tag_val(val) (((unsigned char *) (val)) [-1]) + /* Also an l-value. */ +#define Tag_hp(hp) (((unsigned char *) (hp)) [sizeof(value)-1]) + /* Also an l-value. */ +#else +#define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)]) + /* Also an l-value. */ +#define Tag_hp(hp) (((unsigned char *) (hp)) [0]) + /* Also an l-value. */ +#endif + +/* The lowest tag for blocks containing no value. */ +#define No_scan_tag 251 + + +/* 1- If tag < No_scan_tag : a tuple of fields. */ + +/* Pointer to the first field. */ +#define Op_val(x) ((value *) (x)) +/* Fields are numbered from 0. */ +#define Field(x, i) (((value *)(x)) [i]) /* Also an l-value. */ + +typedef int32_t opcode_t; +typedef opcode_t * code_t; + +/* NOTE: [Forward_tag] and [Infix_tag] must be just under + [No_scan_tag], with [Infix_tag] the lower one. + See [caml_oldify_one] in minor_gc.c for more details. + + NOTE: Update stdlib/obj.ml whenever you change the tags. + */ + +/* Forward_tag: forwarding pointer that the GC may silently shortcut. + See stdlib/lazy.ml. */ +#define Forward_tag 250 +#define Forward_val(v) Field(v, 0) + +/* If tag == Infix_tag : an infix header inside a closure */ +/* Infix_tag must be odd so that the infix header is scanned as an integer */ +/* Infix_tag must be 1 modulo 4 and infix headers can only occur in blocks + with tag Closure_tag (see compact.c). */ + +#define Infix_tag 249 +#define Infix_offset_hd(hd) (Bosize_hd(hd)) +#define Infix_offset_val(v) Infix_offset_hd(Hd_val(v)) + +/* Another special case: objects */ +#define Object_tag 248 +#define Class_val(val) Field((val), 0) +#define Oid_val(val) Long_val(Field((val), 1)) +CAMLextern value caml_get_public_method (value obj, value tag); +/* Called as: + caml_callback(caml_get_public_method(obj, caml_hash_variant(name)), obj) */ +/* caml_get_public_method returns 0 if tag not in the table. + Note however that tags being hashed, same tag does not necessarily mean + same method name. */ + +/* Special case of tuples of fields: closures */ +#define Closure_tag 247 +#define Code_val(val) (((code_t *) (val)) [0]) /* Also an l-value. */ + +/* This tag is used (with Forward_tag) to implement lazy values. + See major_gc.c and stdlib/lazy.ml. */ +#define Lazy_tag 246 + +/* Another special case: variants */ +CAMLextern value caml_hash_variant(char const * tag); + +/* 2- If tag >= No_scan_tag : a sequence of bytes. */ + +/* Pointer to the first byte */ +#define Bp_val(v) ((char *) (v)) +#define Val_bp(p) ((value) (p)) +/* Bytes are numbered from 0. */ +#define Byte(x, i) (((char *) (x)) [i]) /* Also an l-value. */ +#define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */ + +/* Abstract things. Their contents is not traced by the GC; therefore they + must not contain any [value]. Must have odd number so that headers with + this tag cannot be mistaken for pointers (see caml_obj_truncate). +*/ +#define Abstract_tag 251 +#define Data_abstract_val(v) ((void*) Op_val(v)) + +/* Strings. */ +#define String_tag 252 +#ifdef CAML_SAFE_STRING +#define String_val(x) ((const char *) Bp_val(x)) +#else +#define String_val(x) ((char *) Bp_val(x)) +#endif +#define Bytes_val(x) ((unsigned char *) Bp_val(x)) +CAMLextern mlsize_t caml_string_length (value); /* size in bytes */ +CAMLextern int caml_string_is_c_safe (value); + /* true if string contains no '\0' null characters */ + +/* Floating-point numbers. */ +#define Double_tag 253 +#define Double_wosize ((sizeof(double) / sizeof(value))) +#ifndef ARCH_ALIGN_DOUBLE +#define Double_val(v) (* (double *)(v)) +#define Store_double_val(v,d) (* (double *)(v) = (d)) +#else +CAMLextern double caml_Double_val (value); +CAMLextern void caml_Store_double_val (value,double); +#define Double_val(v) caml_Double_val(v) +#define Store_double_val(v,d) caml_Store_double_val(v,d) +#endif + +/* Arrays of floating-point numbers. */ +#define Double_array_tag 254 + +/* The [_flat_field] macros are for [floatarray] values and float-only records. +*/ +#define Double_flat_field(v,i) Double_val((value)((double *)(v) + (i))) +#define Store_double_flat_field(v,i,d) do{ \ + mlsize_t caml__temp_i = (i); \ + double caml__temp_d = (d); \ + Store_double_val((value)((double *) (v) + caml__temp_i), caml__temp_d); \ +}while(0) + +/* The [_array_field] macros are for [float array]. */ +#ifdef FLAT_FLOAT_ARRAY + #define Double_array_field(v,i) Double_flat_field(v,i) + #define Store_double_array_field(v,i,d) Store_double_flat_field(v,i,d) +#else + #define Double_array_field(v,i) Double_val (Field(v,i)) + CAMLextern void caml_Store_double_array_field (value, mlsize_t, double); + #define Store_double_array_field(v,i,d) caml_Store_double_array_field (v,i,d) +#endif + +/* The old [_field] macros are for backward compatibility only. + They work with [floatarray], float-only records, and [float array]. */ +#ifdef FLAT_FLOAT_ARRAY + #define Double_field(v,i) Double_flat_field(v,i) + #define Store_double_field(v,i,d) Store_double_flat_field(v,i,d) +#else + static inline double Double_field (value v, mlsize_t i) { + if (Tag_val (v) == Double_array_tag){ + return Double_flat_field (v, i); + }else{ + return Double_array_field (v, i); + } + } + static inline void Store_double_field (value v, mlsize_t i, double d) { + if (Tag_val (v) == Double_array_tag){ + Store_double_flat_field (v, i, d); + }else{ + Store_double_array_field (v, i, d); + } + } +#endif /* FLAT_FLOAT_ARRAY */ + +CAMLextern mlsize_t caml_array_length (value); /* size in items */ +CAMLextern int caml_is_double_array (value); /* 0 is false, 1 is true */ + + +/* Custom blocks. They contain a pointer to a "method suite" + of functions (for finalization, comparison, hashing, etc) + followed by raw data. The contents of custom blocks is not traced by + the GC; therefore, they must not contain any [value]. + See [custom.h] for operations on method suites. */ +#define Custom_tag 255 +#define Data_custom_val(v) ((void *) &Field((v), 1)) +struct custom_operations; /* defined in [custom.h] */ + +/* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */ + +#define Int32_val(v) (*((int32_t *) Data_custom_val(v))) +#define Nativeint_val(v) (*((intnat *) Data_custom_val(v))) +#ifndef ARCH_ALIGN_INT64 +#define Int64_val(v) (*((int64_t *) Data_custom_val(v))) +#else +CAMLextern int64_t caml_Int64_val(value v); +#define Int64_val(v) caml_Int64_val(v) +#endif + +/* 3- Atoms are 0-tuples. They are statically allocated once and for all. */ + +CAMLextern header_t caml_atom_table[]; +#define Atom(tag) (Val_hp (&(caml_atom_table [(tag)]))) + +/* Booleans are integers 0 or 1 */ + +#define Val_bool(x) Val_int((x) != 0) +#define Bool_val(x) Int_val(x) +#define Val_false Val_int(0) +#define Val_true Val_int(1) +#define Val_not(x) (Val_false + Val_true - (x)) + +/* The unit value is 0 (tagged) */ + +#define Val_unit Val_int(0) + +/* List constructors */ +#define Val_emptylist Val_int(0) +#define Tag_cons 0 + +/* The table of global identifiers */ + +extern value caml_global_data; + +CAMLextern value caml_set_oo_id(value obj); + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_MLVALUES_H */ diff --git a/test/monniaux/ocaml/byterun/caml/osdeps.h b/test/monniaux/ocaml/byterun/caml/osdeps.h new file mode 100644 index 00000000..b65503d8 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/osdeps.h @@ -0,0 +1,152 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2001 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. */ +/* */ +/**************************************************************************/ + +/* Operating system - specific stuff */ + +#ifndef CAML_OSDEPS_H +#define CAML_OSDEPS_H + +#ifdef _WIN32 +extern unsigned short caml_win32_major; +extern unsigned short caml_win32_minor; +extern unsigned short caml_win32_build; +extern unsigned short caml_win32_revision; +#endif + +#ifdef CAML_INTERNALS + +#include "misc.h" +#include "memory.h" + +/* Read at most [n] bytes from file descriptor [fd] into buffer [buf]. + [flags] indicates whether [fd] is a socket + (bit [CHANNEL_FLAG_FROM_SOCKET] is set in this case, see [io.h]). + (This distinction matters for Win32, but not for Unix.) + Return number of bytes read. + In case of error, raises [Sys_error] or [Sys_blocked_io]. */ +extern int caml_read_fd(int fd, int flags, void * buf, int n); + +/* Write at most [n] bytes from buffer [buf] onto file descriptor [fd]. + [flags] indicates whether [fd] is a socket + (bit [CHANNEL_FLAG_FROM_SOCKET] is set in this case, see [io.h]). + (This distinction matters for Win32, but not for Unix.) + Return number of bytes written. + In case of error, raises [Sys_error] or [Sys_blocked_io]. */ +extern int caml_write_fd(int fd, int flags, void * buf, int n); + +/* Decompose the given path into a list of directories, and add them + to the given table. */ +extern char_os * caml_decompose_path(struct ext_table * tbl, char_os * path); + +/* Search the given file in the given list of directories. + If not found, return a copy of [name]. */ +extern char_os * caml_search_in_path(struct ext_table * path, const char_os * name); + +/* Same, but search an executable name in the system path for executables. */ +CAMLextern char_os * caml_search_exe_in_path(const char_os * name); + +/* Same, but search a shared library in the given path. */ +extern char_os * caml_search_dll_in_path(struct ext_table * path, const char_os * name); + +/* Open a shared library and return a handle on it. + If [for_execution] is true, perform full symbol resolution and + execute initialization code so that functions from the shared library + can be called. If [for_execution] is false, functions from this + shared library will not be called, but just checked for presence, + so symbol resolution can be skipped. + If [global] is true, symbols from the shared library can be used + to resolve for other libraries to be opened later on. + Return [NULL] on error. */ +extern void * caml_dlopen(char_os * libname, int for_execution, int global); + +/* Close a shared library handle */ +extern void caml_dlclose(void * handle); + +/* Look up the given symbol in the given shared library. + Return [NULL] if not found, or symbol value if found. */ +extern void * caml_dlsym(void * handle, const char * name); + +extern void * caml_globalsym(const char * name); + +/* Return an error message describing the most recent dynlink failure. */ +extern char * caml_dlerror(void); + +/* 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. */ +extern int caml_read_directory(char_os * dirname, struct ext_table * contents); + +/* Recover executable name if possible (/proc/sef/exe under Linux, + GetModuleFileName under Windows). Return NULL on error, + string allocated with [caml_stat_alloc] on success. */ +extern char_os * caml_executable_name(void); + +/* Secure version of [getenv]: returns NULL if the process has special + privileges (setuid bit, setgid bit, capabilities). +*/ +extern char_os *caml_secure_getenv(char_os const *var); + +/* If [fd] refers to a terminal or console, return the number of rows + (lines) that it displays. Otherwise, or if the number of rows + cannot be determined, return -1. */ +extern int caml_num_rows_fd(int fd); + +#ifdef _WIN32 + +extern int caml_win32_rename(const wchar_t *, const wchar_t *); + +extern void caml_probe_win32_version(void); +extern void caml_setup_win32_terminal(void); +extern void caml_restore_win32_terminal(void); + +extern wchar_t *caml_win32_getenv(wchar_t const *); + +/* Windows Unicode support */ + +extern int win_multi_byte_to_wide_char(const char* s, int slen, wchar_t *out, int outlen); +extern int win_wide_char_to_multi_byte(const wchar_t* s, int slen, char *out, int outlen); + +/* [caml_stat_strdup_to_utf16(s)] returns a NULL-terminated copy of [s], + re-encoded in UTF-16. The encoding of [s] is assumed to be UTF-8 if + [caml_windows_unicode_runtime_enabled] is non-zero **and** [s] is valid + UTF-8, or the current Windows code page otherwise. + + The returned string is allocated with [caml_stat_alloc], so it should be free + using [caml_stat_free]. +*/ +extern wchar_t* caml_stat_strdup_to_utf16(const char *s); + +/* [caml_stat_strdup_of_utf16(s)] returns a NULL-terminated copy of [s], + re-encoded in UTF-8 if [caml_windows_unicode_runtime_enabled] is non-zero or + the current Windows code page otherwise. + + The returned string is allocated with [caml_stat_alloc], so it should be free + using [caml_stat_free]. +*/ +extern char* caml_stat_strdup_of_utf16(const wchar_t *s); + +/* [caml_copy_string_of_utf16(s)] returns an OCaml string containing a copy of + [s] re-encoded in UTF-8 if [caml_windows_unicode_runtime_enabled] is non-zero + or in the current code page otherwise. +*/ +extern value caml_copy_string_of_utf16(const wchar_t *s); + +extern int caml_win32_isatty(int fd); + +#endif /* _WIN32 */ + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_OSDEPS_H */ diff --git a/test/monniaux/ocaml/byterun/caml/prims.h b/test/monniaux/ocaml/byterun/caml/prims.h new file mode 100644 index 00000000..147cd98a --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/prims.h @@ -0,0 +1,40 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Interface with C primitives. */ + +#ifndef CAML_PRIMS_H +#define CAML_PRIMS_H + +#ifdef CAML_INTERNALS + +typedef value (*c_primitive)(); + +extern c_primitive caml_builtin_cprim[]; +extern char * caml_names_of_builtin_cprim[]; + +extern struct ext_table caml_prim_table; +#ifdef DEBUG +extern struct ext_table caml_prim_name_table; +#endif + +#define Primitive(n) ((c_primitive)(caml_prim_table.contents[n])) + +extern char * caml_section_table; +extern asize_t caml_section_table_size; + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_PRIMS_H */ diff --git a/test/monniaux/ocaml/byterun/caml/printexc.h b/test/monniaux/ocaml/byterun/caml/printexc.h new file mode 100644 index 00000000..92c5af53 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/printexc.h @@ -0,0 +1,35 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2001 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_PRINTEXC_H +#define CAML_PRINTEXC_H + + +#include "misc.h" +#include "mlvalues.h" + +#ifdef __cplusplus +extern "C" { +#endif + + +CAMLextern char * caml_format_exception (value); +CAMLnoreturn_start void caml_fatal_uncaught_exception (value) CAMLnoreturn_end; + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_PRINTEXC_H */ diff --git a/test/monniaux/ocaml/byterun/caml/reverse.h b/test/monniaux/ocaml/byterun/caml/reverse.h new file mode 100644 index 00000000..a186078e --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/reverse.h @@ -0,0 +1,92 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Swap byte-order in 16, 32, and 64-bit integers or floats */ + +#ifndef CAML_REVERSE_H +#define CAML_REVERSE_H + +#ifdef CAML_INTERNALS + +#define Reverse_16(dst,src) { \ + char * _p, * _q; \ + char _a; \ + _p = (char *) (src); \ + _q = (char *) (dst); \ + _a = _p[0]; \ + _q[0] = _p[1]; \ + _q[1] = _a; \ +} + +#define Reverse_32(dst,src) { \ + char * _p, * _q; \ + char _a, _b; \ + _p = (char *) (src); \ + _q = (char *) (dst); \ + _a = _p[0]; \ + _b = _p[1]; \ + _q[0] = _p[3]; \ + _q[1] = _p[2]; \ + _q[3] = _a; \ + _q[2] = _b; \ +} + +#define Reverse_64(dst,src) { \ + char * _p, * _q; \ + char _a, _b; \ + _p = (char *) (src); \ + _q = (char *) (dst); \ + _a = _p[0]; \ + _b = _p[1]; \ + _q[0] = _p[7]; \ + _q[1] = _p[6]; \ + _q[7] = _a; \ + _q[6] = _b; \ + _a = _p[2]; \ + _b = _p[3]; \ + _q[2] = _p[5]; \ + _q[3] = _p[4]; \ + _q[5] = _a; \ + _q[4] = _b; \ +} + +#define Perm_index(perm,i) ((perm >> (i * 4)) & 0xF) + +#define Permute_64(dst,perm_dst,src,perm_src) { \ + char * _p; \ + char _a, _b, _c, _d, _e, _f, _g, _h; \ + _p = (char *) (src); \ + _a = _p[Perm_index(perm_src, 0)]; \ + _b = _p[Perm_index(perm_src, 1)]; \ + _c = _p[Perm_index(perm_src, 2)]; \ + _d = _p[Perm_index(perm_src, 3)]; \ + _e = _p[Perm_index(perm_src, 4)]; \ + _f = _p[Perm_index(perm_src, 5)]; \ + _g = _p[Perm_index(perm_src, 6)]; \ + _h = _p[Perm_index(perm_src, 7)]; \ + _p = (char *) (dst); \ + _p[Perm_index(perm_dst, 0)] = _a; \ + _p[Perm_index(perm_dst, 1)] = _b; \ + _p[Perm_index(perm_dst, 2)] = _c; \ + _p[Perm_index(perm_dst, 3)] = _d; \ + _p[Perm_index(perm_dst, 4)] = _e; \ + _p[Perm_index(perm_dst, 5)] = _f; \ + _p[Perm_index(perm_dst, 6)] = _g; \ + _p[Perm_index(perm_dst, 7)] = _h; \ +} + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_REVERSE_H */ diff --git a/test/monniaux/ocaml/byterun/caml/roots.h b/test/monniaux/ocaml/byterun/caml/roots.h new file mode 100644 index 00000000..fed345d3 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/roots.h @@ -0,0 +1,44 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy and Damien Doligez, 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_ROOTS_H +#define CAML_ROOTS_H + +#ifdef CAML_INTERNALS + +#include "misc.h" +#include "memory.h" + +typedef void (*scanning_action) (value, value *); + +void caml_oldify_local_roots (void); +void caml_darken_all_roots_start (void); +intnat caml_darken_all_roots_slice (intnat); +void caml_do_roots (scanning_action, int); +extern uintnat caml_incremental_roots_count; +#ifndef NATIVE_CODE +CAMLextern void caml_do_local_roots (scanning_action, value *, value *, + struct caml__roots_block *); +#else +CAMLextern void caml_do_local_roots(scanning_action f, char * bottom_of_stack, + uintnat last_retaddr, value * gc_regs, + struct caml__roots_block * local_roots); +#endif + +CAMLextern void (*caml_scan_roots_hook) (scanning_action); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_ROOTS_H */ diff --git a/test/monniaux/ocaml/byterun/caml/s.h b/test/monniaux/ocaml/byterun/caml/s.h new file mode 100644 index 00000000..add8c1cc --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/s.h @@ -0,0 +1,217 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Operating system and standard library dependencies. */ + +/* 0. Operating system type string. */ + +#define OCAML_OS_TYPE "Unix" +/* #define OCAML_OS_TYPE "Win32" */ +/* #define OCAML_OS_TYPE "MacOS" */ +#define HAS_STDINT_H 1 + +/* 1. For the runtime system. */ + +/* #define POSIX_SIGNALS */ + +/* Define POSIX_SIGNALS if signal handling is POSIX-compliant. + In particular, sigaction(), sigprocmask() and the operations on + sigset_t are provided. */ + +/* #define BSD_SIGNALS */ + +/* Define BSD_SIGNALS if signal handlers have the BSD semantics: the handler + remains attached to the signal when the signal is received. Leave it + undefined if signal handlers have the System V semantics: the signal + resets the behavior to default. */ + +/* #define HAS_SIGSETMASK */ + +/* Define HAS_SIGSETMASK if you have sigsetmask(), as in BSD. */ + +/* #define SUPPORT_DYNAMIC_LINKING */ + +/* Define SUPPORT_DYNAMIC_LINKING if dynamic loading of C stub code + via dlopen() is available. */ + +#define HAS_C99_FLOAT_OPS + +/* Define HAS_C99_FLOAT_OPS if <math.h> conforms to ISO C99. + In particular, it should provide expm1(), log1p(), hypot(), copysign(). */ + +/* 2. For the Unix library. */ + +/* #define HAS_SOCKETS */ + +/* Define HAS_SOCKETS if you have BSD sockets. */ + +/* #define HAS_SOCKLEN_T */ + +/* Define HAS_SOCKLEN_T if the type socklen_t is defined in + /usr/include/sys/socket.h. */ + +#define HAS_UNISTD + +/* Define HAS_UNISTD if you have /usr/include/unistd.h. */ + +#define HAS_DIRENT + +/* Define HAS_DIRENT if you have /usr/include/dirent.h and the result of + readdir() is of type struct dirent *. + Otherwise, we'll load /usr/include/sys/dir.h, and readdir() is expected to + return a struct direct *. */ + +/* #define HAS_REWINDDIR */ + +/* Define HAS_REWINDDIR if you have rewinddir(). */ + +/* #define HAS_LOCKF */ + +/* Define HAS_LOCKF if the library provides the lockf() function. */ + +/* #define HAS_MKFIFO */ + +/* Define HAS_MKFIFO if the library provides the mkfifo() function. */ + +/* #define HAS_GETCWD */ + +/* Define HAS_GETCWD if the library provides the getcwd() function. */ + +#define HAS_GETPRIORITY + +/* Define HAS_GETPRIORITY if the library provides getpriority() and + setpriority(). Otherwise, we'll use nice(). */ + +#define HAS_UTIME +#define HAS_UTIMES + +/* Define HAS_UTIME if you have /usr/include/utime.h and the library + provides utime(). Define HAS_UTIMES if the library provides utimes(). */ + +#define HAS_DUP2 + +/* Define HAS_DUP2 if you have dup2(). */ + +#define HAS_FCHMOD + +/* Define HAS_FCHMOD if you have fchmod() and fchown(). */ + +#define HAS_TRUNCATE + +/* Define HAS_TRUNCATE if you have truncate() and + ftruncate(). */ + +#define HAS_SELECT + +/* Define HAS_SELECT if you have select(). */ + +#define HAS_SYS_SELECT_H + +/* Define HAS_SYS_SELECT_H if /usr/include/sys/select.h exists + and should be included before using select(). */ + +#define HAS_NANOSLEEP +/* Define HAS_NANOSLEEP if you have nanosleep(). */ + +#define HAS_SYMLINK + +/* Define HAS_SYMLINK if you have symlink() and readlink() and lstat(). */ + +#define HAS_WAIT4 +#define HAS_WAITPID + +/* Define HAS_WAIT4 if you have wait4(). + Define HAS_WAITPID if you have waitpid(). */ + +#define HAS_GETGROUPS + +/* Define HAS_GETGROUPS if you have getgroups(). */ + +#define HAS_SETGROUPS + +/* Define HAS_SETGROUPS if you have setgroups(). */ + +#define HAS_INITGROUPS + +/* Define HAS_INITGROUPS if you have initgroups(). */ + +#define HAS_TERMIOS + +/* Define HAS_TERMIOS if you have /usr/include/termios.h and it is + Posix-compliant. */ + +#define HAS_ASYNC_IO + +/* Define HAS_ASYNC_IO if BSD-style asynchronous I/O are supported + (the process can request to be sent a SIGIO signal when a descriptor + is ready for reading). */ + +#define HAS_SETITIMER + +/* Define HAS_SETITIMER if you have setitimer(). */ + +#define HAS_GETHOSTNAME + +/* Define HAS_GETHOSTNAME if you have gethostname(). */ + +#define HAS_UNAME + +/* Define HAS_UNAME if you have uname(). */ + +#define HAS_GETTIMEOFDAY + +/* Define HAS_GETTIMEOFDAY if you have gettimeofday(). */ + +#define HAS_MKTIME + +/* Define HAS_MKTIME if you have mktime(). */ + +#define HAS_SETSID + +/* Define HAS_SETSID if you have setsid(). */ + +#define HAS_PUTENV + +/* Define HAS_PUTENV if you have putenv(). */ + +#define HAS_LOCALE + +/* Define HAS_LOCALE if you have the include file <locale.h> and the + setlocale() function. */ + +#define HAS_MMAP + +/* Define HAS_MMAP if you have the include file <sys/mman.h> and the + functions mmap() and munmap(). */ + +#define HAS_GETHOSTBYNAME_R 6 + +/* Define HAS_GETHOSTBYNAME_R if gethostbyname_r() is available. + The value of this symbol is the number of arguments of + gethostbyname_r(): either 5 or 6 depending on prototype. + (5 is the Solaris version, 6 is the Linux version). */ + +#define HAS_GETHOSTBYADDR_R 8 + +/* Define HAS_GETHOSTBYADDR_R if gethostbyname_r() is available. + The value of this symbol is the number of arguments of + gethostbyaddr_r(): either 7 or 8 depending on prototype. + (7 is the Solaris version, 8 is the Linux version). */ + +#define HAS_NICE + +/* Define HAS_NICE if you have nice(). */ + +#define OCAML_STDLIB_DIR "/opt/ccomp/ocaml/4.07.1/lib/ocaml" diff --git a/test/monniaux/ocaml/byterun/caml/signals.h b/test/monniaux/ocaml/byterun/caml/signals.h new file mode 100644 index 00000000..99924e4f --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/signals.h @@ -0,0 +1,59 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy and Damien Doligez, 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_SIGNALS_H +#define CAML_SIGNALS_H + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "misc.h" +#include "mlvalues.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef CAML_INTERNALS +CAMLextern intnat volatile caml_signals_are_pending; +CAMLextern intnat volatile caml_pending_signals[]; +CAMLextern int volatile caml_something_to_do; +extern int volatile caml_requested_major_slice; +extern int volatile caml_requested_minor_gc; + +void caml_request_major_slice (void); +void caml_request_minor_gc (void); +CAMLextern int caml_convert_signal_number (int); +CAMLextern int caml_rev_convert_signal_number (int); +void caml_execute_signal(int signal_number, int in_signal_handler); +void caml_record_signal(int signal_number); +void caml_process_pending_signals(void); +void caml_process_event(void); +int caml_set_signal_action(int signo, int action); + +CAMLextern void (*caml_enter_blocking_section_hook)(void); +CAMLextern void (*caml_leave_blocking_section_hook)(void); +CAMLextern int (*caml_try_leave_blocking_section_hook)(void); +CAMLextern void (* volatile caml_async_action_hook)(void); +#endif /* CAML_INTERNALS */ + +CAMLextern void caml_enter_blocking_section (void); +CAMLextern void caml_leave_blocking_section (void); + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_SIGNALS_H */ diff --git a/test/monniaux/ocaml/byterun/caml/signals_machdep.h b/test/monniaux/ocaml/byterun/caml/signals_machdep.h new file mode 100644 index 00000000..ae2145ba --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/signals_machdep.h @@ -0,0 +1,74 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy and Damien Doligez, 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. */ +/* */ +/**************************************************************************/ + +/* Processor-specific operation: atomic "read and clear" */ + +#ifndef CAML_SIGNALS_MACHDEP_H +#define CAML_SIGNALS_MACHDEP_H + +#ifdef CAML_INTERNALS + +#if defined(__GNUC__) && defined(__ATOMIC_SEQ_CST) \ + && defined(__GCC_ATOMIC_LONG_LOCK_FREE) && 0 + +/* Use the "atomic" builtins of GCC and Clang */ +#define Read_and_clear(dst,src) \ + ((dst) = __atomic_exchange_n(&(src), 0, __ATOMIC_SEQ_CST)) + +#elif defined(__GNUC__) && (defined(__i386__) || (defined(__x86_64__) \ + && defined(__ILP32__))) + +#define Read_and_clear(dst,src) \ + asm("xorl %0, %0; xchgl %0, %1" \ + : "=r" (dst), "=m" (src) \ + : "m" (src)) + +#elif defined(__GNUC__) && defined(__x86_64__) + +#define Read_and_clear(dst,src) \ + asm("xorq %0, %0; xchgq %0, %1" \ + : "=r" (dst), "=m" (src) \ + : "m" (src)) + +#elif defined(__GNUC__) && defined(__ppc__) + +#define Read_and_clear(dst,src) \ + asm("0: lwarx %0, 0, %1\n\t" \ + "stwcx. %2, 0, %1\n\t" \ + "bne- 0b" \ + : "=&r" (dst) \ + : "r" (&(src)), "r" (0) \ + : "cr0", "memory") + +#elif defined(__GNUC__) && defined(__ppc64__) + +#define Read_and_clear(dst,src) \ + asm("0: ldarx %0, 0, %1\n\t" \ + "stdcx. %2, 0, %1\n\t" \ + "bne- 0b" \ + : "=&r" (dst) \ + : "r" (&(src)), "r" (0) \ + : "cr0", "memory") + +#else + +/* Default, non-atomic implementation */ +#define Read_and_clear(dst,src) ((dst) = (src), (src) = 0) + +#endif + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_SIGNALS_MACHDEP_H */ diff --git a/test/monniaux/ocaml/byterun/caml/spacetime.h b/test/monniaux/ocaml/byterun/caml/spacetime.h new file mode 100644 index 00000000..5bcc9232 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/spacetime.h @@ -0,0 +1,203 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Mark Shinwell and Leo White, Jane Street Europe */ +/* */ +/* Copyright 2013--2016, Jane Street Group, LLC */ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_SPACETIME_H +#define CAML_SPACETIME_H + +#include "io.h" +#include "misc.h" +#include "stack.h" + +/* Runtime support for Spacetime profiling. + * This header file is not intended for the casual user. + * + * The implementation is split into three files: + * 1. spacetime.c: core management of the instrumentation; + * 2. spacetime_snapshot.c: the taking of heap snapshots; + * 3. spacetime_offline.c: functions that are also used when examining + * saved profiling data. + */ + +typedef enum { + CALL, + ALLOCATION +} c_node_type; + +/* All pointers between nodes point at the word immediately after the + GC headers, and everything is traversable using the normal OCaml rules. + + On entry to an OCaml function: + If the node hole pointer register has the bottom bit set, then the function + is being tail called or called from a self-recursive call site: + - If the node hole is empty, the callee must create a new node and link + it into the tail chain. The node hole pointer will point at the tail + chain. + - Otherwise the node should be used as normal. + Otherwise (not a tail call): + - If the node hole is empty, the callee must create a new node, but the + tail chain is untouched. + - Otherwise the node should be used as normal. +*/ + +/* Classification of nodes (OCaml or C) with corresponding GC tags. */ +#define OCaml_node_tag 0 +#define C_node_tag 1 +#define Is_ocaml_node(node) (Is_block(node) && Tag_val(node) == OCaml_node_tag) +#define Is_c_node(node) (Is_block(node) && Tag_val(node) == C_node_tag) + +/* The header words are: + 1. The node program counter. + 2. The tail link. */ +#define Node_num_header_words 2 + +/* The "node program counter" at the start of an OCaml node. */ +#define Node_pc(node) (Field(node, 0)) +#define Encode_node_pc(pc) (((value) pc) | 1) +#define Decode_node_pc(encoded_pc) ((void*) (encoded_pc & ~1)) + +/* The circular linked list of tail-called functions within OCaml nodes. */ +#define Tail_link(node) (Field(node, 1)) + +/* The convention for pointers from OCaml nodes to other nodes. There are + two special cases: + 1. [Val_unit] means "uninitialized", and further, that this is not a + tail call point. (Tail call points are pre-initialized, as in case 2.) + 2. If the bottom bit is set, and the value is not [Val_unit], this is a + tail call point. */ +#define Encode_tail_caller_node(node) ((node) | 1) +#define Decode_tail_caller_node(node) ((node) & ~1) +#define Is_tail_caller_node_encoded(node) (((node) & 1) == 1) + +/* Allocation points within OCaml nodes. + The "profinfo" value looks exactly like a black Infix_tag header. + This enables us to point just after it and return such pointer as a valid + OCaml value. (Used for the list of all allocation points. We could do + without this and instead just encode the list pointers as integers, but + this would mean that the structure was destroyed on marshalling. This + might not be a great problem since it is intended that the total counts + be obtained via snapshots, but it seems neater and easier to use + Infix_tag. + The "count" is just an OCaml integer giving the total number of words + (including headers) allocated at the point. + The "pointer to next allocation point" points to the "count" word of the + next allocation point in the linked list of all allocation points. + There is no special encoding needed by virtue of the [Infix_tag] trick. */ +#define Alloc_point_profinfo(node, offset) (Field(node, offset)) +#define Alloc_point_count(node, offset) (Field(node, offset + 1)) +#define Alloc_point_next_ptr(node, offset) (Field(node, offset + 2)) + +/* Direct call points (tail or non-tail) within OCaml nodes. + They hold a pointer to the child node and (if the compiler was so + configured) a call count. + The call site and callee are both recorded in the shape. */ +#define Direct_callee_node(node,offset) (Field(node, offset)) +#define Direct_call_count(node,offset) (Field(node, offset + 1)) +#define Encode_call_point_pc(pc) (((value) pc) | 1) +#define Decode_call_point_pc(pc) ((void*) (((value) pc) & ~((uintnat) 1))) + +/* Indirect call points (tail or non-tail) within OCaml nodes. + They hold a linked list of (PC upon entry to the callee, pointer to + child node) pairs. The linked list is encoded using C nodes and should + be thought of as part of the OCaml node itself. */ +#define Indirect_num_fields 1 +#define Indirect_pc_linked_list(node,offset) (Field(node, offset)) + +/* Encodings of the program counter value within a C node. */ +#define Encode_c_node_pc_for_call(pc) ((((value) pc) << 2) | 3) +#define Encode_c_node_pc_for_alloc_point(pc) ((((value) pc) << 2) | 1) +#define Decode_c_node_pc(pc) ((void*) (((uintnat) (pc)) >> 2)) + +typedef struct { + /* The layout and encoding of this structure must match that of the + allocation points within OCaml nodes, so that the linked list + traversal across all allocation points works correctly. */ + value profinfo; /* encoded using [Infix_tag] (see above) */ + value count; + /* [next] is [Val_unit] for the end of the list. + Otherwise it points at the second word of this [allocation_point] + structure. */ + value next; +} allocation_point; + +typedef struct { + value callee_node; + value call_count; +} call_point; + +typedef struct { + /* CR-soon mshinwell: delete [gc_header], all the offset arithmetic will + then go away */ + uintnat gc_header; + uintnat pc; /* see above for encodings */ + union { + call_point call; /* for CALL */ + allocation_point allocation; /* for ALLOCATION */ + } data; + value next; /* [Val_unit] for the end of the list */ +} c_node; /* CR-soon mshinwell: rename to dynamic_node */ + +typedef struct shape_table { + uint64_t* table; + struct shape_table* next; +} shape_table; + +extern uint64_t** caml_spacetime_static_shape_tables; +extern shape_table* caml_spacetime_dynamic_shape_tables; + +typedef struct ext_table* spacetime_unwind_info_cache; + +extern value caml_spacetime_trie_root; +extern value* caml_spacetime_trie_node_ptr; +extern value* caml_spacetime_finaliser_trie_root; + +extern allocation_point* caml_all_allocation_points; + +extern void caml_spacetime_initialize(void); +extern uintnat caml_spacetime_my_profinfo( + spacetime_unwind_info_cache*, uintnat); +extern c_node_type caml_spacetime_classify_c_node(c_node* node); +extern c_node* caml_spacetime_c_node_of_stored_pointer(value); +extern c_node* caml_spacetime_c_node_of_stored_pointer_not_null(value); +extern value caml_spacetime_stored_pointer_of_c_node(c_node* node); +extern void caml_spacetime_register_thread(value*, value*); +extern void caml_spacetime_register_shapes(void*); +extern value caml_spacetime_frame_table(void); +extern value caml_spacetime_shape_table(void); +extern void caml_spacetime_save_snapshot (struct channel *chan, + double time_override, + int use_time_override); +extern value caml_spacetime_timestamp(double time_override, + int use_time_override); +extern void caml_spacetime_automatic_snapshot (void); + +/* For use in runtime functions that are executed from OCaml + code, to save the overhead of using libunwind every time. */ +#ifdef WITH_SPACETIME +#define Get_my_profinfo_with_cached_backtrace(profinfo, size) \ + do { \ + static spacetime_unwind_info_cache spacetime_unwind_info = NULL; \ + profinfo = caml_spacetime_my_profinfo(&spacetime_unwind_info, size); \ + } \ + while (0); +#else +#define Get_my_profinfo_with_cached_backtrace(profinfo, size) \ + profinfo = (uintnat) 0; +#endif + +#else + +#define Get_my_profinfo_with_cached_backtrace(profinfo, size) \ + profinfo = (uintnat) 0; + +#endif diff --git a/test/monniaux/ocaml/byterun/caml/stack.h b/test/monniaux/ocaml/byterun/caml/stack.h new file mode 100644 index 00000000..26686398 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/stack.h @@ -0,0 +1,124 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* Machine-dependent interface with the asm code */ + +#ifndef CAML_STACK_H +#define CAML_STACK_H + +#ifdef CAML_INTERNALS + +/* Macros to access the stack frame */ + +#ifdef TARGET_i386 +#define Saved_return_address(sp) *((intnat *)((sp) - 4)) +#ifndef SYS_win32 +#define Callback_link(sp) ((struct caml_context *)((sp) + 16)) +#else +#define Callback_link(sp) ((struct caml_context *)((sp) + 8)) +#endif +#endif + +#ifdef TARGET_power +#if defined(MODEL_ppc) +#define Saved_return_address(sp) *((intnat *)((sp) - 4)) +#define Callback_link(sp) ((struct caml_context *)((sp) + 16)) +#elif defined(MODEL_ppc64) +#define Saved_return_address(sp) *((intnat *)((sp) + 16)) +#define Callback_link(sp) ((struct caml_context *)((sp) + (48 + 32))) +#elif defined(MODEL_ppc64le) +#define Saved_return_address(sp) *((intnat *)((sp) + 16)) +#define Callback_link(sp) ((struct caml_context *)((sp) + (32 + 32))) +#else +#error "TARGET_power: wrong MODEL" +#endif +#define Already_scanned(sp, retaddr) ((retaddr) & 1) +#define Mask_already_scanned(retaddr) ((retaddr) & ~1) +#define Mark_scanned(sp, retaddr) Saved_return_address(sp) = (retaddr) | 1 +#endif + +#ifdef TARGET_s390x +#define Saved_return_address(sp) *((intnat *)((sp) - SIZEOF_PTR)) +#define Trap_frame_size 16 +#define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) +#endif + +#ifdef TARGET_arm +#define Saved_return_address(sp) *((intnat *)((sp) - 4)) +#define Callback_link(sp) ((struct caml_context *)((sp) + 8)) +#endif + +#ifdef TARGET_amd64 +#define Saved_return_address(sp) *((intnat *)((sp) - 8)) +#define Callback_link(sp) ((struct caml_context *)((sp) + 16)) +#endif + +#ifdef TARGET_arm64 +#define Saved_return_address(sp) *((intnat *)((sp) - 8)) +#define Callback_link(sp) ((struct caml_context *)((sp) + 16)) +#endif + +/* Structure of OCaml callback contexts */ + +struct caml_context { + char * bottom_of_stack; /* beginning of OCaml stack chunk */ + uintnat last_retaddr; /* last return address in OCaml code */ + value * gc_regs; /* pointer to register block */ +#ifdef WITH_SPACETIME + void* trie_node; +#endif +}; + +/* Structure of frame descriptors */ + +typedef struct { + uintnat retaddr; + unsigned short frame_size; + unsigned short num_live; + unsigned short live_ofs[1]; +} frame_descr; + +/* Hash table of frame descriptors */ + +extern frame_descr ** caml_frame_descriptors; +extern int caml_frame_descriptors_mask; + +#define Hash_retaddr(addr) \ + (((uintnat)(addr) >> 3) & caml_frame_descriptors_mask) + +extern void caml_init_frame_descriptors(void); +extern void caml_register_frametable(intnat *); +extern void caml_unregister_frametable(intnat *); +extern void caml_register_dyn_global(void *); + +extern uintnat caml_stack_usage (void); +extern uintnat (*caml_stack_usage_hook)(void); + +/* Declaration of variables used in the asm code */ +extern char * caml_top_of_stack; +extern char * caml_bottom_of_stack; +extern uintnat caml_last_return_address; +extern value * caml_gc_regs; +extern char * caml_exception_pointer; +extern value * caml_globals[]; +extern char caml_globals_map[]; +extern intnat caml_globals_inited; +extern intnat * caml_frametable[]; + +CAMLextern frame_descr * caml_next_frame_descriptor(uintnat * pc, char ** sp); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_STACK_H */ diff --git a/test/monniaux/ocaml/byterun/caml/stacks.h b/test/monniaux/ocaml/byterun/caml/stacks.h new file mode 100644 index 00000000..18ec0ac3 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/stacks.h @@ -0,0 +1,46 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +/* structure of the stacks */ + +#ifndef CAML_STACKS_H +#define CAML_STACKS_H + +#ifdef CAML_INTERNALS + +#include "misc.h" +#include "mlvalues.h" +#include "memory.h" + +CAMLextern value * caml_stack_low; +CAMLextern value * caml_stack_high; +CAMLextern value * caml_stack_threshold; +CAMLextern value * caml_extern_sp; +CAMLextern value * caml_trapsp; +CAMLextern value * caml_trap_barrier; + +#define Trap_pc(tp) (((code_t *)(tp))[0]) +#define Trap_link(tp) (((value **)(tp))[1]) + +void caml_init_stack (uintnat init_max_size); +void caml_realloc_stack (asize_t required_size); +void caml_change_max_stack_size (uintnat new_max_size); +uintnat caml_stack_usage (void); + +CAMLextern uintnat (*caml_stack_usage_hook)(void); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_STACKS_H */ diff --git a/test/monniaux/ocaml/byterun/caml/startup.h b/test/monniaux/ocaml/byterun/caml/startup.h new file mode 100644 index 00000000..2b26e916 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/startup.h @@ -0,0 +1,52 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2001 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_STARTUP_H +#define CAML_STARTUP_H + +#ifdef CAML_INTERNALS + +#include "mlvalues.h" +#include "exec.h" + +CAMLextern void caml_main(char_os **argv); + +CAMLextern void caml_startup_code( + code_t code, asize_t code_size, + char *data, asize_t data_size, + char *section_table, asize_t section_table_size, + int pooling, + char_os **argv); + +CAMLextern value caml_startup_code_exn( + code_t code, asize_t code_size, + char *data, asize_t data_size, + char *section_table, asize_t section_table_size, + int pooling, + char_os **argv); + +enum { FILE_NOT_FOUND = -1, BAD_BYTECODE = -2 }; + +extern int caml_attempt_open(char_os **name, struct exec_trailer *trail, + int do_open_script); +extern void caml_read_section_descriptors(int fd, struct exec_trailer *trail); +extern int32_t caml_seek_optional_section(int fd, struct exec_trailer *trail, + char *name); +extern int32_t caml_seek_section(int fd, struct exec_trailer *trail, + char *name); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_STARTUP_H */ diff --git a/test/monniaux/ocaml/byterun/caml/startup_aux.h b/test/monniaux/ocaml/byterun/caml/startup_aux.h new file mode 100644 index 00000000..7286bc98 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/startup_aux.h @@ -0,0 +1,44 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, Jane Street Group, LLC */ +/* */ +/* Copyright 2015 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_STARTUP_AUX_H +#define CAML_STARTUP_AUX_H + +#ifdef CAML_INTERNALS + +#include "config.h" + +extern void caml_init_atom_table (void); + +extern uintnat caml_init_percent_free; +extern uintnat caml_init_max_percent_free; +extern uintnat caml_init_minor_heap_wsz; +extern uintnat caml_init_heap_chunk_sz; +extern uintnat caml_init_heap_wsz; +extern uintnat caml_init_max_stack_wsz; +extern uintnat caml_init_major_window; +extern uintnat caml_trace_level; +extern uintnat caml_cleanup_on_exit; + +extern void caml_parse_ocamlrunparam (void); + +/* Common entry point to caml_startup. + Returns 0 if the runtime is already initialized. + If [pooling] is 0, [caml_stat_*] functions will not be backed by a pool. */ +extern int caml_startup_aux (int pooling); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_STARTUP_AUX_H */ diff --git a/test/monniaux/ocaml/byterun/caml/sys.h b/test/monniaux/ocaml/byterun/caml/sys.h new file mode 100644 index 00000000..0f372771 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/sys.h @@ -0,0 +1,45 @@ +/**************************************************************************/ +/* */ +/* 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. */ +/* */ +/**************************************************************************/ + +#ifndef CAML_SYS_H +#define CAML_SYS_H + +#ifdef CAML_INTERNALS + +#include "misc.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#define NO_ARG Val_int(0) + +CAMLextern void caml_sys_error (value); +CAMLextern void caml_sys_io_error (value); +CAMLextern double caml_sys_time_unboxed(value); +CAMLextern void caml_sys_init (char_os * exe_name, char_os ** argv); +CAMLextern value caml_sys_exit (value); +extern double caml_sys_time_unboxed(value); +CAMLextern value caml_sys_get_argv(value unit); + +extern char_os * caml_exe_name; + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_SYS_H */ diff --git a/test/monniaux/ocaml/byterun/caml/ui.h b/test/monniaux/ocaml/byterun/caml/ui.h new file mode 100644 index 00000000..3047ba7f --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/ui.h @@ -0,0 +1,32 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, 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. */ +/* */ +/**************************************************************************/ + +/* Function declarations for non-Unix user interfaces */ + +#ifndef CAML_UI_H +#define CAML_UI_H + +#ifdef CAML_INTERNALS + +#include "config.h" + +void ui_exit (int return_code); +int ui_read (int file_desc, char *buf, unsigned int length); +int ui_write (int file_desc, char *buf, unsigned int length); +void ui_print_stderr (char *format, void *arg); + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_UI_H */ diff --git a/test/monniaux/ocaml/byterun/caml/weak.h b/test/monniaux/ocaml/byterun/caml/weak.h new file mode 100644 index 00000000..a8563867 --- /dev/null +++ b/test/monniaux/ocaml/byterun/caml/weak.h @@ -0,0 +1,93 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 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. */ +/* */ +/**************************************************************************/ + +/* Operations on weak arrays */ + +#ifndef CAML_WEAK_H +#define CAML_WEAK_H + +#ifdef CAML_INTERNALS + +#include "mlvalues.h" + +extern value caml_ephe_list_head; +extern value caml_ephe_none; + + +/** The first field 0: weak list; + second field 1: data; + others 2..: keys; + + A weak pointer is an ephemeron with the data at caml_ephe_none + If fields are added, don't forget to update weak.ml [additional_values]. + */ + +#define CAML_EPHE_LINK_OFFSET 0 +#define CAML_EPHE_DATA_OFFSET 1 +#define CAML_EPHE_FIRST_KEY 2 + + +/* In the header, in order to let major_gc.c + and weak.c see the body of the function */ +static inline void caml_ephe_clean (value v){ + value child; + int release_data = 0; + mlsize_t size, i; + header_t hd; + CAMLassert(caml_gc_phase == Phase_clean); + + hd = Hd_val (v); + size = Wosize_hd (hd); + for (i = 2; i < size; i++){ + child = Field (v, i); + ephemeron_again: + if (child != caml_ephe_none + && Is_block (child) && Is_in_heap_or_young (child)){ + if (Tag_val (child) == Forward_tag){ + value f = Forward_val (child); + if (Is_block (f)) { + if (!Is_in_value_area(f) || Tag_val (f) == Forward_tag + || Tag_val (f) == Lazy_tag || Tag_val (f) == Double_tag){ + /* Do not short-circuit the pointer. */ + }else{ + Field (v, i) = child = f; + if (Is_block (f) && Is_young (f)) + add_to_ephe_ref_table(&caml_ephe_ref_table, v, i); + goto ephemeron_again; + } + } + } + if (Is_white_val (child) && !Is_young (child)){ + release_data = 1; + Field (v, i) = caml_ephe_none; + } + } + } + + child = Field (v, 1); + if(child != caml_ephe_none){ + if (release_data){ + Field (v, 1) = caml_ephe_none; + } else { + /* The mark phase must have marked it */ + CAMLassert( !(Is_block (child) && Is_in_heap (child) + && Is_white_val (child)) ); + } + } +} + +#endif /* CAML_INTERNALS */ + +#endif /* CAML_WEAK_H */ |