File: netshm_hashtbl.ml

package info (click to toggle)
ocamlnet 4.1.2-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 51,764 kB
  • ctags: 16,446
  • sloc: ml: 148,419; ansic: 10,989; sh: 1,885; makefile: 1,355
file content (217 lines) | stat: -rw-r--r-- 4,791 bytes parent folder | download | duplicates (3)
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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
(* $Id$ *)

open Netshm
open Netshm_data

type ('a, 'b) t =
    { table : shm_table;
      key_only_manager : 'a data_manager;
      key_val_manager : ('a * 'b) data_manager;
      key_hash_fn : 'a -> int32;
    }

let manage ?pagesize ?init key_manager val_manager lm sd =
  let t = Netshm.manage ?pagesize ?init lm sd in
  let key_only_manager =
    left_pair_manager key_manager in
  let key_val_manager =
    pair_manager key_manager val_manager in
  { table = t;
    key_only_manager = key_only_manager;
    key_val_manager = key_val_manager;
    key_hash_fn = key_manager.hash_fn;
  }


let shm_table t = t.table


let add t k v =
  let h = t.key_hash_fn k in
  let kv_array = t.key_val_manager.to_int32_array (k,v) in
  Netshm.add t.table h kv_array
;;


let find t k =
  let decode_key =
    match t.key_only_manager.of_int32_array_prefix with
      | None -> assert false
      | Some f -> f in
  let h = t.key_hash_fn k in
  let data = ref [] in
  let v_opt = ref None in
  read_blocks t.table h
    (fun data_frag_opt ->
       match data_frag_opt with
         | Some data_frag ->
             data := data_frag :: !data;
	     ( match decode_key !data with
		 | None -> ()
		 | Some k' ->
		     if k <> k' then ( data := []; raise Netshm.Next )
	     )
         | None ->
             (* Important: we must decode the data while the binding is
              * read-locked!
              *)
	     let (k',v) = t.key_val_manager.of_int32_array !data in
	     assert (k = k');
	     v_opt := Some v;
	     raise Netshm.Break
    );
  ( match !v_opt with
      | None -> raise Not_found
      | Some v -> v
  )
;;


let find_all t k =
  let decode_key =
    match t.key_only_manager.of_int32_array_prefix with
      | None -> assert false
      | Some f -> f in
  let h = t.key_hash_fn k in
  let data = ref [] in
  let l = ref [] in
  read_blocks t.table h
    (fun data_frag_opt ->
       match data_frag_opt with
         | Some data_frag ->
             data := data_frag :: !data;
	     ( match decode_key !data with
		 | None -> ()
		 | Some k' ->
		     if k <> k' then ( data := []; raise Netshm.Next )
	     )
         | None ->
             (* Important: we must decode the data while the binding is
              * read-locked!
              *)
	     let (k',v) = t.key_val_manager.of_int32_array !data in
	     assert (k = k');
	     l := v :: !l;
	     data := []
    );
  List.rev !l
;;


let mem t k =
  let decode_key =
    match t.key_only_manager.of_int32_array_prefix with
      | None -> assert false
      | Some f -> f in
  let h = t.key_hash_fn k in
  let data = ref [] in
  let is_mem = ref false in
  read_blocks t.table h
    (fun data_frag_opt ->
       match data_frag_opt with
         | Some data_frag ->
             data := data_frag :: !data;
	     ( match decode_key !data with
		 | None -> ()
		 | Some k' ->
		     if k <> k' then ( data := []; raise Netshm.Next )
	     )
         | None ->
	     is_mem := true;
	     raise Netshm.Break
    );
  !is_mem
;;


let remove t k =
  let decode_key =
    match t.key_only_manager.of_int32_array_prefix with
      | None -> assert false
      | Some f -> f in
  let h = t.key_hash_fn k in
  let data = ref [] in
  let can_stop = ref false in
  write_blocks t.table [`Remove_binding] h
    (fun data_frag_opt ->
       if !can_stop then raise Break;
       match data_frag_opt with
         | Some data_frag ->
             data := data_frag :: !data;
	     ( match decode_key !data with
		 | None -> 
		     `Nop
		 | Some k' ->
		     if k <> k' then ( data := []; raise Netshm.Next );
		     can_stop := true;
		     `Remove_binding
	     )
         | None ->
	     assert false
    )
;;


let replace t k v =
  Netshm.group t.table
    (fun () ->
       remove t k;
       add t k v
    ) 
    ()


let iter f t =
  Netshm.iter
    (fun _ data ->
       let (k,v) = t.key_val_manager.of_int32_array [ data ] in
       f k v
    )
    t.table
;;


let iter_keys f t =
  let decode_key =
    match t.key_only_manager.of_int32_array_prefix with
      | None -> assert false
      | Some f -> f in
  let last_key = ref None in
  let data = ref [] in
  Netshm.iter_keys
    (fun shm_key ->
       Netshm.read_blocks
	 t.table
	 shm_key
	 (fun data_frag_opt ->
	    match data_frag_opt with
              | Some data_frag ->
		  data := data_frag :: !data;
		  ( match decode_key !data with
		      | None -> ()
		      | Some k as sk ->
			  if sk <> !last_key then
			    f k;
			  last_key := sk;
			  data := [];
			  raise Netshm.Next
		  )
              | None ->
		  ()
	 );
    )
    t.table
;;


let fold f t x0 =
  Netshm.fold
    (fun _ data acc ->
       let (k,v) = t.key_val_manager.of_int32_array [ data ] in
       f k v acc)
    t.table
    x0
;;


let length t = Netshm.length t.table