thread-table-1.0.0/0000755000175000017500000000000014707246100012537 5ustar kylekylethread-table-1.0.0/update-gh-pages-for-tag0000755000175000017500000000257514466130725017015 0ustar kylekyle#!/bin/bash set -xeuo pipefail TMP=tmp NAME=thread-table MAIN=doc GIT="git@github.com:ocaml-multicore/$NAME.git" DOC="_build/default/_doc/_html" GH_PAGES=gh-pages TAG="$1" if ! [ -e $NAME.opam ] || [ $# -ne 1 ] || \ { [ "$TAG" != main ] && ! [ "$(git tag -l "$TAG")" ]; }; then CMD="${0##*/}" cat << EOF Usage: $CMD tag-name-or-main This script - clones the repository into a temporary directory ($TMP/$NAME), - builds the documentation for the specified tag or main, - updates $GH_PAGES branch with the documentation in directory for the tag, - prompts whether to also update the main documentation in $MAIN directory, and - prompts whether to push changes to $GH_PAGES. EOF exit 1 fi mkdir $TMP cd $TMP git clone $GIT cd $NAME git checkout "$TAG" dune build @doc --root=. git checkout $GH_PAGES if [ "$TAG" != main ]; then echo "Updating the $TAG doc." if [ -e "$TAG" ]; then git rm -rf "$TAG" fi cp -r $DOC "$TAG" git add "$TAG" fi read -p "Update the main doc? (y/N) " -n 1 -r echo if [[ $REPLY =~ ^[Yy]$ ]]; then if [ -e $MAIN ]; then git rm -rf $MAIN fi cp -r $DOC $MAIN git add $MAIN else echo "Skipped main doc update." fi git commit -m "Update $NAME doc for $TAG" read -p "Push changes to $GH_PAGES? (y/N) " -n 1 -r echo if ! [[ $REPLY =~ ^[Yy]$ ]]; then echo "Leaving $TMP for you to examine." exit 1 fi git push cd .. cd .. rm -rf $TMP thread-table-1.0.0/src/0000755000175000017500000000000014466130725013335 5ustar kylekylethread-table-1.0.0/src/mix.32.ml0000644000175000017500000000066214466130725014713 0ustar kylekyle(* Mixing function proposed by "TheIronBorn" in a Github issue https://github.com/skeeto/hash-prospector/issues/19 in the repository of Hash Prospector by Chris Wellons. Note that the mixing function was originally designed for 32-bit unsigned integers. *) let[@inline] int x = let x = x lxor (x lsr 16) in let x = x * 0x21f0aaad in let x = x lxor (x lsr 15) in let x = x * 0x735a2d97 in x lxor (x lsr 15) thread-table-1.0.0/src/mix.64.ml0000644000175000017500000000054614466130725014721 0ustar kylekyle(* Mixing function proposed by Jon Maiga: https://jonkagstrom.com/mx3/mx3_rev2.html Note that the mixing function was originally designed for 64-bit unsigned integers. *) let[@inline] int x = let x = x lxor (x lsr 32) in let x = x * 0xe9846af9b1a615d in let x = x lxor (x lsr 32) in let x = x * 0xe9846af9b1a615d in x lxor (x lsr 28) thread-table-1.0.0/src/thread_table.ml0000644000175000017500000001170514466130725016311 0ustar kylekyletype 'v bucket = Nil | Cons of int * 'v * 'v bucket type 'v t = { mutable rehash : int; mutable buckets : 'v bucket array; mutable length : int; } let[@tail_mod_cons] rec remove_first removed k' = function | Nil -> Nil | Cons (k, v, kvs) -> if k == k' then begin removed := true; kvs end else Cons (k, v, remove_first removed k' kvs) let[@inline] remove_first removed k' = function | Nil -> Nil | Cons (k, v, kvs) -> if k == k' then begin removed := true; kvs end else Cons (k, v, remove_first removed k' kvs) let rec find k' = function | Nil -> raise_notrace Not_found | Cons (k, v, kvs) -> if k == k' then v else find k' kvs let[@tail_mod_cons] rec filter bit chk = function | Nil -> Nil | Cons (k, v, kvs) -> if Mix.int k land bit = chk then Cons (k, v, filter bit chk kvs) else filter bit chk kvs let[@inline] filter bit chk = function | Nil -> Nil | Cons (k, _, Nil) as kvs -> if Mix.int k land bit = chk then kvs else Nil | Cons (k, v, kvs) -> if Mix.int k land bit = chk then Cons (k, v, filter bit chk kvs) else filter bit chk kvs let[@tail_mod_cons] rec append kvs tail = match kvs with Nil -> tail | Cons (k, v, kvs) -> Cons (k, v, append kvs tail) let[@inline] append kvs tail = match kvs with Nil -> tail | Cons (k, v, kvs) -> Cons (k, v, append kvs tail) let min_buckets = 4 and max_buckets_div_2 = (Sys.max_array_length + 1) asr 1 let create () = { rehash = 0; buckets = Array.make min_buckets Nil; length = 0 } let length t = t.length let find t k' = let h = Mix.int k' in let buckets = t.buckets in let n = Array.length buckets in let i = h land (n - 1) in find k' (Array.unsafe_get buckets i) (* Below we use [@poll error] and [@inline never] to ensure that there are no safe-points where thread switches might occur during critical sections. *) let[@poll error] [@inline never] update_buckets_atomically t old_buckets new_buckets = t.buckets == old_buckets && begin t.buckets <- new_buckets; t.rehash <- 0; true end let rec maybe_rehash t = let old_buckets = t.buckets in let new_n = t.rehash in if new_n <> 0 then let old_n = Array.length old_buckets in let new_buckets = Array.make new_n Nil in if old_n * 2 = new_n then let new_bit = new_n lsr 1 in let rec loop i = if t.buckets == old_buckets then if old_n <= i then begin if not (update_buckets_atomically t old_buckets new_buckets) then maybe_rehash t end else begin let kvs = Array.unsafe_get old_buckets i in Array.unsafe_set new_buckets i (filter new_bit 0 kvs); Array.unsafe_set new_buckets (i lor new_bit) (filter new_bit new_bit kvs); loop (i + 1) end else maybe_rehash t in loop 0 else if old_n = new_n * 2 then let old_bit = old_n lsr 1 in let rec loop i = if t.buckets == old_buckets then if new_n <= i then begin if not (update_buckets_atomically t old_buckets new_buckets) then maybe_rehash t end else begin Array.unsafe_set new_buckets i (append (Array.unsafe_get old_buckets (i + old_bit)) (Array.unsafe_get old_buckets i)); loop (i + 1) end else maybe_rehash t in loop 0 else maybe_rehash t let[@inline] maybe_rehash t = if t.rehash <> 0 then maybe_rehash t let[@poll error] [@inline never] add_atomically t buckets n i before after = t.rehash = 0 && buckets == t.buckets && before == Array.unsafe_get buckets i && begin Array.unsafe_set buckets i after; let length = t.length + 1 in t.length <- length; if n < length && n < max_buckets_div_2 then t.rehash <- n * 2; true end let rec add t k' v' = let h = Mix.int k' in maybe_rehash t; let buckets = t.buckets in let n = Array.length buckets in let i = h land (n - 1) in let before = Array.unsafe_get buckets i in let after = Cons (k', v', before) in if not (add_atomically t buckets n i before after) then add t k' v' let[@poll error] [@inline never] remove_atomically t buckets n i before after removed = t.rehash = 0 && buckets == t.buckets && before == Array.unsafe_get buckets i && ((not !removed) || begin Array.unsafe_set buckets i after; let length = t.length - 1 in t.length <- length; if length * 4 < n && min_buckets < n then t.rehash <- n asr 1; true end) let rec remove t k' = let h = Mix.int k' in let removed = ref false in maybe_rehash t; let buckets = t.buckets in let n = Array.length buckets in let i = h land (n - 1) in let before = Array.unsafe_get buckets i in let after = remove_first removed k' before in if not (remove_atomically t buckets n i before after removed) then remove t k' thread-table-1.0.0/src/thread_table.mli0000644000175000017500000000237614466130725016466 0ustar kylekyle(** A lock-free thread-safe [int]eger keyed hash table. This is designed for associating thread specific state with threads within a domain. ⚠️ This is not {i parallelism-safe} — only {i thread-safe} within a single domain. *) type 'v t (** A lock-free thread-safe [int]eger keyed hash table. *) val create : unit -> 'v t (** [create ()] returns a new lock-free thread-safe [int]eger keyed hash table. The hash table is automatically resized. *) val length : 'v t -> int (** [length t] returns the number of {i bindings} in the hash table [t]. ⚠️ The returned value may be greater than the number of {i distinct keys} in the hash table. *) val find : 'v t -> int -> 'v (** [find t k] returns the current binding of [k] in hash table [t], or raises [Not_found] if no such binding exists. ⚠️ This may use [raise_notrace] for performance reasons. *) val add : 'v t -> int -> 'v -> unit (** [add t k v] adds a binding of key [k] to value [v] to the hash table shadowing the previous binding of the key [k], if any. *) val remove : 'v t -> int -> unit (** [remove t k] removes the most recent existing binding of key [k], if any, from the hash table [t] thereby revealing the earlier binding of [k], if any. *) thread-table-1.0.0/src/dune0000644000175000017500000000047114466130725014215 0ustar kylekyle(library (name Thread_table) (public_name thread-table)) (rule (targets mix.ml) (deps mix.64.ml) (enabled_if %{arch_sixtyfour}) (action (progn (copy mix.64.ml mix.ml)))) (rule (targets mix.ml) (deps mix.32.ml) (enabled_if (not %{arch_sixtyfour})) (action (progn (copy mix.32.ml mix.ml)))) thread-table-1.0.0/README.md0000644000175000017500000000071014466130725014023 0ustar kylekyle[API reference](https://ocaml-multicore.github.io/thread-table/doc/thread-table/Thread_table/index.html) # **thread-table** — A lock-free thread-safe integer keyed hash table A minimalist lock-free thread-safe integer keyed hash table with zero synchronization overhead on lookups designed for associating thread specific state with threads within a domain. ⚠️ This is not _parallelism-safe_ — only _thread-safe_ within a single domain. thread-table-1.0.0/dune-project0000644000175000017500000000123614466130725015072 0ustar kylekyle(lang dune 3.3) (name thread-table) (version 1.0.0) (generate_opam_files true) (source (github ocaml-multicore/thread-table)) (authors "Vesa Karvonen ") (maintainers "Vesa Karvonen ") (homepage "https://github.com/ocaml-multicore/thread-table") (license "ISC") (package (name thread-table) (synopsis "A lock-free thread-safe integer keyed hash table") (description "A minimalist lock-free thread-safe integer keyed hash table with zero synchronization overhead on lookups designed for associating thread specific state with threads within a domain.") (depends (ocaml (>= 4.08)) (alcotest (and (>= 1.7.0) :with-test)))) thread-table-1.0.0/.ocamlformat0000644000175000017500000000007214466130725015052 0ustar kylekyleprofile = default version = 0.26.0 exp-grouping=preserve thread-table-1.0.0/LICENSE.md0000644000175000017500000000133214466130725014151 0ustar kylekyleCopyright © 2023 Vesa Karvonen Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. thread-table-1.0.0/.prettierrc0000644000175000017500000000021514466130725014730 0ustar kylekyle{ "arrowParens": "avoid", "bracketSpacing": false, "printWidth": 80, "semi": false, "singleQuote": true, "proseWrap": "always" } thread-table-1.0.0/.gitignore0000644000175000017500000000000714466130725014533 0ustar kylekyle_build thread-table-1.0.0/thread-table.opam0000644000175000017500000000167114466130725015765 0ustar kylekyleversion: "1.0.0" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "A lock-free thread-safe integer keyed hash table" description: "A minimalist lock-free thread-safe integer keyed hash table with zero synchronization overhead on lookups designed for associating thread specific state with threads within a domain." maintainer: ["Vesa Karvonen "] authors: ["Vesa Karvonen "] license: "ISC" homepage: "https://github.com/ocaml-multicore/thread-table" bug-reports: "https://github.com/ocaml-multicore/thread-table/issues" depends: [ "dune" {>= "3.3"} "ocaml" {>= "4.08"} "alcotest" {>= "1.7.0" & with-test} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/ocaml-multicore/thread-table.git"thread-table-1.0.0/test/0000755000175000017500000000000014466130725013525 5ustar kylekylethread-table-1.0.0/test/test.ml0000644000175000017500000000235714466130725015045 0ustar kylekylelet basics () = let n_threads = 10 in let n_items_per_thread = 100_000 in let t = Thread_table.create () in let threads = Array.init n_threads @@ fun i -> () |> Thread.create @@ fun () -> for i = i * n_items_per_thread to ((i + 1) * n_items_per_thread) - 1 do Thread_table.add t i (-i) done in Array.iter Thread.join threads; Alcotest.check' ~msg:"length" Alcotest.int ~expected:(n_threads * n_items_per_thread) ~actual:(Thread_table.length t); for i = 0 to (n_threads * n_items_per_thread) - 1 do if Thread_table.find t i <> -i then raise Not_found done; let threads = Array.init n_threads @@ fun i -> () |> Thread.create @@ fun () -> for i = ((i + 1) * n_items_per_thread) - 1 downto i * n_items_per_thread do Thread_table.remove t i done in Array.iter Thread.join threads; for i = 0 to (n_threads * n_items_per_thread) - 1 do match Thread_table.find t i with | _ -> raise Not_found | exception Not_found -> () done; Alcotest.check' ~msg:"length" Alcotest.int ~expected:0 ~actual:(Thread_table.length t); () let () = Alcotest.run "Thread_table" [ ("basics", [ Alcotest.test_case "" `Quick basics ]) ] thread-table-1.0.0/test/dune0000644000175000017500000000011714466130725014402 0ustar kylekyle(test (name test) (modules test) (libraries thread-table threads alcotest)) thread-table-1.0.0/HACKING.md0000644000175000017500000000064714466130725014143 0ustar kylekyle### Formatting This project uses [ocamlformat](https://github.com/ocaml-ppx/ocamlformat) (for OCaml) and [prettier](https://prettier.io/) (for Markdown). ### To make a new release 1. Update [CHANGES.md](CHANGES.md). 2. Run `dune-release tag VERSION` to create a tag for the new `VERSION`. 3. Run `dune-release` to publish the new `VERSION`. 4. Run `./update-gh-pages-for-tag VERSION` to update the online documentation. thread-table-1.0.0/CHANGES.md0000644000175000017500000000061514466130725014142 0ustar kylekyle# Release notes All notable changes to this project will be documented in this file. ## 1.0.0 - Use `inline never` for atomicity on old compilers (@polytypic) - Use bit mixing (@polytypic) - Change `find` to use `raise_notrace` for performance (@polytypic) - Change license to ISC from 0BSD (@tarides) ## 0.1.0 - Initial version of lock-free thread-safe integer keyed hash table (@polytypic) thread-table-1.0.0/.github/0000755000175000017500000000000014466130725014106 5ustar kylekylethread-table-1.0.0/.github/workflows/0000755000175000017500000000000014466130725016143 5ustar kylekylethread-table-1.0.0/.github/workflows/workflow.yml0000644000175000017500000000143314466130725020541 0ustar kylekylename: build-and-test on: pull_request: push: branches: - main jobs: build-windows: runs-on: windows-latest steps: - name: Checkout code uses: actions/checkout@v3 - name: Set-up OCaml uses: ocaml/setup-ocaml@v2 with: ocaml-compiler: ocaml.5.0.0,ocaml-option-mingw opam-repositories: | dra27: https://github.com/dra27/opam-repository.git#windows-5.0 default: https://github.com/fdopen/opam-repository-mingw.git#opam2 standard: https://github.com/ocaml/opam-repository.git - name: Install dependencies run: opam install . --deps-only --with-test - name: Build run: opam exec -- dune build - name: Test run: opam exec -- dune runtest