Commits

Markus Mottl  committed cee412e

Improved portability of Bigstring_marshal

  • Participants
  • Parent commits fd6a144

Comments (0)

Files changed (5)

File base/core/lib/bigstring.mli

 
 (** {6 Blitting} *)
 
-(** [blit ~src ?src_pos ?src_len ~dst ?dst_pos ()] blits [src_len] characters from
-    [src] starting at position [src_pos] to [dst] at position [dst_pos].
+(** [blit ~src ?src_pos ?src_len ~dst ?dst_pos ()] blits [src_len] characters
+    from [src] starting at position [src_pos] to [dst] at position [dst_pos].
 
     @raise Invalid_argument if the designated ranges are out of bounds.
 *)
     @param pos default = 0
     @param len default = [length bstr - pos]
 
-    [really_send_no_sigpipe] is not implemented on some platforms, in which case it is an
-    [Error] value that indicates that it is unimplemented. *)
+    [really_send_no_sigpipe] is not implemented on some platforms, in which
+    case it is an [Error] value that indicates that it is unimplemented. *)
 val really_send_no_sigpipe
   : (file_descr -> ?pos : int -> ?len : int -> t -> unit) Or_error.t
 
 *)
 
 val sendto_nonblocking_no_sigpipe :
-  (file_descr -> ?pos : int -> ?len : int -> t -> sockaddr -> int option) Or_error.t
+  (file_descr -> ?pos : int -> ?len : int -> t ->
+    sockaddr -> int option) Or_error.t
 (** [sendto_nonblocking_no_sigpipe sock ?pos ?len bstr sockaddr] tries
     to send [len] bytes in bigstring [bstr] starting at position [pos]
     to socket [sock] using address [addr].  @return [Some bytes_written],
 *)
 
 val sendmsg_nonblocking_no_sigpipe :
-  (file_descr -> ?count : int -> t Core_unix.IOVec.t array -> int option) Or_error.t
+  (file_descr -> ?count : int ->
+    t Core_unix.IOVec.t array -> int option) Or_error.t
 (** [sendmsg_nonblocking_no_sigpipe sock ?count iovecs] sends
     [count] [iovecs] of bigstrings to socket [sock].  @return [Some
     bytes_written], or [None] if the operation would have blocked.

File base/core/lib/bigstring_marshal.ml

 INCLUDE "config.mlh"
-IFDEF LINUX_EXT THEN
 
 open Sexplib.Conv
 open Result.Export
     else next_pos
 ;;
 
-let marshal_to_sock ?buf ?flags sock v =
-  let buf, len =
-    match buf with
-    | None ->
-        let buf = marshal ?flags v in
-        buf, length buf
-    | Some buf -> buf, marshal_blit ?flags v buf
-  in
-  let f = Or_error.ok_exn really_send_no_sigpipe in
-  f sock buf ~len
-;;
-
 let unmarshal_from_sock ?buf sock =
   match buf with
   | None ->
       unsafe_unmarshal ~pos:0 ~len:all_len buf
 ;;
 
-let marshal             = Ok marshal
-let marshal_blit        = Ok marshal_blit
-let marshal_data_size   = Ok marshal_data_size
-let marshal_to_sock     = Ok marshal_to_sock
-let skip                = Ok skip
-let unmarshal           = Ok unmarshal
-let unmarshal_from_sock = Ok unmarshal_from_sock
-let unmarshal_next      = Ok unmarshal_next
+let marshal_to_gen ?buf ?flags dest v ~f =
+  let buf, len =
+    match buf with
+    | None ->
+        let buf = marshal ?flags v in
+        buf, length buf
+    | Some buf -> buf, marshal_blit ?flags v buf
+  in
+  f dest buf ~len
+;;
+
+let marshal_to_fd ?buf ?flags fd v =
+  marshal_to_gen ?buf ?flags fd v ~f:(fun fd buf ~len ->
+    Bigstring.really_write fd buf ~len)
+
+IFDEF LINUX_EXT THEN
+
+let marshal_to_sock_no_sigpipe ?buf ?flags fd v =
+  marshal_to_gen ?buf ?flags fd v ~f:(fun fd buf ~len ->
+    Bigstring.really_send_no_sigpipe fd buf ~len)
+
+let marshal_to_sock_no_sigpipe = Ok marshal_to_sock_no_sigpipe
 
 ELSE
 
 open Std_internal
 
-let marshal             = unimplemented "Bigstring_marshal.marshal"
-let marshal_blit        = unimplemented "Bigstring_marshal.marshal_blit"
-let marshal_data_size   = unimplemented "Bigstring_marshal.marshal_data_size"
-let marshal_to_sock     = unimplemented "Bigstring_marshal.marshal_to_sock"
-let skip                = unimplemented "Bigstring_marshal.skip"
-let unmarshal           = unimplemented "Bigstring_marshal.unmarshal"
-let unmarshal_from_sock = unimplemented "Bigstring_marshal.unmarshal_from_sock"
-let unmarshal_next      = unimplemented "Bigstring_marshal.unmarshal_next"
+let marshal_to_sock_no_sigpipe =
+  unimplemented "Bigstring_marshal.marshal_to_sock_no_sigpipe"
 
 ENDIF

File base/core/lib/bigstring_marshal.mli

     @param pos default = 0
     @param len default = [length buf - pos]
 *)
-val marshal_blit
-  :  (?flags : Marshal.extern_flags list
-      -> 'a
-      -> ?pos : int
-      -> ?len : int
-      -> t
-      -> int) Or_error.t
+val marshal_blit :
+  ?flags : Marshal.extern_flags list -> 'a ->
+  ?pos : int -> ?len : int -> t -> int
 
 (** [marshal ?flags v] marshals value [v] to a bigstring using marshalling
     flags [flags].  This function may need two times more memory than
 
     @param flags default = []
 *)
-val marshal : (?flags : Marshal.extern_flags list -> 'a -> t) Or_error.t
+val marshal : ?flags : Marshal.extern_flags list -> 'a -> t
 
 (** [marshal_data_size ?pos buf] @return the length of marshalled data in
     bigstring [buf] starting at position [pos].
 
     @param pos default = 0
 *)
-val marshal_data_size : (?pos : int -> t -> int) Or_error.t
+val marshal_data_size : ?pos : int -> t -> int
 
 (** [unmarshal ?pos buf] unmarshals data contained in [buf] starting
     at position [pos].
 
     @param pos default = 0
 *)
-val unmarshal : (?pos : int -> t -> 'a) Or_error.t
+val unmarshal : ?pos : int -> t -> 'a
 
 (** [unmarshal_next ?pos buf] unmarshals data contained in [buf] starting
     at position [pos].  @return [(v, next_pos)], where [v] is the
 
     @param pos default = 0
 *)
-val unmarshal_next : (?pos : int -> t -> 'a * int) Or_error.t
+val unmarshal_next : ?pos : int -> t -> 'a * int
 
 (** [skip ?pos buf] skips the marshalled data starting at position [pos].
     @return the start of the byte following the unmarshalled data.
 
     @param pos default = 0
 *)
-val skip : (?pos : int -> t -> int) Or_error.t
+val skip : ?pos : int -> t -> int
 
-(** [marshal_to_sock ?buf sock v] marshals data [v] to socket [sock]
+(** [marshal_to_fd ?buf fd v] marshals data [v] to file descriptor [fd]
     using marshalling buffer [buf], and marshalling flags [flags].
-    Raises input errors as in {!really_send_no_sigpipe_bigstring}.
+    Raises input errors as in {!Bigstring.really_write}.
 
     @raise Failure if [buf] cannot hold enough data for marshalling.
 
     @param flags default = []
     @param buf default = determined dynamically
 *)
-val marshal_to_sock
+val marshal_to_fd :
+  ?buf : t -> ?flags : Marshal.extern_flags list ->
+  Unix.file_descr -> 'a -> unit
+
+(** [marshal_to_sock_no_sigpipe ?buf sock v] same as {!marshal_to_fd}, but
+    writes to sockets only and uses {!Bigstring.really_send_no_sigpipe}
+    to avoid [SIGPIPE] on sockets. *)
+val marshal_to_sock_no_sigpipe
   : (?buf : t
      -> ?flags : Marshal.extern_flags list
      -> Unix.file_descr
 
 (** [unmarshal_from_sock ?buf sock] unmarshals data from socket [sock]
     using unmarshalling buffer [buf].  Raises input errors as in
-    {!really_recv_bigstring}.
+    {!Bigstring.really_recv}.
 
     @raise Failure if [buf] cannot hold enough data for unmarshalling.
 
     @param buf default = determined dynamically
 *)
-val unmarshal_from_sock : (?buf : t -> Unix.file_descr -> 'a) Or_error.t
-
+val unmarshal_from_sock : ?buf : t -> Unix.file_descr -> 'a

File base/core/lib/bigstring_marshal_stubs.c

-#include "config.h"
-#ifdef JSC_LINUX_EXT
-
 #include <string.h>
 #include <unistd.h>
 #include <errno.h>
 
 static inline char * get_bstr(value v_bstr, value v_pos)
 {
-  return (char *) Caml_ba_data_val(v_bstr) + Int_val(v_pos);
+  return (char *) Caml_ba_data_val(v_bstr) + Long_val(v_pos);
 }
 
 
   value v, value v_pos, value v_len, value v_bstr, value v_flags)
 {
   char *bstr = get_bstr(v_bstr, v_pos);
-  return Val_int(caml_output_value_to_block(v, v_flags, bstr, Int_val(v_len)));
+  return
+    Val_long(caml_output_value_to_block(v, v_flags, bstr, Long_val(v_len)));
 }
 
 extern CAMLprim void
   CAMLreturn(v_res);
 }
 
-extern CAMLprim value caml_input_value_from_block(char *buff, int len);
+extern CAMLprim value caml_input_value_from_block(char *buf, int len);
 
 CAMLprim value bigstring_unmarshal_stub(value v_pos, value v_len, value v_bstr)
 {
   CAMLparam1(v_bstr);
   char *bstr = get_bstr(v_bstr, v_pos);
-  value v_res = caml_input_value_from_block(bstr, Int_val(v_len));
+  value v_res = caml_input_value_from_block(bstr, Long_val(v_len));
   CAMLreturn(v_res);
 }
-
-#endif /* JSC_LINUX_EXT */

File base/core/oasis.sh

 function list_stubs {
     for stub in $(find "$HERE/lib" -name "*.[ch]" -exec basename \{\} \;); do
         case "${stub%%.[ch]}" in
-            linux_ext_stubs|bigstring_marshal_stubs)
+            linux_ext_stubs)
                 if [[ "$enable_linux" == "true" ]]; then echo "$stub"; fi;;
 	    backtrace_stubs)
 		if [[ "$(uname -p)" == "x86_64" ]]; then echo "$stub"; fi;;