Source file Tools.ml

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
(******************************************************************************
 * Mathias Bourgoin, Université Pierre et Marie Curie (2011)
 *
 * Mathias.Bourgoin@gmail.com
 *
 * This software is a computer program whose purpose is to allow
 * GPU programming with the OCaml language.
 *
 * This software is governed by the CeCILL-B license under French law and
 * abiding by the rules of distribution of free software.  You can  use, 
 * modify and/ or redistribute the software under the terms of the CeCILL-B
 * license as circulated by CEA, CNRS and INRIA at the following URL
 * "http://www.cecill.info". 
 * 
 * As a counterpart to the access to the source code and  rights to copy,
 * modify and redistribute granted by the license, users are provided only
 * with a limited warranty  and the software's author,  the holder of the
 * economic rights,  and the successive licensors  have only  limited
 * liability. 
 * 
 * In this respect, the user's attention is drawn to the risks associated
 * with loading,  using,  modifying and/or developing or reproducing the
 * software by the user in light of its specific status of free software,
 * that may mean  that it is complicated to manipulate,  and  that  also
 * therefore means  that it is reserved for developers  and  experienced
 * professionals having in-depth computer knowledge. Users are therefore
 * encouraged to load and test the software's suitability as regards their
 * requirements in conditions enabling the security of their systems and/or 
 * data to be ensured and,  more generally, to use and operate it in the 
 * same conditions as regards security. 
 * 
 * The fact that you are presently reading this means that you have had
 * knowledge of the CeCILL-B license and that you accept its terms.
 *******************************************************************************)
external sizeofbool : unit -> int = "custom_getsizeofbool"

external boolget : Vector.customarray -> int -> bool = "custom_boolget"

external boolset : Vector.customarray -> int -> bool -> unit = "custom_boolset"

let print s =
  Printf.printf "%s\n" (string_of_int s) ;
  flush stdout

let iter f vect =
  ( match Vector.dev vect with
  | Vector.No_dev -> ()
  | Vector.Dev d | Vector.Transferring d ->
      Devices.flush d ~queue_id:0 () ;
      Devices.flush d ~queue_id:1 () ;
      Mem.to_cpu vect () ;
      Devices.flush d ~queue_id:0 () ) ;
  for idx = 0 to Vector.length vect - 1 do
    f (Mem.unsafe_get vect idx)
  done

let iteri f vect =
  ( match Vector.dev vect with
  | Vector.No_dev -> ()
  | Vector.Dev d | Vector.Transferring d ->
      Devices.flush d ~queue_id:0 () ;
      Devices.flush d ~queue_id:1 () ;
      Mem.to_cpu vect () ;
      Devices.flush d ~queue_id:0 () ) ;
  for idx = 0 to Vector.length vect - 1 do
    f (Mem.unsafe_get vect idx) idx
  done

let map f kind vect =
  ( match Vector.dev vect with
  | Vector.No_dev -> ()
  | Vector.Dev d | Vector.Transferring d ->
      Devices.flush d ~queue_id:0 () ;
      Devices.flush d ~queue_id:1 () ;
      Mem.to_cpu vect () ;
      Devices.flush d ~queue_id:0 () ) ;
  let newvect = Vector.create kind (Vector.length vect) in
  for i = 0 to Vector.length vect - 1 do
    Mem.unsafe_set newvect i (f (Mem.unsafe_get vect i))
  done ;
  newvect

let trueCustom =
  {Vector.size= sizeofbool () ; Vector.get= boolget ; Vector.set= boolset}

let falseCustom =
  {Vector.size= sizeofbool () ; Vector.get= boolget ; Vector.set= boolset}

let fold_left f seed vect =
  ( match Vector.dev vect with
  | Vector.No_dev -> ()
  | Vector.Dev d | Vector.Transferring d ->
      Devices.flush d ~queue_id:0 () ;
      Devices.flush d ~queue_id:1 () ;
      Mem.to_cpu vect () ;
      Devices.flush d ~queue_id:0 () ) ;
  let s = ref seed in
  for i = 0 to Vector.length vect - 1 do
    s := f !s (Mem.unsafe_get vect i)
  done ;
  !s

let fold_right f vect seed =
  ( match Vector.dev vect with
  | Vector.No_dev -> ()
  | Vector.Dev d | Vector.Transferring d ->
      Devices.flush d ~queue_id:0 () ;
      Devices.flush d ~queue_id:1 () ;
      Mem.to_cpu vect () ;
      Devices.flush d ~queue_id:0 () ) ;
  let s = ref seed in
  for i = Vector.length vect - 1 downto 0 do
    s := f (Mem.unsafe_get vect i) !s
  done ;
  !s

let vfalse = Vector.Custom trueCustom

let vtrue = Vector.Custom falseCustom

let spoc_bool = vfalse