Skip to content

Commit

Permalink
Port to 4.12 and tweak the implementation for size
Browse files Browse the repository at this point in the history
Also a bit of CI maintenance to test on Windows compiler versions.
  • Loading branch information
polytypic committed Sep 27, 2024
1 parent cdd705a commit 4be3bdf
Show file tree
Hide file tree
Showing 6 changed files with 38 additions and 18 deletions.
22 changes: 15 additions & 7 deletions .github/workflows/workflow.yml
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
name: build-and-test
name: ci

on:
pull_request:
Expand All @@ -7,20 +7,28 @@ on:
- main

jobs:
build-windows:
test-on-windows:
strategy:
fail-fast: false
matrix:
ocaml-compiler:
- ocaml.5.0.0,ocaml-option-mingw
- ocaml.5.1.1,ocaml-option-mingw
- ocaml.5.2.0,ocaml-option-mingw

runs-on: windows-latest

steps:
- name: Checkout code
- name: Check out code
uses: actions/checkout@v3

- name: Set-up OCaml
uses: ocaml/setup-ocaml@v2
- name: Set up OCaml
uses: ocaml/setup-ocaml@v3
with:
ocaml-compiler: ocaml.5.0.0,ocaml-option-mingw
ocaml-compiler: ${{ matrix.ocaml-compiler }}
opam-repositories: |
dra27: https://github.com/dra27/opam-repository.git#windows-5.0
default: https://github.com/fdopen/opam-repository-mingw.git#opam2
default: https://github.com/ocaml-opam/opam-repository-mingw.git#sunset
standard: https://github.com/ocaml/opam-repository.git
- name: Install dependencies
Expand Down
2 changes: 1 addition & 1 deletion .ocamlformat
Original file line number Diff line number Diff line change
@@ -1,2 +1,2 @@
profile = default
version = 0.26.0
version = 0.26.2
4 changes: 2 additions & 2 deletions CHANGES.md
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
# Release notes
## 0.1.1

All notable changes to this project will be documented in this file.
- Ported to 4.12 and optimized for size (@polytypic)

## 0.1.0

Expand Down
2 changes: 1 addition & 1 deletion backoff.opam
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ homepage: "https://github.com/ocaml-multicore/backoff"
bug-reports: "https://github.com/ocaml-multicore/backoff/issues"
depends: [
"dune" {>= "3.3"}
"ocaml" {>= "4.13"}
"ocaml" {>= "4.12"}
"alcotest" {>= "1.7.0" & with-test}
"domain_shims" {>= "0.1.0" & with-test}
"odoc" {with-doc}
Expand Down
2 changes: 1 addition & 1 deletion dune-project
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,6 @@
(name backoff)
(synopsis "Exponential backoff mechanism for OCaml")
(depends
(ocaml (>= 4.13))
(ocaml (>= 4.12))
(alcotest (and (>= 1.7.0) :with-test))
(domain_shims (and (>= 0.1.0) :with-test))))
24 changes: 18 additions & 6 deletions src/backoff.ml
Original file line number Diff line number Diff line change
Expand Up @@ -40,15 +40,27 @@ let reset backoff =
let lower_wait_log = get_lower_wait_log backoff in
backoff land lnot mask lor lower_wait_log

let once backoff =
(* We don't want [once] to be inlined. This may avoid code bloat. *)
let[@inline never] once backoff =
(* We call [Random.bits] first. In this case this helps to reduce register
pressure so that fewer words will be allocated from the stack. *)
let t = Random.bits () in
let wait_log = get_wait_log backoff in
let wait_mask = (1 lsl wait_log) - 1 in
let t = Random.bits () land wait_mask land single_mask in
for _ = 0 to t do
Domain.cpu_relax ()
(* We use a ref and a countdown while-loop (uses one variable) instead of a
for-loop (uses two variables) to reduce register pressure. Local ref does
not allocate with native compiler. *)
let t = ref (t land wait_mask land single_mask) in
while 0 <= !t do
Domain.cpu_relax ();
t := !t - 1
done;
let upper_wait_log = get_upper_wait_log backoff in
let next_wait_log = Int.min upper_wait_log (wait_log + 1) in
backoff lxor wait_log lor next_wait_log
(* We recompute [wait_log] to reduce register pressure. *)
let wait_log = get_wait_log backoff in
(* [Bool.to_int] generates branchless code, this reduces branch predictor
pressure and generates shorter code. *)
let next_wait_log = wait_log + Bool.to_int (wait_log < upper_wait_log) in
backoff - wait_log + next_wait_log

let default = create ()

0 comments on commit 4be3bdf

Please sign in to comment.