Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

depollution suite (et fin?) (PR#1914 et PR#1956) 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6047 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Damien Doligez 2004-01-02 19:23:29 +00:00
parent 7ba8c1ca1d
commit 0c7aecb88d
65 changed files with 675 additions and 560 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
asmrun/alpha.S
View File

@ -414,7 +414,7 @@ caml_callback3_exn:
br $107
.end caml_callback3_exn
/* Glue code to call [array_bound_error] */
/* Glue code to call [caml_array_bound_error] */
.globl caml_ml_array_bound_error
.ent caml_ml_array_bound_error
@ -422,7 +422,7 @@ caml_callback3_exn:
caml_ml_array_bound_error:
br $27, $111
$111: ldgp $gp, 0($27)
lda $25, array_bound_error
lda $25, caml_array_bound_error
br caml_c_call /* never returns */
.end caml_ml_array_bound_error

2
asmrun/amd64.S
View File

@ -310,7 +310,7 @@ FUNCTION(caml_ml_array_bound_error)
/* Make the exception handler and alloc ptr available to the C code */
movq %r15, caml_young_ptr(%rip)
movq %r14, caml_exception_pointer(%rip)
jmp array_bound_error
jmp caml_array_bound_error
.data
.globl system__frametable

6
asmrun/arm.S
View File

@ -306,8 +306,8 @@ caml_callback3_exn:
.global caml_ml_array_bound_error
caml_ml_array_bound_error:
/* Load address of array_bound_error in r10 */
ldr r10, .Larray_bound_error
/* Load address of [caml_array_bound_error] in r10 */
ldr r10, .Lcaml_array_bound_error
/* Call that function */
b caml_c_call
@ -324,7 +324,7 @@ caml_ml_array_bound_error:
.Lcaml_apply2: .word caml_apply2
.Lcaml_apply3: .word caml_apply3
.Lcaml_requested_size: .word 0
.Larray_bound_error: .word array_bound_error
.Lcaml_array_bound_error: .word caml_array_bound_error
/* GC roots for callback */

4
asmrun/fail.c
View File

@ -143,7 +143,7 @@ void caml_raise_sys_blocked_io(void)
/* We allocate statically the bucket for the exception because we can't
do a GC before the exception is raised (lack of stack descriptors
for the ccall to [array_bound_error]. */
for the ccall to [caml_array_bound_error]. */
#define BOUND_MSG "index out of bounds"
#define BOUND_MSG_LEN (sizeof(BOUND_MSG) - 1)
@ -159,7 +159,7 @@ static struct {
char data[BOUND_MSG_LEN + sizeof(value)];
} array_bound_error_msg = { 0, BOUND_MSG };
void array_bound_error(void)
void caml_array_bound_error(void)
{
mlsize_t wosize = (BOUND_MSG_LEN + sizeof(value)) / sizeof(value);
mlsize_t offset_index = Bsize_wsize(wosize) - 1;

12
asmrun/hppa.S
View File

@ -58,7 +58,7 @@
.import caml_raise, code
.import caml_apply2, code
.import caml_apply3, code
.import array_bound_error, code
.import caml_array_bound_error, code
caml_young_limit .comm 8
caml_young_ptr .comm 8
@ -528,13 +528,13 @@ G(caml_callback3_exn):
EXPORT_CODE(G(caml_ml_array_bound_error))
G(caml_ml_array_bound_error):
STARTPROC
; Load address of array_bound_error in %r22
; Load address of [caml_array_bound_error] in %r22
#ifdef SYS_hpux
ldil LR%array_bound_error, %r22
ldo RR%array_bound_error(%r22), %r22
ldil LR%caml_array_bound_error, %r22
ldo RR%caml_array_bound_error(%r22), %r22
#else
ldil L`_array_bound_error, %r22
ldo R`_array_bound_error(%r22), %r22
ldil L`_caml_array_bound_error, %r22
ldo R`_caml_array_bound_error(%r22), %r22
#endif
; Reserve 48 bytes of stack space and jump to caml_c_call
b G(caml_c_call)

4
asmrun/i386.S
View File

@ -309,8 +309,8 @@ G(caml_ml_array_bound_error):
ffree %st(5)
ffree %st(6)
ffree %st(7)
/* Branch to array_bound_error */
jmp G(array_bound_error)
/* Branch to [caml_array_bound_error] */
jmp G(caml_array_bound_error)
.data
.globl G(system__frametable)

4
asmrun/ia64.S
View File

@ -503,13 +503,13 @@ caml_callback3_exn:
.endp caml_callback3_exn#
/* Glue code to call array_bound_error */
/* Glue code to call [caml_array_bound_error] */
.global caml_ml_array_bound_error#
.proc caml_ml_array_bound_error#
.align 16
caml_ml_array_bound_error:
ADDRGLOBAL(r2, @fptr(array_bound_error#))
ADDRGLOBAL(r2, @fptr(caml_array_bound_error#))
br.sptk caml_c_call /* never returns */
.rodata

4
asmrun/m68k.S
View File

@ -231,8 +231,8 @@ _caml_callback3_exn:
.globl _caml_ml_array_bound_error
_caml_ml_array_bound_error:
| Load address of array_bound_error in a0 and call it
lea _array_bound_error, a0
| Load address of [caml_array_bound_error] in a0 and call it
lea _caml_array_bound_error, a0
bra _caml_c_call
.data

4
asmrun/mips.s
View File

@ -364,7 +364,7 @@ caml_callback3_exn:
.end caml_callback3_exn
/* Glue code to call array_bound_error */
/* Glue code to call [caml_array_bound_error] */
.globl caml_ml_array_bound_error
.ent caml_ml_array_bound_error
@ -372,7 +372,7 @@ caml_callback3_exn:
caml_ml_array_bound_error:
/* Setup $gp, discarding caller's $gp (we won't return) */
.cpsetup $25, $24, caml_ml_array_bound_error
la $24, array_bound_error
la $24, caml_array_bound_error
jal caml_c_call /* never returns */
.end caml_ml_array_bound_error

4
asmrun/roots.c
View File

@ -188,7 +188,7 @@ void caml_oldify_local_roots (void)
Oldify (gr->root);
}
/* Finalised values */
final_do_young_roots (&caml_oldify_one);
caml_final_do_young_roots (&caml_oldify_one);
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(caml_oldify_one);
}
@ -221,7 +221,7 @@ void caml_do_roots (scanning_action f)
f(*(gr->root), gr->root);
}
/* Finalised values */
final_do_strong_roots (f);
caml_final_do_strong_roots (f);
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
}

20
asmrun/signals.c
View File

@ -33,10 +33,10 @@
#include <sys/resource.h>
#endif
extern char * code_area_start, * code_area_end;
extern char * caml_code_area_start, * caml_code_area_end;
#define In_code_area(pc) \
((char *)(pc) >= code_area_start && (char *)(pc) <= code_area_end)
((char *)(pc) >= caml_code_area_start && (char *)(pc) <= caml_code_area_end)
#ifdef _WIN32
typedef void (*sighandler)(int sig);
@ -463,7 +463,7 @@ value caml_install_signal_handler(value signal_number, value action) /* ML */
if (Is_block(action)) {
if (caml_signal_handlers == 0) {
caml_signal_handlers = caml_alloc(NSIG, 0);
register_global_root(&caml_signal_handlers);
caml_register_global_root(&caml_signal_handlers);
}
caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
}
@ -491,7 +491,7 @@ static void trap_handler(int sig, int code,
sp = (int *) context->sc_sp;
caml_exception_pointer = (char *) sp[5];
caml_young_ptr = (char *) sp[6];
array_bound_error();
caml_array_bound_error();
}
#endif
@ -510,14 +510,14 @@ static void trap_handler(int sig, siginfo_t * info, void * context)
sp = (long *) (((ucontext_t *)context)->uc_mcontext.gregs[REG_SP]);
caml_exception_pointer = (char *) sp[5];
caml_young_ptr = (char *) sp[6];
array_bound_error();
caml_array_bound_error();
}
#endif
#if defined(TARGET_sparc) && (defined(SYS_bsd) || defined(SYS_linux))
static void trap_handler(int sig)
{
/* TODO: recover registers from context and call array_bound_error */
/* TODO: recover registers from context and call [caml_array_bound_error] */
caml_fatal_error("Fatal error: out-of-bound access in array or string\n");
}
#endif
@ -534,7 +534,7 @@ static void trap_handler(int sig, int code, STRUCT_SIGCONTEXT * context)
from registers 31 and 29 */
caml_exception_pointer = (char *) CONTEXT_GPR(context, 29);
caml_young_ptr = (char *) CONTEXT_GPR(context, 31);
array_bound_error();
caml_array_bound_error();
}
#endif
@ -545,7 +545,7 @@ static void trap_handler(int sig, struct sigcontext * context)
from registers 31 and 29 */
caml_exception_pointer = (char *) context->regs->gpr[29];
caml_young_ptr = (char *) context->regs->gpr[31];
array_bound_error();
caml_array_bound_error();
}
#endif
@ -561,7 +561,7 @@ static void trap_handler(int sig, int code, STRUCT_SIGCONTEXT * context)
from registers 31 and 29 */
caml_exception_pointer = (char *) CONTEXT_GPR(context, 29);
caml_young_ptr = (char *) CONTEXT_GPR(context, 31);
array_bound_error();
caml_array_bound_error();
}
#endif
@ -572,7 +572,7 @@ static void trap_handler(int sig, int code, struct sigcontext * context)
from registers 31 and 29 */
caml_exception_pointer = (char *) context->sc_frame.fixreg[29];
caml_young_ptr = (char *) context->sc_frame.fixreg[31];
array_bound_error();
caml_array_bound_error();
}
#endif

17
asmrun/startup.c
View File

@ -33,8 +33,8 @@
extern int caml_parser_trace;
header_t caml_atom_table[256];
char * static_data_start, * static_data_end;
char * code_area_start, * code_area_end;
char * caml_static_data_start, * caml_static_data_end;
char * caml_code_area_start, * caml_code_area_end;
/* Initialize the atom table and the static data and code area limits. */
@ -57,8 +57,9 @@ static void init_atoms(void)
extern struct segment caml_data_segments[], caml_code_segments[];
for (i = 0; i < 256; i++) caml_atom_table[i] = Make_header(0, i, Caml_white);
minmax_table(caml_data_segments, &static_data_start, &static_data_end);
minmax_table(caml_code_segments, &code_area_start, &code_area_end);
minmax_table(caml_data_segments,
&caml_static_data_start, &caml_static_data_end);
minmax_table(caml_code_segments, &caml_code_area_start, &caml_code_area_end);
}
/* Configuration parameters and flags */
@ -116,7 +117,7 @@ struct longjmp_buffer caml_termination_jmpbuf;
void (*caml_termination_hook)(void *) = NULL;
extern value caml_start_program (void);
extern void init_ieee_floats (void);
extern void caml_init_ieee_floats (void);
extern void caml_init_signals (void);
void caml_main(char **argv)
@ -127,14 +128,14 @@ void caml_main(char **argv)
#endif
value res;
init_ieee_floats();
caml_init_ieee_floats();
caml_init_custom_operations();
#ifdef DEBUG
caml_verb_gc = 63;
#endif
parse_camlrunparam();
init_gc (minor_heap_init, heap_size_init, heap_chunk_init,
percent_free_init, max_percent_free_init);
caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init,
percent_free_init, max_percent_free_init);
init_atoms();
caml_init_signals();
exe_name = argv[0];

BIN
boot/ocamlc
View File

Binary file not shown.

BIN
boot/ocamllex
View File

Binary file not shown.

28
bytecomp/bytegen.ml
View File

@ -290,20 +290,20 @@ let comp_primitive p args =
| Pasrint -> Kasrint
| Poffsetint n -> Koffsetint n
| Poffsetref n -> Koffsetref n
| Pintoffloat -> Kccall("int_of_float", 1)
| Pfloatofint -> Kccall("float_of_int", 1)
| Pnegfloat -> Kccall("neg_float", 1)
| Pabsfloat -> Kccall("abs_float", 1)
| Paddfloat -> Kccall("add_float", 2)
| Psubfloat -> Kccall("sub_float", 2)
| Pmulfloat -> Kccall("mul_float", 2)
| Pdivfloat -> Kccall("div_float", 2)
| Pfloatcomp Ceq -> Kccall("eq_float", 2)
| Pfloatcomp Cneq -> Kccall("neq_float", 2)
| Pfloatcomp Clt -> Kccall("lt_float", 2)
| Pfloatcomp Cgt -> Kccall("gt_float", 2)
| Pfloatcomp Cle -> Kccall("le_float", 2)
| Pfloatcomp Cge -> Kccall("ge_float", 2)
| Pintoffloat -> Kccall("caml_int_of_float", 1)
| Pfloatofint -> Kccall("caml_float_of_int", 1)
| Pnegfloat -> Kccall("caml_neg_float", 1)
| Pabsfloat -> Kccall("caml_abs_float", 1)
| Paddfloat -> Kccall("caml_add_float", 2)
| Psubfloat -> Kccall("caml_sub_float", 2)
| Pmulfloat -> Kccall("caml_mul_float", 2)
| Pdivfloat -> Kccall("caml_div_float", 2)
| Pfloatcomp Ceq -> Kccall("caml_eq_float", 2)
| Pfloatcomp Cneq -> Kccall("caml_neq_float", 2)
| Pfloatcomp Clt -> Kccall("caml_lt_float", 2)
| Pfloatcomp Cgt -> Kccall("caml_gt_float", 2)
| Pfloatcomp Cle -> Kccall("caml_le_float", 2)
| Pfloatcomp Cge -> Kccall("caml_ge_float", 2)
| Pstringlength -> Kccall("caml_ml_string_length", 1)
| Pstringrefs -> Kccall("caml_string_get", 2)
| Pstringsets -> Kccall("caml_string_set", 3)

2
bytecomp/translcore.ml
View File

@ -116,7 +116,7 @@ let comparisons_table = create_hashtable 11 [
Pccall{prim_name = "caml_int_compare"; prim_arity = 2;
prim_alloc = false; prim_native_name = "";
prim_native_float = false},
Pccall{prim_name = "float_compare"; prim_arity = 2;
Pccall{prim_name = "caml_float_compare"; prim_arity = 2;
prim_alloc = false; prim_native_name = "";
prim_native_float = false},
Pccall{prim_name = "caml_string_compare"; prim_arity = 2;

2
byterun/alloc.h
View File

@ -29,7 +29,7 @@ CAMLextern value caml_alloc_tuple (mlsize_t);
CAMLextern value caml_alloc_string (mlsize_t); /* size in bytes */
CAMLextern value caml_copy_string (char const *);
CAMLextern value caml_copy_string_array (char const **);
CAMLextern value copy_double (double);
CAMLextern value caml_copy_double (double);
CAMLextern value caml_copy_int32 (int32); /* defined in [ints.c] */
CAMLextern value caml_copy_int64 (int64); /* defined in [ints.c] */
CAMLextern value caml_copy_nativeint (long); /* defined in [ints.c] */

8
byterun/array.c
View File

@ -26,7 +26,7 @@
CAMLprim value caml_array_get_addr(value array, value index)
{
long idx = Long_val(index);
if (idx < 0 || idx >= Wosize_val(array)) array_bound_error();
if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
return Field(array, idx);
}
@ -37,7 +37,7 @@ CAMLprim value caml_array_get_float(value array, value index)
value res;
if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
array_bound_error();
caml_array_bound_error();
d = Double_field(array, idx);
#define Setup_for_gc
#define Restore_after_gc
@ -59,7 +59,7 @@ CAMLprim value caml_array_get(value array, value index)
CAMLprim value caml_array_set_addr(value array, value index, value newval)
{
long idx = Long_val(index);
if (idx < 0 || idx >= Wosize_val(array)) array_bound_error();
if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
Modify(&Field(array, idx), newval);
return Val_unit;
}
@ -68,7 +68,7 @@ CAMLprim value caml_array_set_float(value array, value index, value newval)
{
long idx = Long_val(index);
if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
array_bound_error();
caml_array_bound_error();
Store_double_field(array, idx, Double_val(newval));
return Val_unit;
}

14
byterun/backtrace.c
View File

@ -59,7 +59,7 @@ enum {
void caml_init_backtrace(void)
{
caml_backtrace_active = 1;
register_global_root(&caml_backtrace_last_exn);
caml_register_global_root(&caml_backtrace_last_exn);
/* Note: lazy initialization of caml_backtrace_buffer in caml_stash_backtrace
to simplify the interface with the thread libraries */
}
@ -69,7 +69,7 @@ void caml_init_backtrace(void)
void caml_stash_backtrace(value exn, code_t pc, value * sp)
{
code_t end_code = (code_t) ((char *) start_code + code_size);
code_t end_code = (code_t) ((char *) caml_start_code + caml_code_size);
if (pc != NULL) pc = pc - 1;
if (exn != caml_backtrace_last_exn) {
caml_backtrace_pos = 0;
@ -80,12 +80,12 @@ void caml_stash_backtrace(value exn, code_t pc, value * sp)
if (caml_backtrace_buffer == NULL) return;
}
if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) return;
if (pc >= start_code && pc < end_code){
if (pc >= caml_start_code && pc < end_code){
caml_backtrace_buffer[caml_backtrace_pos++] = pc;
}
for (/*nothing*/; sp < caml_trapsp; sp++) {
code_t p = (code_t) *sp;
if (p >= start_code && p < end_code) {
if (p >= caml_start_code && p < end_code) {
if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) break;
caml_backtrace_buffer[caml_backtrace_pos++] = p;
}
@ -144,8 +144,8 @@ static value event_for_location(value events, code_t pc)
mlsize_t i;
value pos, l, ev, ev_pos;
Assert(pc >= start_code && pc < start_code + code_size);
pos = Val_long((char *) pc - (char *) start_code);
Assert(pc >= caml_start_code && pc < caml_start_code + caml_code_size);
pos = Val_long((char *) pc - (char *) caml_start_code);
for (i = 0; i < Wosize_val(events); i++) {
for (l = Field(events, i); l != Val_int(0); l = Field(l, 1)) {
ev = Field(l, 0);
@ -167,7 +167,7 @@ static void print_location(value events, int index)
value ev;
ev = event_for_location(events, pc);
if (is_instruction(*pc, RAISE)) {
if (caml_is_instruction(*pc, RAISE)) {
/* Ignore compiler-inserted raise */
if (ev == Val_false) return;
/* Initial raise if index == 0, re-raise otherwise */

4
byterun/callback.c
View File

@ -40,7 +40,7 @@ static int callback_code_threaded = 0;
static void thread_callback(void)
{
thread_code(callback_code, sizeof(callback_code));
caml_thread_code(callback_code, sizeof(callback_code));
callback_code_threaded = 1;
}
@ -196,7 +196,7 @@ CAMLprim value caml_register_named_value(value vname, value val)
nv->val = val;
nv->next = named_value_table[h];
named_value_table[h] = nv;
register_global_root(&nv->val);
caml_register_global_root(&nv->val);
return Val_unit;
}

35
byterun/compact.c
View File

@ -42,7 +42,7 @@ extern void caml_shrink_heap (char *); /* memory.c */
XXX Should be fixed:
XXX The above assumes that all roots are aligned on a 4-byte boundary,
XXX which is not always guaranteed by C.
XXX (see [register_global_roots] and [caml_init_exceptions])
XXX (see [caml_register_global_roots] and [caml_init_exceptions])
XXX Should be able to fix it to only assume 2-byte alignment.
*/
#define Make_ehd(s,t,c) (((s) << 10) | (t) << 2 | (c))
@ -151,7 +151,7 @@ void caml_compact_heap (void)
caml_gc_message (0x10, "Compacting heap...\n", 0);
#ifdef DEBUG
heap_check ();
caml_heap_check ();
#endif
/* First pass: encode all noninfix headers. */
@ -187,7 +187,7 @@ void caml_compact_heap (void)
data structures to find its roots. Fortunately, it doesn't need
the headers (see above). */
caml_do_roots (invert_root);
final_do_weak_roots (invert_root);
caml_final_do_weak_roots (invert_root);
ch = caml_heap_start;
while (ch != NULL){
@ -380,16 +380,16 @@ void caml_compact_heap (void)
/* Rebuild the free list. */
{
ch = caml_heap_start;
fl_reset ();
caml_fl_reset ();
while (ch != NULL){
if (Chunk_size (ch) > Chunk_alloc (ch)){
make_free_blocks ((value *) (ch + Chunk_alloc (ch)),
Wsize_bsize (Chunk_size (ch) - Chunk_alloc (ch)), 1);
caml_make_free_blocks ((value *) (ch + Chunk_alloc (ch)),
Wsize_bsize (Chunk_size(ch)-Chunk_alloc(ch)), 1);
}
ch = Chunk_next (ch);
}
}
++ stat_compactions;
++ caml_stat_compactions;
caml_gc_message (0x10, "done.\n", 0);
}
@ -398,24 +398,25 @@ unsigned long caml_percent_max; /* used in gc_ctrl.c */
void caml_compact_heap_maybe (void)
{
/* Estimated free words in the heap:
FW = fl_size_at_change + 3 * (fl_cur_size - fl_size_at_change)
FW = 3 * fl_cur_size - 2 * fl_size_at_change
Estimated live words: LW = stat_heap_size - FW
FW = fl_size_at_change + 3 * (caml_fl_cur_size
- caml_fl_size_at_phase_change)
FW = 3 * caml_fl_cur_size - 2 * caml_fl_size_at_phase_change
Estimated live words: LW = caml_stat_heap_size - FW
Estimated free percentage: FP = 100 * FW / LW
We compact the heap if FP > caml_percent_max
*/
float fw, fp;
Assert (caml_gc_phase == Phase_idle);
if (caml_percent_max >= 1000000) return;
if (stat_major_collections < 5 || stat_heap_chunks < 5) return;
if (caml_stat_major_collections < 5 || caml_stat_heap_chunks < 5) return;
fw = 3.0 * fl_cur_size - 2.0 * caml_fl_size_at_phase_change;
if (fw < 0) fw = fl_cur_size;
fw = 3.0 * caml_fl_cur_size - 2.0 * caml_fl_size_at_phase_change;
if (fw < 0) fw = caml_fl_cur_size;
if (fw >= Wsize_bsize (stat_heap_size)){
if (fw >= Wsize_bsize (caml_stat_heap_size)){
fp = 1000000.0;
}else{
fp = 100.0 * fw / (Wsize_bsize (stat_heap_size) - fw);
fp = 100.0 * fw / (Wsize_bsize (caml_stat_heap_size) - fw);
if (fp > 1000000.0) fp = 1000000.0;
}
caml_gc_message (0x200, "FL size at phase change = %lu\n",
@ -426,8 +427,8 @@ void caml_compact_heap_maybe (void)
caml_finish_major_cycle ();
/* We just did a complete GC, so we can measure the overhead exactly. */
fw = fl_cur_size;
fp = 100.0 * fw / (Wsize_bsize (stat_heap_size) - fw);
fw = caml_fl_cur_size;
fp = 100.0 * fw / (Wsize_bsize (caml_stat_heap_size) - fw);
caml_gc_message (0x200, "Measured overhead: %lu%%\n", (unsigned long) fp);
caml_compact_heap ();

128
byterun/compatibility.h
View File

@ -26,6 +26,11 @@
g --> ident global C
*/
/* FIXME a faire:
system__frametable dans <arch>.s
supprimer lazy_is_forward dans obj.c
*/
/* **** alloc.c */
#define alloc caml_alloc
#define alloc_small caml_alloc_small
@ -144,7 +149,7 @@
#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 FIXME */
#define array_bound_error caml_array_bound_error
#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
@ -154,30 +159,122 @@
#define raise_sys_blocked_io caml_raise_sys_blocked_io
#define init_exceptions caml_init_exceptions
/* **** asmrun/fail.c */
/* g Out_of_memory -> caml_Out_of_memory FIXME a faire */
/* g Sys_error -> caml_Sys_error FIXME a faire */
/* g Failure -> caml_Failure FIXME a faire */
/* g Invalid_argument -> caml_Invalid_argument FIXME a faire */
/* g End_of_file -> caml_End_of_file FIXME a faire */
/* g Division_by_zero -> caml_Division_by_zero FIXME a faire */
/* g Not_found -> caml_Not_found FIXME a faire */
/* g Match_failure -> caml_Match_failure FIXME a faire */
/* g Sys_blocked_io -> caml_Sys_blocked_io FIXME a faire */
/* g Stack_overflow -> caml_Stack_overflow FIXME a faire */
/* g bucket_Out_of_memory -> caml_bucket_Out_of_memory FIXME pkoi extern? */
/* g bucket_Stack_overflow -> caml_bucket_Stack_overflow FIXME idem */
/* g raise_caml_exception -> caml_raise_exception */
/* **** asmrun/<arch>.s */
/* g caml_array_bound_error -> caml_ml_array_bound_error */
/* **** finalise.c */
/* g final_update -> caml_final_update */
/* g final_do_calls -> caml_final_do_calls */
/* g final_do_strong_roots -> caml_final_do_strong_roots */
/* g final_do_weak_roots -> caml_final_do_weak_roots */
/* g final_do_young_roots -> caml_final_do_young_roots */
/* g final_empty_young -> caml_final_empty_young */
/* final_register -> caml_final_register */
/* **** fix_code.c */
/* g start_code -> caml_start_code */
/* g code_size -> caml_code_size */
/* g saved_code -> caml_saved_code */
/* g code_md5 -> caml_code_md5 */
/* g load_code -> caml_load_code */
/* g fixup_endianness -> caml_fixup_endianness */
/* g instr_table -> caml_instr_table */
/* g instr_base -> caml_instr_base */
/* g thread_code -> caml_thread_code */
/* g set_instruction -> caml_set_instruction */
/* g is_instruction -> caml_is_instruction */
/* **** floats.c */
/*#define Double_val caml_Double_val done as needed in mlvalues.h */
/*#define Store_double_val caml_Store_double_val done as needed in mlvalues.h */
#define copy_double caml_copy_double
/* format_float -> caml_format_float */
/* float_of_string -> caml_float_of_string */
/* int_of_float -> caml_int_of_float */
/* float_of_int -> caml_float_of_int */
/* neg_float -> caml_neg_float */
/* abs_float -> caml_abs_float */
/* add_float -> caml_add_float */
/* sub_float -> caml_sub_float */
/* mul_float -> caml_mul_float */
/* div_float -> caml_div_float */
/* exp_float -> caml_exp_float */
/* floor_float -> caml_floor_float */
/* fmod_float -> caml_fmod_float */
/* frexp_float -> caml_frexp_float */
/* ldexp_float -> caml_ldexp_float */
/* log_float -> caml_log_float */
/* log10_float -> caml_log10_float */
/* modf_float -> caml_modf_float */
/* sqrt_float -> caml_sqrt_float */
/* power_float -> caml_power_float */
/* sin_float -> caml_sin_float */
/* sinh_float -> caml_sinh_float */
/* cos_float -> caml_cos_float */
/* cosh_float -> caml_cosh_float */
/* tan_float -> caml_tan_float */
/* tanh_float -> caml_tanh_float */
/* asin_float -> caml_asin_float */
/* acos_float -> caml_acos_float */
/* atan_float -> caml_atan_float */
/* atan2_float -> caml_atan2_float */
/* ceil_float -> caml_ceil_float */
/* eq_float -> caml_eq_float */
/* neq_float -> caml_neq_float */
/* le_float -> caml_le_float */
/* lt_float -> caml_lt_float */
/* ge_float -> caml_ge_float */
/* gt_float -> caml_gt_float */
/* float_compare -> caml_float_compare */
/* classify_float -> caml_classify_float */
/* init_ieee_float -> caml_init_ieee_float */
/* **** freelist.c */
/* g fl_merge -> caml_fl_merge */
/* g fl_cur_size -> caml_fl_cur_size */
/* fl_check *** devient static */
/* g fl_allocate -> caml_fl_allocate */
/* g fl_init_merge -> caml_fl_init_merge */
/* g fl_reset -> caml_fl_reset */
/* g fl_merge_block -> caml_fl_merge_block */
/* g fl_add_block -> caml_fl_add_block */
/* g make_free_blocks -> caml_make_free_blocks */
/* **** gc_ctrl.c */
/* g stat_minor_words -> caml_stat_minor_words */
/* g stat_promoted_words -> caml_stat_promoted_words */
/* g stat_major-words -> caml_stat_major_words */
/* g stat_minor_collections -> caml_stat_minor_collections */
/* g stat_major_collections -> caml_stat_major_collections */
/* g stat_heap_size -> caml_stat_heap_size */
/* g stat_top_heap_size -> caml_stat_top_heap_size */
/* g stat_compactions -> caml_stat_compactions */
/* g stat_heap_chunks -> caml_stat_heap_chunks */
/* g heap_check -> caml_heap_check */
/* gc_stat -> caml_gc_stat */
/* gc_counters -> caml_gc_counters */
/* gc_get -> caml_gc_get */
/* gc_set -> caml_gc_set */
/* gc_minor -> caml_gc_minor */
/* gc_major -> caml_gc_major */
/* gc_full_major -> caml_gc_full_major */
/* gc_major_slice -> caml_gc_major_slice */
/* gc_compaction -> caml_gc_compaction */
/* **** globroots.c */
#define register_global_root caml_register_global_root /* FIXME extern/export */
#define remove_global_root caml_remove_global_root /* FIXME extern sans export*/
/* **** hash.c */
/* hash_univ_param -> caml_hash_univ_param */
#define hash_variant caml_hash_variant */
/* **** instrtrace.c */
/* g icount -> caml_icount */
/* g stop_here -> caml_stop_here */
/* g trace_flag -> caml_trace_flag */
/* g disasm_instr -> caml_disasm_instr */
/* **** intern.c */
/* g input_val -> caml_input_val */
@ -504,6 +601,11 @@
/* g read_section_descriptors -> caml_read_section_descriptors */
/* g seek_optional_section -> caml_seek_optional_section */
/* g seek_section -> caml_seek_section */
/* **** asmrun/startup.c */
/* g static_data_start -> caml_static_data_start */
/* g static_data_end -> caml_static_data_end */
/* g code_area_start -> caml_code_area_start */
/* g code_area_end -> caml_code_area_end */
/* **** str.c */
#define string_length caml_string_length

20
byterun/debugger.c
View File

@ -202,7 +202,7 @@ void caml_debugger(enum event_kind event)
caml_putword(dbg_out, caml_event_count);
if (event == EVENT_COUNT || event == BREAKPOINT) {
caml_putword(dbg_out, caml_stack_high - frame);
caml_putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
caml_putword(dbg_out, (Pc(frame) - caml_start_code) * sizeof(opcode_t));
} else {
/* No PC and no stack frame associated with other events */
caml_putword(dbg_out, 0);
@ -218,21 +218,21 @@ void caml_debugger(enum event_kind event)
case REQ_SET_EVENT:
pos = caml_getword(dbg_in);
Assert (pos >= 0);
Assert (pos < code_size);
set_instruction(start_code + pos / sizeof(opcode_t), EVENT);
Assert (pos < caml_code_size);
caml_set_instruction(caml_start_code + pos / sizeof(opcode_t), EVENT);
break;
case REQ_SET_BREAKPOINT:
pos = caml_getword(dbg_in);
Assert (pos >= 0);
Assert (pos < code_size);
set_instruction(start_code + pos / sizeof(opcode_t), BREAK);
Assert (pos < caml_code_size);
caml_set_instruction(caml_start_code + pos / sizeof(opcode_t), BREAK);
break;
case REQ_RESET_INSTR:
pos = caml_getword(dbg_in);
Assert (pos >= 0);
Assert (pos < code_size);
Assert (pos < caml_code_size);
pos = pos / sizeof(opcode_t);
set_instruction(start_code + pos, saved_code[pos]);
caml_set_instruction(caml_start_code + pos, caml_saved_code[pos]);
break;
case REQ_CHECKPOINT:
i = fork();
@ -259,7 +259,7 @@ void caml_debugger(enum event_kind event)
case REQ_GET_FRAME:
caml_putword(dbg_out, caml_stack_high - frame);
if (frame < caml_stack_high){
caml_putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
caml_putword(dbg_out, (Pc(frame) - caml_start_code) * sizeof(opcode_t));
}else{
caml_putword (dbg_out, 0);
}
@ -276,7 +276,7 @@ void caml_debugger(enum event_kind event)
} else {
frame += Extra_args(frame) + i + 3;
caml_putword(dbg_out, caml_stack_high - frame);
caml_putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
caml_putword(dbg_out, (Pc(frame) - caml_start_code) * sizeof(opcode_t));
}
caml_flush(dbg_out);
break;
@ -328,7 +328,7 @@ void caml_debugger(enum event_kind event)
break;
case REQ_GET_CLOSURE_CODE:
val = getval(dbg_in);
caml_putword(dbg_out, (Code_val(val) - start_code) * sizeof(opcode_t));
caml_putword(dbg_out, (Code_val(val)-caml_start_code) * sizeof(opcode_t));
caml_flush(dbg_out);
break;
}

4
byterun/extern.c
View File

@ -376,10 +376,10 @@ static void extern_rec(value v)
}
return;
}
if ((char *) v >= code_area_start && (char *) v < code_area_end) {
if ((char *) v >= caml_code_area_start && (char *) v < caml_code_area_end) {
if (!extern_closures)
extern_invalid_argument("output_value: functional value");
writecode32(CODE_CODEPOINTER, (char *) v - code_area_start);
writecode32(CODE_CODEPOINTER, (char *) v - caml_code_area_start);
writeblock((char *) caml_code_checksum(), 16);
return;
}

4
byterun/fail.c
View File

@ -81,7 +81,7 @@ CAMLexport void caml_invalid_argument (char *msg)
caml_raise_with_string(Field(caml_global_data, INVALID_EXN), msg);
}
CAMLexport void array_bound_error(void)
CAMLexport void caml_array_bound_error(void)
{
caml_invalid_argument("index out of bounds");
}
@ -139,5 +139,5 @@ void caml_init_exceptions(void)
{
out_of_memory_bucket.hdr = Make_header(1, 0, Caml_white);
out_of_memory_bucket.exn = Field(caml_global_data, OUT_OF_MEMORY_EXN);
register_global_root(&out_of_memory_bucket.exn);
caml_register_global_root(&out_of_memory_bucket.exn);
}

2
byterun/fail.h
View File

@ -70,7 +70,7 @@ CAMLextern void caml_raise_end_of_file (void) Noreturn;
CAMLextern void caml_raise_zero_divide (void) Noreturn;
CAMLextern void caml_raise_not_found (void) Noreturn;
CAMLextern void caml_init_exceptions (void);
CAMLextern void array_bound_error (void) Noreturn;
CAMLextern void caml_array_bound_error (void) Noreturn;
CAMLextern void caml_raise_sys_blocked_io (void) Noreturn;
#endif /* CAML_FAIL_H */

14
byterun/finalise.c
View File

@ -38,7 +38,7 @@ static unsigned long old = 0, young = 0, active = 0, size = 0;
finalising set.
The recent set is empty.
*/
void final_update (void)
void caml_final_update (void)
{
unsigned long i;
unsigned long oldactive = active;
@ -78,7 +78,7 @@ void final_update (void)
/* Call the finalisation functions for the finalising set.
Note that this function must be reentrant.
*/
void final_do_calls (void)
void caml_final_do_calls (void)
{
struct final f;
@ -102,7 +102,7 @@ void final_do_calls (void)
This is called by the major GC and the compactor
through [caml_darken_all_roots].
*/
void final_do_strong_roots (scanning_action f)
void caml_final_do_strong_roots (scanning_action f)
{
unsigned long i;
@ -120,7 +120,7 @@ void final_do_strong_roots (scanning_action f)
The recent set is empty.
This is called directly by the compactor.
*/
void final_do_weak_roots (scanning_action f)
void caml_final_do_weak_roots (scanning_action f)
{
unsigned long i;
@ -131,7 +131,7 @@ void final_do_weak_roots (scanning_action f)
/* Call [*f] on the closures and values of the recent set.
This is called by the minor GC through [caml_oldify_local_roots].
*/
void final_do_young_roots (scanning_action f)
void caml_final_do_young_roots (scanning_action f)
{
unsigned long i;
@ -146,13 +146,13 @@ void final_do_young_roots (scanning_action f)
This is called at the end of each minor collection.
The minor heap must be empty when this is called.
*/
void final_empty_young (void)
void caml_final_empty_young (void)
{
old = young;
}
/* Put (f,v) in the recent set. */
CAMLprim value final_register (value f, value v)
CAMLprim value caml_final_register (value f, value v)
{
if (!(Is_block (v) && (Is_in_heap (v) || Is_young (v)))){
caml_invalid_argument ("Gc.finalise");

14
byterun/finalise.h
View File

@ -18,12 +18,12 @@
#include "roots.h"
void final_update (void);
void final_do_calls (void);
void final_do_strong_roots (scanning_action f);
void final_do_weak_roots (scanning_action f);
void final_do_young_roots (scanning_action f);
void final_empty_young (void);
value final_register (value f, value v);
void caml_final_update (void);
void caml_final_do_calls (void);
void caml_final_do_strong_roots (scanning_action f);
void caml_final_do_weak_roots (scanning_action f);
void caml_final_do_young_roots (scanning_action f);
void caml_final_empty_young (void);
value caml_final_register (value f, value v);
#endif /* CAML_FINALISE_H */

46
byterun/fix_code.c
View File

@ -30,38 +30,38 @@
#include "mlvalues.h"
#include "reverse.h"
code_t start_code;
asize_t code_size;
unsigned char * saved_code;
unsigned char code_md5[16];
code_t caml_start_code;
asize_t caml_code_size;
unsigned char * caml_saved_code;
unsigned char caml_code_md5[16];
/* Read the main bytecode block from a file */
void load_code(int fd, asize_t len)
void caml_load_code(int fd, asize_t len)
{
int i;
struct MD5Context ctx;
code_size = len;
start_code = (code_t) caml_stat_alloc(code_size);
if (read(fd, (char *) start_code, code_size) != code_size)
caml_code_size = len;
caml_start_code = (code_t) caml_stat_alloc(caml_code_size);
if (read(fd, (char *) caml_start_code, caml_code_size) != caml_code_size)
caml_fatal_error("Fatal error: truncated bytecode file.\n");
caml_MD5Init(&ctx);
caml_MD5Update(&ctx, (unsigned char *) start_code, code_size);
caml_MD5Final(code_md5, &ctx);
caml_MD5Update(&ctx, (unsigned char *) caml_start_code, caml_code_size);
caml_MD5Final(caml_code_md5, &ctx);
#ifdef ARCH_BIG_ENDIAN
fixup_endianness(start_code, code_size);
caml_fixup_endianness(caml_start_code, caml_code_size);
#endif
if (caml_debugger_in_use) {
len /= sizeof(opcode_t);
saved_code = (unsigned char *) caml_stat_alloc(len);
for (i = 0; i < len; i++) saved_code[i] = start_code[i];
caml_saved_code = (unsigned char *) caml_stat_alloc(len);
for (i = 0; i < len; i++) caml_saved_code[i] = caml_start_code[i];
}
#ifdef THREADED_CODE
/* Better to thread now than at the beginning of [caml_interprete],
since the debugger interface needs to perform SET_EVENT requests
on the code. */
thread_code(start_code, code_size);
caml_thread_code(caml_start_code, caml_code_size);
#endif
}
@ -69,7 +69,7 @@ void load_code(int fd, asize_t len)
#ifdef ARCH_BIG_ENDIAN
void fixup_endianness(code_t code, asize_t len)
void caml_fixup_endianness(code_t code, asize_t len)
{
code_t p;
len /= sizeof(opcode_t);
@ -84,10 +84,10 @@ void fixup_endianness(code_t code, asize_t len)
#ifdef THREADED_CODE
char ** instr_table;
char * instr_base;
char ** caml_instr_table;
char * caml_instr_base;
void thread_code (code_t code, asize_t len)
void caml_thread_code (code_t code, asize_t len)
{
code_t p;
int l [STOP + 1];
@ -124,7 +124,7 @@ void thread_code (code_t code, asize_t len)
*/
instr = STOP;
}
*p++ = (opcode_t)(instr_table[instr] - instr_base);
*p++ = (opcode_t)(caml_instr_table[instr] - caml_instr_base);
if (instr == SWITCH) {
uint32 sizes = *p++;
uint32 const_size = sizes & 0xFFFF;
@ -143,19 +143,19 @@ void thread_code (code_t code, asize_t len)
#endif /* THREADED_CODE */
void set_instruction(code_t pos, opcode_t instr)
void caml_set_instruction(code_t pos, opcode_t instr)
{
#ifdef THREADED_CODE
*pos = (opcode_t)(instr_table[instr] - instr_base);
*pos = (opcode_t)(caml_instr_table[instr] - caml_instr_base);
#else
*pos = instr;
#endif
}
int is_instruction(opcode_t instr1, opcode_t instr2)
int caml_is_instruction(opcode_t instr1, opcode_t instr2)
{
#ifdef THREADED_CODE
return instr1 == (opcode_t)(instr_table[instr2] - instr_base);
return instr1 == (opcode_t)(caml_instr_table[instr2] - caml_instr_base);
#else
return instr1 == instr2;
#endif

22
byterun/fix_code.h
View File

@ -23,20 +23,20 @@
#include "misc.h"
#include "mlvalues.h"
extern code_t start_code;
extern asize_t code_size;
extern unsigned char * saved_code;
extern unsigned char code_md5[16];
extern code_t caml_start_code;
extern asize_t caml_code_size;
extern unsigned char * caml_saved_code;
extern unsigned char caml_code_md5[16];
void load_code (int fd, asize_t len);
void fixup_endianness (code_t code, asize_t len);
void set_instruction (code_t pos, opcode_t instr);
int is_instruction (opcode_t instr1, opcode_t instr2);
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 ** instr_table;
extern char * instr_base;
void thread_code (code_t code, asize_t len);
extern char ** caml_instr_table;
extern char * caml_instr_base;
void caml_thread_code (code_t code, asize_t len);
#endif
#endif /* CAML_FIX_CODE_H */

148
byterun/floats.c
View File

@ -30,7 +30,7 @@
#ifdef ARCH_ALIGN_DOUBLE
CAMLexport double Double_val(value val)
CAMLexport double caml_Double_val(value val)
{
union { value v[2]; double d; } buffer;
@ -40,7 +40,7 @@ CAMLexport double Double_val(value val)
return buffer.d;
}
CAMLexport void Store_double_val(value val, double dbl)
CAMLexport void caml_Store_double_val(value val, double dbl)
{
union { value v[2]; double d; } buffer;
@ -52,7 +52,7 @@ CAMLexport void Store_double_val(value val, double dbl)
#endif
CAMLexport value copy_double(double d)
CAMLexport value caml_copy_double(double d)
{
value res;
@ -65,7 +65,7 @@ CAMLexport value copy_double(double d)
return res;
}
CAMLprim value format_float(value fmt, value arg)
CAMLprim value caml_format_float(value fmt, value arg)
{
#define MAX_DIGITS 350
/* Max number of decimal digits in a "natural" (not artificially padded)
@ -106,7 +106,7 @@ CAMLprim value format_float(value fmt, value arg)
return res;
}
CAMLprim value float_of_string(value vs)
CAMLprim value caml_float_of_string(value vs)
{
char parse_buffer[64];
char * buf, * src, * dst, * end;
@ -126,93 +126,93 @@ CAMLprim value float_of_string(value vs)
d = strtod((const char *) buf, &end);
if (buf != parse_buffer) caml_stat_free(buf);
if (end != dst) caml_failwith("float_of_string");
return copy_double(d);
return caml_copy_double(d);
}
CAMLprim value int_of_float(value f)
CAMLprim value caml_int_of_float(value f)
{
return Val_long((long) Double_val(f));
}
CAMLprim value float_of_int(value n)
CAMLprim value caml_float_of_int(value n)
{
return copy_double((double) Long_val(n));
return caml_copy_double((double) Long_val(n));
}
CAMLprim value neg_float(value f)
CAMLprim value caml_neg_float(value f)
{
return copy_double(- Double_val(f));
return caml_copy_double(- Double_val(f));
}
CAMLprim value abs_float(value f)
CAMLprim value caml_abs_float(value f)
{
return copy_double(fabs(Double_val(f)));
return caml_copy_double(fabs(Double_val(f)));
}
CAMLprim value add_float(value f, value g)
CAMLprim value caml_add_float(value f, value g)
{
return copy_double(Double_val(f) + Double_val(g));
return caml_copy_double(Double_val(f) + Double_val(g));
}
CAMLprim value sub_float(value f, value g)
CAMLprim value caml_sub_float(value f, value g)
{
return copy_double(Double_val(f) - Double_val(g));
return caml_copy_double(Double_val(f) - Double_val(g));
}
CAMLprim value mul_float(value f, value g)
CAMLprim value caml_mul_float(value f, value g)
{
return copy_double(Double_val(f) * Double_val(g));
return caml_copy_double(Double_val(f) * Double_val(g));
}
CAMLprim value div_float(value f, value g)
CAMLprim value caml_div_float(value f, value g)
{
return copy_double(Double_val(f) / Double_val(g));
return caml_copy_double(Double_val(f) / Double_val(g));
}
CAMLprim value exp_float(value f)
CAMLprim value caml_exp_float(value f)
{
return copy_double(exp(Double_val(f)));
return caml_copy_double(exp(Double_val(f)));
}
CAMLprim value floor_float(value f)
CAMLprim value caml_floor_float(value f)
{
return copy_double(floor(Double_val(f)));
return caml_copy_double(floor(Double_val(f)));
}
CAMLprim value fmod_float(value f1, value f2)
CAMLprim value caml_fmod_float(value f1, value f2)
{
return copy_double(fmod(Double_val(f1), Double_val(f2)));
return caml_copy_double(fmod(Double_val(f1), Double_val(f2)));
}
CAMLprim value frexp_float(value f)
CAMLprim value caml_frexp_float(value f)
{
CAMLparam1 (f);
CAMLlocal2 (res, mantissa);
int exponent;
mantissa = copy_double(frexp (Double_val(f), &exponent));
mantissa = caml_copy_double(frexp (Double_val(f), &exponent));
res = caml_alloc_tuple(2);
Field(res, 0) = mantissa;
Field(res, 1) = Val_int(exponent);
CAMLreturn (res);
}
CAMLprim value ldexp_float(value f, value i)
CAMLprim value caml_ldexp_float(value f, value i)
{
return copy_double(ldexp(Double_val(f), Int_val(i)));
return caml_copy_double(ldexp(Double_val(f), Int_val(i)));
}
CAMLprim value log_float(value f)
CAMLprim value caml_log_float(value f)
{
return copy_double(log(Double_val(f)));
return caml_copy_double(log(Double_val(f)));
}
CAMLprim value log10_float(value f)
CAMLprim value caml_log10_float(value f)
{
return copy_double(log10(Double_val(f)));
return caml_copy_double(log10(Double_val(f)));
}
CAMLprim value modf_float(value f)
CAMLprim value caml_modf_float(value f)
{
#if __SC__
_float_eval frem; /* Problem with Apple's <math.h> */
@ -222,110 +222,110 @@ CAMLprim value modf_float(value f)
CAMLparam1 (f);
CAMLlocal3 (res, quo, rem);
quo = copy_double(modf (Double_val(f), &frem));
rem = copy_double(frem);
quo = caml_copy_double(modf (Double_val(f), &frem));
rem = caml_copy_double(frem);
res = caml_alloc_tuple(2);
Field(res, 0) = quo;
Field(res, 1) = rem;
CAMLreturn (res);
}
CAMLprim value sqrt_float(value f)
CAMLprim value caml_sqrt_float(value f)
{
return copy_double(sqrt(Double_val(f)));
return caml_copy_double(sqrt(Double_val(f)));
}
CAMLprim value power_float(value f, value g)
CAMLprim value caml_power_float(value f, value g)
{
return copy_double(pow(Double_val(f), Double_val(g)));
return caml_copy_double(pow(Double_val(f), Double_val(g)));
}
CAMLprim value sin_float(value f)
CAMLprim value caml_sin_float(value f)
{
return copy_double(sin(Double_val(f)));
return caml_copy_double(sin(Double_val(f)));
}
CAMLprim value sinh_float(value f)
CAMLprim value caml_sinh_float(value f)
{
return copy_double(sinh(Double_val(f)));
return caml_copy_double(sinh(Double_val(f)));
}
CAMLprim value cos_float(value f)
CAMLprim value caml_cos_float(value f)
{
return copy_double(cos(Double_val(f)));
return caml_copy_double(cos(Double_val(f)));
}
CAMLprim value cosh_float(value f)
CAMLprim value caml_cosh_float(value f)
{
return copy_double(cosh(Double_val(f)));
return caml_copy_double(cosh(Double_val(f)));
}
CAMLprim value tan_float(value f)
CAMLprim value caml_tan_float(value f)
{
return copy_double(tan(Double_val(f)));
return caml_copy_double(tan(Double_val(f)));
}
CAMLprim value tanh_float(value f)
CAMLprim value caml_tanh_float(value f)
{
return copy_double(tanh(Double_val(f)));
return caml_copy_double(tanh(Double_val(f)));
}
CAMLprim value asin_float(value f)
CAMLprim value caml_asin_float(value f)
{
return copy_double(asin(Double_val(f)));
return caml_copy_double(asin(Double_val(f)));
}
CAMLprim value acos_float(value f)
CAMLprim value caml_acos_float(value f)
{
return copy_double(acos(Double_val(f)));
return caml_copy_double(acos(Double_val(f)));
}
CAMLprim value atan_float(value f)
CAMLprim value caml_atan_float(value f)
{
return copy_double(atan(Double_val(f)));
return caml_copy_double(atan(Double_val(f)));
}
CAMLprim value atan2_float(value f, value g)
CAMLprim value caml_atan2_float(value f, value g)
{
return copy_double(atan2(Double_val(f), Double_val(g)));
return caml_copy_double(atan2(Double_val(f), Double_val(g)));
}
CAMLprim value ceil_float(value f)
CAMLprim value caml_ceil_float(value f)
{
return copy_double(ceil(Double_val(f)));
return caml_copy_double(ceil(Double_val(f)));
}
CAMLprim value eq_float(value f, value g)
CAMLprim value caml_eq_float(value f, value g)
{
return Val_bool(Double_val(f) == Double_val(g));
}
CAMLprim value neq_float(value f, value g)
CAMLprim value caml_neq_float(value f, value g)
{
return Val_bool(Double_val(f) != Double_val(g));
}
CAMLprim value le_float(value f, value g)
CAMLprim value caml_le_float(value f, value g)
{
return Val_bool(Double_val(f) <= Double_val(g));
}
CAMLprim value lt_float(value f, value g)
CAMLprim value caml_lt_float(value f, value g)
{
return Val_bool(Double_val(f) < Double_val(g));
}
CAMLprim value ge_float(value f, value g)
CAMLprim value caml_ge_float(value f, value g)
{
return Val_bool(Double_val(f) >= Double_val(g));
}
CAMLprim value gt_float(value f, value g)
CAMLprim value caml_gt_float(value f, value g)
{
return Val_bool(Double_val(f) > Double_val(g));
}
CAMLprim value float_compare(value vf, value vg)
CAMLprim value caml_float_compare(value vf, value vg)
{
double f = Double_val(vf);
double g = Double_val(vg);
@ -341,7 +341,7 @@ CAMLprim value float_compare(value vf, value vg)
enum { FP_normal, FP_subnormal, FP_zero, FP_infinite, FP_nan };
CAMLprim value classify_float(value vd)
CAMLprim value caml_classify_float(value vd)
{
/* Cygwin 1.3 has problems with fpclassify (PR#1293), so don't use it */
#if defined(fpclassify) && !defined(__CYGWIN32__) && !defined(__MINGW32__)
@ -383,7 +383,7 @@ CAMLprim value classify_float(value vd)
#endif
}
/* The init_ieee_float function should initialize floating-point hardware
/* The [caml_init_ieee_float] function should initialize floating-point hardware
so that it behaves as much as possible like the IEEE standard.
In particular, return special numbers like Infinity and NaN instead
of signalling exceptions. Currently, everyone is in IEEE mode
@ -396,7 +396,7 @@ CAMLprim value classify_float(value vd)
#endif
#endif
void init_ieee_floats(void)
void caml_init_ieee_floats(void)
{
#if defined(__FreeBSD__) && (__FreeBSD_version < 400017)
fpsetmask(0);

78
byterun/freelist.c
View File

@ -23,7 +23,7 @@
/* The free-list is kept sorted by increasing addresses.
This makes the merging of adjacent free blocks possible.
(See [fl_merge_block].)
(See [caml_fl_merge_block].)
*/
typedef struct {
@ -42,16 +42,16 @@ static struct {
#define Fl_head ((char *) (&(sentinel.first_bp)))
static char *fl_prev = Fl_head; /* Current allocation pointer. */
static char *fl_last = NULL; /* Last block in the list. Only valid
just after fl_allocate returned NULL. */
char *fl_merge = Fl_head; /* Current insertion pointer. Managed
just after [caml_fl_allocate] returns NULL. */
char *caml_fl_merge = Fl_head; /* Current insertion pointer. Managed
jointly with [sweep_slice]. */
asize_t fl_cur_size = 0; /* Number of words in the free list,
asize_t caml_fl_cur_size = 0; /* Number of words in the free list,
including headers but not fragments. */
#define Next(b) (((block *) (b))->next_bp)
#ifdef DEBUG
void fl_check (void)
static void fl_check (void)
{
char *cur, *prev;
int prev_found = 0, merge_found = 0;
@ -63,17 +63,17 @@ void fl_check (void)
size_found += Whsize_bp (cur);
Assert (Is_in_heap (cur));
if (cur == fl_prev) prev_found = 1;
if (cur == fl_merge) merge_found = 1;
if (cur == caml_fl_merge) merge_found = 1;
prev = cur;
cur = Next (prev);
}
Assert (prev_found || fl_prev == Fl_head);
Assert (merge_found || fl_merge == Fl_head);
Assert (size_found == fl_cur_size);
Assert (merge_found || caml_fl_merge == Fl_head);
Assert (size_found == caml_fl_cur_size);
}
#endif
/* [allocate_block] is called by [fl_allocate]. Given a suitable free
/* [allocate_block] is called by [caml_fl_allocate]. Given a suitable free
block and the desired size, it allocates a new block from the free
block. There are three cases:
0. The free block has the desired size. Detach the block from the
@ -92,30 +92,30 @@ static char *allocate_block (mlsize_t wh_sz, char *prev, char *cur)
header_t h = Hd_bp (cur);
Assert (Whsize_hd (h) >= wh_sz);
if (Wosize_hd (h) < wh_sz + 1){ /* Cases 0 and 1. */
fl_cur_size -= Whsize_hd (h);
caml_fl_cur_size -= Whsize_hd (h);
Next (prev) = Next (cur);
Assert (Is_in_heap (Next (prev)) || Next (prev) == NULL);
if (fl_merge == cur) fl_merge = prev;
if (caml_fl_merge == cur) caml_fl_merge = prev;
#ifdef DEBUG
fl_last = NULL;
#endif
/* In case 1, the following creates the empty block correctly.
In case 0, it gives an invalid header to the block. The function
calling [fl_allocate] will overwrite it. */
calling [caml_fl_allocate] will overwrite it. */
Hd_op (cur) = Make_header (0, 0, Caml_white);
}else{ /* Case 2. */
fl_cur_size -= wh_sz;
caml_fl_cur_size -= wh_sz;
Hd_op (cur) = Make_header (Wosize_hd (h) - wh_sz, 0, Caml_blue);
}
fl_prev = prev;
return cur + Bosize_hd (h) - Bsize_wsize (wh_sz);
}
/* [fl_allocate] does not set the header of the newly allocated block.
/* [caml_fl_allocate] does not set the header of the newly allocated block.
The calling function must do it before any GC function gets called.
[fl_allocate] returns a head pointer.
[caml_fl_allocate] returns a head pointer.
*/
char *fl_allocate (mlsize_t wo_sz)
char *caml_fl_allocate (mlsize_t wo_sz)
{
char *cur, *prev;
Assert (sizeof (char *) == sizeof (value));
@ -148,33 +148,33 @@ char *fl_allocate (mlsize_t wo_sz)
static char *last_fragment;
void fl_init_merge (void)
void caml_fl_init_merge (void)
{
last_fragment = NULL;
fl_merge = Fl_head;
caml_fl_merge = Fl_head;
#ifdef DEBUG
fl_check ();
#endif
}
/* This is called by caml_compact_heap. */
void fl_reset (void)
void caml_fl_reset (void)
{
Next (Fl_head) = 0;
fl_prev = Fl_head;
fl_cur_size = 0;
fl_init_merge ();
caml_fl_cur_size = 0;
caml_fl_init_merge ();
}
/* [fl_merge_block] returns the head pointer of the next block after [bp],
/* [caml_fl_merge_block] returns the head pointer of the next block after [bp],
because merging blocks may change the size of [bp]. */
char *fl_merge_block (char *bp)
char *caml_fl_merge_block (char *bp)
{
char *prev, *cur, *adj;
header_t hd = Hd_bp (bp);
mlsize_t prev_wosz;
fl_cur_size += Whsize_hd (hd);
caml_fl_cur_size += Whsize_hd (hd);
#ifdef DEBUG
{
@ -184,7 +184,7 @@ char *fl_merge_block (char *bp)
}
}
#endif
prev = fl_merge;
prev = caml_fl_merge;
cur = Next (prev);
/* The sweep code makes sure that this is the right place to insert
this block: */
@ -198,7 +198,7 @@ char *fl_merge_block (char *bp)
hd = Make_header (bp_whsz, 0, Caml_white);
bp = last_fragment;
Hd_bp (bp) = hd;
fl_cur_size += Whsize_wosize (0);
caml_fl_cur_size += Whsize_wosize (0);
}
}
@ -232,29 +232,29 @@ char *fl_merge_block (char *bp)
#ifdef DEBUG
Hd_bp (bp) = Debug_free_major;
#endif
Assert (fl_merge == prev);
Assert (caml_fl_merge == prev);
}else if (Wosize_hd (hd) != 0){
Hd_bp (bp) = Bluehd_hd (hd);
Next (bp) = cur;
Next (prev) = bp;
fl_merge = bp;
caml_fl_merge = bp;
}else{
/* This is a fragment. Leave it in white but remember it for eventual
merging with the next block. */
last_fragment = bp;
fl_cur_size -= Whsize_wosize (0);
caml_fl_cur_size -= Whsize_wosize (0);
}
return adj;
}
/* This is a heap extension. We have to insert it in the right place
in the free-list.
[fl_add_block] can only be called just after a call to [fl_allocate]
that returned NULL.
[caml_fl_add_block] can only be called right after a call to
[caml_fl_allocate] that returned NULL.
Most of the heap extensions are expected to be at the end of the
free list. (This depends on the implementation of [malloc].)
*/
void fl_add_block (char *bp)
void caml_fl_add_block (char *bp)
{
Assert (fl_last != NULL);
Assert (Next (fl_last) == NULL);
@ -267,7 +267,7 @@ void fl_add_block (char *bp)
}
#endif
fl_cur_size += Whsize_bp (bp);
caml_fl_cur_size += Whsize_bp (bp);
if (bp > fl_last){
Next (fl_last) = bp;
@ -284,10 +284,10 @@ void fl_add_block (char *bp)
Assert (cur > bp || cur == NULL);
Next (bp) = cur;
Next (prev) = bp;
/* When inserting a block between fl_merge and caml_gc_sweep_hp, we must
advance fl_merge to the new block, so that fl_merge is always the
last free-list block before caml_gc_sweep_hp. */
if (prev == fl_merge && bp <= caml_gc_sweep_hp) fl_merge = bp;
/* When inserting a block between [caml_fl_merge] and [caml_gc_sweep_hp],
we must advance [caml_fl_merge] to the new block, so that [caml_fl_merge]
is always the last free-list block before [caml_gc_sweep_hp]. */
if (prev == caml_fl_merge && bp <= caml_gc_sweep_hp) caml_fl_merge = bp;
}
}
@ -298,7 +298,7 @@ void fl_add_block (char *bp)
size: size of the block (in words)
do_merge: 1 -> do merge; 0 -> do not merge
*/
void make_free_blocks (value *p, mlsize_t size, int do_merge)
void caml_make_free_blocks (value *p, mlsize_t size, int do_merge)
{
mlsize_t sz;
@ -309,7 +309,7 @@ void make_free_blocks (value *p, mlsize_t size, int do_merge)
sz = size;
}
*(header_t *)p = Make_header (Wosize_whsize (sz), 0, Caml_white);
if (do_merge) fl_merge_block (Bp_hp (p));
if (do_merge) caml_fl_merge_block (Bp_hp (p));
size -= sz;
p += sz;
}

14
byterun/freelist.h
View File

@ -22,14 +22,14 @@
#include "misc.h"
#include "mlvalues.h"
extern asize_t fl_cur_size; /* size in words */
extern asize_t caml_fl_cur_size; /* size in words */
char *fl_allocate (mlsize_t);
void fl_init_merge (void);
void fl_reset (void);
char *fl_merge_block (char *);
void fl_add_block (char *);
void make_free_blocks (value *, mlsize_t, int);
char *caml_fl_allocate (mlsize_t);
void caml_fl_init_merge (void);
void caml_fl_reset (void);
char *caml_fl_merge_block (char *);
void caml_fl_add_block (char *);
void caml_make_free_blocks (value *, mlsize_t, int);
#endif /* CAML_FREELIST_H */

89
byterun/gc_ctrl.c
View File

@ -29,16 +29,16 @@
extern unsigned long caml_max_stack_size; /* defined in stacks.c */
#endif
double stat_minor_words = 0.0,
stat_promoted_words = 0.0,
stat_major_words = 0.0;
double caml_stat_minor_words = 0.0,
caml_stat_promoted_words = 0.0,
caml_stat_major_words = 0.0;
long stat_minor_collections = 0,
stat_major_collections = 0,
stat_heap_size = 0, /* bytes */
stat_top_heap_size = 0, /* bytes */
stat_compactions = 0,
stat_heap_chunks = 0;
long caml_stat_minor_collections = 0,
caml_stat_major_collections = 0,
caml_stat_heap_size = 0, /* bytes */
caml_stat_top_heap_size = 0, /* bytes */
caml_stat_compactions = 0,
caml_stat_heap_chunks = 0;
extern asize_t caml_major_heap_increment; /* bytes; see major_gc.c */
extern unsigned long caml_percent_free; /* see major_gc.c */
@ -201,27 +201,28 @@ static value heap_stats (int returnstats)
chunk = Chunk_next (chunk);
}
Assert (heap_chunks == stat_heap_chunks);
Assert (live_words + free_words + fragments == Wsize_bsize (stat_heap_size));
Assert (heap_chunks == caml_stat_heap_chunks);
Assert (live_words + free_words + fragments
== Wsize_bsize (caml_stat_heap_size));
if (returnstats){
CAMLlocal1 (res);
/* get a copy of these before allocating anything... */
double minwords = stat_minor_words
double minwords = caml_stat_minor_words
+ (double) Wsize_bsize (caml_young_end - caml_young_ptr);
double prowords = stat_promoted_words;
double majwords = stat_major_words + (double) caml_allocated_words;
long mincoll = stat_minor_collections;
long majcoll = stat_major_collections;
long heap_words = Wsize_bsize (stat_heap_size);
long cpct = stat_compactions;
long top_heap_words = Wsize_bsize (stat_top_heap_size);
double prowords = caml_stat_promoted_words;
double majwords = caml_stat_major_words + (double) caml_allocated_words;
long mincoll = caml_stat_minor_collections;
long majcoll = caml_stat_major_collections;
long heap_words = Wsize_bsize (caml_stat_heap_size);
long cpct = caml_stat_compactions;
long top_heap_words = Wsize_bsize (caml_stat_top_heap_size);
res = caml_alloc_tuple (15);
Store_field (res, 0, copy_double (minwords));
Store_field (res, 1, copy_double (prowords));
Store_field (res, 2, copy_double (majwords));
Store_field (res, 0, caml_copy_double (minwords));
Store_field (res, 1, caml_copy_double (prowords));
Store_field (res, 2, caml_copy_double (majwords));
Store_field (res, 3, Val_long (mincoll));
Store_field (res, 4, Val_long (majcoll));
Store_field (res, 5, Val_long (heap_words));
@ -241,37 +242,37 @@ static value heap_stats (int returnstats)
}
#ifdef DEBUG
void heap_check (void)
void caml_heap_check (void)
{
heap_stats (0);
}
#endif
CAMLprim value gc_stat(value v)
CAMLprim value caml_gc_stat(value v)
{
Assert (v == Val_unit);
return heap_stats (1);
}
CAMLprim value gc_counters(value v)
CAMLprim value caml_gc_counters(value v)
{
CAMLparam0 (); /* v is ignored */
CAMLlocal1 (res);
/* get a copy of these before allocating anything... */
double minwords = stat_minor_words
double minwords = caml_stat_minor_words
+ (double) Wsize_bsize (caml_young_end - caml_young_ptr);
double prowords = stat_promoted_words;
double majwords = stat_major_words + (double) caml_allocated_words;
double prowords = caml_stat_promoted_words;
double majwords = caml_stat_major_words + (double) caml_allocated_words;
res = caml_alloc_tuple (3);
Store_field (res, 0, copy_double (minwords));
Store_field (res, 1, copy_double (prowords));
Store_field (res, 2, copy_double (majwords));
Store_field (res, 0, caml_copy_double (minwords));
Store_field (res, 1, caml_copy_double (prowords));
Store_field (res, 2, caml_copy_double (majwords));
CAMLreturn (res);
}
CAMLprim value gc_get(value v)
CAMLprim value caml_gc_get(value v)
{
CAMLparam0 (); /* v is ignored */
CAMLlocal1 (res);
@ -317,7 +318,7 @@ static long norm_minsize (long int s)
return s;
}
CAMLprim value gc_set(value v)
CAMLprim value caml_gc_set(value v)
{
unsigned long newpf, newpm;
asize_t newheapincr;
@ -359,39 +360,39 @@ CAMLprim value gc_set(value v)
return Val_unit;
}
CAMLprim value gc_minor(value v)
CAMLprim value caml_gc_minor(value v)
{ Assert (v == Val_unit);
caml_minor_collection ();
return Val_unit;
}
CAMLprim value gc_major(value v)
CAMLprim value caml_gc_major(value v)
{ Assert (v == Val_unit);
caml_empty_minor_heap ();
caml_finish_major_cycle ();
final_do_calls ();
caml_final_do_calls ();
return Val_unit;
}
CAMLprim value gc_full_major(value v)
CAMLprim value caml_gc_full_major(value v)
{ Assert (v == Val_unit);
caml_empty_minor_heap ();
caml_finish_major_cycle ();
final_do_calls ();
caml_final_do_calls ();
caml_empty_minor_heap ();
caml_finish_major_cycle ();
final_do_calls ();
caml_final_do_calls ();
return Val_unit;
}
CAMLprim value gc_major_slice (value v)
CAMLprim value caml_gc_major_slice (value v)
{
Assert (Is_long (v));
caml_empty_minor_heap ();
return Val_long (caml_major_collection_slice (Long_val (v)));
}
CAMLprim value gc_compaction(value v)
CAMLprim value caml_gc_compaction(value v)
{ Assert (v == Val_unit);
caml_empty_minor_heap ();
caml_finish_major_cycle ();
@ -400,9 +401,9 @@ CAMLprim value gc_compaction(value v)
return Val_unit;
}
void init_gc (unsigned long minor_size, unsigned long major_size,
unsigned long major_incr, unsigned long percent_fr,
unsigned long percent_m)
void caml_init_gc (unsigned long minor_size, unsigned long major_size,
unsigned long major_incr, unsigned long percent_fr,
unsigned long percent_m)
{
unsigned long major_heap_size = Bsize_wsize (norm_heapincr (major_size));

24
byterun/gc_ctrl.h
View File

@ -19,24 +19,24 @@
#include "misc.h"
extern double
stat_minor_words,
stat_promoted_words,
stat_major_words;
caml_stat_minor_words,
caml_stat_promoted_words,
caml_stat_major_words;
extern long
stat_minor_collections,
stat_major_collections,
stat_heap_size,
stat_top_heap_size,
stat_compactions,
stat_heap_chunks;
caml_stat_minor_collections,
caml_stat_major_collections,
caml_stat_heap_size,
caml_stat_top_heap_size,
caml_stat_compactions,
caml_stat_heap_chunks;
void init_gc (unsigned long, unsigned long, unsigned long,
unsigned long, unsigned long);
void caml_init_gc (unsigned long, unsigned long, unsigned long,
unsigned long, unsigned long);
#ifdef DEBUG
void heap_check (void);
void caml_heap_check (void);
#endif
#endif /* CAML_GC_CTRL_H */

4
byterun/globroots.c
View File

@ -55,7 +55,7 @@ struct global_root_list caml_global_roots = { NULL, { NULL, }, 0 };
/* Register a global C root */
void register_global_root(value *r)
void caml_register_global_root(value *r)
{
struct global_root * update[MAX_LEVEL];
struct global_root * e, * f;
@ -95,7 +95,7 @@ void register_global_root(value *r)
/* Un-register a global C root */
void remove_global_root(value *r)
void caml_remove_global_root(value *r)
{
struct global_root * update[MAX_LEVEL];
struct global_root * e, * f;

5
byterun/hash.c
View File

@ -26,7 +26,7 @@ static long hash_univ_limit, hash_univ_count;
static void hash_aux(value obj);
CAMLprim value hash_univ_param(value count, value limit, value obj)
CAMLprim value caml_hash_univ_param(value count, value limit, value obj)
{
hash_univ_limit = Long_val(limit);
hash_univ_count = Long_val(count);
@ -142,7 +142,7 @@ static void hash_aux(value obj)
/* Hashing variant tags */
CAMLexport value hash_variant(char * tag)
CAMLexport value caml_hash_variant(char * tag)
{
value accu;
/* Same hashing algorithm as in ../typing/btype.ml, function hash_variant */
@ -155,4 +155,3 @@ CAMLexport value hash_variant(char * tag)
platforms */
return (int32) accu;
}

12
byterun/instrtrace.c
View File

@ -24,19 +24,19 @@
#include "opnames.h"
#include "prims.h"
extern code_t start_code;
extern code_t caml_start_code;
long icount = 0;
long caml_icount = 0;
void stop_here () {}
void caml_stop_here () {}
int trace_flag = 0;
int caml_trace_flag = 0;
void disasm_instr(pc)
void caml_disasm_instr(pc)
code_t pc;
{
int instr = *pc;
printf("%6ld %s", (long) (pc - start_code),
printf("%6ld %s", (long) (pc - caml_start_code),
instr < 0 || instr > STOP ? "???" : names_of_instructions[instr]);
pc++;
switch(instr) {

8
byterun/instrtrace.h
View File

@ -22,10 +22,10 @@
#include "mlvalues.h"
#include "misc.h"
extern int trace_flag;
extern long icount;
void stop_here (void);
void disasm_instr (code_t pc);
extern int caml_trace_flag;
extern long caml_icount;
void caml_stop_here (void);
void caml_disasm_instr (code_t pc);
#endif

12
byterun/intern.c
View File

@ -293,7 +293,7 @@ static void intern_rec(value *dest)
intern_cleanup();
caml_failwith("input_value: code mismatch");
}
v = (value) (code_area_start + ofs);
v = (value) (caml_code_area_start + ofs);
break;
case CODE_INFIXPOINTER:
ofs = read32u();
@ -378,8 +378,8 @@ static void intern_add_to_heap(mlsize_t whsize)
(header_t *) intern_extra_block + Wsize_bsize(request);
Assert(intern_dest <= end_extra_block);
if (intern_dest < end_extra_block){
make_free_blocks ((value *) intern_dest, end_extra_block - intern_dest,
0);
caml_make_free_blocks ((value *) intern_dest,
end_extra_block - intern_dest, 0);
}
caml_add_to_heap(intern_extra_block);
}
@ -564,8 +564,8 @@ unsigned char * caml_code_checksum(void)
struct MD5Context ctx;
caml_MD5Init(&ctx);
caml_MD5Update(&ctx,
(unsigned char *) code_area_start,
code_area_end - code_area_start);
(unsigned char *) caml_code_area_start,
caml_code_area_end - caml_code_area_start);
caml_MD5Final(checksum, &ctx);
checksum_computed = 1;
}
@ -578,7 +578,7 @@ unsigned char * caml_code_checksum(void)
unsigned char * caml_code_checksum(void)
{
return code_md5;
return caml_code_md5;
}
#endif

14
byterun/interp.c
View File

@ -100,10 +100,10 @@ sp is a local copy of the global variable caml_extern_sp. */
#ifdef THREADED_CODE
#define Restart_curr_instr \
goto *(jumptable[saved_code[pc - 1 - start_code]])
goto *(jumptable[caml_saved_code[pc - 1 - caml_start_code]])
#else
#define Restart_curr_instr \
curr_instr = saved_code[pc - 1 - start_code]; \
curr_instr = caml_saved_code[pc - 1 - caml_start_code]; \
goto dispatch_instr
#endif
@ -225,8 +225,8 @@ value caml_interprete(code_t prog, asize_t prog_size)
if (prog == NULL) { /* Interpreter is initializing */
#ifdef THREADED_CODE
instr_table = (char **) jumptable;
instr_base = Jumptbl_base;
caml_instr_table = (char **) jumptable;
caml_instr_base = Jumptbl_base;
#endif
return Val_unit;
}
@ -258,7 +258,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
#ifdef THREADED_CODE
#ifdef DEBUG
next_instr:
if (icount-- == 0) stop_here ();
if (caml_icount-- == 0) caml_stop_here ();
Assert(sp >= caml_stack_low);
Assert(sp <= caml_stack_high);
#endif
@ -266,8 +266,8 @@ value caml_interprete(code_t prog, asize_t prog_size)
#else
while(1) {
#ifdef DEBUG
if (icount-- == 0) stop_here ();
if (trace_flag) disasm_instr(pc);
if (caml_icount-- == 0) caml_stop_here ();
if (caml_trace_flag) caml_disasm_instr(pc);
Assert(sp >= caml_stack_low);
Assert(sp <= caml_stack_high);
#endif

6
byterun/intext.h
View File

@ -165,10 +165,10 @@ unsigned char * caml_code_checksum (void);
#ifndef NATIVE_CODE
#include "fix_code.h"
#define code_area_start ((char *) start_code)
#define code_area_end ((char *) start_code + code_size)
#define caml_code_area_start ((char *) caml_start_code)
#define caml_code_area_end ((char *) caml_start_code + caml_code_size)
#else
extern char * code_area_start, * code_area_end;
extern char * caml_code_area_start, * caml_code_area_end;
#endif
/* </private> */

10
byterun/ints.c
View File

@ -295,7 +295,7 @@ CAMLprim value caml_int32_of_float(value v)
{ return caml_copy_int32((int32)(Double_val(v))); }
CAMLprim value caml_int32_to_float(value v)
{ return copy_double((double)(Int32_val(v))); }
{ return caml_copy_double((double)(Int32_val(v))); }
CAMLprim value caml_int32_compare(value v1, value v2)
{
@ -336,7 +336,7 @@ CAMLprim value caml_int32_float_of_bits(value vi)
{
union { float d; int32 i; } u;
u.i = Int32_val(vi);
return copy_double(u.d);
return caml_copy_double(u.d);
}
/* 64-bit integers */
@ -470,7 +470,7 @@ CAMLprim value caml_int64_of_float(value v)
CAMLprim value caml_int64_to_float(value v)
{
int64 i = Int64_val(v);
return copy_double(I64_to_double(i));
return caml_copy_double(I64_to_double(i));
}
CAMLprim value caml_int64_of_int32(value v)
@ -558,7 +558,7 @@ CAMLprim value caml_int64_float_of_bits(value vi)
{
union { double d; int64 i; } u;
u.i = Int64_val(vi);
return copy_double(u.d);
return caml_copy_double(u.d);
}
/* Native integers */
@ -692,7 +692,7 @@ CAMLprim value caml_nativeint_of_float(value v)
{ return caml_copy_nativeint((long)(Double_val(v))); }
CAMLprim value caml_nativeint_to_float(value v)
{ return copy_double((double)(Nativeint_val(v))); }
{ return caml_copy_double((double)(Nativeint_val(v))); }
CAMLprim value caml_nativeint_of_int32(value v)
{ return caml_copy_nativeint(Int32_val(v)); }

57
byterun/major_gc.c
View File

@ -45,7 +45,7 @@ unsigned long caml_allocated_words;
double caml_extra_heap_memory;
unsigned long caml_fl_size_at_phase_change = 0;
extern char *fl_merge; /* Defined in freelist.c. */
extern char *caml_fl_merge; /* Defined in freelist.c. */
static char *markhp, *chunk, *limit;
@ -60,7 +60,7 @@ static void realloc_gray_vals (void)
value *new;
Assert (gray_vals_cur == gray_vals_end);
if (gray_vals_size < stat_heap_size / 128){
if (gray_vals_size < caml_stat_heap_size / 128){
caml_gc_message (0x08, "Growing gray_vals to %luk bytes\n",
(long) gray_vals_size * sizeof (value) / 512);
new = (value *) realloc ((char *) gray_vals,
@ -103,7 +103,7 @@ static void start_cycle (void)
gc_subphase = Subphase_main;
markhp = NULL;
#ifdef DEBUG
heap_check ();
caml_heap_check ();
#endif
}
@ -222,7 +222,7 @@ static void mark_slice (long work)
}else{
/* Subphase_weak is done. Handle finalised values. */
gray_vals_cur = gray_vals_ptr;
final_update ();
caml_final_update ();
gray_vals_ptr = gray_vals_cur;
gc_subphase = Subphase_final;
}
@ -231,13 +231,13 @@ static void mark_slice (long work)
/* Initialise the sweep phase. */
gray_vals_cur = gray_vals_ptr;
caml_gc_sweep_hp = caml_heap_start;
fl_init_merge ();
caml_fl_init_merge ();
caml_gc_phase = Phase_sweep;
chunk = caml_heap_start;
caml_gc_sweep_hp = chunk;
limit = chunk + Chunk_size (chunk);
work = 0;
caml_fl_size_at_phase_change = fl_cur_size;
caml_fl_size_at_phase_change = caml_fl_cur_size;
}
}
gray_vals_cur = gray_vals_ptr;
@ -261,11 +261,11 @@ static void sweep_slice (long work)
void (*final_fun)(value) = Custom_ops_val(Val_hp(hp))->finalize;
if (final_fun != NULL) final_fun(Val_hp(hp));
}
caml_gc_sweep_hp = fl_merge_block (Bp_hp (hp));
caml_gc_sweep_hp = caml_fl_merge_block (Bp_hp (hp));
break;
case Caml_blue:
/* Only the blocks of the free-list are blue. See [freelist.c]. */
fl_merge = Bp_hp (hp);
caml_fl_merge = Bp_hp (hp);
break;
default: /* gray or black */
Assert (Color_hd (hd) == Caml_black);
@ -277,7 +277,7 @@ static void sweep_slice (long work)
chunk = Chunk_next (chunk);
if (chunk == NULL){
/* Sweeping is done. */
++ stat_major_collections;
++ caml_stat_major_collections;
work = 0;
caml_gc_phase = Phase_idle;
}else{
@ -298,7 +298,7 @@ long caml_major_collection_slice (long howmuch)
long computed_work;
/*
Free memory at the start of the GC cycle (garbage + free list) (assumed):
FM = stat_heap_size * caml_percent_free
FM = caml_stat_heap_size * caml_percent_free
/ (100 + caml_percent_free)
Assuming steady state and enforcing a constant allocation rate, then
@ -310,28 +310,28 @@ long caml_major_collection_slice (long howmuch)
Proportion of G consumed since the previous slice:
PH = caml_allocated_words / G
= caml_allocated_words * 3 * (100 + caml_percent_free)
/ (2 * stat_heap_size * caml_percent_free)
/ (2 * caml_stat_heap_size * caml_percent_free)
Proportion of extra-heap memory consumed since the previous slice:
PE = caml_extra_heap_memory
Proportion of total work to do in this slice:
P = max (PH, PE)
Amount of marking work for the GC cycle:
MW = stat_heap_size * 100 / (100 + caml_percent_free)
MW = caml_stat_heap_size * 100 / (100 + caml_percent_free)
Amount of sweeping work for the GC cycle:
SW = stat_heap_size
SW = caml_stat_heap_size
Amount of marking work for this slice:
MS = P * MW
MS = P * stat_heap_size * 100 / (100 + caml_percent_free)
MS = P * caml_stat_heap_size * 100 / (100 + caml_percent_free)
Amount of sweeping work for this slice:
SS = P * SW
SS = P * stat_heap_size
SS = P * caml_stat_heap_size
This slice will either mark 2*MS words or sweep 2*SS words.
*/
if (caml_gc_phase == Phase_idle) start_cycle ();
p = (double) caml_allocated_words * 3.0 * (100 + caml_percent_free)
/ Wsize_bsize (stat_heap_size) / caml_percent_free / 2.0;
/ Wsize_bsize (caml_stat_heap_size) / caml_percent_free / 2.0;
if (p < caml_extra_heap_memory) p = caml_extra_heap_memory;
caml_gc_message (0x40, "allocated_words = %lu\n", caml_allocated_words);
@ -341,10 +341,10 @@ long caml_major_collection_slice (long howmuch)
(unsigned long) (p * 1000000));
if (caml_gc_phase == Phase_mark){
computed_work = 2 * (long) (p * Wsize_bsize (stat_heap_size) * 100
computed_work = 2 * (long) (p * Wsize_bsize (caml_stat_heap_size) * 100
/ (100 + caml_percent_free));
}else{
computed_work = 2 * (long) (p * Wsize_bsize (stat_heap_size));
computed_work = 2 * (long) (p * Wsize_bsize (caml_stat_heap_size));
}
caml_gc_message (0x40, "ordered work = %ld words\n", howmuch);
caml_gc_message (0x40, "computed work = %ld words\n", computed_work);
@ -360,7 +360,7 @@ long caml_major_collection_slice (long howmuch)
if (caml_gc_phase == Phase_idle) caml_compact_heap_maybe ();
stat_major_words += caml_allocated_words;
caml_stat_major_words += caml_allocated_words;
caml_allocated_words = 0;
caml_extra_heap_memory = 0.0;
return computed_work;
@ -380,7 +380,7 @@ void caml_finish_major_cycle (void)
Assert (caml_gc_phase == Phase_sweep);
while (caml_gc_phase == Phase_sweep) sweep_slice (LONG_MAX);
Assert (caml_gc_phase == Phase_idle);
stat_major_words += caml_allocated_words;
caml_stat_major_words += caml_allocated_words;
caml_allocated_words = 0;
}
@ -421,17 +421,17 @@ void caml_init_major_heap (asize_t heap_size)
asize_t page_table_size;
page_table_entry *page_table_block;
stat_heap_size = clip_heap_chunk_size (heap_size);
stat_top_heap_size = stat_heap_size;
Assert (stat_heap_size % Page_size == 0);
caml_heap_start = (char *) caml_alloc_for_heap (stat_heap_size);
caml_stat_heap_size = clip_heap_chunk_size (heap_size);
caml_stat_top_heap_size = caml_stat_heap_size;
Assert (caml_stat_heap_size % Page_size == 0);
caml_heap_start = (char *) caml_alloc_for_heap (caml_stat_heap_size);
if (caml_heap_start == NULL)
caml_fatal_error ("Fatal error: not enough memory for the initial heap.\n");
Chunk_next (caml_heap_start) = NULL;
caml_heap_end = caml_heap_start + stat_heap_size;
caml_heap_end = caml_heap_start + caml_stat_heap_size;
Assert ((unsigned long) caml_heap_end % Page_size == 0);
stat_heap_chunks = 1;
caml_stat_heap_chunks = 1;
caml_page_low = Page (caml_heap_start);
caml_page_high = Page (caml_heap_end);
@ -447,8 +447,9 @@ void caml_init_major_heap (asize_t heap_size)
caml_page_table [i] = In_heap;
}
fl_init_merge ();
make_free_blocks ((value *) caml_heap_start, Wsize_bsize (stat_heap_size), 1);
caml_fl_init_merge ();
caml_make_free_blocks ((value *) caml_heap_start,
Wsize_bsize (caml_stat_heap_size), 1);
caml_gc_phase = Phase_idle;
gray_vals_size = 2048;
gray_vals = (value *) malloc (gray_vals_size * sizeof (value));

26
byterun/memory.c
View File

@ -150,15 +150,17 @@ int caml_add_to_heap (char *m)
Chunk_next (m) = cur;
*last = m;
++ stat_heap_chunks;
++ caml_stat_heap_chunks;
}
/* Update the heap bounds as needed. */
/* already done: if (m < caml_heap_start) heap_start = m; */
if (m + Chunk_size (m) > caml_heap_end) caml_heap_end = m + Chunk_size (m);
stat_heap_size += Chunk_size (m);
if (stat_heap_size > stat_top_heap_size) stat_top_heap_size = stat_heap_size;
caml_stat_heap_size += Chunk_size (m);
if (caml_stat_heap_size > caml_stat_top_heap_size){
caml_stat_top_heap_size = caml_stat_heap_size;
}
return 0;
}
@ -175,7 +177,7 @@ static char *expand_heap (mlsize_t request)
malloc_request = caml_round_heap_chunk_size (Bhsize_wosize (request));
caml_gc_message (0x04, "Growing heap to %luk bytes\n",
(stat_heap_size + malloc_request) / 1024);
(caml_stat_heap_size + malloc_request) / 1024);
mem = caml_alloc_for_heap (malloc_request);
if (mem == NULL){
caml_gc_message (0x04, "No room for growing heap\n", 0);
@ -207,8 +209,9 @@ void caml_shrink_heap (char *chunk)
*/
if (chunk == caml_heap_start) return;
stat_heap_size -= Chunk_size (chunk);
caml_gc_message (0x04, "Shrinking heap to %luk bytes\n", stat_heap_size/1024);
caml_stat_heap_size -= Chunk_size (chunk);
caml_gc_message (0x04, "Shrinking heap to %luk bytes\n",
caml_stat_heap_size / 1024);
#ifdef DEBUG
{
@ -219,7 +222,7 @@ void caml_shrink_heap (char *chunk)
}
#endif
-- stat_heap_chunks;
-- caml_stat_heap_chunks;
/* Remove [chunk] from the list of chunks. */
cp = &caml_heap_start;
@ -253,7 +256,7 @@ value caml_alloc_shr (mlsize_t wosize, tag_t tag)
char *hp, *new_block;
if (wosize > Max_wosize) caml_raise_out_of_memory ();
hp = fl_allocate (wosize);
hp = caml_fl_allocate (wosize);
if (hp == NULL){
new_block = expand_heap (wosize);
if (new_block == NULL) {
@ -262,8 +265,8 @@ value caml_alloc_shr (mlsize_t wosize, tag_t tag)
else
caml_raise_out_of_memory ();
}
fl_add_block (new_block);
hp = fl_allocate (wosize);
caml_fl_add_block (new_block);
hp = caml_fl_allocate (wosize);
}
Assert (Is_in_heap (Val_hp (hp)));
@ -312,7 +315,8 @@ void caml_adjust_gc_speed (mlsize_t mem, mlsize_t max)
caml_urge_major_slice ();
}
if (caml_extra_heap_memory > (double) Wsize_bsize (caml_minor_heap_size)
/ 2.0 / (double) Wsize_bsize (stat_heap_size)) {
/ 2.0
/ (double) Wsize_bsize (caml_stat_heap_size)) {
caml_urge_major_slice ();
}
}

12
byterun/memory.h
View File

@ -363,16 +363,16 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */
#define End_roots() caml_local_roots = caml__roots_block.next; }
/* [register_global_root] registers a global C variable as a memory root
for the duration of the program, or until [remove_global_root] is
/* [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 register_global_root (value *);
CAMLextern void caml_register_global_root (value *);
/* [remove_global_root] removes a memory root registered on a global C
variable with [register_global_root]. */
/* [caml_remove_global_root] removes a memory root registered on a global C
variable with [caml_register_global_root]. */
CAMLextern void remove_global_root (value *);
CAMLextern void caml_remove_global_root (value *);
#endif /* CAML_MEMORY_H */

4
byterun/meta.c
View File

@ -39,10 +39,10 @@ CAMLprim value caml_reify_bytecode(value prog, value len)
{
value clos;
#ifdef ARCH_BIG_ENDIAN
fixup_endianness((code_t) prog, (asize_t) Long_val(len));
caml_fixup_endianness((code_t) prog, (asize_t) Long_val(len));
#endif
#ifdef THREADED_CODE
thread_code((code_t) prog, (asize_t) Long_val(len));
caml_thread_code((code_t) prog, (asize_t) Long_val(len));
#endif
clos = caml_alloc_small (1, Closure_tag);
Code_val(clos) = (code_t) prog;

10
byterun/minor_gc.c
View File

@ -192,7 +192,7 @@ void caml_empty_minor_heap (void)
}
caml_oldify_mopup ();
if (caml_young_ptr < caml_young_start) caml_young_ptr = caml_young_start;
stat_minor_words += Wsize_bsize (caml_young_end - caml_young_ptr);
caml_stat_minor_words += Wsize_bsize (caml_young_end - caml_young_ptr);
caml_young_ptr = caml_young_end;
caml_young_limit = caml_young_start;
caml_ref_table_ptr = ref_table;
@ -200,7 +200,7 @@ void caml_empty_minor_heap (void)
caml_gc_message (0x02, ">", 0);
caml_in_minor_collection = 0;
}
final_empty_young ();
caml_final_empty_young ();
#ifdef DEBUG
{
value *p;
@ -221,12 +221,12 @@ void caml_minor_collection (void)
caml_empty_minor_heap ();
stat_promoted_words += caml_allocated_words - prev_alloc_words;
++ stat_minor_collections;
caml_stat_promoted_words += caml_allocated_words - prev_alloc_words;
++ caml_stat_minor_collections;
caml_major_collection_slice (0);
caml_force_major_slice = 0;
final_do_calls ();
caml_final_do_calls ();
caml_empty_minor_heap ();
}

15
byterun/mlvalues.h
View File

@ -197,7 +197,7 @@ typedef opcode_t * code_t;
#define Lazy_tag 246
/* Another special case: variants */
CAMLextern value hash_variant(char * tag);
CAMLextern value caml_hash_variant(char * tag);
/* 2- If tag >= No_scan_tag : a sequence of bytes. */
@ -225,8 +225,10 @@ CAMLextern mlsize_t caml_string_length (value); /* size in bytes */
#define Double_val(v) (* (double *)(v))
#define Store_double_val(v,d) (* (double *)(v) = (d))
#else
CAMLextern double Double_val (value);
CAMLextern void Store_double_val (value,double);
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) caml_Store_double_val(v)
#endif
/* Arrays of floating-point numbers. */
@ -272,10 +274,11 @@ CAMLextern header_t caml_atom_table[];
#ifndef NATIVE_CODE
#define Is_atom(v) ((v) >= Atom(0) && (v) <= Atom(255))
#else
CAMLextern char * static_data_start, * static_data_end;
CAMLextern char * caml_static_data_start, * caml_static_data_end;
#define Is_atom(v) \
((((char *)(v) >= static_data_start && (char *)(v) < static_data_end) || \
((v) >= Atom(0) && (v) <= Atom(255))))
((((char *)(v) >= caml_static_data_start \
&& (char *)(v) < caml_static_data_end) \
|| ((v) >= Atom(0) && (v) <= Atom(255))))
#endif
/* Booleans are integers 0 or 1 */

4
byterun/obj.c
View File

@ -155,10 +155,12 @@ CAMLprim value caml_obj_truncate (value v, value newsize)
/* [lazy_is_forward] is obsolete. Stays here to make bootstrapping
easier for patched versions of 3.07. To be removed before 3.08. FIXME */
CAMLprim value lazy_is_forward (value v)
/*
CAMLxxprim value lazy_is_forward (value v)
{
return Val_bool (Is_block (v) && Tag_val (v) == Forward_tag);
}
*/
CAMLprim value caml_lazy_follow_forward (value v)
{

4
byterun/roots.c
View File

@ -58,7 +58,7 @@ void caml_oldify_local_roots (void)
caml_oldify_one(*(gr->root), gr->root);
}
/* Finalised values */
final_do_young_roots (&caml_oldify_one);
caml_final_do_young_roots (&caml_oldify_one);
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one);
}
@ -85,7 +85,7 @@ void caml_do_roots (scanning_action f)
f(*(gr->root), gr->root);
}
/* Finalised values */
final_do_strong_roots (f);
caml_final_do_strong_roots (f);
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
}

2
byterun/signals.c
View File

@ -292,7 +292,7 @@ CAMLprim value caml_install_signal_handler(value signal_number, value action)
if (Is_block(action)) {
if (caml_signal_handlers == 0) {
caml_signal_handlers = caml_alloc(NSIG, 0);
register_global_root(&caml_signal_handlers);
caml_register_global_root(&caml_signal_handlers);
}
caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
}

28
byterun/startup.c
View File

@ -236,7 +236,7 @@ static int parse_command_line(char **argv)
switch(argv[i][1]) {
#ifdef DEBUG
case 't':
trace_flag = 1;
caml_trace_flag = 1;
break;
#endif
case 'v':
@ -304,7 +304,7 @@ static void parse_camlrunparam(void)
}
}
extern void init_ieee_floats (void);
extern void caml_init_ieee_floats (void);
#ifdef _WIN32
extern void caml_signal_thread(void * lpParam);
@ -326,7 +326,7 @@ CAMLexport void caml_main(char **argv)
/* Machine-dependent initialization of the floating-point hardware
so that it behaves as much as possible as specified in IEEE */
init_ieee_floats();
caml_init_ieee_floats();
caml_init_custom_operations();
caml_ext_table_init(&caml_shared_libs_path, 8);
caml_external_raise = NULL;
@ -362,8 +362,8 @@ CAMLexport void caml_main(char **argv)
/* Read the table of contents (section descriptors) */
caml_read_section_descriptors(fd, &trail);
/* Initialize the abstract machine */
init_gc (minor_heap_init, heap_size_init, heap_chunk_init,
percent_free_init, max_percent_free_init);
caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init,
percent_free_init, max_percent_free_init);
caml_init_stack (max_stack_init);
init_atoms();
/* Initialize the interpreter */
@ -371,8 +371,8 @@ CAMLexport void caml_main(char **argv)
/* Initialize the debugger, if needed */
caml_debugger_init();
/* Load the code */
code_size = caml_seek_section(fd, &trail, "CODE");
load_code(fd, code_size);
caml_code_size = caml_seek_section(fd, &trail, "CODE");
caml_load_code(fd, caml_code_size);
/* Build the table of primitives */
shared_lib_path = read_section(fd, &trail, "DLPT");
shared_libs = read_section(fd, &trail, "DLLS");
@ -401,7 +401,7 @@ CAMLexport void caml_main(char **argv)
#endif
/* Execute the program */
caml_debugger(PROGRAM_START);
res = caml_interprete(start_code, code_size);
res = caml_interprete(caml_start_code, caml_code_size);
if (Is_exception_result(res)) {
caml_exn_bucket = Extract_exception(res);
if (caml_debugger_in_use) {
@ -420,7 +420,7 @@ CAMLexport void caml_startup_code(code_t code, asize_t code_size,
{
value res;
init_ieee_floats();
caml_init_ieee_floats();
caml_init_custom_operations();
#ifdef DEBUG
caml_verb_gc = 63;
@ -428,16 +428,16 @@ CAMLexport void caml_startup_code(code_t code, asize_t code_size,
parse_camlrunparam();
caml_external_raise = NULL;
/* Initialize the abstract machine */
init_gc (minor_heap_init, heap_size_init, heap_chunk_init,
percent_free_init, max_percent_free_init);
caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init,
percent_free_init, max_percent_free_init);
caml_init_stack (max_stack_init);
init_atoms();
/* Initialize the interpreter */
caml_interprete(NULL, 0);
/* Load the code */
start_code = code;
caml_start_code = code;
#ifdef THREADED_CODE
thread_code(start_code, code_size);
caml_thread_code(caml_start_code, code_size);
#endif
/* Use the builtin table of primitives */
caml_prim_table.size = caml_prim_table.capacity = -1;
@ -450,7 +450,7 @@ CAMLexport void caml_startup_code(code_t code, asize_t code_size,
/* Run the code */
caml_init_exceptions();
caml_sys_init("", argv);
res = caml_interprete(start_code, code_size);
res = caml_interprete(caml_start_code, code_size);
if (Is_exception_result(res))
caml_fatal_uncaught_exception(Extract_exception(res));
}

4
byterun/str.c
View File

@ -53,14 +53,14 @@ CAMLprim value caml_create_string(value len)
CAMLprim value caml_string_get(value str, value index)
{
long idx = Long_val(index);
if (idx < 0 || idx >= caml_string_length(str)) array_bound_error();
if (idx < 0 || idx >= caml_string_length(str)) caml_array_bound_error();
return Val_int(Byte_u(str, idx));
}
CAMLprim value caml_string_set(value str, value index, value newval)
{
long idx = Long_val(index);
if (idx < 0 || idx >= caml_string_length(str)) array_bound_error();
if (idx < 0 || idx >= caml_string_length(str)) caml_array_bound_error();
Byte_u(str, idx) = Int_val(newval);
return Val_unit;
}

4
byterun/sys.c
View File

@ -299,10 +299,10 @@ CAMLprim value caml_sys_time(value unit)
#endif
struct tms t;
times(&t);
return copy_double((double)(t.tms_utime + t.tms_stime) / CLK_TCK);
return caml_copy_double((double)(t.tms_utime + t.tms_stime) / CLK_TCK);
#else
/* clock() is standard ANSI C */
return copy_double((double)clock() / CLOCKS_PER_SEC);
return caml_copy_double((double)clock() / CLOCKS_PER_SEC);
#endif
}

67
otherlibs/threads/pervasives.ml
View File

@ -85,28 +85,28 @@ external (+.) : float -> float -> float = "%addfloat"
external (-.) : float -> float -> float = "%subfloat"
external ( *. ) : float -> float -> float = "%mulfloat"
external (/.) : float -> float -> float = "%divfloat"
external ( ** ) : float -> float -> float = "power_float" "pow" "float"
external exp : float -> float = "exp_float" "exp" "float"
external acos : float -> float = "acos_float" "acos" "float"
external asin : float -> float = "asin_float" "asin" "float"
external atan : float -> float = "atan_float" "atan" "float"
external atan2 : float -> float -> float = "atan2_float" "atan2" "float"
external cos : float -> float = "cos_float" "cos" "float"
external cosh : float -> float = "cosh_float" "cosh" "float"
external log : float -> float = "log_float" "log" "float"
external log10 : float -> float = "log10_float" "log10" "float"
external sin : float -> float = "sin_float" "sin" "float"
external sinh : float -> float = "sinh_float" "sinh" "float"
external sqrt : float -> float = "sqrt_float" "sqrt" "float"
external tan : float -> float = "tan_float" "tan" "float"
external tanh : float -> float = "tanh_float" "tanh" "float"
external ceil : float -> float = "ceil_float" "ceil" "float"
external floor : float -> float = "floor_float" "floor" "float"
external ( ** ) : float -> float -> float = "caml_power_float" "pow" "float"
external exp : float -> float = "caml_exp_float" "exp" "float"
external acos : float -> float = "caml_acos_float" "acos" "float"
external asin : float -> float = "caml_asin_float" "asin" "float"
external atan : float -> float = "caml_atan_float" "atan" "float"
external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
external cos : float -> float = "caml_cos_float" "cos" "float"
external cosh : float -> float = "caml_cosh_float" "cosh" "float"
external log : float -> float = "caml_log_float" "log" "float"
external log10 : float -> float = "caml_log10_float" "log10" "float"
external sin : float -> float = "caml_sin_float" "sin" "float"
external sinh : float -> float = "caml_sinh_float" "sinh" "float"
external sqrt : float -> float = "caml_sqrt_float" "sqrt" "float"
external tan : float -> float = "caml_tan_float" "tan" "float"
external tanh : float -> float = "caml_tanh_float" "tanh" "float"
external ceil : float -> float = "caml_ceil_float" "ceil" "float"
external floor : float -> float = "caml_floor_float" "floor" "float"
external abs_float : float -> float = "%absfloat"
external mod_float : float -> float -> float = "fmod_float" "fmod" "float"
external frexp : float -> float * int = "frexp_float"
external ldexp : float -> int -> float = "ldexp_float"
external modf : float -> float * float = "modf_float"
external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
external frexp : float -> float * int = "caml_frexp_float"
external ldexp : float -> int -> float = "caml_ldexp_float"
external modf : float -> float * float = "caml_modf_float"
external float : int -> float = "%floatofint"
external float_of_int : int -> float = "%floatofint"
external truncate : float -> int = "%intoffloat"
@ -136,14 +136,14 @@ type fpclass =
| FP_zero
| FP_infinite
| FP_nan
external classify_float: float -> fpclass = "classify_float"
external classify_float: float -> fpclass = "caml_classify_float"
(* String operations -- more in module String *)
external string_length : string -> int = "%string_length"
external string_create: int -> string = "create_string"
external string_create: int -> string = "caml_create_string"
external string_blit : string -> int -> string -> int -> int -> unit
= "blit_string" "noalloc"
= "caml_blit_string" "noalloc"
let (^) s1 s2 =
let l1 = string_length s1 and l2 = string_length s2 in
@ -179,8 +179,8 @@ external decr: int ref -> unit = "%decr"
(* String conversion functions *)
external format_int: string -> int -> string = "format_int"
external format_float: string -> float -> string = "format_float"
external format_int: string -> int -> string = "caml_format_int"
external format_float: string -> float -> string = "caml_format_float"
let string_of_bool b =
if b then "true" else "false"
@ -207,7 +207,7 @@ let valid_float_lexem s =
let string_of_float f = valid_float_lexem (format_float "%.12g" f);;
external float_of_string : string -> float = "float_of_string"
external float_of_string : string -> float = "caml_float_of_string"
(* List operations -- more in module List *)
@ -256,7 +256,7 @@ type open_flag =
| Open_creat | Open_trunc | Open_excl
| Open_binary | Open_text | Open_nonblock
external open_desc: string -> open_flag list -> int -> int = "sys_open"
external open_desc: string -> open_flag list -> int -> int = "caml_sys_open"
let open_out_gen mode perm name =
open_descriptor_out(open_desc name mode perm)
@ -339,7 +339,7 @@ let output_binary_int oc n =
output_byte oc n
external marshal_to_string : 'a -> unit list -> string
= "output_value_to_string"
= "caml_output_value_to_string"
let output_value oc v = output_string oc (marshal_to_string v [])
@ -441,8 +441,8 @@ let input_binary_int ic =
let b4 = input_byte ic in
(n1 lsl 24) + (b2 lsl 16) + (b3 lsl 8) + b4
external unmarshal : string -> int -> 'a = "input_value_from_string"
external marshal_data_size : string -> int -> int = "marshal_data_size"
external unmarshal : string -> int -> 'a = "caml_input_value_from_string"
external marshal_data_size : string -> int -> int = "caml_marshal_data_size"
let input_value ic =
let header = string_create 20 in
@ -512,7 +512,7 @@ let (( ^^ ) : ('a, 'b, 'c, 'd) format4 -> ('d, 'b, 'c, 'e) format4 ->
(* Miscellaneous *)
external sys_exit : int -> 'a = "sys_exit"
external sys_exit : int -> 'a = "caml_sys_exit"
let exit_function = ref flush_all
@ -526,6 +526,7 @@ let exit retcode =
do_at_exit ();
sys_exit retcode
external register_named_value: string -> 'a -> unit = "register_named_value"
external register_named_value : string -> 'a -> unit
= "caml_register_named_value"
let _ = register_named_value "Pervasives.do_at_exit" do_at_exit

20
stdlib/gc.ml
View File

@ -40,15 +40,15 @@ type control = {
mutable stack_limit : int;
};;
external stat : unit -> stat = "gc_stat";;
external counters : unit -> (float * float * float) = "gc_counters";;
external get : unit -> control = "gc_get";;
external set : control -> unit = "gc_set";;
external minor : unit -> unit = "gc_minor";;
external major_slice : int -> int = "gc_major_slice";;
external major : unit -> unit = "gc_major";;
external full_major : unit -> unit = "gc_full_major";;
external compact : unit -> unit = "gc_compaction";;
external stat : unit -> stat = "caml_gc_stat";;
external counters : unit -> (float * float * float) = "caml_gc_counters";;
external get : unit -> control = "caml_gc_get";;
external set : control -> unit = "caml_gc_set";;
external minor : unit -> unit = "caml_gc_minor";;
external major_slice : int -> int = "caml_gc_major_slice";;
external major : unit -> unit = "caml_gc_major";;
external full_major : unit -> unit = "caml_gc_full_major";;
external compact : unit -> unit = "caml_gc_compaction";;
open Printf;;
@ -76,7 +76,7 @@ let allocated_bytes () =
(mi +. ma -. pro) *. float_of_int (Sys.word_size / 8)
;;
external finalise : ('a -> unit) -> 'a -> unit = "final_register";;
external finalise : ('a -> unit) -> 'a -> unit = "caml_final_register";;
type alarm = bool ref;;

18
stdlib/gc.mli
View File

@ -129,38 +129,38 @@ type control =
}
(** The GC parameters are given as a [control] record. *)
external stat : unit -> stat = "gc_stat"
external stat : unit -> stat = "caml_gc_stat"
(** Return the current values of the memory management counters in a
[stat] record. *)
external counters : unit -> float * float * float = "gc_counters"
external counters : unit -> float * float * float = "caml_gc_counters"
(** Return [(minor_words, promoted_words, major_words)]. Much faster
than [stat]. *)
external get : unit -> control = "gc_get"
external get : unit -> control = "caml_gc_get"
(** Return the current values of the GC parameters in a [control] record. *)
external set : control -> unit = "gc_set"
external set : control -> unit = "caml_gc_set"
(** [set r] changes the GC parameters according to the [control] record [r].
The normal usage is: [Gc.set { (Gc.get()) with Gc.verbose = 0x00d }] *)
external minor : unit -> unit = "gc_minor"
external minor : unit -> unit = "caml_gc_minor"
(** Trigger a minor collection. *)
external major_slice : int -> int = "gc_major_slice";;
external major_slice : int -> int = "caml_gc_major_slice";;
(** Do a minor collection and a slice of major collection. The argument
is the size of the slice, 0 to use the automatically-computed
slice size. In all cases, the result is the computed slice size. *)
external major : unit -> unit = "gc_major"
external major : unit -> unit = "caml_gc_major"
(** Do a minor collection and finish the current major collection cycle. *)
external full_major : unit -> unit = "gc_full_major"
external full_major : unit -> unit = "caml_gc_full_major"
(** Do a minor collection, finish the current major collection cycle,
and perform a complete new cycle. This will collect all currently
unreachable blocks. *)
external compact : unit -> unit = "gc_compaction"
external compact : unit -> unit = "caml_gc_compaction"
(** Perform a full major collection and compact the heap. Note that heap
compaction is a lengthy operation. *)

2
stdlib/hashtbl.ml
View File

@ -15,7 +15,7 @@
(* Hash tables *)
external hash_param : int -> int -> 'a -> int = "hash_univ_param" "noalloc"
external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
let hash x = hash_param 10 100 x

2
stdlib/hashtbl.mli
View File

@ -154,7 +154,7 @@ val hash : 'a -> int
Moreover, [hash] always terminates, even on cyclic
structures. *)
external hash_param : int -> int -> 'a -> int = "hash_univ_param" "noalloc"
external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
(** [Hashtbl.hash_param n m x] computes a hash value for [x], with the
same properties as for [hash]. The two extra parameters [n] and
[m] give more precise control over hashing. Hashing performs a

2
stdlib/moreLabels.mli
View File

@ -60,7 +60,7 @@ module Hashtbl : sig
module Make : functor (H : HashedType) -> S with type key = H.t
val hash : 'a -> int
external hash_param : int -> int -> 'a -> int
= "hash_univ_param" "noalloc"
= "caml_hash_univ_param" "noalloc"
end
module Map : sig

48
stdlib/pervasives.ml
View File

@ -81,28 +81,28 @@ external (+.) : float -> float -> float = "%addfloat"
external (-.) : float -> float -> float = "%subfloat"
external ( *. ) : float -> float -> float = "%mulfloat"
external (/.) : float -> float -> float = "%divfloat"
external ( ** ) : float -> float -> float = "power_float" "pow" "float"
external exp : float -> float = "exp_float" "exp" "float"
external acos : float -> float = "acos_float" "acos" "float"
external asin : float -> float = "asin_float" "asin" "float"
external atan : float -> float = "atan_float" "atan" "float"
external atan2 : float -> float -> float = "atan2_float" "atan2" "float"
external cos : float -> float = "cos_float" "cos" "float"
external cosh : float -> float = "cosh_float" "cosh" "float"
external log : float -> float = "log_float" "log" "float"
external log10 : float -> float = "log10_float" "log10" "float"
external sin : float -> float = "sin_float" "sin" "float"
external sinh : float -> float = "sinh_float" "sinh" "float"
external sqrt : float -> float = "sqrt_float" "sqrt" "float"
external tan : float -> float = "tan_float" "tan" "float"
external tanh : float -> float = "tanh_float" "tanh" "float"
external ceil : float -> float = "ceil_float" "ceil" "float"
external floor : float -> float = "floor_float" "floor" "float"
external ( ** ) : float -> float -> float = "caml_power_float" "pow" "float"
external exp : float -> float = "caml_exp_float" "exp" "float"
external acos : float -> float = "caml_acos_float" "acos" "float"
external asin : float -> float = "caml_asin_float" "asin" "float"
external atan : float -> float = "caml_atan_float" "atan" "float"
external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
external cos : float -> float = "caml_cos_float" "cos" "float"
external cosh : float -> float = "caml_cosh_float" "cosh" "float"
external log : float -> float = "caml_log_float" "log" "float"
external log10 : float -> float = "caml_log10_float" "log10" "float"
external sin : float -> float = "caml_sin_float" "sin" "float"
external sinh : float -> float = "caml_sinh_float" "sinh" "float"
external sqrt : float -> float = "caml_sqrt_float" "sqrt" "float"
external tan : float -> float = "caml_tan_float" "tan" "float"
external tanh : float -> float = "caml_tanh_float" "tanh" "float"
external ceil : float -> float = "caml_ceil_float" "ceil" "float"
external floor : float -> float = "caml_floor_float" "floor" "float"
external abs_float : float -> float = "%absfloat"
external mod_float : float -> float -> float = "fmod_float" "fmod" "float"
external frexp : float -> float * int = "frexp_float"
external ldexp : float -> int -> float = "ldexp_float"
external modf : float -> float * float = "modf_float"
external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
external frexp : float -> float * int = "caml_frexp_float"
external ldexp : float -> int -> float = "caml_ldexp_float"
external modf : float -> float * float = "caml_modf_float"
external float : int -> float = "%floatofint"
external float_of_int : int -> float = "%floatofint"
external truncate : float -> int = "%intoffloat"
@ -127,7 +127,7 @@ type fpclass =
| FP_zero
| FP_infinite
| FP_nan
external classify_float: float -> fpclass = "classify_float"
external classify_float: float -> fpclass = "caml_classify_float"
(* String operations -- more in module String *)
@ -162,7 +162,7 @@ external snd : 'a * 'b -> 'b = "%field1"
(* String conversion functions *)
external format_int: string -> int -> string = "caml_format_int"
external format_float: string -> float -> string = "format_float"
external format_float: string -> float -> string = "caml_format_float"
let string_of_bool b =
if b then "true" else "false"
@ -193,7 +193,7 @@ let valid_float_lexem s =
let string_of_float f = valid_float_lexem (format_float "%.12g" f);;
external float_of_string : string -> float = "float_of_string"
external float_of_string : string -> float = "caml_float_of_string"
(* List operations -- more in module List *)

46
stdlib/pervasives.mli
View File

@ -247,55 +247,55 @@ external ( *. ) : float -> float -> float = "%mulfloat"
external ( /. ) : float -> float -> float = "%divfloat"
(** Floating-point division. *)
external ( ** ) : float -> float -> float = "power_float" "pow" "float"
external ( ** ) : float -> float -> float = "caml_power_float" "pow" "float"
(** Exponentiation *)
external sqrt : float -> float = "sqrt_float" "sqrt" "float"
external sqrt : float -> float = "caml_sqrt_float" "sqrt" "float"
(** Square root *)
external exp : float -> float = "exp_float" "exp" "float"
external exp : float -> float = "caml_exp_float" "exp" "float"
(** Exponential. *)
external log : float -> float = "log_float" "log" "float"
external log : float -> float = "caml_log_float" "log" "float"
(** Natural logarithm. *)
external log10 : float -> float = "log10_float" "log10" "float"
external log10 : float -> float = "caml_log10_float" "log10" "float"
(** Base 10 logarithm. *)
external cos : float -> float = "cos_float" "cos" "float"
external cos : float -> float = "caml_cos_float" "cos" "float"
(** See {!Pervasives.atan2}. *)
external sin : float -> float = "sin_float" "sin" "float"
external sin : float -> float = "caml_sin_float" "sin" "float"
(** See {!Pervasives.atan2}. *)
external tan : float -> float = "tan_float" "tan" "float"
external tan : float -> float = "caml_tan_float" "tan" "float"
(** See {!Pervasives.atan2}. *)
external acos : float -> float = "acos_float" "acos" "float"
external acos : float -> float = "caml_acos_float" "acos" "float"
(** See {!Pervasives.atan2}. *)
external asin : float -> float = "asin_float" "asin" "float"
external asin : float -> float = "caml_asin_float" "asin" "float"
(** See {!Pervasives.atan2}. *)
external atan : float -> float = "atan_float" "atan" "float"
external atan : float -> float = "caml_atan_float" "atan" "float"
(** See {!Pervasives.atan2}. *)
external atan2 : float -> float -> float = "atan2_float" "atan2" "float"
external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
(** The usual trigonometric functions. *)
external cosh : float -> float = "cosh_float" "cosh" "float"
external cosh : float -> float = "caml_cosh_float" "cosh" "float"
(** See {!Pervasives.tanh}. *)
external sinh : float -> float = "sinh_float" "sinh" "float"
external sinh : float -> float = "caml_sinh_float" "sinh" "float"
(** See {!Pervasives.tanh}. *)
external tanh : float -> float = "tanh_float" "tanh" "float"
external tanh : float -> float = "caml_tanh_float" "tanh" "float"
(** The usual hyperbolic trigonometric functions. *)
external ceil : float -> float = "ceil_float" "ceil" "float"
external ceil : float -> float = "caml_ceil_float" "ceil" "float"
(** See {!Pervasives.floor}. *)
external floor : float -> float = "floor_float" "floor" "float"
external floor : float -> float = "caml_floor_float" "floor" "float"
(** Round the given float to an integer value.
[floor f] returns the greatest integer value less than or
equal to [f].
@ -305,22 +305,22 @@ external floor : float -> float = "floor_float" "floor" "float"
external abs_float : float -> float = "%absfloat"
(** Return the absolute value of the argument. *)
external mod_float : float -> float -> float = "fmod_float" "fmod" "float"
external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
(** [mod_float a b] returns the remainder of [a] with respect to
[b]. The returned value is [a -. n *. b], where [n]
is the quotient [a /. b] rounded towards zero to an integer. *)
external frexp : float -> float * int = "frexp_float"
external frexp : float -> float * int = "caml_frexp_float"
(** [frexp f] returns the pair of the significant
and the exponent of [f]. When [f] is zero, the
significant [x] and the exponent [n] of [f] are equal to
zero. When [f] is non-zero, they are defined by
[f = x *. 2 ** n] and [0.5 <= x < 1.0]. *)
external ldexp : float -> int -> float = "ldexp_float"
external ldexp : float -> int -> float = "caml_ldexp_float"
(** [ldexp x n] returns [x *. 2 ** n]. *)
external modf : float -> float * float = "modf_float"
external modf : float -> float * float = "caml_modf_float"
(** [modf f] returns the pair of the fractional and integral
part of [f]. *)
@ -370,7 +370,7 @@ type fpclass =
(** The five classes of floating-point numbers, as determined by
the {!Pervasives.classify_float} function. *)
external classify_float : float -> fpclass = "classify_float"
external classify_float : float -> fpclass = "caml_classify_float"
(** Return the class of the given floating-point number:
normal, subnormal, zero, infinite, or not a number. *)
@ -434,7 +434,7 @@ external int_of_string : string -> int = "caml_int_of_string"
val string_of_float : float -> string
(** Return the string representation of a floating-point number. *)
external float_of_string : string -> float = "float_of_string"
external float_of_string : string -> float = "caml_float_of_string"
(** Convert the given string to a float. Raise [Failure "float_of_string"]
if the given string is not a valid representation of a float. *)

2
stdlib/printf.ml
View File

@ -18,7 +18,7 @@ external format_int32: string -> int32 -> string = "caml_int32_format"
external format_nativeint: string -> nativeint -> string
= "caml_nativeint_format"
external format_int64: string -> int64 -> string = "caml_int64_format"
external format_float: string -> float -> string = "format_float"
external format_float: string -> float -> string = "caml_format_float"
let bad_format fmt pos =
invalid_arg

2
stdlib/sys.ml
View File

@ -78,4 +78,4 @@ let catch_break on =
(* OCaml version string, must be in the format described in sys.mli. *)
let ocaml_version = "3.07+10 (2004-01-01)";;
let ocaml_version = "3.07+11 (2004-01-02)";;