Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

patch pour flush_all #2687

Closed
vicuna opened this issue Feb 22, 2001 · 1 comment
Closed

patch pour flush_all #2687

vicuna opened this issue Feb 22, 2001 · 1 comment

Comments

@vicuna
Copy link

vicuna commented Feb 22, 2001

Original bug ID: 289
Reporter: administrator
Status: closed
Resolution: fixed
Priority: normal
Severity: feature
Category: ~DO NOT USE (was: OCaml general)

Bug description

Voici un patch pour Pervasives.flush_all. J'ai patché le diff --
enlevé d'autres modifications sans rapport direct -- pour que la
commande patch le digère; j'espère que c'est suffisant.

Note: channels est une liste de tous les channels; pour flush_all, il
n'y a besoin que des out_channel's. Mais pour cash, ça ne suffirait
pas.

Note 2: vu que flush_all n'est pas implémenté pour le moment pour les
threads, la modification de la version 1.45 d'io.c me semble encore
nécessaire; peut-être pas dans caml_flush, si caml_flush_partial est
bien le seul flush appelé avec les threads (je n'ai pas vérifié en
détail).

Bruno.


cvs server: Diffing byterun
Index: byterun/debugger.c

RCS file: /caml/ocaml/byterun/debugger.c,v
retrieving revision 1.20
diff -C3 -r1.20 debugger.c
*** debugger.c 2000/10/12 18:05:38 1.20
--- debugger.c 2001/02/22 10:17:47


*** 72,79 ****
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);
if (!debugger_in_use) putword(dbg_out, -1); /* first connection /
putword(dbg_out, getpid());
flush(dbg_out);
--- 72,79 ----
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);
Index: byterun/io.c

RCS file: /caml/ocaml/byterun/io.c,v
retrieving revision 1.44
diff -C3 -r1.44 io.c
*** io.c 2001/02/06 15:21:50 1.44
--- io.c 2001/02/22 10:17:47


*** 48,60 ****
void (*channel_mutex_unlock) (struct channel *) = NULL;
void (*channel_mutex_unlock_exn) (void) = 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 */

! struct channel * open_descriptor(int fd)
{
struct channel * channel;

--- 48,63 ----
void (*channel_mutex_unlock) (struct channel *) = NULL;
void (*channel_mutex_unlock_exn) (void) = NULL;

  • /* List of opened channels */

  • struct channel * 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 */

! struct channel * open_descriptor_in(int fd)
{
struct channel * channel;


*** 64,76 ****
--- 67,105 ----
channel->curr = channel->max = channel->buff;
channel->end = channel->buff + IO_BUFFER_SIZE;
channel->mutex = NULL;

  • channel->next = channels;

  • channels = channel;
    return channel;
    }

  • 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 = &channels;

  • while (*cp != channel && *cp != NULL)

  • cp = &(*cp)->next;
    
  • if (*cp != NULL)

  • *cp = (*cp)->next;
    
  • }

  • void close_channel(struct channel *channel)
    {
    close(channel->fd);
    if (channel_mutex_free != NULL) (*channel_mutex_free)(channel);

  • unlink_channel(channel);
    stat_free(channel);
    }


*** 196,202 ****
memmove(channel->buff, channel->buff + written, towrite - written);
channel->offset += written;
channel->curr = channel->end - written;

  • channel->max = channel->end - written;
    return free;
    
    }
    }
    --- 225,230 ----

*** 372,378 ****
--- 400,408 ----
static void finalize_channel(value vchan)
{
struct channel * chan = Channel(vchan);
if (channel_mutex_free != NULL) (*channel_mutex_free)(chan);

  • unlink_channel(chan);
    stat_free(chan);
    }

*** 392,408 ****
custom_deserialize_default
};

! static value alloc_channel(struct channel *chan)
{
value res = alloc_custom(&channel_operations, sizeof(struct channel *),
1, 1000);
Channel(res) = chan;
return res;
}

! value caml_open_descriptor(value fd) /* ML */
{
! return alloc_channel(open_descriptor(Int_val(fd)));
}

value channel_descriptor(value vchannel) /* ML */
--- 422,454 ----
custom_deserialize_default
};

! /* static */ value alloc_channel(struct channel *chan)
{
value res = alloc_custom(&channel_operations, sizeof(struct channel *),
1, 1000);
Channel(res) = chan;
return res;
}
+

  • value caml_open_descriptor_in(value fd) /* ML */
  • {
  • return alloc_channel(open_descriptor_in(Int_val(fd)));
  • }

! value caml_open_descriptor_out(value fd) /* ML /
{
! return alloc_channel(open_descriptor_out(Int_val(fd)));
! }
!
! value caml_flush_all_out_channels (value unit) /
ML */
! {
! struct channel * cp;
!
! for (cp = channels; cp != NULL; cp = cp->next)
! if (cp->fd >= 0 && cp->max == NULL)
! flush (cp);
! return Val_unit;
}

value channel_descriptor(value vchannel) /* ML */
Index: byterun/io.h

RCS file: /caml/ocaml/byterun/io.h,v
retrieving revision 1.13
diff -C3 -r1.13 io.h
*** io.h 2000/02/10 14:04:57 1.13
--- io.h 2001/02/22 10:17:47


*** 32,37 ****
--- 32,39 ----
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; /* Next opened channel for flushing them all, e.g. /
    char buff[IO_BUFFER_SIZE]; /
    The buffer itself */
    };

*** 53,59 ****
? refill(channel)
: (unsigned char) *((channel))->curr++)

! struct channel * open_descriptor (int);
void close_channel (struct channel *);
int channel_binary_mode (struct channel *);

--- 57,64 ----
? refill(channel)
: (unsigned char) *((channel))->curr++)

! struct channel * open_descriptor_in (int);
! struct channel * open_descriptor_out (int);
void close_channel (struct channel *);
int channel_binary_mode (struct channel *);

Index: byterun/startup.c

RCS file: /caml/ocaml/byterun/startup.c,v
retrieving revision 1.39
diff -C3 -r1.39 startup.c
*** startup.c 2000/04/04 13:19:12 1.39
--- startup.c 2001/02/22 10:17:47


*** 338,344 ****
check_primitives(fd, seek_section(fd, &trail, "PRIM"));
/* Load the globals /
seek_section(fd, &trail, "DATA");
! chan = open_descriptor(fd);
global_data = input_val(chan);
close_channel(chan); /
this also closes fd /
stat_free(trail.section);
--- 338,344 ----
check_primitives(fd, seek_section(fd, &trail, "PRIM"));
/
Load the globals /
seek_section(fd, &trail, "DATA");
! chan = open_descriptor_in(fd);
global_data = input_val(chan);
close_channel(chan); /
this also closes fd */
stat_free(trail.section);
cvs server: Diffing otherlibs/threads
Index: otherlibs/threads/pervasives.ml

RCS file: /caml/ocaml/otherlibs/threads/pervasives.ml,v
retrieving revision 1.28
diff -C3 -r1.28 pervasives.ml
*** pervasives.ml 2001/02/09 09:40:12 1.28
--- pervasives.ml 2001/02/22 10:17:54


*** 202,209 ****
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"

let stdin = open_descriptor_in 0
let stdout = open_descriptor_out 1
--- 202,209 ----
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"

let stdin = open_descriptor_in 0
let stdout = open_descriptor_out 1


*** 255,260 ****
--- 255,263 ----
with Sys_blocked_io ->
wait_outchan oc (-1); false in
if success then () else flush oc
+

  • let flush_all () =
  • invalid_arg "flush_all with threads not implemented"

external unsafe_output_partial : out_channel -> string -> int -> int -> int
= "caml_output_partial"
cvs server: Diffing otherlibs/unix
Index: otherlibs/unix/unix.ml

RCS file: /caml/ocaml/otherlibs/unix/unix.ml,v
retrieving revision 1.45
diff -C3 -r1.45 unix.ml
*** unix.ml 2000/12/28 13:05:32 1.45
--- unix.ml 2001/02/22 10:17:54


*** 166,174 ****
else unsafe_write fd buf ofs len

external in_channel_of_descr : file_descr -> in_channel
! = "caml_open_descriptor"
external out_channel_of_descr : file_descr -> out_channel
! = "caml_open_descriptor"
external descr_of_in_channel : in_channel -> file_descr = "channel_descriptor"
external descr_of_out_channel : out_channel -> file_descr
= "channel_descriptor"
--- 166,174 ----
else unsafe_write fd buf ofs len

external in_channel_of_descr : file_descr -> in_channel
! = "caml_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"
external descr_of_out_channel : out_channel -> file_descr
= "channel_descriptor"
cvs server: Diffing otherlibs/win32unix
Index: otherlibs/win32unix/unix.ml

RCS file: /caml/ocaml/otherlibs/win32unix/unix.ml,v
retrieving revision 1.26
diff -C3 -r1.26 unix.ml
*** unix.ml 2000/12/28 13:05:45 1.26
--- unix.ml 2001/02/22 10:17:55


*** 188,195 ****

(* 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 fd_of_in_channel : in_channel -> int = "channel_descriptor"
external fd_of_out_channel : out_channel -> int = "channel_descriptor"

--- 188,195 ----

(* 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"

cvs server: Diffing stdlib
Index: stdlib/pervasives.ml

RCS file: /caml/ocaml/stdlib/pervasives.ml,v
retrieving revision 1.40
diff -C3 -r1.40 pervasives.ml
*** pervasives.ml 2000/12/04 15:36:59 1.40
--- pervasives.ml 2001/02/22 10:17:55


*** 171,178 ****
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"

let stdin = open_descriptor_in 0
let stdout = open_descriptor_out 1
--- 171,178 ----
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"

let stdin = open_descriptor_in 0
let stdout = open_descriptor_out 1


*** 198,203 ****
--- 198,204 ----

external fflush : out_channel -> unit = "caml_flush"
external flush : out_channel -> unit = "caml_flush"

  • external flush_all : unit -> unit = "caml_flush_all_out_channels"

    external unsafe_output : out_channel -> string -> int -> int -> unit
    = "caml_output"


*** 329,335 ****

external sys_exit : int -> 'a = "sys_exit"

! let exit_function = ref (fun () -> flush stdout; flush stderr)

let at_exit f =
let g = !exit_function in
--- 330,336 ----

external sys_exit : int -> 'a = "sys_exit"

! let exit_function = ref flush_all

let at_exit f =
let g = !exit_function in
Index: stdlib/pervasives.mli

RCS file: /caml/ocaml/stdlib/pervasives.mli,v
retrieving revision 1.55
diff -C3 -r1.55 pervasives.mli
*** pervasives.mli 2000/12/04 15:37:00 1.55
--- pervasives.mli 2001/02/22 10:17:55


*** 451,456 ****
--- 451,458 ----
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


@vicuna
Copy link
Author

vicuna commented Nov 5, 2002

Comment author: administrator

Ce patch est integre depuis un certain temps. -- Damien 2002-11-05

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant