Ajout de flush_all + modifs pour Cash (Bruno Verlyck)
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3872 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
48485d8d8a
commit
2f7123618c
BIN
boot/ocamllex
BIN
boot/ocamllex
Binary file not shown.
|
@ -93,7 +93,7 @@ static value read_debug_info(void)
|
|||
close(fd);
|
||||
CAMLreturn(Val_false);
|
||||
}
|
||||
chan = open_descriptor(fd);
|
||||
chan = open_descriptor_in(fd);
|
||||
num_events = getword(chan);
|
||||
events = alloc(num_events, 0);
|
||||
for (i = 0; i < num_events; i++) {
|
||||
|
|
|
@ -72,8 +72,8 @@ static void open_connection(void)
|
|||
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(dbg_socket);
|
||||
dbg_out = open_descriptor(dbg_socket);
|
||||
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);
|
||||
|
|
|
@ -102,7 +102,7 @@ static void intern_cleanup(void)
|
|||
if (intern_extra_block != NULL) {
|
||||
/* free newly allocated heap chunk */
|
||||
free_for_heap(intern_extra_block);
|
||||
} else if (intern_block != NULL) {
|
||||
} else if (intern_block != 0) {
|
||||
/* restore original header for heap block, otherwise GC is confused */
|
||||
Hd_val(intern_block) = intern_header;
|
||||
}
|
||||
|
@ -286,7 +286,7 @@ static void intern_alloc(mlsize_t whsize, mlsize_t num_objects)
|
|||
if (whsize == 0) {
|
||||
intern_obj_table = NULL;
|
||||
intern_extra_block = NULL;
|
||||
intern_block = NULL;
|
||||
intern_block = 0;
|
||||
return;
|
||||
}
|
||||
wosize = Wosize_whsize(whsize);
|
||||
|
|
80
byterun/io.c
80
byterun/io.c
|
@ -48,13 +48,16 @@ CAMLexport void (*channel_mutex_lock) (struct channel *) = NULL;
|
|||
CAMLexport void (*channel_mutex_unlock) (struct channel *) = NULL;
|
||||
CAMLexport void (*channel_mutex_unlock_exn) (void) = NULL;
|
||||
|
||||
/* List of opened channels */
|
||||
CAMLexport struct channel * all_opened_channels = NULL;
|
||||
|
||||
/* Basic functions over type struct channel *.
|
||||
These functions can be called directly from C.
|
||||
No locking is performed. */
|
||||
|
||||
/* Functions shared between input and output */
|
||||
|
||||
CAMLexport struct channel * open_descriptor(int fd)
|
||||
CAMLexport struct channel * open_descriptor_in(int fd)
|
||||
{
|
||||
struct channel * channel;
|
||||
|
||||
|
@ -64,13 +67,39 @@ CAMLexport struct channel * open_descriptor(int fd)
|
|||
channel->curr = channel->max = channel->buff;
|
||||
channel->end = channel->buff + IO_BUFFER_SIZE;
|
||||
channel->mutex = NULL;
|
||||
channel->revealed = 0;
|
||||
channel->old_revealed = 0;
|
||||
channel->refcount = 0;
|
||||
channel->next = all_opened_channels;
|
||||
all_opened_channels = channel;
|
||||
return channel;
|
||||
}
|
||||
|
||||
CAMLexport struct channel * open_descriptor_out(int fd)
|
||||
{
|
||||
struct channel * channel;
|
||||
|
||||
channel = open_descriptor_in(fd);
|
||||
channel->max = NULL;
|
||||
return channel;
|
||||
}
|
||||
|
||||
static void unlink_channel(struct channel *channel)
|
||||
{
|
||||
struct channel ** cp = &all_opened_channels;
|
||||
|
||||
while (*cp != channel && *cp != NULL)
|
||||
cp = &(*cp)->next;
|
||||
if (*cp != NULL)
|
||||
*cp = (*cp)->next;
|
||||
}
|
||||
|
||||
CAMLexport void close_channel(struct channel *channel)
|
||||
{
|
||||
close(channel->fd);
|
||||
if (channel->refcount > 0) return;
|
||||
if (channel_mutex_free != NULL) (*channel_mutex_free)(channel);
|
||||
unlink_channel(channel);
|
||||
stat_free(channel);
|
||||
}
|
||||
|
||||
|
@ -196,7 +225,6 @@ CAMLexport int putblock(struct channel *channel, char *p, long int len)
|
|||
memmove(channel->buff, channel->buff + written, towrite - written);
|
||||
channel->offset += written;
|
||||
channel->curr = channel->end - written;
|
||||
channel->max = channel->end - written;
|
||||
return free;
|
||||
}
|
||||
}
|
||||
|
@ -369,10 +397,12 @@ CAMLexport long input_scan_line(struct channel *channel)
|
|||
objects into a heap-allocated object. Perform locking
|
||||
and unlocking around the I/O operations. */
|
||||
|
||||
static void finalize_channel(value vchan)
|
||||
CAMLexport void finalize_channel(value vchan)
|
||||
{
|
||||
struct channel * chan = Channel(vchan);
|
||||
if (--chan->refcount > 0) return;
|
||||
if (channel_mutex_free != NULL) (*channel_mutex_free)(chan);
|
||||
unlink_channel(chan);
|
||||
stat_free(chan);
|
||||
}
|
||||
|
||||
|
@ -392,17 +422,47 @@ static struct custom_operations channel_operations = {
|
|||
custom_deserialize_default
|
||||
};
|
||||
|
||||
static value alloc_channel(struct channel *chan)
|
||||
CAMLexport value alloc_channel(struct channel *chan)
|
||||
{
|
||||
value res = alloc_custom(&channel_operations, sizeof(struct channel *),
|
||||
1, 1000);
|
||||
Channel(res) = chan;
|
||||
chan->refcount++;
|
||||
return res;
|
||||
}
|
||||
|
||||
CAMLprim value caml_open_descriptor(value fd)
|
||||
CAMLprim value caml_open_descriptor_in(value fd)
|
||||
{
|
||||
return alloc_channel(open_descriptor(Int_val(fd)));
|
||||
return alloc_channel(open_descriptor_in(Int_val(fd)));
|
||||
}
|
||||
|
||||
CAMLprim value caml_open_descriptor_out(value fd)
|
||||
{
|
||||
return alloc_channel(open_descriptor_out(Int_val(fd)));
|
||||
}
|
||||
|
||||
#define Pair_tag 0
|
||||
|
||||
CAMLprim value caml_out_channels_list (value unit)
|
||||
{
|
||||
CAMLparam0 ();
|
||||
CAMLlocal3 (res, tail, chan);
|
||||
struct channel * channel;
|
||||
|
||||
res = Val_emptylist;
|
||||
for (channel = 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. */
|
||||
if (channel->max == NULL) {
|
||||
chan = alloc_channel (channel);
|
||||
tail = res;
|
||||
res = alloc_small (2, Pair_tag);
|
||||
Field (res, 0) = chan;
|
||||
Field (res, 1) = tail;
|
||||
}
|
||||
CAMLreturn (res);
|
||||
}
|
||||
|
||||
CAMLprim value channel_descriptor(value vchannel)
|
||||
|
@ -444,9 +504,7 @@ CAMLprim value caml_flush_partial(value vchannel)
|
|||
{
|
||||
struct channel * channel = Channel(vchannel);
|
||||
int res;
|
||||
/* Don't fail if channel is closed, this causes problem with flush on
|
||||
stdout and stderr at exit. Revise when "flushall" is implemented. */
|
||||
if (channel->fd == -1) return Val_true;
|
||||
|
||||
Lock(channel);
|
||||
res = flush_partial(channel);
|
||||
Unlock(channel);
|
||||
|
@ -456,9 +514,7 @@ CAMLprim value caml_flush_partial(value vchannel)
|
|||
CAMLprim value caml_flush(value vchannel)
|
||||
{
|
||||
struct channel * channel = Channel(vchannel);
|
||||
/* Don't fail if channel is closed, this causes problem with flush on
|
||||
stdout and stderr at exit. Revise when "flushall" is implemented. */
|
||||
if (channel->fd == -1) return Val_unit;
|
||||
|
||||
Lock(channel);
|
||||
flush(channel);
|
||||
Unlock(channel);
|
||||
|
|
|
@ -32,6 +32,10 @@ struct channel {
|
|||
char * curr; /* Current position in the buffer */
|
||||
char * max; /* Logical end of the buffer (for input) */
|
||||
void * mutex; /* Placeholder for mutex (for systhreads) */
|
||||
struct channel * next; /* Linear chaining of channels (flush_all) */
|
||||
int revealed; /* For Cash only */
|
||||
int old_revealed; /* For Cash only */
|
||||
int refcount; /* For Cash only */
|
||||
char buff[IO_BUFFER_SIZE]; /* The buffer itself */
|
||||
};
|
||||
|
||||
|
@ -54,7 +58,8 @@ struct channel {
|
|||
? refill(channel) \
|
||||
: (unsigned char) *((channel))->curr++)
|
||||
|
||||
CAMLextern struct channel * open_descriptor (int);
|
||||
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 *);
|
||||
|
||||
|
|
|
@ -371,7 +371,7 @@ CAMLexport void caml_main(char **argv)
|
|||
stat_free(req_prims);
|
||||
/* Load the globals */
|
||||
seek_section(fd, &trail, "DATA");
|
||||
chan = open_descriptor(fd);
|
||||
chan = open_descriptor_in(fd);
|
||||
global_data = input_val(chan);
|
||||
close_channel(chan); /* this also closes fd */
|
||||
stat_free(trail.section);
|
||||
|
|
|
@ -178,7 +178,7 @@ let string_of_bool b =
|
|||
let bool_of_string = function
|
||||
| "true" -> true
|
||||
| "false" -> false
|
||||
| _ -> invalid_arg "string_of_bool"
|
||||
| _ -> invalid_arg "bool_of_string"
|
||||
|
||||
let string_of_int n =
|
||||
format_int "%d" n
|
||||
|
@ -202,8 +202,8 @@ let rec (@) l1 l2 =
|
|||
type in_channel
|
||||
type out_channel
|
||||
|
||||
external open_descriptor_out: int -> out_channel = "caml_open_descriptor"
|
||||
external open_descriptor_in: int -> in_channel = "caml_open_descriptor"
|
||||
external open_descriptor_out: int -> out_channel = "caml_open_descriptor_out"
|
||||
external open_descriptor_in: int -> in_channel = "caml_open_descriptor_in"
|
||||
|
||||
let stdin = open_descriptor_in 0
|
||||
let stdout = open_descriptor_out 1
|
||||
|
@ -256,6 +256,21 @@ let rec flush oc =
|
|||
wait_outchan oc (-1); false in
|
||||
if success then () else flush oc
|
||||
|
||||
external out_channels_list : unit -> out_channel list
|
||||
= "caml_out_channels_list"
|
||||
|
||||
let flush_all () =
|
||||
let rec iter = function
|
||||
[] -> ()
|
||||
| a::l ->
|
||||
begin try
|
||||
flush a
|
||||
with Sys_error _ ->
|
||||
() (* ignore channels closed during a preceding flush. *)
|
||||
end;
|
||||
iter l
|
||||
in iter (out_channels ())
|
||||
|
||||
external unsafe_output_partial : out_channel -> string -> int -> int -> int
|
||||
= "caml_output_partial"
|
||||
|
||||
|
@ -451,7 +466,7 @@ let read_float () = float_of_string(read_line())
|
|||
|
||||
external sys_exit : int -> 'a = "sys_exit"
|
||||
|
||||
let exit_function = ref (fun () -> flush stdout; flush stderr)
|
||||
let exit_function = ref flush_all
|
||||
|
||||
let at_exit f =
|
||||
let g = !exit_function in
|
||||
|
|
|
@ -166,9 +166,9 @@ 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"
|
||||
= "caml_open_descriptor_in"
|
||||
external out_channel_of_descr : file_descr -> out_channel
|
||||
= "caml_open_descriptor"
|
||||
= "caml_open_descriptor_out"
|
||||
external descr_of_in_channel : in_channel -> file_descr = "channel_descriptor"
|
||||
external descr_of_out_channel : out_channel -> file_descr
|
||||
= "channel_descriptor"
|
||||
|
|
|
@ -188,8 +188,8 @@ let write fd buf ofs len =
|
|||
|
||||
(* Interfacing with the standard input/output library *)
|
||||
|
||||
external open_read_descriptor : int -> in_channel = "caml_open_descriptor"
|
||||
external open_write_descriptor : int -> out_channel = "caml_open_descriptor"
|
||||
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"
|
||||
|
||||
|
|
|
@ -188,8 +188,8 @@ let rec (@) l1 l2 =
|
|||
type in_channel
|
||||
type out_channel
|
||||
|
||||
external open_descriptor_out: int -> out_channel = "caml_open_descriptor"
|
||||
external open_descriptor_in: int -> in_channel = "caml_open_descriptor"
|
||||
external open_descriptor_out: int -> out_channel = "caml_open_descriptor_out"
|
||||
external open_descriptor_in: int -> in_channel = "caml_open_descriptor_in"
|
||||
|
||||
let stdin = open_descriptor_in 0
|
||||
let stdout = open_descriptor_out 1
|
||||
|
@ -215,6 +215,15 @@ let open_out_bin name =
|
|||
|
||||
external flush : out_channel -> unit = "caml_flush"
|
||||
|
||||
external out_channels_list : unit -> out_channel list
|
||||
= "caml_out_channels_list"
|
||||
|
||||
let flush_all () =
|
||||
let rec iter = function
|
||||
[] -> ()
|
||||
| a::l -> flush a; iter l
|
||||
in iter (out_channels_list ())
|
||||
|
||||
external unsafe_output : out_channel -> string -> int -> int -> unit
|
||||
= "caml_output"
|
||||
|
||||
|
@ -345,7 +354,7 @@ external decr: int ref -> unit = "%decr"
|
|||
|
||||
external sys_exit : int -> 'a = "sys_exit"
|
||||
|
||||
let exit_function = ref (fun () -> flush stdout; flush stderr)
|
||||
let exit_function = ref flush_all
|
||||
|
||||
let at_exit f =
|
||||
let g = !exit_function in
|
||||
|
|
|
@ -482,6 +482,8 @@ val flush : out_channel -> unit
|
|||
performing all pending writes on that channel.
|
||||
Interactive programs must be careful about flushing standard
|
||||
output and standard error at the right time. *)
|
||||
val flush_all : unit -> unit
|
||||
(* Flush all opened output channels. *)
|
||||
val output_char : out_channel -> char -> unit
|
||||
(* Write the character on the given output channel. *)
|
||||
val output_string : out_channel -> string -> unit
|
||||
|
|
Loading…
Reference in New Issue