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

depollution suite (PR#1914 et PR#1956); byterun/weak.c: PR#1929 suite 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6041 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Damien Doligez 2003-12-29 22:15:02 +00:00
parent dbf40e0b61
commit 31943bac1d
65 changed files with 638 additions and 511 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
asmcomp/cmmgen.ml
View File

@ -332,7 +332,7 @@ let make_alloc_generic set_fn tag wordsize args =
| e1::el -> Csequence(set_fn (Cvar id) (Cconst_int idx) e1,
fill_fields (idx + 2) el) in
Clet(id,
Cop(Cextcall("alloc", typ_addr, true),
Cop(Cextcall("caml_alloc", typ_addr, true),
[Cconst_int wordsize; Cconst_int tag]),
fill_fields 1 args)
end
@ -1451,7 +1451,8 @@ and transl_letrec bindings cont =
let rec init_blocks = function
| [] -> fill_nonrec bsz
| (id, exp, RHS_block sz) :: rem ->
Clet(id, Cop(Cextcall("alloc_dummy", typ_addr, true), [int_const sz]),
Clet(id, Cop(Cextcall("caml_alloc_dummy", typ_addr, true),
[int_const sz]),
init_blocks rem)
| (id, exp, RHS_nonrec) :: rem ->
Clet (id, Cconst_int 0, init_blocks rem)
@ -1463,7 +1464,7 @@ and transl_letrec bindings cont =
and fill_blocks = function
| [] -> cont
| (id, exp, RHS_block _) :: rem ->
Csequence(Cop(Cextcall("update_dummy", typ_void, false),
Csequence(Cop(Cextcall("caml_update_dummy", typ_void, false),
[Cvar id; transl exp]),
fill_blocks rem)
| (id, exp, RHS_nonrec) :: rem ->

3
asmrun/Makefile
View File

@ -16,7 +16,8 @@
include ../config/Makefile
CC=$(NATIVECC)
FLAGS=-I../byterun -DNATIVE_CODE -DTARGET_$(ARCH) -DSYS_$(SYSTEM)
FLAGS=-I../byterun -DCAML_NAME_SPACE -DNATIVE_CODE \
-DTARGET_$(ARCH) -DSYS_$(SYSTEM)
CFLAGS=$(FLAGS) -O $(NATIVECCCOMPOPTS)
DFLAGS=$(FLAGS) -g -DDEBUG $(NATIVECCCOMPOPTS)
PFLAGS=$(FLAGS) -pg -O -DPROFILING $(NATIVECCPROFOPTS)

6
asmrun/fail.c
View File

@ -66,7 +66,7 @@ void raise_constant(value tag)
{
value bucket;
Begin_root (tag);
bucket = alloc_small (1, 0);
bucket = caml_alloc_small (1, 0);
Field(bucket, 0) = tag;
End_roots ();
mlraise(bucket);
@ -76,7 +76,7 @@ void raise_with_arg(value tag, value arg)
{
value bucket;
Begin_roots2 (tag, arg);
bucket = alloc_small (2, 0);
bucket = caml_alloc_small (2, 0);
Field(bucket, 0) = tag;
Field(bucket, 1) = arg;
End_roots ();
@ -85,7 +85,7 @@ void raise_with_arg(value tag, value arg)
void raise_with_string(value tag, char *msg)
{
raise_with_arg(tag, copy_string(msg));
raise_with_arg(tag, caml_copy_string(msg));
}
void failwith (char *msg)

12
asmrun/signals.c
View File

@ -62,7 +62,7 @@ extern sighandler win32_signal(int sig, sighandler action);
ctx_version = 2;
}
}else{
fatal_error ("cannot determine SIGCONTEXT format");
caml_fatal_error ("cannot determine SIGCONTEXT format");
}
}
@ -440,14 +440,14 @@ value install_signal_handler(value signal_number, value action) /* ML */
#else
sigact.sa_flags = 0;
#endif
if (sigaction(sig, &sigact, &oldsigact) == -1) sys_error(NO_ARG);
if (sigaction(sig, &sigact, &oldsigact) == -1) caml_sys_error(NO_ARG);
oldact = oldsigact.sa_handler;
#else
oldact = signal(sig, act);
if (oldact == SIG_ERR) sys_error(NO_ARG);
if (oldact == SIG_ERR) caml_sys_error(NO_ARG);
#endif
if (oldact == (void (*)(int)) handle_signal) {
res = alloc_small(1, 0); /* Signal_handle */
res = caml_alloc_small(1, 0); /* Signal_handle */
Field(res, 0) = Field(signal_handlers, sig);
}
else if (oldact == SIG_IGN)
@ -456,7 +456,7 @@ value install_signal_handler(value signal_number, value action) /* ML */
res = Val_int(0); /* Signal_default */
if (Is_block(action)) {
if (signal_handlers == 0) {
signal_handlers = alloc(NSIG, 0);
signal_handlers = caml_alloc(NSIG, 0);
register_global_root(&signal_handlers);
}
modify(&Field(signal_handlers, sig), Field(action, 0));
@ -510,7 +510,7 @@ static void trap_handler(int sig, siginfo_t * info, void * context)
static void trap_handler(int sig)
{
/* TODO: recover registers from context and call array_bound_error */
fatal_error("Fatal error: out-of-bound access in array or string\n");
caml_fatal_error("Fatal error: out-of-bound access in array or string\n");
}
#endif

4
asmrun/startup.c
View File

@ -104,7 +104,7 @@ static void parse_camlrunparam(void)
case 'l': scanmult (opt, &max_stack_init); break;
case 'o': scanmult (opt, &percent_free_init); break;
case 'O': scanmult (opt, &max_percent_free_init); break;
case 'v': scanmult (opt, &verb_gc); break;
case 'v': scanmult (opt, &caml_verb_gc); break;
case 'p': parser_trace = 1; break;
}
}
@ -130,7 +130,7 @@ void caml_main(char **argv)
init_ieee_floats();
init_custom_operations();
#ifdef DEBUG
verb_gc = 63;
caml_verb_gc = 63;
#endif
parse_camlrunparam();
init_gc (minor_heap_init, heap_size_init, heap_chunk_init,

BIN
boot/ocamlc
View File

Binary file not shown.

BIN
boot/ocamllex
View File

Binary file not shown.

4
bytecomp/bytegen.ml
View File

@ -467,7 +467,7 @@ let rec comp_expr env exp sz cont =
| [] -> comp_nonrec new_env sz ndecl decl_size
| (id, exp, RHS_block blocksize) :: rem ->
Kconst(Const_base(Const_int blocksize)) ::
Kccall("alloc_dummy", 1) :: Kpush ::
Kccall("caml_alloc_dummy", 1) :: Kpush ::
comp_init (add_var id (sz+1) new_env) (sz+1) rem
| (id, exp, RHS_nonrec) :: rem ->
Kconst(Const_base(Const_int 0)) :: Kpush ::
@ -483,7 +483,7 @@ let rec comp_expr env exp sz cont =
| [] -> comp_expr new_env body sz (add_pop ndecl cont)
| (id, exp, RHS_block blocksize) :: rem ->
comp_expr new_env exp sz
(Kpush :: Kacc i :: Kccall("update_dummy", 2) ::
(Kpush :: Kacc i :: Kccall("caml_update_dummy", 2) ::
comp_rec new_env sz (i-1) rem)
| (id, exp, RHS_nonrec) :: rem ->
comp_rec new_env sz (i-1) rem

2
bytecomp/translmod.ml
View File

@ -198,7 +198,7 @@ let reorder_rec_bindings bindings =
(* Generate lambda-code for a reordered list of bindings *)
let prim_update =
{ prim_name = "update_dummy";
{ prim_name = "caml_update_dummy";
prim_arity = 2;
prim_alloc = true;
prim_native_name = "";

35
byterun/alloc.c
View File

@ -29,7 +29,7 @@
#define Setup_for_gc
#define Restore_after_gc
CAMLexport value alloc (mlsize_t wosize, tag_t tag)
CAMLexport value caml_alloc (mlsize_t wosize, tag_t tag)
{
value result;
mlsize_t i;
@ -51,7 +51,7 @@ CAMLexport value alloc (mlsize_t wosize, tag_t tag)
return result;
}
CAMLexport value alloc_small (mlsize_t wosize, tag_t tag)
CAMLexport value caml_alloc_small (mlsize_t wosize, tag_t tag)
{
value result;
@ -62,12 +62,12 @@ CAMLexport value alloc_small (mlsize_t wosize, tag_t tag)
return result;
}
CAMLexport value alloc_tuple(mlsize_t n)
CAMLexport value caml_alloc_tuple(mlsize_t n)
{
return alloc(n, 0);
return caml_alloc(n, 0);
}
CAMLexport value alloc_string (mlsize_t len)
CAMLexport value caml_alloc_string (mlsize_t len)
{
value result;
mlsize_t offset_index;
@ -85,25 +85,26 @@ CAMLexport value alloc_string (mlsize_t len)
return result;
}
CAMLexport value alloc_final (mlsize_t len, final_fun fun,
mlsize_t mem, mlsize_t max)
CAMLexport value caml_alloc_final (mlsize_t len, final_fun fun,
mlsize_t mem, mlsize_t max)
{
return alloc_custom(final_custom_operations(fun),
len * sizeof(value), mem, max);
}
CAMLexport value copy_string(char const *s)
CAMLexport value caml_copy_string(char const *s)
{
int len;
value res;
len = strlen(s);
res = alloc_string(len);
res = caml_alloc_string(len);
memmove(String_val(res), s, len);
return res;
}
CAMLexport value alloc_array(value (*funct)(char const *), char const ** arr)
CAMLexport value caml_alloc_array(value (*funct)(char const *),
char const ** arr)
{
CAMLparam0 ();
mlsize_t nbr, n;
@ -114,7 +115,7 @@ CAMLexport value alloc_array(value (*funct)(char const *), char const ** arr)
if (nbr == 0) {
CAMLreturn (Atom(0));
} else {
result = alloc (nbr, 0);
result = caml_alloc (nbr, 0);
for (n = 0; n < nbr; n++) {
/* The two statements below must be separate because of evaluation
order (don't take the address &Field(result, n) before
@ -126,12 +127,12 @@ CAMLexport value alloc_array(value (*funct)(char const *), char const ** arr)
}
}
CAMLexport value copy_string_array(char const ** arr)
CAMLexport value caml_copy_string_array(char const ** arr)
{
return alloc_array(copy_string, arr);
return caml_alloc_array(caml_copy_string, arr);
}
CAMLexport int convert_flag_list(value list, int *flags)
CAMLexport int caml_convert_flag_list(value list, int *flags)
{
int res;
res = 0;
@ -144,15 +145,15 @@ CAMLexport int convert_flag_list(value list, int *flags)
/* For compiling let rec over values */
CAMLprim value alloc_dummy(value size)
CAMLprim value caml_alloc_dummy(value size)
{
mlsize_t wosize = Int_val(size);
if (wosize == 0) return Atom(0);
return alloc (wosize, 0);
return caml_alloc (wosize, 0);
}
CAMLprim value update_dummy(value dummy, value newval)
CAMLprim value caml_update_dummy(value dummy, value newval)
{
mlsize_t size, i;
size = Wosize_val(newval);

28
byterun/alloc.h
View File

@ -17,29 +17,31 @@
#define CAML_ALLOC_H
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
#include "misc.h"
#include "mlvalues.h"
CAMLextern value alloc (mlsize_t, tag_t);
CAMLextern value alloc_small (mlsize_t, tag_t);
CAMLextern value alloc_tuple (mlsize_t);
CAMLextern value alloc_string (mlsize_t); /* size in bytes */
CAMLextern value copy_string (char const *);
CAMLextern value copy_string_array (char const **);
CAMLextern value caml_alloc (mlsize_t, tag_t);
CAMLextern value caml_alloc_small (mlsize_t, tag_t);
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 copy_int32 (int32); /* defined in [ints.c] */
CAMLextern value copy_int64 (int64); /* defined in [ints.c] */
CAMLextern value copy_nativeint (long); /* defined in [ints.c] */
CAMLextern value alloc_array (value (*funct) (char const *),
char const ** array);
CAMLextern value caml_alloc_array (value (*funct) (char const *),
char const ** array);
typedef void (*final_fun)(value);
CAMLextern value alloc_final (mlsize_t, /*size in words*/
final_fun, /*finalization function*/
mlsize_t, /*resources consumed*/
mlsize_t /*max resources*/);
CAMLextern value caml_alloc_final (mlsize_t, /*size in words*/
final_fun, /*finalization function*/
mlsize_t, /*resources consumed*/
mlsize_t /*max resources*/);
CAMLextern int convert_flag_list (value, int *);
CAMLextern int caml_convert_flag_list (value, int *);
#endif /* CAML_ALLOC_H */

6
byterun/array.c
View File

@ -144,14 +144,14 @@ CAMLprim value make_vect(value len, value init)
d = Double_val(init);
wsize = size * Double_wosize;
if (wsize > Max_wosize) invalid_argument("Array.make");
res = alloc(wsize, Double_array_tag);
res = caml_alloc(wsize, Double_array_tag);
for (i = 0; i < size; i++) {
Store_double_field(res, i, d);
}
} else {
if (size > Max_wosize) invalid_argument("Array.make");
if (size < Max_young_wosize) {
res = alloc_small(size, 0);
res = caml_alloc_small(size, 0);
for (i = 0; i < size; i++) Field(res, i) = init;
}
else if (Is_block(init) && Is_young(init)) {
@ -187,7 +187,7 @@ CAMLprim value make_array(value init)
} else {
Assert(size < Max_young_wosize);
wsize = size * Double_wosize;
res = alloc_small(wsize, Double_array_tag);
res = caml_alloc_small(wsize, Double_array_tag);
for (i = 0; i < size; i++) {
Store_double_field(res, i, Double_val(Field(init, i)));
}

10
byterun/backtrace.c
View File

@ -119,11 +119,11 @@ static value read_debug_info(void)
close(fd);
CAMLreturn(Val_false);
}
chan = open_descriptor_in(fd);
num_events = getword(chan);
events = alloc(num_events, 0);
chan = caml_open_descriptor_in(fd);
num_events = caml_getword(chan);
events = caml_alloc(num_events, 0);
for (i = 0; i < num_events; i++) {
orig = getword(chan);
orig = caml_getword(chan);
evl = input_val(chan);
/* Relocate events in event list */
for (l = evl; l != Val_int(0); l = Field(l, 1)) {
@ -133,7 +133,7 @@ static value read_debug_info(void)
/* Record event list */
Store_field(events, i, evl);
}
close_channel(chan);
caml_close_channel(chan);
CAMLreturn(events);
}

2
byterun/callback.h
View File

@ -18,7 +18,9 @@
#ifndef CAML_CALLBACK_H
#define CAML_CALLBACK_H
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
#include "mlvalues.h"
CAMLextern value callback (value closure, value arg);

14
byterun/compact.c
View File

@ -148,7 +148,7 @@ void compact_heap (void)
{
char *ch, *chend;
Assert (gc_phase == Phase_idle);
gc_message (0x10, "Compacting heap...\n", 0);
caml_gc_message (0x10, "Compacting heap...\n", 0);
#ifdef DEBUG
heap_check ();
@ -390,7 +390,7 @@ void compact_heap (void)
}
}
++ stat_compactions;
gc_message (0x10, "done.\n", 0);
caml_gc_message (0x10, "done.\n", 0);
}
unsigned long percent_max;
@ -418,17 +418,17 @@ void compact_heap_maybe (void)
fp = 100.0 * fw / (Wsize_bsize (stat_heap_size) - fw);
if (fp > 1000000.0) fp = 1000000.0;
}
gc_message (0x200, "FL size at phase change = %lu\n",
(unsigned long) fl_size_at_phase_change);
gc_message (0x200, "Estimated overhead = %lu%%\n", (unsigned long) fp);
caml_gc_message (0x200, "FL size at phase change = %lu\n",
(unsigned long) fl_size_at_phase_change);
caml_gc_message (0x200, "Estimated overhead = %lu%%\n", (unsigned long) fp);
if (fp >= percent_max){
gc_message (0x200, "Automatic compaction triggered.\n", 0);
caml_gc_message (0x200, "Automatic compaction triggered.\n", 0);
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);
gc_message (0x200, "Measured overhead: %lu%%\n", (unsigned long) fp);
caml_gc_message (0x200, "Measured overhead: %lu%%\n", (unsigned long) fp);
compact_heap ();
}

89
byterun/compatibility.h
View File

@ -4,7 +4,7 @@
/* */
/* Damien Doligez, projet Moscova, INRIA Rocquencourt */
/* */
/* Copyright 1997 Institut National de Recherche en Informatique et */
/* Copyright 2003 Institut National de Recherche en Informatique et */
/* en Automatique. All rights reserved. This file is distributed */
/* under the terms of the GNU Library General Public License, with */
/* the special exception on linking described in file ../LICENSE. */
@ -21,6 +21,18 @@
#ifndef CAML_NAME_SPACE
/* **** alloc.c */
#define alloc caml_alloc
#define alloc_small caml_alloc_small
#define alloc_tuple caml_alloc_tuple
#define alloc_string caml_alloc_string
#define alloc_final caml_alloc_final
#define copy_string caml_copy_string
#define alloc_array caml_alloc_array
#define copy_string_array caml_copy_string_array
#define convert_flag_list caml_convert_flag_list
/* alloc_dummy -> caml_alloc_dummy */
/* update_dummy -> caml_update_dummy */
/* **** array.c */
/* **** backtrace.c */
/* **** callback.c */
@ -42,26 +54,95 @@
/* **** intern.c */
/* **** interp.c */
/* **** ints.c */
/* **** io.c */
#define channel_mutex_free caml_channel_mutex_free
#define channel_mutex_lock caml_channel_mutex_lock
#define channel_mutex_unlock caml_channel_mutex_unlock
#define channel_mutex_unlock_exn caml_channel_mutex_unlock_exn
#define all_opened_channels caml_all_opened_channels
#define open_descriptor_in caml_open_descriptor_in
#define open_descriptor_out caml_open_descriptor_out
#define close_channel caml_close_channel
#define channel_size caml_channel_size
#define channel_binary_mode caml_channel_binary_mode
#define flush_partial caml_flush_partial
#define flush caml_flush
#define putword caml_putword
#define putblock caml_putblock
#define really_putblock caml_really_putblock
#define seek_out caml_seek_out
#define pos_out caml_pos_out
#define do_read caml_do_read /* FIXME not in io.h */
#define refill caml_refill
#define getword caml_getword
#define getblock caml_getblock
#define really_getblock caml_really_getblock
#define seek_in caml_seek_in
#define pos_in caml_pos_in
#define input_scan_line caml_input_scan_line
#define finalize_channel caml_finalize_channel /* FIXME not in io.h */
#define alloc_channel caml_alloc_channel
/* caml_open_descriptor_in -> caml_ml_open_descriptor_in */
/* caml_open_descriptor_out -> caml_ml_open_descriptor_out */
/* caml_out_channels_list -> caml_ml_out_channels_list */
/* channel_descriptor -> caml_channel_descriptor */
/* caml_close_channel -> caml_ml_close_channel */
/* caml_channel_size -> caml_ml_channel_size */
/* caml_channel_size_64 -> caml_ml_channel_size_64 */
/* caml_set_binary_mode -> caml_ml_set_binary_mode */
/* caml_flush_partial -> caml_ml_flush_partial */
/* caml_flush -> caml_ml_flush */
/* caml_output_char -> caml_ml_output_char */
/* caml_output_int -> caml_ml_output_int */
/* caml_output_partial -> caml_ml_output_partial */
/* caml_output -> caml_ml_output */
/* caml_seek_out -> caml_ml_seek_out */
/* caml_seek_out_64 -> caml_ml_seek_out_64 */
/* caml_pos_out -> caml_ml_pos_out */
/* caml_pos_out_64 -> caml_ml_pos_out_64 */
/* caml_input_char -> caml_ml_input_char */
/* caml_input_int -> caml_ml_input_int */
/* caml_input -> caml_ml_input */
/* caml_seek_in -> caml_ml_seek_in */
/* caml_seek_in_64 -> caml_ml_seek_in_64 */
/* caml_pos_in -> caml_ml_pos_in */
/* caml_pos_in_64 -> caml_ml_pos_in_64 */
/* caml_input_scan_line -> caml_ml_input_scan_line */
/* #define Val_file_offset caml_Val_file_offset *** done in io.h */
/* #define File_offset_val caml_File_offset_val *** done in io.h */
/* **** lexing.c */
/* **** macintosh.c */
/* **** macintosh.c (a supprimer) */
/* **** main.c */
/* **** major_gc.c */
/* **** md5.c */
/* **** memory.c */
/* **** meta.c */
/* **** minor_gc.c */
/* **** misc.c */
/* **** mpwtool.c */
/* g verb_gc -> caml_verb_gc */
/* g gc_message -> caml_gc_message */
/* g fatal_error -> caml_fatal_error */
/* g fatal_error_arg -> caml_fatal_error_arg */
/* g fatal_error_arg2 -> caml_fatal_error_arg2 */
/* g aligned_malloc -> caml_aligned_malloc */
/* g ext_table_init -> caml_ext_table_init */
/* g ext_table_add -> caml_ext_table_add */
/* g ext_table_free -> caml_ext_table_free */
/* **** mpwtool.c (a supprimer) */
/* **** obj.c */
/* **** parsing.c */
/* **** prims.c */
/* **** printexc.c */
/* **** roots.c check asmrun */
/* **** rotatecursor.c */
/* **** rotatecursor.c (a supprimer) */
/* **** signals.c check asmrun */
/* **** stacks.c */
/* **** startup.c check asmrun */
/* **** str.c */
#define string_length caml_string_length
/* ml_string_length -> caml_ml_string_length */

2
byterun/config.h
View File

@ -28,7 +28,9 @@
#endif
/* </private> */
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
/* Types for signed chars, 16-bit integers, 32-bit integers, 64-bit integers */

2
byterun/custom.c
View File

@ -31,7 +31,7 @@ CAMLextern value alloc_custom(struct custom_operations * ops,
wosize = 1 + (size + sizeof(value) - 1) / sizeof(value);
if (ops->finalize == NULL && wosize <= Max_young_wosize) {
result = alloc_small(wosize, Custom_tag);
result = caml_alloc_small(wosize, Custom_tag);
Custom_ops_val(result) = ops;
} else {
result = alloc_shr(wosize, Custom_tag);

2
byterun/custom.h
View File

@ -17,7 +17,9 @@
#define CAML_CUSTOM_H
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
#include "mlvalues.h"
struct custom_operations {

104
byterun/debugger.c
View File

@ -72,19 +72,19 @@ static void open_connection(void)
dbg_socket = socket(sock_domain, SOCK_STREAM, 0);
if (dbg_socket == -1 ||
connect(dbg_socket, &sock_addr.s_gen, sock_addr_len) == -1)
fatal_error("cannot connect to debugger");
dbg_in = open_descriptor_in(dbg_socket);
dbg_out = open_descriptor_out(dbg_socket);
if (!debugger_in_use) putword(dbg_out, -1); /* first connection */
putword(dbg_out, getpid());
flush(dbg_out);
caml_fatal_error("cannot connect to debugger");
dbg_in = caml_open_descriptor_in(dbg_socket);
dbg_out = caml_open_descriptor_out(dbg_socket);
if (!debugger_in_use) caml_putword(dbg_out, -1); /* first connection */
caml_putword(dbg_out, getpid());
caml_flush(dbg_out);
}
static void close_connection(void)
{
close_channel(dbg_in);
close_channel(dbg_out);
dbg_socket = -1; /* was closed by close_channel */
caml_close_channel(dbg_in);
caml_close_channel(dbg_out);
dbg_socket = -1; /* was closed by caml_close_channel */
}
void debugger_init(void)
@ -121,7 +121,7 @@ void debugger_init(void)
if (sock_addr.s_inet.sin_addr.s_addr == -1) {
host = gethostbyname(address);
if (host == NULL)
fatal_error_arg("Unknown debugging host %s\n", address);
caml_fatal_error_arg("Unknown debugging host %s\n", address);
memmove(&sock_addr.s_inet.sin_addr, host->h_addr, host->h_length);
}
sock_addr.s_inet.sin_port = htons(atoi(port));
@ -135,14 +135,14 @@ void debugger_init(void)
static value getval(struct channel *chan)
{
value res;
if (really_getblock(chan, (char *) &res, sizeof(res)) == 0)
raise_end_of_file(); /* Bad, but consistent with getword */
if (caml_really_getblock(chan, (char *) &res, sizeof(res)) == 0)
raise_end_of_file(); /* Bad, but consistent with caml_getword */
return res;
}
static void putval(struct channel *chan, value val)
{
really_putblock(chan, (char *) &val, sizeof(val));
caml_really_putblock(chan, (char *) &val, sizeof(val));
}
static void safe_output_value(struct channel *chan, value val)
@ -156,7 +156,7 @@ static void safe_output_value(struct channel *chan, value val)
output_val(chan, val, Val_unit);
} else {
/* Send wrong magic number, will cause input_value to fail */
really_putblock(chan, "\000\000\000\000", 4);
caml_really_putblock(chan, "\000\000\000\000", 4);
}
external_raise = saved_external_raise;
}
@ -199,16 +199,16 @@ void debugger(enum event_kind event)
putch(dbg_out, REP_UNCAUGHT_EXC);
break;
}
putword(dbg_out, event_count);
caml_putword(dbg_out, event_count);
if (event == EVENT_COUNT || event == BREAKPOINT) {
putword(dbg_out, stack_high - frame);
putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
caml_putword(dbg_out, stack_high - frame);
caml_putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
} else {
/* No PC and no stack frame associated with other events */
putword(dbg_out, 0);
putword(dbg_out, 0);
caml_putword(dbg_out, 0);
caml_putword(dbg_out, 0);
}
flush(dbg_out);
caml_flush(dbg_out);
command_loop:
@ -216,19 +216,19 @@ void debugger(enum event_kind event)
while(1) {
switch(getch(dbg_in)) {
case REQ_SET_EVENT:
pos = getword(dbg_in);
pos = caml_getword(dbg_in);
Assert (pos >= 0);
Assert (pos < code_size);
set_instruction(start_code + pos / sizeof(opcode_t), EVENT);
break;
case REQ_SET_BREAKPOINT:
pos = getword(dbg_in);
pos = caml_getword(dbg_in);
Assert (pos >= 0);
Assert (pos < code_size);
set_instruction(start_code + pos / sizeof(opcode_t), BREAK);
break;
case REQ_RESET_INSTR:
pos = getword(dbg_in);
pos = caml_getword(dbg_in);
Assert (pos >= 0);
Assert (pos < code_size);
pos = pos / sizeof(opcode_t);
@ -240,12 +240,12 @@ void debugger(enum event_kind event)
close_connection(); /* Close parent connection. */
open_connection(); /* Open new connection with debugger */
} else {
putword(dbg_out, i);
flush(dbg_out);
caml_putword(dbg_out, i);
caml_flush(dbg_out);
}
break;
case REQ_GO:
event_count = getword(dbg_in);
event_count = caml_getword(dbg_in);
return;
case REQ_STOP:
exit(0);
@ -257,79 +257,79 @@ void debugger(enum event_kind event)
frame = extern_sp + 1;
/* Fall through */
case REQ_GET_FRAME:
putword(dbg_out, stack_high - frame);
caml_putword(dbg_out, stack_high - frame);
if (frame < stack_high){
putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
caml_putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
}else{
putword (dbg_out, 0);
caml_putword (dbg_out, 0);
}
flush(dbg_out);
caml_flush(dbg_out);
break;
case REQ_SET_FRAME:
i = getword(dbg_in);
i = caml_getword(dbg_in);
frame = stack_high - i;
break;
case REQ_UP_FRAME:
i = getword(dbg_in);
i = caml_getword(dbg_in);
if (frame + Extra_args(frame) + i + 3 >= stack_high) {
putword(dbg_out, -1);
caml_putword(dbg_out, -1);
} else {
frame += Extra_args(frame) + i + 3;
putword(dbg_out, stack_high - frame);
putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
caml_putword(dbg_out, stack_high - frame);
caml_putword(dbg_out, (Pc(frame) - start_code) * sizeof(opcode_t));
}
flush(dbg_out);
caml_flush(dbg_out);
break;
case REQ_SET_TRAP_BARRIER:
i = getword(dbg_in);
i = caml_getword(dbg_in);
trap_barrier = stack_high - i;
break;
case REQ_GET_LOCAL:
i = getword(dbg_in);
i = caml_getword(dbg_in);
putval(dbg_out, Locals(frame)[i]);
flush(dbg_out);
caml_flush(dbg_out);
break;
case REQ_GET_ENVIRONMENT:
i = getword(dbg_in);
i = caml_getword(dbg_in);
putval(dbg_out, Field(Env(frame), i));
flush(dbg_out);
caml_flush(dbg_out);
break;
case REQ_GET_GLOBAL:
i = getword(dbg_in);
i = caml_getword(dbg_in);
putval(dbg_out, Field(global_data, i));
flush(dbg_out);
caml_flush(dbg_out);
break;
case REQ_GET_ACCU:
putval(dbg_out, *extern_sp);
flush(dbg_out);
caml_flush(dbg_out);
break;
case REQ_GET_HEADER:
val = getval(dbg_in);
putword(dbg_out, Hd_val(val));
flush(dbg_out);
caml_putword(dbg_out, Hd_val(val));
caml_flush(dbg_out);
break;
case REQ_GET_FIELD:
val = getval(dbg_in);
i = getword(dbg_in);
i = caml_getword(dbg_in);
if (Tag_val(val) != Double_array_tag) {
putch(dbg_out, 0);
putval(dbg_out, Field(val, i));
} else {
double d = Double_field(val, i);
putch(dbg_out, 1);
really_putblock(dbg_out, (char *) &d, 8);
caml_really_putblock(dbg_out, (char *) &d, 8);
}
flush(dbg_out);
caml_flush(dbg_out);
break;
case REQ_MARSHAL_OBJ:
val = getval(dbg_in);
safe_output_value(dbg_out, val);
flush(dbg_out);
caml_flush(dbg_out);
break;
case REQ_GET_CLOSURE_CODE:
val = getval(dbg_in);
putword(dbg_out, (Code_val(val) - start_code) * sizeof(opcode_t));
flush(dbg_out);
caml_putword(dbg_out, (Code_val(val) - start_code) * sizeof(opcode_t));
caml_flush(dbg_out);
break;
}
}

48
byterun/dynlink.c
View File

@ -90,23 +90,24 @@ static char * parse_ld_conf(void)
}
ldconf = open(ldconfname, O_RDONLY, 0);
if (ldconf == -1)
fatal_error_arg("Fatal error: cannot read loader config file %s\n",
ldconfname);
caml_fatal_error_arg("Fatal error: cannot read loader config file %s\n",
ldconfname);
config = stat_alloc(st.st_size + 1);
nread = read(ldconf, config, st.st_size);
if (nread == -1)
fatal_error_arg("Fatal error: error while reading loader config file %s\n",
ldconfname);
caml_fatal_error_arg
("Fatal error: error while reading loader config file %s\n",
ldconfname);
config[nread] = 0;
q = config;
for (p = config; *p != 0; p++) {
if (*p == '\n') {
*p = 0;
ext_table_add(&shared_libs_path, q);
caml_ext_table_add(&shared_libs_path, q);
q = p + 1;
}
}
if (q < p) ext_table_add(&shared_libs_path, q);
if (q < p) caml_ext_table_add(&shared_libs_path, q);
close(ldconf);
stat_free(ldconfname);
return config;
@ -120,12 +121,13 @@ static void open_shared_lib(char * name)
void * handle;
realname = search_dll_in_path(&shared_libs_path, name);
gc_message(0x100, "Loading shared library %s\n", (unsigned long) realname);
caml_gc_message(0x100, "Loading shared library %s\n",
(unsigned long) realname);
handle = caml_dlopen(realname);
if (handle == NULL)
fatal_error_arg2("Fatal error: cannot load shared library %s\n", name,
"Reason: %s\n", caml_dlerror());
ext_table_add(&shared_libs, handle);
caml_fatal_error_arg2("Fatal error: cannot load shared library %s\n", name,
"Reason: %s\n", caml_dlerror());
caml_ext_table_add(&shared_libs, handle);
stat_free(realname);
}
@ -147,31 +149,31 @@ void build_primitive_table(char * lib_path,
tofree1 = decompose_path(&shared_libs_path, getenv("CAML_LD_LIBRARY_PATH"));
if (lib_path != NULL)
for (p = lib_path; *p != 0; p += strlen(p) + 1)
ext_table_add(&shared_libs_path, p);
caml_ext_table_add(&shared_libs_path, p);
tofree2 = parse_ld_conf();
/* Open the shared libraries */
ext_table_init(&shared_libs, 8);
caml_ext_table_init(&shared_libs, 8);
if (libs != NULL)
for (p = libs; *p != 0; p += strlen(p) + 1)
open_shared_lib(p);
/* Build the primitive table */
ext_table_init(&prim_table, 0x180);
caml_ext_table_init(&prim_table, 0x180);
#ifdef DEBUG
ext_table_init(&prim_name_table, 0x180);
caml_ext_table_init(&prim_name_table, 0x180);
#endif
for (p = req_prims; *p != 0; p += strlen(p) + 1) {
c_primitive prim = lookup_primitive(p);
if (prim == NULL)
fatal_error_arg("Fatal error: unknown C primitive `%s'\n", p);
ext_table_add(&prim_table, (void *) prim);
caml_fatal_error_arg("Fatal error: unknown C primitive `%s'\n", p);
caml_ext_table_add(&prim_table, (void *) prim);
#ifdef DEBUG
ext_table_add(&prim_name_table, strdup(p));
caml_ext_table_add(&prim_name_table, strdup(p));
#endif
}
/* Clean up */
stat_free(tofree1);
stat_free(tofree2);
ext_table_free(&shared_libs_path, 0);
caml_ext_table_free(&shared_libs_path, 0);
}
#endif
@ -187,7 +189,7 @@ CAMLprim value dynlink_open_lib(value filename)
handle = caml_dlopen(String_val(filename));
if (handle == NULL) failwith(caml_dlerror());
result = alloc_small(1, Abstract_tag);
result = caml_alloc_small(1, Abstract_tag);
Handle_val(result) = handle;
return result;
}
@ -207,7 +209,7 @@ CAMLprim value dynlink_lookup_symbol(value handle, value symbolname)
/* printf("%s = 0x%lx\n", String_val(symbolname), symb);
fflush(stdout); */
if (symb == NULL) return Val_unit /*failwith(caml_dlerror())*/;
result = alloc_small(1, Abstract_tag);
result = caml_alloc_small(1, Abstract_tag);
Handle_val(result) = symb;
return result;
}
@ -216,7 +218,7 @@ CAMLprim value dynlink_lookup_symbol(value handle, value symbolname)
CAMLprim value dynlink_add_primitive(value handle)
{
return Val_int(ext_table_add(&prim_table, Handle_val(handle)));
return Val_int(caml_ext_table_add(&prim_table, Handle_val(handle)));
}
CAMLprim value dynlink_get_current_libs(value unit)
@ -225,9 +227,9 @@ CAMLprim value dynlink_get_current_libs(value unit)
CAMLlocal1(res);
int i;
res = alloc_tuple(shared_libs.size);
res = caml_alloc_tuple(shared_libs.size);
for (i = 0; i < shared_libs.size; i++) {
value v = alloc_small(1, Abstract_tag);
value v = caml_alloc_small(1, Abstract_tag);
Handle_val(v) = shared_libs.contents[i];
Store_field(res, i, v);
}

10
byterun/extern.c
View File

@ -394,7 +394,7 @@ static long extern_value(value v, value flags)
long res_len;
int fl;
/* Parse flag list */
fl = convert_flag_list(flags, extern_flags);
fl = caml_convert_flag_list(flags, extern_flags);
extern_ignore_sharing = fl & NO_SHARING;
extern_closures = fl & CLOSURES;
/* Allocate hashtable of objects already seen, if needed */
@ -444,15 +444,15 @@ void output_val(struct channel *chan, value v, value flags)
long len;
char * block;
if (! channel_binary_mode(chan))
if (! caml_channel_binary_mode(chan))
failwith("output_value: not a binary channel");
alloc_extern_block();
len = extern_value(v, flags);
/* During really_putblock, concurrent output_val operations can take
/* During caml_really_putblock, concurrent output_val operations can take
place (via signal handlers or context switching in systhreads),
and extern_block may change. So, save the pointer in a local variable. */
block = extern_block;
really_putblock(chan, extern_block, len);
caml_really_putblock(chan, extern_block, len);
stat_free(block);
}
@ -473,7 +473,7 @@ CAMLprim value output_value_to_string(value v, value flags)
value res;
alloc_extern_block();
len = extern_value(v, flags);
res = alloc_string(len);
res = caml_alloc_string(len);
memmove(String_val(res), extern_block, len);
stat_free(extern_block);
return res;

9
byterun/fail.c
View File

@ -46,7 +46,7 @@ CAMLexport void raise_constant(value tag)
CAMLparam1 (tag);
CAMLlocal1 (bucket);
bucket = alloc_small (1, 0);
bucket = caml_alloc_small (1, 0);
Field(bucket, 0) = tag;
mlraise(bucket);
}
@ -56,7 +56,7 @@ CAMLexport void raise_with_arg(value tag, value arg)
CAMLparam2 (tag, arg);
CAMLlocal1 (bucket);
bucket = alloc_small (2, 0);
bucket = caml_alloc_small (2, 0);
Field(bucket, 0) = tag;
Field(bucket, 1) = arg;
mlraise(bucket);
@ -67,7 +67,7 @@ CAMLexport void raise_with_string(value tag, char *msg)
CAMLparam1 (tag);
CAMLlocal1 (vmsg);
vmsg = copy_string(msg);
vmsg = caml_copy_string(msg);
raise_with_arg(tag, vmsg);
}
@ -98,7 +98,8 @@ static struct {
CAMLexport void raise_out_of_memory(void)
{
if (out_of_memory_bucket.exn == 0)
fatal_error("Fatal error: out of memory while raising Out_of_memory\n");
caml_fatal_error
("Fatal error: out of memory while raising Out_of_memory\n");
mlraise((value) &(out_of_memory_bucket.exn));
}

2
byterun/fail.h
View File

@ -20,7 +20,9 @@
#include <setjmp.h>
/* </private> */
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
#include "misc.h"
#include "mlvalues.h"

4
byterun/finalise.c
View File

@ -84,12 +84,12 @@ void final_do_calls (void)
Assert (active <= size);
if (active < size){
gc_message (0x80, "Calling finalisation functions.\n", 0);
caml_gc_message (0x80, "Calling finalisation functions.\n", 0);
while (active < size){
f = final_table[active++];
callback (f.fun, f.val);
}
gc_message (0x80, "Done calling finalisation functions.\n", 0);
caml_gc_message (0x80, "Done calling finalisation functions.\n", 0);
}
}

8
byterun/fix_code.c
View File

@ -45,7 +45,7 @@ void load_code(int fd, asize_t len)
code_size = len;
start_code = (code_t) stat_alloc(code_size);
if (read(fd, (char *) start_code, code_size) != code_size)
fatal_error("Fatal error: truncated bytecode file.\n");
caml_fatal_error("Fatal error: truncated bytecode file.\n");
MD5Init(&ctx);
MD5Update(&ctx, (unsigned char *) start_code, code_size);
MD5Final(code_md5, &ctx);
@ -118,9 +118,9 @@ void thread_code (code_t code, asize_t len)
for (p = code; p < code + len; /*nothing*/) {
opcode_t instr = *p;
if (instr < 0 || instr > STOP){
/*
fatal_error_arg ("Fatal error in fix_code: bad opcode (%lx)\n",
(char *)(long)instr);
/* FIXME -- should Assert(false) ?
caml_fatal_error_arg ("Fatal error in fix_code: bad opcode (%lx)\n",
(char *)(long)instr);
*/
instr = STOP;
}

6
byterun/floats.c
View File

@ -99,7 +99,7 @@ CAMLprim value format_float(value fmt, value arg)
dest = stat_alloc(prec);
}
sprintf(dest, String_val(fmt), Double_val(arg));
res = copy_string(dest);
res = caml_copy_string(dest);
if (dest != format_buffer) {
stat_free(dest);
}
@ -191,7 +191,7 @@ CAMLprim value frexp_float(value f)
int exponent;
mantissa = copy_double(frexp (Double_val(f), &exponent));
res = alloc_tuple(2);
res = caml_alloc_tuple(2);
Field(res, 0) = mantissa;
Field(res, 1) = Val_int(exponent);
CAMLreturn (res);
@ -224,7 +224,7 @@ CAMLprim value modf_float(value f)
quo = copy_double(modf (Double_val(f), &frem));
rem = copy_double(frem);
res = alloc_tuple(2);
res = caml_alloc_tuple(2);
Field(res, 0) = quo;
Field(res, 1) = rem;
CAMLreturn (res);

44
byterun/gc_ctrl.c
View File

@ -85,7 +85,8 @@ static void check_block (char *hp)
switch (Tag_hp (hp)){
case Abstract_tag: break;
case String_tag:
/* not true when check_urgent_gc is called by alloc or alloc_string:
/* not true when check_urgent_gc is called by caml_alloc
or caml_alloc_string:
lastbyte = Bosize_val (v) - 1;
i = Byte (v, lastbyte);
Assert (i >= 0);
@ -133,7 +134,7 @@ static value heap_stats (int returnstats)
header_t cur_hd;
#ifdef DEBUG
gc_message (-1, "### O'Caml runtime: heap check ###\n", 0);
caml_gc_message (-1, "### O'Caml runtime: heap check ###\n", 0);
#endif
while (chunk != NULL){
@ -217,7 +218,7 @@ static value heap_stats (int returnstats)
long cpct = stat_compactions;
long top_heap_words = Wsize_bsize (stat_top_heap_size);
res = alloc_tuple (15);
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));
@ -263,7 +264,7 @@ CAMLprim value gc_counters(value v)
double prowords = stat_promoted_words;
double majwords = stat_major_words + (double) allocated_words;
res = alloc_tuple (3);
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));
@ -275,11 +276,11 @@ CAMLprim value gc_get(value v)
CAMLparam0 (); /* v is ignored */
CAMLlocal1 (res);
res = alloc_tuple (6);
res = caml_alloc_tuple (6);
Store_field (res, 0, Val_long (Wsize_bsize (minor_heap_size))); /* s */
Store_field (res, 1, Val_long (Wsize_bsize (major_heap_increment))); /* i */
Store_field (res, 2, Val_long (percent_free)); /* o */
Store_field (res, 3, Val_long (verb_gc)); /* v */
Store_field (res, 3, Val_long (caml_verb_gc)); /* v */
Store_field (res, 4, Val_long (percent_max)); /* O */
#ifndef NATIVE_CODE
Store_field (res, 5, Val_long (max_stack_size)); /* l */
@ -322,7 +323,7 @@ CAMLprim value gc_set(value v)
asize_t newheapincr;
asize_t newminsize;
verb_gc = Long_val (Field (v, 3));
caml_verb_gc = Long_val (Field (v, 3));
#ifndef NATIVE_CODE
change_max_stack_size (Long_val (Field (v, 5)));
@ -331,27 +332,28 @@ CAMLprim value gc_set(value v)
newpf = norm_pfree (Long_val (Field (v, 2)));
if (newpf != percent_free){
percent_free = newpf;
gc_message (0x20, "New space overhead: %d%%\n", percent_free);
caml_gc_message (0x20, "New space overhead: %d%%\n", percent_free);
}
newpm = norm_pmax (Long_val (Field (v, 4)));
if (newpm != percent_max){
percent_max = newpm;
gc_message (0x20, "New max overhead: %d%%\n", percent_max);
caml_gc_message (0x20, "New max overhead: %d%%\n", percent_max);
}
newheapincr = Bsize_wsize (norm_heapincr (Long_val (Field (v, 1))));
if (newheapincr != major_heap_increment){
major_heap_increment = newheapincr;
gc_message (0x20, "New heap increment size: %luk bytes\n",
major_heap_increment/1024);
caml_gc_message (0x20, "New heap increment size: %luk bytes\n",
major_heap_increment/1024);
}
/* Minor heap size comes last because it will trigger a minor collection
(thus invalidating [v]) and it can raise [Out_of_memory]. */
newminsize = norm_minsize (Bsize_wsize (Long_val (Field (v, 0))));
if (newminsize != minor_heap_size){
gc_message (0x20, "New minor heap size: %luk bytes\n", newminsize/1024);
caml_gc_message (0x20, "New minor heap size: %luk bytes\n",
newminsize/1024);
set_minor_heap_size (newminsize);
}
return Val_unit;
@ -405,7 +407,7 @@ void init_gc (unsigned long minor_size, unsigned long major_size,
unsigned long major_heap_size = Bsize_wsize (norm_heapincr (major_size));
#ifdef DEBUG
gc_message (-1, "### O'Caml runtime: debug mode "
caml_gc_message (-1, "### O'Caml runtime: debug mode "
#ifdef CPU_TYPE_STRING
"(" CPU_TYPE_STRING ") "
#endif
@ -417,12 +419,12 @@ void init_gc (unsigned long minor_size, unsigned long major_size,
percent_free = norm_pfree (percent_fr);
percent_max = norm_pmax (percent_m);
init_major_heap (major_heap_size);
gc_message (0x20, "Initial minor heap size: %luk bytes\n",
minor_heap_size / 1024);
gc_message (0x20, "Initial major heap size: %luk bytes\n",
major_heap_size / 1024);
gc_message (0x20, "Initial space overhead: %lu%%\n", percent_free);
gc_message (0x20, "Initial max overhead: %lu%%\n", percent_max);
gc_message (0x20, "Initial heap increment: %luk bytes\n",
major_heap_increment / 1024);
caml_gc_message (0x20, "Initial minor heap size: %luk bytes\n",
minor_heap_size / 1024);
caml_gc_message (0x20, "Initial major heap size: %luk bytes\n",
major_heap_size / 1024);
caml_gc_message (0x20, "Initial space overhead: %lu%%\n", percent_free);
caml_gc_message (0x20, "Initial max overhead: %lu%%\n", percent_max);
caml_gc_message (0x20, "Initial heap increment: %luk bytes\n",
major_heap_increment / 1024);
}

22
byterun/intern.c
View File

@ -344,11 +344,11 @@ static void intern_alloc(mlsize_t whsize, mlsize_t num_objects)
intern_color = allocation_color(intern_extra_block);
intern_dest = (header_t *) intern_extra_block;
} else {
/* this is a specialised version of alloc from alloc.c */
/* this is a specialised version of caml_alloc from alloc.c */
if (wosize == 0){
intern_block = Atom (String_tag);
}else if (wosize <= Max_young_wosize){
intern_block = alloc_small (wosize, String_tag);
intern_block = caml_alloc_small (wosize, String_tag);
}else{
intern_block = alloc_shr (wosize, String_tag);
/* do not do the urgent_gc check here because it might darken
@ -392,21 +392,21 @@ value input_val(struct channel *chan)
char * block;
value res;
if (! channel_binary_mode(chan))
if (! caml_channel_binary_mode(chan))
failwith("input_value: not a binary channel");
magic = getword(chan);
magic = caml_getword(chan);
if (magic != Intext_magic_number) failwith("input_value: bad object");
block_len = getword(chan);
num_objects = getword(chan);
size_32 = getword(chan);
size_64 = getword(chan);
block_len = caml_getword(chan);
num_objects = caml_getword(chan);
size_32 = caml_getword(chan);
size_64 = caml_getword(chan);
/* Read block from channel */
block = stat_alloc(block_len);
/* During really_getblock, concurrent input_val operations can take
/* During caml_really_getblock, concurrent input_val operations can take
place (via signal handlers or context switching in systhreads),
and intern_input may change. So, wait until really_getblock
and intern_input may change. So, wait until caml_really_getblock
is over before using intern_input and the other global vars. */
if (really_getblock(chan, block, block_len) == 0) {
if (caml_really_getblock(chan, block, block_len) == 0) {
stat_free(block);
failwith("input_value: truncated object");
}

4
byterun/interp.c
View File

@ -1044,8 +1044,8 @@ value interprete(code_t prog, asize_t prog_size)
#if _MSC_VER >= 1200
__assume(0);
#else
fatal_error_arg("Fatal error: bad opcode (%lx)\n",
(char *)(long)(*(pc-1)));
caml_fatal_error_arg("Fatal error: bad opcode (%lx)\n",
(char *)(long)(*(pc-1)));
#endif
}
}

2
byterun/intext.h
View File

@ -18,7 +18,9 @@
#ifndef CAML_INTEXT_H
#define CAML_INTEXT_H
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
#include "misc.h"
#include "mlvalues.h"

8
byterun/ints.c
View File

@ -183,7 +183,7 @@ CAMLprim value format_int(value fmt, value arg)
sprintf(buffer, format_string, Long_val(arg));
break;
}
res = copy_string(buffer);
res = caml_copy_string(buffer);
if (buffer != default_format_buffer) stat_free(buffer);
return res;
}
@ -313,7 +313,7 @@ CAMLprim value int32_format(value fmt, value arg)
buffer = parse_format(fmt, "", format_string, default_format_buffer, &conv);
sprintf(buffer, format_string, (long) Int32_val(arg));
res = copy_string(buffer);
res = caml_copy_string(buffer);
if (buffer != default_format_buffer) stat_free(buffer);
return res;
}
@ -508,7 +508,7 @@ CAMLprim value int64_format(value fmt, value arg)
buffer = parse_format(fmt, ARCH_INT64_PRINTF_FORMAT,
format_string, default_format_buffer, &conv);
I64_format(buffer, format_string, Int64_val(arg));
res = copy_string(buffer);
res = caml_copy_string(buffer);
if (buffer != default_format_buffer) stat_free(buffer);
return res;
}
@ -714,7 +714,7 @@ CAMLprim value nativeint_format(value fmt, value arg)
buffer = parse_format(fmt, "l", format_string, default_format_buffer, &conv);
sprintf(buffer, format_string, (long) Nativeint_val(arg));
res = copy_string(buffer);
res = caml_copy_string(buffer);
if (buffer != default_format_buffer) stat_free(buffer);
return res;
}

204
byterun/io.c
View File

@ -47,13 +47,13 @@
/* Hooks for locking channels */
CAMLexport void (*channel_mutex_free) (struct channel *) = NULL;
CAMLexport void (*channel_mutex_lock) (struct channel *) = NULL;
CAMLexport void (*channel_mutex_unlock) (struct channel *) = NULL;
CAMLexport void (*channel_mutex_unlock_exn) (void) = NULL;
CAMLexport void (*caml_channel_mutex_free) (struct channel *) = NULL;
CAMLexport void (*caml_channel_mutex_lock) (struct channel *) = NULL;
CAMLexport void (*caml_channel_mutex_unlock) (struct channel *) = NULL;
CAMLexport void (*caml_channel_mutex_unlock_exn) (void) = NULL;
/* List of opened channels */
CAMLexport struct channel * all_opened_channels = NULL;
CAMLexport struct channel * caml_all_opened_channels = NULL;
/* Basic functions over type struct channel *.
These functions can be called directly from C.
@ -61,7 +61,7 @@ CAMLexport struct channel * all_opened_channels = NULL;
/* Functions shared between input and output */
CAMLexport struct channel * open_descriptor_in(int fd)
CAMLexport struct channel * caml_open_descriptor_in(int fd)
{
struct channel * channel;
@ -74,23 +74,23 @@ CAMLexport struct channel * open_descriptor_in(int fd)
channel->revealed = 0;
channel->old_revealed = 0;
channel->refcount = 0;
channel->next = all_opened_channels;
all_opened_channels = channel;
channel->next = caml_all_opened_channels;
caml_all_opened_channels = channel;
return channel;
}
CAMLexport struct channel * open_descriptor_out(int fd)
CAMLexport struct channel * caml_open_descriptor_out(int fd)
{
struct channel * channel;
channel = open_descriptor_in(fd);
channel = caml_open_descriptor_in(fd);
channel->max = NULL;
return channel;
}
static void unlink_channel(struct channel *channel)
{
struct channel ** cp = &all_opened_channels;
struct channel ** cp = &caml_all_opened_channels;
while (*cp != channel && *cp != NULL)
cp = &(*cp)->next;
@ -98,16 +98,16 @@ static void unlink_channel(struct channel *channel)
*cp = (*cp)->next;
}
CAMLexport void close_channel(struct channel *channel)
CAMLexport void caml_close_channel(struct channel *channel)
{
close(channel->fd);
if (channel->refcount > 0) return;
if (channel_mutex_free != NULL) (*channel_mutex_free)(channel);
if (caml_channel_mutex_free != NULL) (*caml_channel_mutex_free)(channel);
unlink_channel(channel);
stat_free(channel);
}
CAMLexport file_offset channel_size(struct channel *channel)
CAMLexport file_offset caml_channel_size(struct channel *channel)
{
file_offset end;
@ -119,7 +119,7 @@ CAMLexport file_offset channel_size(struct channel *channel)
return end;
}
CAMLexport int channel_binary_mode(struct channel *channel)
CAMLexport int caml_channel_binary_mode(struct channel *channel)
{
#ifdef _WIN32
int oldmode = setmode(channel->fd, O_BINARY);
@ -175,7 +175,7 @@ again:
end of the flush, or false if some data remains in the buffer.
*/
CAMLexport int flush_partial(struct channel *channel)
CAMLexport int caml_flush_partial(struct channel *channel)
{
int towrite, written;
@ -192,16 +192,16 @@ CAMLexport int flush_partial(struct channel *channel)
/* Flush completely the buffer. */
CAMLexport void flush(struct channel *channel)
CAMLexport void caml_flush(struct channel *channel)
{
while (! flush_partial(channel)) /*nothing*/;
while (! caml_flush_partial(channel)) /*nothing*/;
}
/* Output data */
CAMLexport void putword(struct channel *channel, uint32 w)
CAMLexport void caml_putword(struct channel *channel, uint32 w)
{
if (! channel_binary_mode(channel))
if (! caml_channel_binary_mode(channel))
failwith("output_binary_int: not a binary channel");
putch(channel, w >> 24);
putch(channel, w >> 16);
@ -209,7 +209,7 @@ CAMLexport void putword(struct channel *channel, uint32 w)
putch(channel, w);
}
CAMLexport int putblock(struct channel *channel, char *p, long int len)
CAMLexport int caml_putblock(struct channel *channel, char *p, long int len)
{
int n, free, towrite, written;
@ -234,32 +234,32 @@ CAMLexport int putblock(struct channel *channel, char *p, long int len)
}
}
CAMLexport void really_putblock(struct channel *channel, char *p, long int len)
CAMLexport void caml_really_putblock(struct channel *channel, char *p, long len)
{
int written;
while (len > 0) {
written = putblock(channel, p, len);
written = caml_putblock(channel, p, len);
p += written;
len -= written;
}
}
CAMLexport void seek_out(struct channel *channel, file_offset dest)
CAMLexport void caml_seek_out(struct channel *channel, file_offset dest)
{
flush(channel);
caml_flush(channel);
if (lseek(channel->fd, dest, SEEK_SET) != dest) caml_sys_error(NO_ARG);
channel->offset = dest;
}
CAMLexport file_offset pos_out(struct channel *channel)
CAMLexport file_offset caml_pos_out(struct channel *channel)
{
return channel->offset + (file_offset)(channel->curr - channel->buff);
}
/* Input */
/* do_read is exported for Cash */
CAMLexport int do_read(int fd, char *p, unsigned int n)
/* caml_do_read is exported for Cash */
CAMLexport int caml_do_read(int fd, char *p, unsigned int n)
{
int retcode;
@ -279,11 +279,11 @@ CAMLexport int do_read(int fd, char *p, unsigned int n)
return retcode;
}
CAMLexport unsigned char refill(struct channel *channel)
CAMLexport unsigned char caml_refill(struct channel *channel)
{
int n;
n = do_read(channel->fd, channel->buff, channel->end - channel->buff);
n = caml_do_read(channel->fd, channel->buff, channel->end - channel->buff);
if (n == 0) raise_end_of_file();
channel->offset += n;
channel->max = channel->buff + n;
@ -291,12 +291,12 @@ CAMLexport unsigned char refill(struct channel *channel)
return (unsigned char)(channel->buff[0]);
}
CAMLexport uint32 getword(struct channel *channel)
CAMLexport uint32 caml_getword(struct channel *channel)
{
int i;
uint32 res;
if (! channel_binary_mode(channel))
if (! caml_channel_binary_mode(channel))
failwith("input_binary_int: not a binary channel");
res = 0;
for(i = 0; i < 4; i++) {
@ -305,7 +305,7 @@ CAMLexport uint32 getword(struct channel *channel)
return res;
}
CAMLexport int getblock(struct channel *channel, char *p, long int len)
CAMLexport int caml_getblock(struct channel *channel, char *p, long int len)
{
int n, avail, nread;
@ -320,7 +320,8 @@ CAMLexport int getblock(struct channel *channel, char *p, long int len)
channel->curr += avail;
return avail;
} else {
nread = do_read(channel->fd, channel->buff, channel->end - channel->buff);
nread = caml_do_read(channel->fd, channel->buff,
channel->end - channel->buff);
channel->offset += nread;
channel->max = channel->buff + nread;
if (n > nread) n = nread;
@ -330,11 +331,11 @@ CAMLexport int getblock(struct channel *channel, char *p, long int len)
}
}
CAMLexport int really_getblock(struct channel *chan, char *p, long int n)
CAMLexport int caml_really_getblock(struct channel *chan, char *p, long int n)
{
int r;
while (n > 0) {
r = getblock(chan, p, n);
r = caml_getblock(chan, p, n);
if (r == 0) break;
p += r;
n -= r;
@ -342,7 +343,7 @@ CAMLexport int really_getblock(struct channel *chan, char *p, long int n)
return (n == 0);
}
CAMLexport void seek_in(struct channel *channel, file_offset dest)
CAMLexport void caml_seek_in(struct channel *channel, file_offset dest)
{
if (dest >= channel->offset - (channel->max - channel->buff) &&
dest <= channel->offset) {
@ -354,12 +355,12 @@ CAMLexport void seek_in(struct channel *channel, file_offset dest)
}
}
CAMLexport file_offset pos_in(struct channel *channel)
CAMLexport file_offset caml_pos_in(struct channel *channel)
{
return channel->offset - (file_offset)(channel->max - channel->curr);
}
CAMLexport long input_scan_line(struct channel *channel)
CAMLexport long caml_input_scan_line(struct channel *channel)
{
char * p;
int n;
@ -384,7 +385,7 @@ CAMLexport long input_scan_line(struct channel *channel)
return -(channel->max - channel->curr);
}
/* Fill the buffer as much as possible */
n = do_read(channel->fd, channel->max, channel->end - channel->max);
n = caml_do_read(channel->fd, channel->max, channel->end - channel->max);
if (n == 0) {
/* End-of-file encountered. Return the number of characters in the
buffer, with negative sign since we haven't encountered
@ -402,12 +403,12 @@ CAMLexport long input_scan_line(struct channel *channel)
/* Caml entry points for the I/O functions. Wrap struct channel *
objects into a heap-allocated object. Perform locking
and unlocking around the I/O operations. */
CAMLexport void finalize_channel(value vchan)
/* FIXME CAMLexport, but not in io.h exported for Cash ? */
CAMLexport void caml_finalize_channel(value vchan)
{
struct channel * chan = Channel(vchan);
if (--chan->refcount > 0) return;
if (channel_mutex_free != NULL) (*channel_mutex_free)(chan);
if (caml_channel_mutex_free != NULL) (*caml_channel_mutex_free)(chan);
unlink_channel(chan);
stat_free(chan);
}
@ -421,14 +422,14 @@ static int compare_channel(value vchan1, value vchan2)
static struct custom_operations channel_operations = {
"_chan",
finalize_channel,
caml_finalize_channel,
compare_channel,
custom_hash_default,
custom_serialize_default,
custom_deserialize_default
};
CAMLexport value alloc_channel(struct channel *chan)
CAMLexport value caml_alloc_channel(struct channel *chan)
{
value res;
chan->refcount++; /* prevent finalization during next alloc */
@ -437,48 +438,48 @@ CAMLexport value alloc_channel(struct channel *chan)
return res;
}
CAMLprim value caml_open_descriptor_in(value fd)
CAMLprim value caml_ml_open_descriptor_in(value fd)
{
return alloc_channel(open_descriptor_in(Int_val(fd)));
return caml_alloc_channel(caml_open_descriptor_in(Int_val(fd)));
}
CAMLprim value caml_open_descriptor_out(value fd)
CAMLprim value caml_ml_open_descriptor_out(value fd)
{
return alloc_channel(open_descriptor_out(Int_val(fd)));
return caml_alloc_channel(caml_open_descriptor_out(Int_val(fd)));
}
#define Pair_tag 0
CAMLprim value caml_out_channels_list (value unit)
CAMLprim value caml_ml_out_channels_list (value unit)
{
CAMLparam0 ();
CAMLlocal3 (res, tail, chan);
struct channel * channel;
res = Val_emptylist;
for (channel = all_opened_channels;
for (channel = caml_all_opened_channels;
channel != NULL;
channel = channel->next)
/* Testing channel->fd >= 0 looks unnecessary, as
caml_close_channel changes max when setting fd to -1. */
caml_ml_close_channel changes max when setting fd to -1. */
if (channel->max == NULL) {
chan = alloc_channel (channel);
chan = caml_alloc_channel (channel);
tail = res;
res = alloc_small (2, Pair_tag);
res = caml_alloc_small (2, Pair_tag);
Field (res, 0) = chan;
Field (res, 1) = tail;
}
CAMLreturn (res);
}
CAMLprim value channel_descriptor(value vchannel)
CAMLprim value caml_channel_descriptor(value vchannel)
{
int fd = Channel(vchannel)->fd;
if (fd == -1) { errno = EBADF; caml_sys_error(NO_ARG); }
return Val_int(fd);
}
CAMLprim value caml_close_channel(value vchannel)
CAMLprim value caml_ml_close_channel(value vchannel)
{
int result;
@ -491,7 +492,7 @@ CAMLprim value caml_close_channel(value vchannel)
result = 0;
}
/* Ensure that every read or write on the channel will cause an
immediate flush_partial or refill, thus raising a Sys_error
immediate caml_flush_partial or caml_refill, thus raising a Sys_error
exception */
channel->curr = channel->max = channel->end;
if (result == -1) caml_sys_error (NO_ARG);
@ -507,19 +508,19 @@ CAMLprim value caml_close_channel(value vchannel)
#define EOVERFLOW ERANGE
#endif
CAMLprim value caml_channel_size(value vchannel)
CAMLprim value caml_ml_channel_size(value vchannel)
{
file_offset size = channel_size(Channel(vchannel));
file_offset size = caml_channel_size(Channel(vchannel));
if (size > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
return Val_long(size);
}
CAMLprim value caml_channel_size_64(value vchannel)
CAMLprim value caml_ml_channel_size_64(value vchannel)
{
return Val_file_offset(channel_size(Channel(vchannel)));
return Val_file_offset(caml_channel_size(Channel(vchannel)));
}
CAMLprim value caml_set_binary_mode(value vchannel, value mode)
CAMLprim value caml_ml_set_binary_mode(value vchannel, value mode)
{
#ifdef _WIN32
struct channel * channel = Channel(vchannel);
@ -536,30 +537,30 @@ CAMLprim value caml_set_binary_mode(value vchannel, value mode)
file descriptors that may be closed.
*/
CAMLprim value caml_flush_partial(value vchannel)
CAMLprim value caml_ml_flush_partial(value vchannel)
{
struct channel * channel = Channel(vchannel);
int res;
if (channel->fd == -1) return Val_true;
Lock(channel);
res = flush_partial(channel);
res = caml_flush_partial(channel);
Unlock(channel);
return Val_bool(res);
}
CAMLprim value caml_flush(value vchannel)
CAMLprim value caml_ml_flush(value vchannel)
{
struct channel * channel = Channel(vchannel);
if (channel->fd == -1) return Val_unit;
Lock(channel);
flush(channel);
caml_flush(channel);
Unlock(channel);
return Val_unit;
}
CAMLprim value caml_output_char(value vchannel, value ch)
CAMLprim value caml_ml_output_char(value vchannel, value ch)
{
struct channel * channel = Channel(vchannel);
Lock(channel);
@ -568,28 +569,30 @@ CAMLprim value caml_output_char(value vchannel, value ch)
return Val_unit;
}
CAMLprim value caml_output_int(value vchannel, value w)
CAMLprim value caml_ml_output_int(value vchannel, value w)
{
struct channel * channel = Channel(vchannel);
Lock(channel);
putword(channel, Long_val(w));
caml_putword(channel, Long_val(w));
Unlock(channel);
return Val_unit;
}
CAMLprim value caml_output_partial(value vchannel, value buff, value start, value length)
CAMLprim value caml_ml_output_partial(value vchannel, value buff, value start,
value length)
{
CAMLparam4 (vchannel, buff, start, length);
struct channel * channel = Channel(vchannel);
int res;
Lock(channel);
res = putblock(channel, &Byte(buff, Long_val(start)), Long_val(length));
res = caml_putblock(channel, &Byte(buff, Long_val(start)), Long_val(length));
Unlock(channel);
CAMLreturn (Val_int(res));
}
CAMLprim value caml_output(value vchannel, value buff, value start, value length)
CAMLprim value caml_ml_output(value vchannel, value buff, value start,
value length)
{
CAMLparam4 (vchannel, buff, start, length);
struct channel * channel = Channel(vchannel);
@ -598,7 +601,7 @@ CAMLprim value caml_output(value vchannel, value buff, value start, value length
Lock(channel);
while (len > 0) {
int written = putblock(channel, &Byte(buff, pos), len);
int written = caml_putblock(channel, &Byte(buff, pos), len);
pos += written;
len -= written;
}
@ -606,37 +609,37 @@ CAMLprim value caml_output(value vchannel, value buff, value start, value length
CAMLreturn (Val_unit);
}
CAMLprim value caml_seek_out(value vchannel, value pos)
CAMLprim value caml_ml_seek_out(value vchannel, value pos)
{
struct channel * channel = Channel(vchannel);
Lock(channel);
seek_out(channel, Long_val(pos));
caml_seek_out(channel, Long_val(pos));
Unlock(channel);
return Val_unit;
}
CAMLprim value caml_seek_out_64(value vchannel, value pos)
CAMLprim value caml_ml_seek_out_64(value vchannel, value pos)
{
struct channel * channel = Channel(vchannel);
Lock(channel);
seek_out(channel, File_offset_val(pos));
caml_seek_out(channel, File_offset_val(pos));
Unlock(channel);
return Val_unit;
}
CAMLprim value caml_pos_out(value vchannel)
CAMLprim value caml_ml_pos_out(value vchannel)
{
file_offset pos = pos_out(Channel(vchannel));
file_offset pos = caml_pos_out(Channel(vchannel));
if (pos > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
return Val_long(pos);
}
CAMLprim value caml_pos_out_64(value vchannel)
CAMLprim value caml_ml_pos_out_64(value vchannel)
{
return Val_file_offset(pos_out(Channel(vchannel)));
return Val_file_offset(caml_pos_out(Channel(vchannel)));
}
CAMLprim value caml_input_char(value vchannel)
CAMLprim value caml_ml_input_char(value vchannel)
{
struct channel * channel = Channel(vchannel);
unsigned char c;
@ -647,13 +650,13 @@ CAMLprim value caml_input_char(value vchannel)
return Val_long(c);
}
CAMLprim value caml_input_int(value vchannel)
CAMLprim value caml_ml_input_int(value vchannel)
{
struct channel * channel = Channel(vchannel);
long i;
Lock(channel);
i = getword(channel);
i = caml_getword(channel);
Unlock(channel);
#ifdef ARCH_SIXTYFOUR
i = (i << 32) >> 32; /* Force sign extension */
@ -661,7 +664,8 @@ CAMLprim value caml_input_int(value vchannel)
return Val_long(i);
}
CAMLprim value caml_input(value vchannel,value buff,value vstart,value vlength)
CAMLprim value caml_ml_input(value vchannel, value buff, value vstart,
value vlength)
{
CAMLparam4 (vchannel, buff, vstart, vlength);
struct channel * channel = Channel(vchannel);
@ -669,7 +673,8 @@ CAMLprim value caml_input(value vchannel,value buff,value vstart,value vlength)
int n, avail, nread;
Lock(channel);
/* We cannot call getblock here because buff may move during do_read */
/* We cannot call caml_getblock here because buff may move during
caml_do_read */
start = Long_val(vstart);
len = Long_val(vlength);
n = len >= INT_MAX ? INT_MAX : (int) len;
@ -682,7 +687,8 @@ CAMLprim value caml_input(value vchannel,value buff,value vstart,value vlength)
channel->curr += avail;
n = avail;
} else {
nread = do_read(channel->fd, channel->buff, channel->end - channel->buff);
nread = caml_do_read(channel->fd, channel->buff,
channel->end - channel->buff);
channel->offset += nread;
channel->max = channel->buff + nread;
if (n > nread) n = nread;
@ -693,43 +699,43 @@ CAMLprim value caml_input(value vchannel,value buff,value vstart,value vlength)
CAMLreturn (Val_long(n));
}
CAMLprim value caml_seek_in(value vchannel, value pos)
CAMLprim value caml_ml_seek_in(value vchannel, value pos)
{
struct channel * channel = Channel(vchannel);
Lock(channel);
seek_in(channel, Long_val(pos));
caml_seek_in(channel, Long_val(pos));
Unlock(channel);
return Val_unit;
}
CAMLprim value caml_seek_in_64(value vchannel, value pos)
CAMLprim value caml_ml_seek_in_64(value vchannel, value pos)
{
struct channel * channel = Channel(vchannel);
Lock(channel);
seek_in(channel, File_offset_val(pos));
caml_seek_in(channel, File_offset_val(pos));
Unlock(channel);
return Val_unit;
}
CAMLprim value caml_pos_in(value vchannel)
CAMLprim value caml_ml_pos_in(value vchannel)
{
file_offset pos = pos_in(Channel(vchannel));
file_offset pos = caml_pos_in(Channel(vchannel));
if (pos > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
return Val_long(pos);
}
CAMLprim value caml_pos_in_64(value vchannel)
CAMLprim value caml_ml_pos_in_64(value vchannel)
{
return Val_file_offset(pos_in(Channel(vchannel)));
return Val_file_offset(caml_pos_in(Channel(vchannel)));
}
CAMLprim value caml_input_scan_line(value vchannel)
CAMLprim value caml_ml_input_scan_line(value vchannel)
{
struct channel * channel = Channel(vchannel);
long res;
Lock(channel);
res = input_scan_line(channel);
res = caml_input_scan_line(channel);
Unlock(channel);
return Val_long(res);
}
@ -737,7 +743,7 @@ CAMLprim value caml_input_scan_line(value vchannel)
/* Conversion between file_offset and int64 */
#ifndef ARCH_INT64_TYPE
CAMLexport value Val_file_offset(file_offset fofs)
CAMLexport value caml_Val_file_offset(file_offset fofs)
{
int64 ofs;
ofs.l = fofs;
@ -745,7 +751,7 @@ CAMLexport value Val_file_offset(file_offset fofs)
return copy_int64(ofs);
}
CAMLexport file_offset File_offset_val(value v)
CAMLexport file_offset caml_File_offset_val(value v)
{
int64 ofs = Int64_val(v);
return (file_offset) ofs.l;

50
byterun/io.h
View File

@ -56,30 +56,30 @@ struct channel {
type struct channel *. No locking is performed. */
#define putch(channel, ch) do{ \
if ((channel)->curr >= (channel)->end) flush_partial(channel); \
if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \
*((channel)->curr)++ = (ch); \
}while(0)
#define getch(channel) \
((channel)->curr >= (channel)->max \
? refill(channel) \
? caml_refill(channel) \
: (unsigned char) *((channel)->curr)++)
CAMLextern struct channel * open_descriptor_in (int);
CAMLextern struct channel * open_descriptor_out (int);
CAMLextern void close_channel (struct channel *);
CAMLextern int channel_binary_mode (struct channel *);
CAMLextern struct channel * caml_open_descriptor_in (int);
CAMLextern struct channel * caml_open_descriptor_out (int);
CAMLextern void caml_close_channel (struct channel *);
CAMLextern int caml_channel_binary_mode (struct channel *);
CAMLextern int flush_partial (struct channel *);
CAMLextern void flush (struct channel *);
CAMLextern void putword (struct channel *, uint32);
CAMLextern int putblock (struct channel *, char *, long);
CAMLextern void really_putblock (struct channel *, char *, long);
CAMLextern int caml_flush_partial (struct channel *);
CAMLextern void caml_flush (struct channel *);
CAMLextern void caml_putword (struct channel *, uint32);
CAMLextern int caml_putblock (struct channel *, char *, long);
CAMLextern void caml_really_putblock (struct channel *, char *, long);
CAMLextern unsigned char refill (struct channel *);
CAMLextern uint32 getword (struct channel *);
CAMLextern int getblock (struct channel *, char *, long);
CAMLextern int really_getblock (struct channel *, char *, long);
CAMLextern unsigned char caml_refill (struct channel *);
CAMLextern uint32 caml_getword (struct channel *);
CAMLextern int caml_getblock (struct channel *, char *, long);
CAMLextern int caml_really_getblock (struct channel *, char *, long);
/* Extract a struct channel * from the heap object representing it */
@ -87,17 +87,17 @@ CAMLextern int really_getblock (struct channel *, char *, long);
/* The locking machinery */
CAMLextern void (*channel_mutex_free) (struct channel *);
CAMLextern void (*channel_mutex_lock) (struct channel *);
CAMLextern void (*channel_mutex_unlock) (struct channel *);
CAMLextern void (*channel_mutex_unlock_exn) (void);
CAMLextern void (*caml_channel_mutex_free) (struct channel *);
CAMLextern void (*caml_channel_mutex_lock) (struct channel *);
CAMLextern void (*caml_channel_mutex_unlock) (struct channel *);
CAMLextern void (*caml_channel_mutex_unlock_exn) (void);
#define Lock(channel) \
if (channel_mutex_lock != NULL) (*channel_mutex_lock)(channel)
if (caml_channel_mutex_lock != NULL) (*caml_channel_mutex_lock)(channel)
#define Unlock(channel) \
if (channel_mutex_unlock != NULL) (*channel_mutex_unlock)(channel)
if (caml_channel_mutex_unlock != NULL) (*caml_channel_mutex_unlock)(channel)
#define Unlock_exn() \
if (channel_mutex_unlock_exn != NULL) (*channel_mutex_unlock_exn)()
if (caml_channel_mutex_unlock_exn != NULL) (*caml_channel_mutex_unlock_exn)()
/* Conversion between file_offset and int64 */
@ -105,8 +105,10 @@ CAMLextern void (*channel_mutex_unlock_exn) (void);
#define Val_file_offset(fofs) copy_int64(fofs)
#define File_offset_val(v) ((file_offset) Int64_val(v))
#else
CAMLextern value Val_file_offset(file_offset fofs);
CAMLextern file_offset File_offset_val(value v);
CAMLextern value caml_Val_file_offset(file_offset fofs);
CAMLextern file_offset caml_File_offset_val(value v);
#define Val_file_offset caml_Val_file_offset
#define File_offset_val caml_File_offset_val
#endif
#endif /* CAML_IO_H */

6
byterun/macintosh.c
View File

@ -283,12 +283,12 @@ void build_primitive_table(char * lib_path,
{
char * p;
ext_table_init(&prim_table, 0x180);
caml_ext_table_init(&prim_table, 0x180);
for (p = req_prims; *p != 0; p += strlen(p) + 1) {
c_primitive prim = lookup_primitive(p);
if (prim == NULL)
fatal_error_arg("Fatal error: unknown C primitive `%s'\n", p);
ext_table_add(&prim_table, (void *) prim);
caml_fatal_error_arg("Fatal error: unknown C primitive `%s'\n", p);
caml_ext_table_add(&prim_table, (void *) prim);
}
}

36
byterun/major_gc.c
View File

@ -61,12 +61,12 @@ static void realloc_gray_vals (void)
Assert (gray_vals_cur == gray_vals_end);
if (gray_vals_size < stat_heap_size / 128){
gc_message (0x08, "Growing gray_vals to %luk bytes\n",
(long) gray_vals_size * sizeof (value) / 512);
caml_gc_message (0x08, "Growing gray_vals to %luk bytes\n",
(long) gray_vals_size * sizeof (value) / 512);
new = (value *) realloc ((char *) gray_vals,
2 * gray_vals_size * sizeof (value));
if (new == NULL){
gc_message (0x08, "No room for growing gray_vals\n", 0);
caml_gc_message (0x08, "No room for growing gray_vals\n", 0);
gray_vals_cur = gray_vals;
heap_is_pure = 0;
}else{
@ -97,7 +97,7 @@ static void start_cycle (void)
{
Assert (gc_phase == Phase_idle);
Assert (gray_vals_cur == gray_vals);
gc_message (0x01, "Starting new major GC cycle\n", 0);
caml_gc_message (0x01, "Starting new major GC cycle\n", 0);
darken_all_roots();
gc_phase = Phase_mark;
gc_subphase = Subphase_main;
@ -114,7 +114,7 @@ static void mark_slice (long work)
header_t hd;
mlsize_t size, i;
gc_message (0x40, "Marking %ld words\n", work);
caml_gc_message (0x40, "Marking %ld words\n", work);
gray_vals_ptr = gray_vals_cur;
while (work > 0){
if (gray_vals_ptr > gray_vals){
@ -248,7 +248,7 @@ static void sweep_slice (long work)
char *hp;
header_t hd;
gc_message (0x40, "Sweeping %ld words\n", work);
caml_gc_message (0x40, "Sweeping %ld words\n", work);
while (work > 0){
if (gc_sweep_hp < limit){
hp = gc_sweep_hp;
@ -333,11 +333,11 @@ long major_collection_slice (long howmuch)
/ Wsize_bsize (stat_heap_size) / percent_free / 2.0;
if (p < extra_heap_memory) p = extra_heap_memory;
gc_message (0x40, "allocated_words = %lu\n", allocated_words);
gc_message (0x40, "extra_heap_memory = %luu\n",
(unsigned long) (extra_heap_memory * 1000000));
gc_message (0x40, "amount of work to do = %luu\n",
(unsigned long) (p * 1000000));
caml_gc_message (0x40, "allocated_words = %lu\n", allocated_words);
caml_gc_message (0x40, "extra_heap_memory = %luu\n",
(unsigned long) (extra_heap_memory * 1000000));
caml_gc_message (0x40, "amount of work to do = %luu\n",
(unsigned long) (p * 1000000));
if (gc_phase == Phase_mark){
computed_work = 2 * (long) (p * Wsize_bsize (stat_heap_size) * 100
@ -345,16 +345,16 @@ long major_collection_slice (long howmuch)
}else{
computed_work = 2 * (long) (p * Wsize_bsize (stat_heap_size));
}
gc_message (0x40, "ordered work = %ld words\n", howmuch);
gc_message (0x40, "computed work = %ld words\n", computed_work);
caml_gc_message (0x40, "ordered work = %ld words\n", howmuch);
caml_gc_message (0x40, "computed work = %ld words\n", computed_work);
if (howmuch == 0) howmuch = computed_work;
if (gc_phase == Phase_mark){
mark_slice (howmuch);
gc_message (0x02, "!", 0);
caml_gc_message (0x02, "!", 0);
}else{
Assert (gc_phase == Phase_sweep);
sweep_slice (howmuch);
gc_message (0x02, "$", 0);
caml_gc_message (0x02, "$", 0);
}
if (gc_phase == Phase_idle) compact_heap_maybe ();
@ -425,7 +425,7 @@ void init_major_heap (asize_t heap_size)
Assert (stat_heap_size % Page_size == 0);
heap_start = (char *) alloc_for_heap (stat_heap_size);
if (heap_start == NULL)
fatal_error ("Fatal error: not enough memory for the initial heap.\n");
caml_fatal_error ("Fatal error: not enough memory for the initial heap.\n");
Chunk_next (heap_start) = NULL;
heap_end = heap_start + stat_heap_size;
Assert ((unsigned long) heap_end % Page_size == 0);
@ -439,7 +439,7 @@ void init_major_heap (asize_t heap_size)
page_table_block =
(page_table_entry *) malloc (page_table_size * sizeof (page_table_entry));
if (page_table_block == NULL){
fatal_error ("Fatal error: not enough memory for the initial heap.\n");
caml_fatal_error ("Fatal error: not enough memory for the initial heap.\n");
}
page_table = page_table_block - page_low;
for (i = Page (heap_start); i < Page (heap_end); i++){
@ -452,7 +452,7 @@ void init_major_heap (asize_t heap_size)
gray_vals_size = 2048;
gray_vals = (value *) malloc (gray_vals_size * sizeof (value));
if (gray_vals == NULL)
fatal_error ("Fatal error: not enough memory for the initial heap.\n");
caml_fatal_error ("Fatal error: not enough memory for the initial heap.\n");
gray_vals_cur = gray_vals;
gray_vals_end = gray_vals + gray_vals_size;
heap_is_pure = 1;

10
byterun/md5.c
View File

@ -29,7 +29,7 @@ CAMLprim value md5_string(value str, value ofs, value len)
value res;
MD5Init(&ctx);
MD5Update(&ctx, &Byte_u(str, Long_val(ofs)), Long_val(len));
res = alloc_string(16);
res = caml_alloc_string(16);
MD5Final(&Byte_u(res, 0), &ctx);
return res;
}
@ -47,20 +47,20 @@ CAMLprim value md5_chan(value vchan, value len)
toread = Long_val(len);
if (toread < 0){
while (1){
read = getblock (chan, buffer, sizeof(buffer));
read = caml_getblock (chan, buffer, sizeof(buffer));
if (read == 0) break;
MD5Update (&ctx, (unsigned char *) buffer, read);
}
}else{
while (toread > 0) {
read = getblock(chan, buffer,
toread > sizeof(buffer) ? sizeof(buffer) : toread);
read = caml_getblock(chan, buffer,
toread > sizeof(buffer) ? sizeof(buffer) : toread);
if (read == 0) raise_end_of_file();
MD5Update(&ctx, (unsigned char *) buffer, read);
toread -= read;
}
}
res = alloc_string(16);
res = caml_alloc_string(16);
MD5Final(&Byte_u(res, 0), &ctx);
Unlock(chan);
return res;

22
byterun/memory.c
View File

@ -47,8 +47,8 @@ char *alloc_for_heap (asize_t request)
mem = aligned_mmap (request + sizeof (heap_chunk_head),
sizeof (heap_chunk_head), &block);
#else
mem = aligned_malloc (request + sizeof (heap_chunk_head),
sizeof (heap_chunk_head), &block);
mem = caml_aligned_malloc (request + sizeof (heap_chunk_head),
sizeof (heap_chunk_head), &block);
#endif
if (mem == NULL) return NULL;
mem += sizeof (heap_chunk_head);
@ -93,10 +93,10 @@ int add_to_heap (char *m)
asize_t new_page_low = Page (m);
asize_t new_size = page_high - new_page_low;
gc_message (0x08, "Growing page table to %lu entries\n", new_size);
caml_gc_message (0x08, "Growing page table to %lu entries\n", new_size);
block = malloc (new_size * sizeof (page_table_entry));
if (block == NULL){
gc_message (0x08, "No room for growing page table\n", 0);
caml_gc_message (0x08, "No room for growing page table\n", 0);
return -1;
}
new_page_table = block - new_page_low;
@ -111,10 +111,10 @@ int add_to_heap (char *m)
asize_t new_page_high = Page (m + Chunk_size (m));
asize_t new_size = new_page_high - page_low;
gc_message (0x08, "Growing page table to %lu entries\n", new_size);
caml_gc_message (0x08, "Growing page table to %lu entries\n", new_size);
block = malloc (new_size * sizeof (page_table_entry));
if (block == NULL){
gc_message (0x08, "No room for growing page table\n", 0);
caml_gc_message (0x08, "No room for growing page table\n", 0);
return -1;
}
new_page_table = block - page_low;
@ -168,11 +168,11 @@ static char *expand_heap (mlsize_t request)
asize_t malloc_request;
malloc_request = round_heap_chunk_size (Bhsize_wosize (request));
gc_message (0x04, "Growing heap to %luk bytes\n",
(stat_heap_size + malloc_request) / 1024);
caml_gc_message (0x04, "Growing heap to %luk bytes\n",
(stat_heap_size + malloc_request) / 1024);
mem = alloc_for_heap (malloc_request);
if (mem == NULL){
gc_message (0x04, "No room for growing heap\n", 0);
caml_gc_message (0x04, "No room for growing heap\n", 0);
return NULL;
}
Assert (Wosize_bhsize (malloc_request) >= request);
@ -202,7 +202,7 @@ void shrink_heap (char *chunk)
if (chunk == heap_start) return;
stat_heap_size -= Chunk_size (chunk);
gc_message (0x04, "Shrinking heap to %luk bytes\n", stat_heap_size / 1024);
caml_gc_message (0x04, "Shrinking heap to %luk bytes\n", stat_heap_size/1024);
#ifdef DEBUG
{
@ -251,7 +251,7 @@ value alloc_shr (mlsize_t wosize, tag_t tag)
new_block = expand_heap (wosize);
if (new_block == NULL) {
if (in_minor_collection)
fatal_error ("Fatal error: out of memory.\n");
caml_fatal_error ("Fatal error: out of memory.\n");
else
raise_out_of_memory ();
}

3
byterun/memory.h
View File

@ -18,8 +18,9 @@
#ifndef CAML_MEMORY_H
#define CAML_MEMORY_H
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
#include "config.h"
/* <private> */
#include "gc.h"

5
byterun/meta.c
View File

@ -44,7 +44,7 @@ CAMLprim value reify_bytecode(value prog, value len)
#ifdef THREADED_CODE
thread_code((code_t) prog, (asize_t) Long_val(len));
#endif
clos = alloc_small (1, Closure_tag);
clos = caml_alloc_small (1, Closure_tag);
Code_val(clos) = (code_t) prog;
return clos;
}
@ -58,7 +58,8 @@ CAMLprim value realloc_global(value size)
actual_size = Wosize_val(global_data);
if (requested_size >= actual_size) {
requested_size = (requested_size + 0x100) & 0xFFFFFF00;
gc_message (0x08, "Growing global data to %lu entries\n", requested_size);
caml_gc_message (0x08, "Growing global data to %lu entries\n",
requested_size);
new_global_data = alloc_shr(requested_size, 0);
for (i = 0; i < actual_size; i++)
initialize(&Field(new_global_data, i), Field(global_data, i));

12
byterun/minor_gc.c
View File

@ -185,7 +185,7 @@ void empty_minor_heap (void)
if (young_ptr != young_end){
in_minor_collection = 1;
gc_message (0x02, "<", 0);
caml_gc_message (0x02, "<", 0);
oldify_local_roots();
for (r = ref_table; r < ref_table_ptr; r++){
oldify_one (**r, *r);
@ -197,7 +197,7 @@ void empty_minor_heap (void)
young_limit = young_start;
ref_table_ptr = ref_table;
ref_table_limit = ref_table_threshold;
gc_message (0x02, ">", 0);
caml_gc_message (0x02, ">", 0);
in_minor_collection = 0;
}
final_empty_young ();
@ -244,7 +244,7 @@ void realloc_ref_table (void)
Assert (ref_table_limit >= ref_table_threshold);
if (ref_table_limit == ref_table_threshold){
gc_message (0x08, "ref_table threshold crossed\n", 0);
caml_gc_message (0x08, "ref_table threshold crossed\n", 0);
ref_table_limit = ref_table_end;
urge_major_slice ();
}else{ /* This will almost never happen with the bytecode interpreter. */
@ -254,9 +254,11 @@ void realloc_ref_table (void)
ref_table_size *= 2;
sz = (ref_table_size + ref_table_reserve) * sizeof (value *);
gc_message (0x08, "Growing ref_table to %ldk bytes\n", (long) sz / 1024);
caml_gc_message (0x08, "Growing ref_table to %ldk bytes\n", (long) sz/1024);
ref_table = (value **) realloc ((char *) ref_table, sz);
if (ref_table == NULL) fatal_error ("Fatal error: ref_table overflow\n");
if (ref_table == NULL){
caml_fatal_error ("Fatal error: ref_table overflow\n");
}
ref_table_end = ref_table + ref_table_size + ref_table_reserve;
ref_table_threshold = ref_table + ref_table_size;
ref_table_ptr = ref_table + cur_ptr;

20
byterun/misc.c
View File

@ -34,11 +34,11 @@ int caml_failed_assert (char * expr, char * file, int line)
#endif
unsigned long verb_gc = 0;
unsigned long caml_verb_gc = 0;
void gc_message (int level, char *msg, unsigned long arg)
void caml_gc_message (int level, char *msg, unsigned long arg)
{
if (level < 0 || (verb_gc & level) != 0){
if (level < 0 || (caml_verb_gc & level) != 0){
#ifdef HAS_UI
ui_print_stderr(msg, (void *) arg);
#else
@ -48,7 +48,7 @@ void gc_message (int level, char *msg, unsigned long arg)
}
}
void fatal_error (char *msg)
void caml_fatal_error (char *msg)
{
#ifdef HAS_UI
ui_print_stderr("%s", msg);
@ -59,7 +59,7 @@ void fatal_error (char *msg)
#endif
}
void fatal_error_arg (char *fmt, char *arg)
void caml_fatal_error_arg (char *fmt, char *arg)
{
#ifdef HAS_UI
ui_print_stderr(fmt, arg);
@ -70,7 +70,7 @@ void fatal_error_arg (char *fmt, char *arg)
#endif
}
void fatal_error_arg2 (char *fmt1, char *arg1, char *fmt2, char *arg2)
void caml_fatal_error_arg2 (char *fmt1, char *arg1, char *fmt2, char *arg2)
{
#ifdef HAS_UI
ui_print_stderr(fmt1, arg1);
@ -83,7 +83,7 @@ void fatal_error_arg2 (char *fmt1, char *arg1, char *fmt2, char *arg2)
#endif
}
char *aligned_malloc (asize_t size, int modulo, void **block)
char *caml_aligned_malloc (asize_t size, int modulo, void **block)
{
char *raw_mem;
unsigned long aligned_mem;
@ -109,14 +109,14 @@ char *aligned_malloc (asize_t size, int modulo, void **block)
return (char *) (aligned_mem - modulo);
}
void ext_table_init(struct ext_table * tbl, int init_capa)
void caml_ext_table_init(struct ext_table * tbl, int init_capa)
{
tbl->size = 0;
tbl->capacity = init_capa;
tbl->contents = stat_alloc(sizeof(void *) * init_capa);
}
int ext_table_add(struct ext_table * tbl, void * data)
int caml_ext_table_add(struct ext_table * tbl, void * data)
{
int res;
if (tbl->size >= tbl->capacity) {
@ -130,7 +130,7 @@ int ext_table_add(struct ext_table * tbl, void * data)
return res;
}
void ext_table_free(struct ext_table * tbl, int free_entries)
void caml_ext_table_free(struct ext_table * tbl, int free_entries)
{
int i;
if (free_entries)

27
byterun/misc.h
View File

@ -18,8 +18,9 @@
#ifndef CAML_MISC_H
#define CAML_MISC_H
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
#include "config.h"
/* Standard definitions */
@ -73,10 +74,10 @@ int caml_failed_assert (char *, char *, int);
#define CAMLassert(x) 0
#endif
void fatal_error (char *msg) Noreturn;
void fatal_error_arg (char *fmt, char *arg) Noreturn;
void fatal_error_arg2 (char *fmt1, char *arg1,
char *fmt2, char *arg2) Noreturn;
void caml_fatal_error (char *msg) Noreturn;
void caml_fatal_error_arg (char *fmt, char *arg) Noreturn;
void caml_fatal_error_arg2 (char *fmt1, char *arg1,
char *fmt2, char *arg2) Noreturn;
/* Data structures */
@ -86,18 +87,18 @@ struct ext_table {
void ** contents;
};
extern void ext_table_init(struct ext_table * tbl, int init_capa);
extern int ext_table_add(struct ext_table * tbl, void * data);
extern void ext_table_free(struct ext_table * tbl, int free_entries);
extern void caml_ext_table_init(struct ext_table * tbl, int init_capa);
extern int caml_ext_table_add(struct ext_table * tbl, void * data);
extern void caml_ext_table_free(struct ext_table * tbl, int free_entries);
/* GC flags and messages */
extern unsigned long verb_gc;
void gc_message (int, char *, unsigned long);
extern unsigned long caml_verb_gc;
void caml_gc_message (int, char *, unsigned long);
/* Memory routines */
char *aligned_malloc (asize_t, int, void **);
char *caml_aligned_malloc (asize_t, int, void **);
#ifdef DEBUG
#ifdef ARCH_SIXTYFOUR
@ -115,8 +116,8 @@ char *aligned_malloc (asize_t, int, void **);
04 -> fields deallocated by obj_truncate
10 -> uninitialised fields of minor objects
11 -> uninitialised fields of major objects
15 -> uninitialised words of aligned_malloc blocks
85 -> filler bytes of aligned_malloc
15 -> uninitialised words of caml_aligned_malloc blocks
85 -> filler bytes of caml_aligned_malloc
special case (byte by byte):
D7 -> uninitialised words of stat_alloc blocks

3
byterun/mlvalues.h
View File

@ -16,8 +16,9 @@
#ifndef CAML_MLVALUES_H
#define CAML_MLVALUES_H
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
#include "config.h"
#include "misc.h"

8
byterun/obj.c
View File

@ -73,7 +73,7 @@ CAMLprim value obj_block(value tag, value size)
sz = Long_val(size);
tg = Long_val(tag);
if (sz == 0) return Atom(tg);
res = alloc(sz, tg);
res = caml_alloc(sz, tg);
for (i = 0; i < sz; i++)
Field(res, i) = Val_long(0);
@ -91,10 +91,10 @@ CAMLprim value obj_dup(value arg)
if (sz == 0) return arg;
tg = Tag_val(arg);
if (tg >= No_scan_tag) {
res = alloc(sz, tg);
res = caml_alloc(sz, tg);
memcpy(Bp_val(res), Bp_val(arg), sz * sizeof(value));
} else if (sz <= Max_young_wosize) {
res = alloc_small(sz, tg);
res = caml_alloc_small(sz, tg);
for (i = 0; i < sz; i++) Field(res, i) = Field(arg, i);
} else {
res = alloc_shr(sz, tg);
@ -173,7 +173,7 @@ CAMLprim value lazy_make_forward (value v)
CAMLparam1 (v);
CAMLlocal1 (res);
res = alloc_small (1, Forward_tag);
res = caml_alloc_small (1, Forward_tag);
Modify (&Field (res, 0), v);
CAMLreturn (res);
}

4
byterun/signals.c
View File

@ -277,7 +277,7 @@ CAMLprim value install_signal_handler(value signal_number, value action)
if (oldact == SIG_ERR) caml_sys_error(NO_ARG);
#endif
if (oldact == handle_signal) {
res = alloc_small (1, 0); /* Signal_handle */
res = caml_alloc_small (1, 0); /* Signal_handle */
Field(res, 0) = Field(signal_handlers, sig);
}
else if (oldact == SIG_IGN)
@ -286,7 +286,7 @@ CAMLprim value install_signal_handler(value signal_number, value action)
res = Val_int(0); /* Signal_default */
if (Is_block(action)) {
if (signal_handlers == 0) {
signal_handlers = alloc(NSIG, 0);
signal_handlers = caml_alloc(NSIG, 0);
register_global_root(&signal_handlers);
}
modify(&Field(signal_handlers, sig), Field(action, 0));

2
byterun/signals.h
View File

@ -16,7 +16,9 @@
#ifndef CAML_SIGNALS_H
#define CAML_SIGNALS_H
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
#include "misc.h"
#include "mlvalues.h"

12
byterun/stacks.c
View File

@ -41,8 +41,8 @@ void init_stack (long unsigned int initial_max_size)
trapsp = stack_high;
trap_barrier = stack_high + 1;
max_stack_size = initial_max_size;
gc_message (0x08, "Initial stack limit: %luk bytes\n",
max_stack_size / 1024 * sizeof (value));
caml_gc_message (0x08, "Initial stack limit: %luk bytes\n",
max_stack_size / 1024 * sizeof (value));
}
void realloc_stack(asize_t required_space)
@ -57,8 +57,8 @@ void realloc_stack(asize_t required_space)
if (size >= max_stack_size) raise_stack_overflow();
size *= 2;
} while (size < stack_high - extern_sp + required_space);
gc_message (0x08, "Growing stack to %luk bytes\n",
(unsigned long) size * sizeof(value) / 1024);
caml_gc_message (0x08, "Growing stack to %luk bytes\n",
(unsigned long) size * sizeof(value) / 1024);
new_low = (value *) stat_alloc(size * sizeof(value));
new_high = new_low + size;
@ -95,8 +95,8 @@ void change_max_stack_size (long unsigned int new_max_size)
if (new_max_size < size) new_max_size = size;
if (new_max_size != max_stack_size){
gc_message (0x08, "Changing stack limit to %luk bytes\n",
new_max_size * sizeof (value) / 1024);
caml_gc_message (0x08, "Changing stack limit to %luk bytes\n",
new_max_size * sizeof (value) / 1024);
}
max_stack_size = new_max_size;
}

42
byterun/startup.c
View File

@ -104,25 +104,25 @@ int attempt_open(char **name, struct exec_trailer *trail,
truename = search_exe_in_path(*name);
*name = truename;
gc_message(0x100, "Opening bytecode executable %s\n",
(unsigned long) truename);
caml_gc_message(0x100, "Opening bytecode executable %s\n",
(unsigned long) truename);
fd = open(truename, O_RDONLY | O_BINARY);
if (fd == -1) {
gc_message(0x100, "Cannot open file\n", 0);
caml_gc_message(0x100, "Cannot open file\n", 0);
return FILE_NOT_FOUND;
}
if (!do_open_script) {
err = read (fd, buf, 2);
if (err < 2 || (buf [0] == '#' && buf [1] == '!')) {
close(fd);
gc_message(0x100, "Rejected #! script\n", 0);
caml_gc_message(0x100, "Rejected #! script\n", 0);
return BAD_BYTECODE;
}
}
err = read_trailer(fd, trail);
if (err != 0) {
close(fd);
gc_message(0x100, "Not a bytecode executable\n", 0);
caml_gc_message(0x100, "Not a bytecode executable\n", 0);
return err;
}
return fd;
@ -138,7 +138,7 @@ void read_section_descriptors(int fd, struct exec_trailer *trail)
trail->section = stat_alloc(toc_size);
lseek(fd, - (long) (TRAILER_SIZE + toc_size), SEEK_END);
if (read(fd, (char *) trail->section, toc_size) != toc_size)
fatal_error("Fatal error: cannot read section table\n");
caml_fatal_error("Fatal error: cannot read section table\n");
/* Fixup endianness of lengths */
for (i = 0; i < trail->num_sections; i++)
fixup_endianness_trailer(&(trail->section[i].len));
@ -171,7 +171,7 @@ int32 seek_section(int fd, struct exec_trailer *trail, char *name)
{
int32 len = seek_optional_section(fd, trail, name);
if (len == -1)
fatal_error_arg("Fatal_error: section `%s' is missing\n", name);
caml_fatal_error_arg("Fatal_error: section `%s' is missing\n", name);
return len;
}
@ -187,7 +187,7 @@ static char * read_section(int fd, struct exec_trailer *trail, char *name)
if (len == -1) return NULL;
data = stat_alloc(len + 1);
if (read(fd, data, len) != len)
fatal_error_arg("Fatal error: error reading section %s\n", name);
caml_fatal_error_arg("Fatal error: error reading section %s\n", name);
data[len] = 0;
return data;
}
@ -240,7 +240,7 @@ static int parse_command_line(char **argv)
break;
#endif
case 'v':
verb_gc = 0x001+0x004+0x008+0x010+0x020;
caml_verb_gc = 0x001+0x004+0x008+0x010+0x020;
break;
case 'p':
for (j = 0; names_of_builtin_cprim[j] != NULL; j++)
@ -252,12 +252,12 @@ static int parse_command_line(char **argv)
break;
case 'I':
if (argv[i + 1] != NULL) {
ext_table_add(&shared_libs_path, argv[i + 1]);
caml_ext_table_add(&shared_libs_path, argv[i + 1]);
i++;
}
break;
default:
fatal_error_arg("Unknown option %s.\n", argv[i]);
caml_fatal_error_arg("Unknown option %s.\n", argv[i]);
}
}
return i;
@ -296,7 +296,7 @@ static void parse_camlrunparam(void)
case 'l': scanmult (opt, &max_stack_init); break;
case 'o': scanmult (opt, &percent_free_init); break;
case 'O': scanmult (opt, &max_percent_free_init); break;
case 'v': scanmult (opt, &verb_gc); break;
case 'v': scanmult (opt, &caml_verb_gc); break;
case 'b': init_backtrace(); break;
case 'p': parser_trace = 1; break;
}
@ -328,11 +328,11 @@ CAMLexport void caml_main(char **argv)
so that it behaves as much as possible as specified in IEEE */
init_ieee_floats();
init_custom_operations();
ext_table_init(&shared_libs_path, 8);
caml_ext_table_init(&shared_libs_path, 8);
external_raise = NULL;
/* Determine options and position of bytecode file */
#ifdef DEBUG
verb_gc = 63;
caml_verb_gc = 63;
#endif
parse_camlrunparam();
pos = 0;
@ -345,15 +345,15 @@ CAMLexport void caml_main(char **argv)
if (fd < 0) {
pos = parse_command_line(argv);
if (argv[pos] == 0)
fatal_error("No bytecode file specified.\n");
caml_fatal_error("No bytecode file specified.\n");
exe_name = argv[pos];
fd = attempt_open(&exe_name, &trail, 1);
switch(fd) {
case FILE_NOT_FOUND:
fatal_error_arg("Fatal error: cannot find file %s\n", argv[pos]);
caml_fatal_error_arg("Fatal error: cannot find file %s\n", argv[pos]);
break;
case BAD_BYTECODE:
fatal_error_arg(
caml_fatal_error_arg(
"Fatal error: the file %s is not a bytecode executable file\n",
argv[pos]);
break;
@ -377,16 +377,16 @@ CAMLexport void caml_main(char **argv)
shared_lib_path = read_section(fd, &trail, "DLPT");
shared_libs = read_section(fd, &trail, "DLLS");
req_prims = read_section(fd, &trail, "PRIM");
if (req_prims == NULL) fatal_error("Fatal error: no PRIM section\n");
if (req_prims == NULL) caml_fatal_error("Fatal error: no PRIM section\n");
build_primitive_table(shared_lib_path, shared_libs, req_prims);
stat_free(shared_lib_path);
stat_free(shared_libs);
stat_free(req_prims);
/* Load the globals */
seek_section(fd, &trail, "DATA");
chan = open_descriptor_in(fd);
chan = caml_open_descriptor_in(fd);
global_data = input_val(chan);
close_channel(chan); /* this also closes fd */
caml_close_channel(chan); /* this also closes fd */
stat_free(trail.section);
/* Ensure that the globals are in the major heap. */
oldify_one (global_data, &global_data);
@ -422,7 +422,7 @@ CAMLexport void caml_startup_code(code_t code, asize_t code_size,
init_ieee_floats();
init_custom_operations();
#ifdef DEBUG
verb_gc = 63;
caml_verb_gc = 63;
#endif
parse_camlrunparam();
external_raise = NULL;

2
byterun/str.c
View File

@ -45,7 +45,7 @@ CAMLprim value caml_create_string(value len)
{
mlsize_t size = Long_val(len);
if (size > Bsize_wsize (Max_wosize) - 1) invalid_argument("String.create");
return alloc_string(size);
return caml_alloc_string(size);
}
CAMLprim value caml_string_get(value str, value index)

28
byterun/sys.c
View File

@ -103,11 +103,11 @@ CAMLexport void caml_sys_error(value arg)
} else {
err = error_message();
if (arg == NO_ARG) {
str = copy_string(err);
str = caml_copy_string(err);
} else {
int err_len = strlen(err);
int arg_len = caml_string_length(arg);
str = alloc_string(arg_len + 2 + err_len);
str = caml_alloc_string(arg_len + 2 + err_len);
memmove(&Byte(str, 0), String_val(arg), arg_len);
memmove(&Byte(str, arg_len), ": ", 2);
memmove(&Byte(str, arg_len + 2), err, err_len);
@ -158,7 +158,7 @@ CAMLprim value caml_sys_open(value path, value flags, value perm)
strcpy(p, String_val(path));
/* open on a named FIFO can block (PR#1533) */
enter_blocking_section();
fd = open(p, convert_flag_list(flags, sys_open_flags)
fd = open(p, caml_convert_flag_list(flags, sys_open_flags)
#if !macintosh
, Int_val(perm)
#endif
@ -221,7 +221,7 @@ CAMLprim value caml_sys_getcwd(value unit)
#else
if (getwd(buff) == 0) caml_sys_error(NO_ARG);
#endif /* HAS_GETCWD */
return copy_string(buff);
return caml_copy_string(buff);
}
CAMLprim value caml_sys_getenv(value var)
@ -230,7 +230,7 @@ CAMLprim value caml_sys_getenv(value var)
res = getenv(String_val(var));
if (res == 0) raise_not_found();
return copy_string(res);
return caml_copy_string(res);
}
char * caml_exe_name;
@ -240,9 +240,9 @@ CAMLprim value caml_sys_get_argv(value unit)
{
CAMLparam0 (); /* unit is unused */
CAMLlocal3 (exe_name, argv, res);
exe_name = copy_string(caml_exe_name);
argv = copy_string_array((char const **) caml_main_argv);
res = alloc_small(2, 0);
exe_name = caml_copy_string(caml_exe_name);
argv = caml_copy_string_array((char const **) caml_main_argv);
res = caml_alloc_small(2, 0);
Field(res, 0) = exe_name;
Field(res, 1) = argv;
CAMLreturn(res);
@ -327,8 +327,8 @@ CAMLprim value caml_sys_get_config(value unit)
CAMLparam0 (); /* unit is unused */
CAMLlocal2 (result, ostype);
ostype = copy_string(OCAML_OS_TYPE);
result = alloc_small (2, 0);
ostype = caml_copy_string(OCAML_OS_TYPE);
result = caml_alloc_small (2, 0);
Field(result, 0) = ostype;
Field(result, 1) = Val_long (8 * sizeof(value));
CAMLreturn (result);
@ -340,10 +340,10 @@ CAMLprim value caml_sys_read_directory(value path)
CAMLlocal1(result);
struct ext_table tbl;
ext_table_init(&tbl, 50);
caml_ext_table_init(&tbl, 50);
if (caml_read_directory(String_val(path), &tbl) == -1) caml_sys_error(path);
ext_table_add(&tbl, NULL);
result = copy_string_array((char const **) tbl.contents);
ext_table_free(&tbl, 1);
caml_ext_table_add(&tbl, NULL);
result = caml_copy_string_array((char const **) tbl.contents);
caml_ext_table_free(&tbl, 1);
CAMLreturn(result);
}

2
byterun/terminfo.c
View File

@ -67,7 +67,7 @@ CAMLprim value terminfo_setup (value vchan)
|| standout == NULL || standend == NULL){
return Bad_term;
}
result = alloc_small (1, Good_term_tag);
result = caml_alloc_small (1, Good_term_tag);
Field (result, 0) = Val_int (num_lines);
return result;
}

8
byterun/unix.c
View File

@ -56,7 +56,7 @@ char * decompose_path(struct ext_table * tbl, char * path)
q = p;
while (1) {
for (n = 0; q[n] != 0 && q[n] != ':'; n++) /*nothing*/;
ext_table_add(tbl, q);
caml_ext_table_add(tbl, q);
q = q + n;
if (*q == 0) break;
*q = 0;
@ -141,7 +141,7 @@ char * search_exe_in_path(char * name)
char * tofree;
char * res;
ext_table_init(&path, 8);
caml_ext_table_init(&path, 8);
tofree = decompose_path(&path, getenv("PATH"));
#ifndef __CYGWIN32__
res = search_in_path(&path, name);
@ -149,7 +149,7 @@ char * search_exe_in_path(char * name)
res = cygwin_search_exe_in_path(&path, name);
#endif
stat_free(tofree);
ext_table_free(&path, 0);
caml_ext_table_free(&path, 0);
return res;
}
@ -349,7 +349,7 @@ int caml_read_directory(char * dirname, struct ext_table * contents)
if (strcmp(e->d_name, ".") == 0 || strcmp(e->d_name, "..") == 0) continue;
p = stat_alloc(strlen(e->d_name) + 1);
strcpy(p, e->d_name);
ext_table_add(contents, p);
caml_ext_table_add(contents, p);
}
closedir(d);
return 0;

9
byterun/weak.c
View File

@ -55,6 +55,8 @@ CAMLprim value weak_set (value ar, value n, value el)
v = Field (el, 0);
if (Is_block (v) && (Is_young (v) || Is_in_heap (v))){
Modify (&Field (ar, offset), v);
}else{
Field (ar, offset) = v;
}
}
return Val_unit;
@ -77,7 +79,7 @@ CAMLprim value weak_get (value ar, value n)
if (gc_phase == Phase_mark && Is_block (elt) && Is_in_heap (elt)){
darken (elt, NULL);
}
res = alloc_small (1, Some_tag);
res = caml_alloc_small (1, Some_tag);
Field (res, 0) = elt;
}
CAMLreturn (res);
@ -98,7 +100,8 @@ CAMLprim value weak_get_copy (value ar, value n)
v = Field (ar, offset);
if (v == weak_none) CAMLreturn (None_val);
if (Is_block (v) && (Is_young (v) || Is_in_heap (v))){
elt = alloc (Wosize_val (v), Tag_val (v)); /* The GC may erase or move v. */
elt = caml_alloc (Wosize_val (v), Tag_val (v));
/* The GC may erase or move v during this call to caml_alloc. */
v = Field (ar, offset);
if (v == weak_none) CAMLreturn (None_val);
if (Tag_val (v) < No_scan_tag){
@ -112,7 +115,7 @@ CAMLprim value weak_get_copy (value ar, value n)
}else{
elt = v;
}
res = alloc_small (1, Some_tag);
res = caml_alloc_small (1, Some_tag);
Field (res, 0) = elt;
CAMLreturn (res);

8
byterun/win32.c
View File

@ -48,7 +48,7 @@ char * decompose_path(struct ext_table * tbl, char * path)
q = p;
while (1) {
for (n = 0; q[n] != 0 && q[n] != ';'; n++) /*nothing*/;
ext_table_add(tbl, q);
caml_ext_table_add(tbl, q);
q = q + n;
if (*q == 0) break;
*q = 0;
@ -72,12 +72,12 @@ char * search_in_path(struct ext_table * path, char * name)
strcpy(fullname, (char *)(path->contents[i]));
strcat(fullname, "\\");
strcat(fullname, name);
gc_message(0x100, "Searching %s\n", (unsigned long) fullname);
caml_gc_message(0x100, "Searching %s\n", (unsigned long) fullname);
if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) return fullname;
stat_free(fullname);
}
not_found:
gc_message(0x100, "%s not found in search path\n", (unsigned long) name);
caml_gc_message(0x100, "%s not found in search path\n", (unsigned long) name);
fullname = stat_alloc(strlen(name) + 1);
strcpy(fullname, name);
return fullname;
@ -353,7 +353,7 @@ int caml_read_directory(char * dirname, struct ext_table * contents)
if (strcmp(fileinfo.name, ".") != 0 && strcmp(fileinfo.name, "..") != 0) {
p = stat_alloc(strlen(fileinfo.name) + 1);
strcpy(p, fileinfo.name);
ext_table_add(contents, p);
caml_ext_table_add(contents, p);
}
} while (_findnext(h, &fileinfo) == 0);
_findclose(h);

2
otherlibs/labltk/browser/dummyUnix.mli
View File

@ -23,5 +23,5 @@ end
module Thread : sig
type t
external create : ('a -> 'b) -> 'a -> t = "caml_input"
external create : ('a -> 'b) -> 'a -> t = "caml_ml_input"
end

8
otherlibs/systhreads/posix.c
View File

@ -353,10 +353,10 @@ value caml_thread_initialize(value unit) /* ML */
#ifdef NATIVE_CODE
caml_termination_hook = pthread_exit;
#endif
channel_mutex_free = caml_io_mutex_free;
channel_mutex_lock = caml_io_mutex_lock;
channel_mutex_unlock = caml_io_mutex_unlock;
channel_mutex_unlock_exn = caml_io_mutex_unlock_exn;
caml_channel_mutex_free = caml_io_mutex_free;
caml_channel_mutex_lock = caml_io_mutex_lock;
caml_channel_mutex_unlock = caml_io_mutex_unlock;
caml_channel_mutex_unlock_exn = caml_io_mutex_unlock_exn;
/* Fork the tick thread */
pthread_attr_init(&attr);
pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);

8
otherlibs/systhreads/win32.c
View File

@ -319,10 +319,10 @@ CAMLprim value caml_thread_initialize(value unit)
enter_blocking_section_hook = caml_thread_enter_blocking_section;
prev_leave_blocking_section_hook = leave_blocking_section_hook;
leave_blocking_section_hook = caml_thread_leave_blocking_section;
channel_mutex_free = caml_io_mutex_free;
channel_mutex_lock = caml_io_mutex_lock;
channel_mutex_unlock = caml_io_mutex_unlock;
channel_mutex_unlock_exn = caml_io_mutex_unlock_exn;
caml_channel_mutex_free = caml_io_mutex_free;
caml_channel_mutex_lock = caml_io_mutex_lock;
caml_channel_mutex_unlock = caml_io_mutex_unlock;
caml_channel_mutex_unlock_exn = caml_io_mutex_unlock_exn;
/* Fork the tick thread */
tick_thread = (HANDLE) _beginthread(caml_thread_tick, 0, NULL);
if (tick_thread == (HANDLE)(-1)) caml_wthread_error("Thread.init");

19
otherlibs/threads/pervasives.ml
View File

@ -221,8 +221,8 @@ let rec (@) l1 l2 =
type in_channel
type out_channel
external open_descriptor_out: int -> out_channel = "caml_open_descriptor_out"
external open_descriptor_in: int -> in_channel = "caml_open_descriptor_in"
external open_descriptor_out: int -> out_channel = "caml_ml_open_descriptor_out"
external open_descriptor_in: int -> in_channel = "caml_ml_open_descriptor_in"
let stdin = open_descriptor_in 0
let stdout = open_descriptor_out 1
@ -238,8 +238,10 @@ let thread_wait_write fd = thread_wait_write_prim fd
external inchan_ready : in_channel -> bool = "thread_inchan_ready"
external outchan_ready : out_channel -> int -> bool = "thread_outchan_ready"
external descr_inchan : in_channel -> Unix.file_descr = "channel_descriptor"
external descr_outchan : out_channel -> Unix.file_descr = "channel_descriptor"
external descr_inchan : in_channel -> Unix.file_descr
= "caml_channel_descriptor"
external descr_outchan : out_channel -> Unix.file_descr
= "caml_channel_descriptor"
let wait_inchan ic =
if not (inchan_ready ic) then thread_wait_read(descr_inchan ic)
@ -265,7 +267,7 @@ let open_out name =
let open_out_bin name =
open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o666 name
external flush_partial : out_channel -> bool = "caml_flush_partial"
external flush_partial : out_channel -> bool = "caml_ml_flush_partial"
let rec flush oc =
let success =
@ -291,7 +293,7 @@ let flush_all () =
in iter (out_channels_list ())
external unsafe_output_partial : out_channel -> string -> int -> int -> int
= "caml_output_partial"
= "caml_ml_output_partial"
let rec unsafe_output oc buf pos len =
if len > 0 then begin
@ -304,8 +306,9 @@ let rec unsafe_output oc buf pos len =
end
external output_char_blocking : out_channel -> char -> unit
= "caml_output_char"
external output_byte_blocking : out_channel -> int -> unit = "caml_output_char"
= "caml_ml_output_char"
external output_byte_blocking : out_channel -> int -> unit
= "caml_ml_output_char"
let rec output_char oc c =
try

2
otherlibs/threads/scheduler.c
View File

@ -514,7 +514,7 @@ try_again:
static void check_callback(void)
{
if (callback_depth > 1)
fatal_error("Thread: deadlock during callback");
caml_fatal_error("Thread: deadlock during callback");
}
/* Reschedule without suspending the current thread */

9
otherlibs/threads/unix.ml
View File

@ -220,12 +220,13 @@ let rec write fd buf ofs len =
wait_write fd; write fd buf ofs len
external in_channel_of_descr : file_descr -> in_channel
= "caml_open_descriptor_in"
= "caml_ml_open_descriptor_in"
external out_channel_of_descr : file_descr -> out_channel
= "caml_open_descriptor_out"
external descr_of_in_channel : in_channel -> file_descr = "channel_descriptor"
= "caml_ml_open_descriptor_out"
external descr_of_in_channel : in_channel -> file_descr
= "caml_channel_descriptor"
external descr_of_out_channel : out_channel -> file_descr
= "channel_descriptor"
= "caml_channel_descriptor"
type seek_command =
SEEK_SET

9
otherlibs/unix/unix.ml
View File

@ -172,12 +172,13 @@ let write fd buf ofs len =
else unsafe_write fd buf ofs len
external in_channel_of_descr : file_descr -> in_channel
= "caml_open_descriptor_in"
= "caml_ml_open_descriptor_in"
external out_channel_of_descr : file_descr -> out_channel
= "caml_open_descriptor_out"
external descr_of_in_channel : in_channel -> file_descr = "channel_descriptor"
= "caml_ml_open_descriptor_out"
external descr_of_in_channel : in_channel -> file_descr
= "caml_channel_descriptor"
external descr_of_out_channel : out_channel -> file_descr
= "channel_descriptor"
= "caml_channel_descriptor"
type seek_command =
SEEK_SET

9
otherlibs/win32unix/unix.ml
View File

@ -192,10 +192,11 @@ let write fd buf ofs len =
(* Interfacing with the standard input/output library *)
external open_read_descriptor : int -> in_channel = "caml_open_descriptor_in"
external open_write_descriptor : int -> out_channel = "caml_open_descriptor_out"
external fd_of_in_channel : in_channel -> int = "channel_descriptor"
external fd_of_out_channel : out_channel -> int = "channel_descriptor"
external open_read_descriptor : int -> in_channel = "caml_ml_open_descriptor_in"
external open_write_descriptor : int -> out_channel
= "caml_ml_open_descriptor_out"
external fd_of_in_channel : in_channel -> int = "caml_channel_descriptor"
external fd_of_out_channel : out_channel -> int = "caml_channel_descriptor"
external open_handle : file_descr -> int = "win_fd_handle"

59
stdlib/pervasives.ml
View File

@ -207,8 +207,8 @@ let rec (@) l1 l2 =
type in_channel
type out_channel
external open_descriptor_out: int -> out_channel = "caml_open_descriptor_out"
external open_descriptor_in: int -> in_channel = "caml_open_descriptor_in"
external open_descriptor_out: int -> out_channel = "caml_ml_open_descriptor_out"
external open_descriptor_in: int -> in_channel = "caml_ml_open_descriptor_in"
let stdin = open_descriptor_in 0
let stdout = open_descriptor_out 1
@ -232,10 +232,10 @@ let open_out name =
let open_out_bin name =
open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o666 name
external flush : out_channel -> unit = "caml_flush"
external flush : out_channel -> unit = "caml_ml_flush"
external out_channels_list : unit -> out_channel list
= "caml_out_channels_list"
= "caml_ml_out_channels_list"
let flush_all () =
let rec iter = function
@ -244,9 +244,9 @@ let flush_all () =
in iter (out_channels_list ())
external unsafe_output : out_channel -> string -> int -> int -> unit
= "caml_output"
= "caml_ml_output"
external output_char : out_channel -> char -> unit = "caml_output_char"
external output_char : out_channel -> char -> unit = "caml_ml_output_char"
let output_string oc s =
unsafe_output oc s 0 (string_length s)
@ -256,23 +256,23 @@ let output oc s ofs len =
then invalid_arg "output"
else unsafe_output oc s ofs len
external output_byte : out_channel -> int -> unit = "caml_output_char"
external output_binary_int : out_channel -> int -> unit = "caml_output_int"
external output_byte : out_channel -> int -> unit = "caml_ml_output_char"
external output_binary_int : out_channel -> int -> unit = "caml_ml_output_int"
external marshal_to_channel : out_channel -> 'a -> unit list -> unit
= "output_value"
let output_value chan v = marshal_to_channel chan v []
external seek_out : out_channel -> int -> unit = "caml_seek_out"
external pos_out : out_channel -> int = "caml_pos_out"
external out_channel_length : out_channel -> int = "caml_channel_size"
external close_out_channel : out_channel -> unit = "caml_close_channel"
external seek_out : out_channel -> int -> unit = "caml_ml_seek_out"
external pos_out : out_channel -> int = "caml_ml_pos_out"
external out_channel_length : out_channel -> int = "caml_ml_channel_size"
external close_out_channel : out_channel -> unit = "caml_ml_close_channel"
let close_out oc = flush oc; close_out_channel oc
let close_out_noerr oc =
(try flush oc with _ -> ());
(try close_out_channel oc with _ -> ())
external set_binary_mode_out : out_channel -> bool -> unit
= "caml_set_binary_mode"
= "caml_ml_set_binary_mode"
(* General input functions *)
@ -285,10 +285,10 @@ let open_in name =
let open_in_bin name =
open_in_gen [Open_rdonly; Open_binary] 0 name
external input_char : in_channel -> char = "caml_input_char"
external input_char : in_channel -> char = "caml_ml_input_char"
external unsafe_input : in_channel -> string -> int -> int -> int
= "caml_input"
= "caml_ml_input"
let input ic s ofs len =
if ofs < 0 || len < 0 || ofs > string_length s - len
@ -308,7 +308,7 @@ let really_input ic s ofs len =
then invalid_arg "really_input"
else unsafe_really_input ic s ofs len
external input_scan_line : in_channel -> int = "caml_input_scan_line"
external input_scan_line : in_channel -> int = "caml_ml_input_scan_line"
let input_line chan =
let rec build_result buf pos = function
@ -338,16 +338,16 @@ let input_line chan =
end
in scan [] 0
external input_byte : in_channel -> int = "caml_input_char"
external input_binary_int : in_channel -> int = "caml_input_int"
external input_byte : in_channel -> int = "caml_ml_input_char"
external input_binary_int : in_channel -> int = "caml_ml_input_int"
external input_value : in_channel -> 'a = "input_value"
external seek_in : in_channel -> int -> unit = "caml_seek_in"
external pos_in : in_channel -> int = "caml_pos_in"
external in_channel_length : in_channel -> int = "caml_channel_size"
external close_in : in_channel -> unit = "caml_close_channel"
external seek_in : in_channel -> int -> unit = "caml_ml_seek_in"
external pos_in : in_channel -> int = "caml_ml_pos_in"
external in_channel_length : in_channel -> int = "caml_ml_channel_size"
external close_in : in_channel -> unit = "caml_ml_close_channel"
let close_in_noerr ic = (try close_in ic with _ -> ());;
external set_binary_mode_in : in_channel -> bool -> unit
= "caml_set_binary_mode"
= "caml_ml_set_binary_mode"
(* Output functions on standard output *)
@ -379,12 +379,13 @@ let read_float () = float_of_string(read_line())
module LargeFile =
struct
external seek_out : out_channel -> int64 -> unit = "caml_seek_out_64"
external pos_out : out_channel -> int64 = "caml_pos_out_64"
external out_channel_length : out_channel -> int64 = "caml_channel_size_64"
external seek_in : in_channel -> int64 -> unit = "caml_seek_in_64"
external pos_in : in_channel -> int64 = "caml_pos_in_64"
external in_channel_length : in_channel -> int64 = "caml_channel_size_64"
external seek_out : out_channel -> int64 -> unit = "caml_ml_seek_out_64"
external pos_out : out_channel -> int64 = "caml_ml_pos_out_64"
external out_channel_length : out_channel -> int64
= "caml_ml_channel_size_64"
external seek_in : in_channel -> int64 -> unit = "caml_ml_seek_in_64"
external pos_in : in_channel -> int64 = "caml_ml_pos_in_64"
external in_channel_length : in_channel -> int64 = "caml_ml_channel_size_64"
end
(* References *)

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+7 (2003-12-17)";;
let ocaml_version = "3.07+8 (2003-12-29)";;