File: threadUnix.ml

package info (click to toggle)
ocaml 3.12.1-4
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 25,412 kB
  • sloc: ml: 245,686; ansic: 39,092; sh: 5,924; asm: 5,371; lisp: 4,963; makefile: 3,150; perl: 82; fortran: 21; sed: 19; cs: 9; tcl: 2
file content (61 lines) | stat: -rw-r--r-- 2,409 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
(*                                                                     *)
(*  Copyright 1996 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.  *)
(*                                                                     *)
(***********************************************************************)

(* $Id: threadUnix.ml 6553 2004-07-13 12:25:21Z xleroy $ *)

(* Module [ThreadUnix]: thread-compatible system calls *)

let execv = Unix.execv
let execve = Unix.execve
let execvp = Unix.execvp
let wait = Unix.wait
let waitpid = Unix.waitpid
let system = Unix.system
let read = Unix.read
let write = Unix.write
let single_write = Unix.single_write
let select = Unix.select
let pipe = Unix.pipe
let open_process_in = Unix.open_process_in
let open_process_out = Unix.open_process_out
let open_process = Unix.open_process
let open_process_full = Unix.open_process_full
let sleep = Unix.sleep
let socket = Unix.socket
let socketpair = Unix.socketpair
let accept = Unix.accept
let connect = Unix.connect
let recv = Unix.recv
let recvfrom = Unix.recvfrom
let send = Unix.send
let sendto = Unix.sendto
let open_connection = Unix.open_connection
let establish_server = Unix.establish_server

open Unix

let rec timed_read fd buff ofs len timeout =
  if Thread.wait_timed_read fd timeout
  then begin try Unix.read fd buff ofs len
             with Unix_error((EAGAIN | EWOULDBLOCK), _, _) ->
                    timed_read fd buff ofs len timeout
       end
  else raise (Unix_error(ETIMEDOUT, "timed_read", ""))

let rec timed_write fd buff ofs len timeout =
  if Thread.wait_timed_write fd timeout
  then begin try Unix.write fd buff ofs len
             with Unix_error((EAGAIN | EWOULDBLOCK), _, _) ->
                    timed_write fd buff ofs len timeout
       end
  else raise (Unix_error(ETIMEDOUT, "timed_write", ""))