1. #== Atomics available on all backends ============================================
  2. #-- fetching a value atomically
  3. proto sub atomic-fetch($) {*}
  4. multi sub atomic-fetch($source is rw) {
  5. nqp::atomicload($source)
  6. }
  7. proto sub prefix:<⚛>($) {*}
  8. multi sub prefix:<⚛>($source is rw) {
  9. nqp::atomicload($source)
  10. }
  11. #-- assigning a value atomically
  12. proto sub atomic-assign($, $) {*}
  13. multi sub atomic-assign($target is rw, \value) {
  14. nqp::atomicstore($target, value)
  15. }
  16. #-- atomic compare and swap
  17. proto sub cas(|) {*}
  18. multi sub cas($target is rw, \expected, \value) {
  19. nqp::cas($target, expected, value)
  20. }
  21. multi sub cas($target is rw, &code) {
  22. my $current := nqp::atomicload($target);
  23. loop {
  24. my $updated := code($current);
  25. my $seen := nqp::cas($target, $current, $updated);
  26. return $updated if nqp::eqaddr($seen, $current);
  27. $current := $seen;
  28. }
  29. }
  30. #== Native integer atomics only available on MoarVM ==============================
  31. my native atomicint is repr('P6int') is Int is ctype('atomic') { }
  32. #-- fetching a native integer value atomically
  33. multi sub atomic-fetch(atomicint $source is rw) {
  34. nqp::atomicload_i($source)
  35. }
  36. multi sub prefix:<⚛>(atomicint $source is rw) {
  37. nqp::atomicload_i($source)
  38. }
  39. #-- assigning a native integer value atomically
  40. multi sub atomic-assign(atomicint $target is rw, int $value) {
  41. nqp::atomicstore_i($target, $value)
  42. }
  43. multi sub atomic-assign(atomicint $target is rw, Int:D $value) {
  44. nqp::atomicstore_i($target, $value)
  45. }
  46. multi sub atomic-assign(atomicint $target is rw, $value) {
  47. nqp::atomicstore_i($target, $value.Int)
  48. }
  49. proto sub infix:<⚛=>($, $) {*}
  50. multi sub infix:<⚛=>($target is rw, \value) {
  51. nqp::atomicstore($target, value)
  52. }
  53. multi sub infix:<⚛=>(atomicint $target is rw, int $value) {
  54. nqp::atomicstore_i($target, $value)
  55. }
  56. multi sub infix:<⚛=>(atomicint $target is rw, Int:D $value) {
  57. nqp::atomicstore_i($target, $value)
  58. }
  59. multi sub infix:<⚛=>(atomicint $target is rw, $value) {
  60. nqp::atomicstore_i($target, $value.Int)
  61. }
  62. #-- atomically fetch native integer value and increment it
  63. proto sub atomic-fetch-inc(|) {*}
  64. multi sub atomic-fetch-inc(atomicint $target is rw --> atomicint) {
  65. nqp::atomicinc_i($target)
  66. }
  67. proto sub postfix:<⚛++>(|) {*}
  68. multi sub postfix:<⚛++>(atomicint $target is rw --> atomicint) {
  69. nqp::atomicinc_i($target)
  70. }
  71. #-- atomically increment native integer value and fetch it
  72. proto sub atomic-inc-fetch(|) {*}
  73. multi sub atomic-inc-fetch(atomicint $target is rw --> atomicint) {
  74. my atomicint $ = nqp::atomicinc_i($target) + 1
  75. }
  76. proto sub prefix:<++⚛>(|) {*}
  77. multi sub prefix:<++⚛>(atomicint $target is rw --> atomicint) {
  78. my atomicint $ = nqp::atomicinc_i($target) + 1
  79. }
  80. #-- atomically fetch native integer value and decrement it
  81. proto sub atomic-fetch-dec(|) {*}
  82. multi sub atomic-fetch-dec(atomicint $target is rw --> atomicint) {
  83. nqp::atomicdec_i($target)
  84. }
  85. proto sub postfix:<⚛-->(|) {*}
  86. multi sub postfix:<⚛-->(atomicint $target is rw --> atomicint) {
  87. nqp::atomicdec_i($target)
  88. }
  89. #-- atomically decrement native integer value and fetch it
  90. proto sub atomic-dec-fetch(|) {*}
  91. multi sub atomic-dec-fetch(atomicint $target is rw --> atomicint) {
  92. my atomicint $ = nqp::atomicdec_i($target) - 1
  93. }
  94. proto sub prefix:<--⚛>(|) {*}
  95. multi sub prefix:<--⚛>(atomicint $target is rw --> atomicint) {
  96. my atomicint $ = nqp::atomicdec_i($target) - 1
  97. }
  98. #-- atomically fetch native integer value and then add given value to it
  99. proto sub atomic-fetch-add($, $) {*}
  100. multi sub atomic-fetch-add(atomicint $target is rw, int $add --> atomicint) {
  101. nqp::atomicadd_i($target, $add)
  102. }
  103. multi sub atomic-fetch-add(atomicint $target is rw, Int:D $add --> atomicint) {
  104. nqp::atomicadd_i($target, $add)
  105. }
  106. multi sub atomic-fetch-add(atomicint $target is rw, $add --> atomicint) {
  107. nqp::atomicadd_i($target, $add.Int)
  108. }
  109. #-- atomically add given native integer value to value and return that
  110. proto sub atomic-add-fetch($, $) {*}
  111. multi sub atomic-add-fetch(atomicint $target is rw, int $add --> atomicint) {
  112. my atomicint $ = nqp::atomicadd_i($target, $add) + $add
  113. }
  114. multi sub atomic-add-fetch(atomicint $target is rw, Int:D $add --> atomicint) {
  115. my atomicint $ = nqp::atomicadd_i($target, $add) + $add
  116. }
  117. multi sub atomic-add-fetch(atomicint $target is rw, $add --> atomicint) {
  118. my int $add-int = $add.Int;
  119. my atomicint $ = nqp::atomicadd_i($target, $add-int) + $add-int
  120. }
  121. proto sub infix:<⚛+=>($, $) {*}
  122. multi sub infix:<⚛+=>(atomicint $target is rw, int $add --> atomicint) {
  123. my atomicint $ = nqp::atomicadd_i($target, $add) + $add
  124. }
  125. multi sub infix:<⚛+=>(atomicint $target is rw, Int:D $add --> atomicint) {
  126. my atomicint $ = nqp::atomicadd_i($target, $add) + $add
  127. }
  128. multi sub infix:<⚛+=>(atomicint $target is rw, $add --> atomicint) {
  129. my int $add-int = $add.Int;
  130. my atomicint $ = nqp::atomicadd_i($target, $add-int) + $add-int
  131. }
  132. #-- atomically fetch native integer value and then subtract given value from it
  133. proto sub atomic-fetch-sub($, $) {*}
  134. multi sub atomic-fetch-sub(atomicint $target is rw, int $add --> atomicint) {
  135. nqp::atomicadd_i($target, nqp::neg_i($add))
  136. }
  137. multi sub atomic-fetch-sub(atomicint $target is rw, Int:D $add --> atomicint) {
  138. nqp::atomicadd_i($target, nqp::neg_i($add))
  139. }
  140. multi sub atomic-fetch-sub(atomicint $target is rw, $add --> atomicint) {
  141. nqp::atomicadd_i($target, nqp::neg_i($add.Int))
  142. }
  143. #-- atomically subtract given native integer value from value and return that
  144. proto sub atomic-sub-fetch($, $) {*}
  145. multi sub atomic-sub-fetch(atomicint $target is rw, int $add --> atomicint) {
  146. my atomicint $ = nqp::atomicadd_i($target, nqp::neg_i($add)) - $add
  147. }
  148. multi sub atomic-sub-fetch(atomicint $target is rw, Int:D $add --> atomicint) {
  149. my atomicint $ = nqp::atomicadd_i($target, nqp::neg_i($add)) - $add
  150. }
  151. multi sub atomic-sub-fetch(atomicint $target is rw, $add --> atomicint) {
  152. my int $add-int = nqp::neg_i($add.Int);
  153. my atomicint $ = nqp::atomicadd_i($target, $add-int) + $add-int
  154. }
  155. proto sub infix:<⚛-=>($, $) {*}
  156. multi sub infix:<⚛-=>(atomicint $target is rw, int $add --> atomicint) {
  157. my atomicint $ = nqp::atomicadd_i($target, nqp::neg_i($add)) - $add
  158. }
  159. multi sub infix:<⚛-=>(atomicint $target is rw, Int:D $add --> atomicint) {
  160. my atomicint $ = nqp::atomicadd_i($target, nqp::neg_i($add)) - $add
  161. }
  162. multi sub infix:<⚛-=>(atomicint $target is rw, $add --> atomicint) {
  163. my int $add-int = nqp::neg_i($add.Int);
  164. my atomicint $ = nqp::atomicadd_i($target, $add-int) + $add-int
  165. }
  166. my constant &infix:<⚛−=> := &infix:<⚛-=>;
  167. #-- provide full barrier semantics
  168. proto sub full-barrier(|) {*}
  169. multi sub full-barrier(--> Nil) {
  170. nqp::barrierfull()
  171. }
  172. #-- atomic compare and swap a native integer
  173. multi sub cas(atomicint $target is rw, int $expected, int $value) {
  174. nqp::cas_i($target, $expected, $value)
  175. }
  176. multi sub cas(atomicint $target is rw, Int:D $expected, Int:D $value) {
  177. nqp::cas_i($target, $expected, $value)
  178. }
  179. multi sub cas(atomicint $target is rw, $expected, $value) {
  180. nqp::cas_i($target, $expected.Int, $value.Int)
  181. }
  182. multi sub cas(atomicint $target is rw, &code) {
  183. my int $current = nqp::atomicload_i($target);
  184. loop {
  185. my int $updated = code($current);
  186. my int $seen = nqp::cas_i($target, $current, $updated);
  187. return $updated if $seen == $current;
  188. $current = $seen;
  189. }
  190. }