Source file IntArray.ml

# 1 "IntArray.cppo.ml"
(******************************************************************************)
(*                                                                            *)
(*                                   Hector                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

# 1 "Loop.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                   Hector                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* An ordinary loop, from [start] (included) to [finish] (excluded).
   The loop index is named [i], and can be used in the loop [body]. *)


# 22 "Loop.frag.ml"
(* An unrolled loop, with the same semantics. The loop is unrolled
   five times. *)

(* Unrolling a loop five times lets us avoid a bizarre slowness that
   we have observed on arm64 processors, including Apple M1 and M2;
   see https://github.com/ocaml/ocaml/issues/13262 *)


# 49 "Loop.frag.ml"
(* An ordinary loop, from [start] (included) to [finish] (excluded).
   The loop index is named [i], and can be used in the loop body. The
   loop body is of the form [let data = read in write]. We assume that
   the iterations are independent (this is a parallel loop), so a read
   in one iteration commutes with the write in a previous iteration. *)


# 61 "Loop.frag.ml"
(* An unrolled loop, with the same semantics. The loop is unrolled five times.
   We schedule the five reads before the five writes, in the hope of reducing
   the latency caused by load instructions and (perhaps) allowing the compiler
   to merge several memory barriers into one. *)


# 91 "Loop.frag.ml"
(* An ordinary loop, from [finish] (excluded) down to [start] (included).
   The loop index is named [i], and can be used in the loop [body]. *)

# 1 "ValidateSegment.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                   Hector                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* -------------------------------------------------------------------------- *)

(**[validate_segment n ofs len] checks that the offset [ofs] and the
   length [len] determine a valid interval inside an array or vector of
   length [n]. *)

let[@inline never] invalid_segment n ofs len =
  Printf.ksprintf invalid_arg
    "invalid segment (ofs = %d, len = %d) in a sequence of length %d"
    ofs len n

let[@inline] validate_segment n ofs len =
  if not (0 <= len && 0 <= ofs && ofs + len <= n) then
    invalid_segment n ofs len
  
# 15 "IntArray.cppo.ml"
  (* needed by MonoArray.frag.ml *)

(* Our implementation of integer arrays is compiled by the OCaml compiler with
   the knowledge that elements have type [int]. As a result, we get better
   machine code. In particular, when reading and writing arrays, the special
   case of floating-point arrays (tagged 254) disappears; and when writing
   arrays, the write barrier (_caml_modify) vanishes. *)

(* -------------------------------------------------------------------------- *)

(* Types. *)

type element = int
type dummy = element
type t = element array
type length = int
type index = int
type offset = int

(* -------------------------------------------------------------------------- *)

(* [unsafe_fill_bytes b o n c] fills the buffer [b], at offset [o], with [n]
   copies of the character [c]. It is implemented in runtime/str.c as a call
   to [memset]. *)

external unsafe_fill_bytes :
  Bytes.t ->
  (* offset in bytes: *) int  ->
  (* length in bytes: *) int  ->
  (* value:           *) char ->
  unit = "caml_fill_bytes" [@@noalloc]

(* [unsafe_initialize_int_array_segment a o n] initializes the array segment
   determined by array [a], offset [o], and length [n], with arbitrary (valid)
   integer values. *)

let unsafe_initialize_int_array_segment (a : int array) (o : int) (n : int) =
  (* Translate offset and length into bytes. *)
  let o = o * (Sys.word_size / 8) in
  let n = n * (Sys.word_size / 8) in
  (* Fill the array with odd bytes, which are valid integers. *)
  unsafe_fill_bytes (Obj.magic a) o n '\001'

(* -------------------------------------------------------------------------- *)

(* Allocation: [empty], [alloc], and [make]. *)

let empty =
  [||]

(* Instead of [Array.make], we use an unorthodox method to allocate a custom
   block, which the garbage collector does not scan, and disguise it as an
   integer array. The arrays slots are uninitialized; they may contain
   arbitrary data. *)

let alloc (n : length) (_dummy : element) : t =
  assert (0 <= n);
  (* Allocate an uninitialized memory block, which the GC does not scan. *)
  let a = Obj.new_block Obj.abstract_tag n in
  (* Cast it to the type [int array]. *)
  let a : int array = Obj.obj a in
  (* Initialize it. *)
  (* We cannot use [Array.fill], as it can (in some circumstances) read and
     interpret the previous content of the array. A simple loop would work,
     but would be a bit slow (not vectorized; with a safe point). [memset]
     is faster. *)
  unsafe_initialize_int_array_segment a 0 n;
  (* Done. *)
  a

let make (n : length) (x : element) : t =
  assert (0 <= n);
  (* Allocate an uninitialized memory block, which the GC does not scan. *)
  let a = Obj.new_block Obj.abstract_tag n in
  (* Cast it to the type [int array]. *)
  let a : int array = Obj.obj a in
  (* Initialize it. *)
  (* As above, we cannot use [Array.fill]. There is no [memset64] in C.
     So, we use a loop. *)
  
# 94 "IntArray.cppo.ml"
   (
  let __finish = ( n) in
  let __index = ref ( 0) in
  let __limit = __finish - 5 in
  while !__index <= __limit do
    let __this = !__index in
    (let i = __this + 0 in  Array.unsafe_set a i x (* safe *));
    (let i = __this + 1 in  Array.unsafe_set a i x (* safe *));
    (let i = __this + 2 in  Array.unsafe_set a i x (* safe *));
    (let i = __this + 3 in  Array.unsafe_set a i x (* safe *));
    (let i = __this + 4 in  Array.unsafe_set a i x (* safe *));
    __index := __this + 5
  done;
  let __finish = __limit + 5 in
  while !__index < __finish do
    (let i = !__index + 0 in  Array.unsafe_set a i x (* safe *));
    __index := !__index + 1
  done
) 
# 94 "IntArray.cppo.ml"
                                                   ;
  (* Done. *)
  a

(* -------------------------------------------------------------------------- *)

(* Then comes our implementation of monomorphic arrays. *)

(* #defining IMMEDIATE tells MonoArray that we are dealing with an immediate
   type, that is, a non-pointer type. *)


# 1 "MonoArray.frag.ml"
(******************************************************************************)
(*                                                                            *)
(*                                   Hector                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*                                                                            *)
(*       Copyright 2024--2024 Inria. All rights reserved. This file is        *)
(*       distributed under the terms of the GNU Library General Public        *)
(*       License, with an exception, as described in the file LICENSE.        *)
(*                                                                            *)
(******************************************************************************)

(* This file implements several functions on arrays, based on [alloc],
   [unsafe_get], and [unsafe_set]. We also need the empty array, [empty]. *)

(* We ensure that [alloc] is the only function that constructs arrays.
   This allows the user to provide exotic (and possibly unorthodox)
   array construction methods. *)

(* -------------------------------------------------------------------------- *)

(* [length], [unsafe_get], [unsafe_set] are taken from [Stdlib.Array]. *)

(* Type annotations ensure that we perform monomorphic
   array accesses only. (These produce better code.) *)

let length =
  Array.length

let[@inline] unsafe_get (a : t) i =
  Array.unsafe_get a i

let[@inline] unsafe_set (a : t) i x =
  Array.unsafe_set a i x

(* -------------------------------------------------------------------------- *)

(* [blit]. *)


# 42 "MonoArray.frag.ml"
(* If the type [element] is immediate (i.e., not a pointer type) then
   [memmove] can be used. *)

(* In the case of integer arrays, [memmove] can be 4 times faster than
   hand-written loop, and 12 times faster than [Array.blit]. *)

external unsafe_blit :
  int array -> int ->
  int array -> int ->
  int ->
  unit
= "hector_array_blit"

let blit (src : t) sofs dst dofs n =
  validate_segment (length src) sofs n;
  validate_segment (length dst) dofs n;
  unsafe_blit src sofs dst dofs n


# 75 "MonoArray.frag.ml"
(* -------------------------------------------------------------------------- *)

(* We implement [init] and [sub] using [alloc], so that [alloc] is our
   single factory function for arrays. *)

let init n f =
  assert (0 <= n);
  if n = 0 then empty else
  let x = f 0 in
  let a = alloc n x in
  unsafe_set a 0 x; (* safe *)
  
# 86 "MonoArray.frag.ml"
   (
  let __finish = ( n) in
  let __index = ref ( 1) in
  let __limit = __finish - 5 in
  while !__index <= __limit do
    let __this = !__index in
    (let i = __this + 0 in  unsafe_set a i (f i) (* safe *));
    (let i = __this + 1 in  unsafe_set a i (f i) (* safe *));
    (let i = __this + 2 in  unsafe_set a i (f i) (* safe *));
    (let i = __this + 3 in  unsafe_set a i (f i) (* safe *));
    (let i = __this + 4 in  unsafe_set a i (f i) (* safe *));
    __index := __this + 5
  done;
  let __finish = __limit + 5 in
  while !__index < __finish do
    (let i = !__index + 0 in  unsafe_set a i (f i) (* safe *));
    __index := !__index + 1
  done
) 
# 86 "MonoArray.frag.ml"
                                                 ;
  a

(* [sub a o n] is equivalent to [init n (fun i -> A.get a (o + i))]. *)

let sub a o n =
  validate_segment (length a) o n;
  if n = 0 then empty else
  let dummy = unsafe_get a o in (* safe *)
  let a' = alloc n dummy in
  blit a o a' 0 n;
  a'

(* [copy] is a special case of [sub]. *)

let[@inline] copy a =
  sub a 0 (length a)

(* -------------------------------------------------------------------------- *)

(* [fill] is taken from [Stdlib.Array]. *)

(* Because there is no word-sized variant of [memset] in C, we cannot
   implement [fill] in a more efficient way, even when IMMEDIATE is
   #defined. *)

let[@inline] fill (a : t) o k x =
  Array.fill a o k x

# 109 "IntArray.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* [grow] allocates a semi-initialized array. *)

(* Of course, [grow] can always be implemented by a combination of [alloc]
   and [blit]. Our implementation (below) can in theory be more efficient,
   as the lower segment is written just once, instead of twice. In practice,
   we observe that it yields only a 1% performance improvement on the [push]
   benchmark. *)

let grow (n : length) (_dummy : element) (s : t) (k : length) : t =
  assert (0 <= k && k <= n);
  (* Allocate an uninitialized memory block, which the GC does not scan. *)
  let a = Obj.new_block Obj.abstract_tag n in
  (* Cast it to the type [int array]. *)
  let a : int array = Obj.obj a in
  (* Initialize the lower segment by copying data from [s]. *)
  unsafe_blit s 0 a 0 k;
  (* Initialize the upper segment with arbitrary integer values. *)
  unsafe_initialize_int_array_segment a k (n - k);
  (* Done. *)
  a