← Back to branch summary

~ubuntu-branches/ubuntu/trusty/ocamlnet/trusty

« back to all changes in this revision

Viewing changes to src/netsys/netsys_oothr.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-09-02 14:12:33 UTC
  • mfrom: (18.2.3 sid)
  • Revision ID: james.westby@ubuntu.com-20110902141233-zbj0ygxb92u6gy4z
Tags: 3.4-1
http://bugs.debian.org/637147
* New upstream release
  - add a new NetcgiRequire directive to ease dependency management
    (Closes: #637147)
  - remove patches that were applied upstream:
    + Added-missing-shebang-lines-in-example-shell-scripts
    + Try-also-ocamlc-for-POSIX-threads

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/netsys/netsys_oothr.ml
 
1
(* $Id: netsys_oothr.ml 1529 2011-01-04 01:37:10Z gerd $ *)
 
2
 
 
3
class type mtprovider =
 
4
object
 
5
  method single_threaded : bool
 
6
  method create_thread : 's 't . ('s -> 't) -> 's -> thread
 
7
  method self : thread
 
8
  method yield : unit -> unit
 
9
  method create_mutex : unit -> mutex
 
10
  method create_condition : unit -> condition
 
11
end
 
12
 
 
13
and thread =
 
14
object
 
15
  method id : int
 
16
  method join : unit -> unit
 
17
  method repr : exn
 
18
end
 
19
 
 
20
and mutex =
 
21
object
 
22
  method lock : unit -> unit
 
23
  method unlock : unit -> unit
 
24
  method try_lock : unit -> bool
 
25
  method repr : exn
 
26
end
 
27
 
 
28
and condition =
 
29
object
 
30
  method wait : mutex -> unit
 
31
  method signal : unit -> unit
 
32
  method broadcast : unit -> unit
 
33
  method repr : exn
 
34
end
 
35
 
 
36
(* single-threaded dummy stuff: *)
 
37
 
 
38
exception Dummy
 
39
 
 
40
let stthread() : thread =
 
41
  ( object
 
42
      method id = 0
 
43
      method join() = 
 
44
        failwith "Netsys_oothr: join not possible in single-threaded program"
 
45
      method repr = Dummy
 
46
    end
 
47
  )
 
48
 
 
49
let stmutex() : mutex =
 
50
  ( object
 
51
      method lock() = ()
 
52
      method unlock() = ()
 
53
      method try_lock() = true
 
54
      method repr = Dummy
 
55
    end
 
56
  )
 
57
 
 
58
let stcondition() : condition =
 
59
  ( object
 
60
      method wait _ = ()
 
61
      method signal() = ()
 
62
      method broadcast() = ()
 
63
      method repr = Dummy
 
64
    end
 
65
  )
 
66
 
 
67
let stprovider : mtprovider =
 
68
  ( object
 
69
      method single_threaded = true
 
70
      method create_thread : 's 't . ('s -> 't) -> 's -> thread =
 
71
        fun _ _ -> failwith "Netsys_oothr: create_thread not possible in single-threaded program"
 
72
      method self = stthread()
 
73
      method yield() = ()
 
74
      method create_mutex() = stmutex()
 
75
      method create_condition() = stcondition()
 
76
    end
 
77
  )
 
78
 
 
79
let provider = ref stprovider
 
80
let single_threaded = ref false  (* whether we know this for sure *)
 
81
let st_init = ref false
 
82
 
 
83
let serialize  mutex f arg =
 
84
  if !single_threaded then (
 
85
    f arg
 
86
  )
 
87
  else (
 
88
    if not !st_init then (
 
89
      single_threaded := !provider # single_threaded;
 
90
      st_init := true
 
91
    );
 
92
    mutex # lock();
 
93
    let r = 
 
94
      try f arg
 
95
      with e -> mutex # unlock(); raise e in
 
96
    mutex # unlock();
 
97
    r
 
98
  )