Skip to content

Commit 28c5d09

Browse files
puredangerpuredanger
committed
Revert ASYNC-248 due to the surfaced issue in ASYNC-249
1 parent 9ebd84a commit 28c5d09

File tree

3 files changed

+116
-32
lines changed

3 files changed

+116
-32
lines changed

‎src/main/clojure/clojure/core/async.clj

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ to catch and handle."
2626
[clojure.core.async.impl.buffers :as buffers]
2727
[clojure.core.async.impl.timers :as timers]
2828
[clojure.core.async.impl.dispatch :as dispatch]
29-
[clojure.core.async.impl.runtime :as ioc]
29+
[clojure.core.async.impl.ioc-macros :as ioc]
3030
[clojure.core.async.impl.mutex :as mutex]
3131
[clojure.core.async.impl.concurrent :as conc]
3232
)
@@ -417,7 +417,7 @@ to catch and handle."
417417

418418
(defn ioc-alts! [state cont-block ports & {:as opts}]
419419
(ioc/aset-all! state ioc/STATE-IDX cont-block)
420-
(when-let [cb (do-alts
420+
(when-let [cb (clojure.core.async/do-alts
421421
(fn [val]
422422
(ioc/aset-all! state ioc/VALUE-IDX val)
423423
(ioc/run-state-machine-wrapped state))
@@ -462,8 +462,7 @@ to catch and handle."
462462
(dispatch/run
463463
(^:once fn* []
464464
(let [~@(mapcat (fn [[l sym]] [sym `(^:once fn* [] ~(vary-meta l dissoc :tag))]) crossing-env)
465-
f# ~((requiring-resolve 'clojure.core.async.impl.ioc-macros/state-machine)
466-
`(do ~@body) 1 [crossing-env &env] ioc/async-custom-terminators)
465+
f# ~(ioc/state-machine `(do ~@body) 1 [crossing-env &env] ioc/async-custom-terminators)
467466
state# (-> (f#)
468467
(ioc/aset-all! ioc/USER-START-IDX c#
469468
ioc/BINDINGS-IDX captured-bindings#))]

‎src/main/clojure/clojure/core/async/impl/ioc_macros.clj

Lines changed: 110 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -19,14 +19,40 @@
1919
[clojure.tools.analyzer.passes.jvm.annotate-loops :refer [annotate-loops]]
2020
[clojure.tools.analyzer.passes.jvm.warn-on-reflection :refer [warn-on-reflection]]
2121
[clojure.tools.analyzer.jvm :as an-jvm]
22-
[clojure.core.async.impl.runtime :as rt]
22+
[clojure.core.async.impl.protocols :as impl]
2323
[clojure.set :as set])
24-
(:import [java.util.concurrent.atomic AtomicReferenceArray]))
24+
(:import [java.util.concurrent.locks Lock]
25+
[java.util.concurrent.atomic AtomicReferenceArray]))
2526

2627
(defn debug [x]
2728
(pprint x)
2829
x)
2930

31+
(def ^{:const true :tag 'long} FN-IDX 0)
32+
(def ^{:const true :tag 'long} STATE-IDX 1)
33+
(def ^{:const true :tag 'long} VALUE-IDX 2)
34+
(def ^{:const true :tag 'long} BINDINGS-IDX 3)
35+
(def ^{:const true :tag 'long} EXCEPTION-FRAMES 4)
36+
(def ^{:const true :tag 'long} USER-START-IDX 5)
37+
38+
(defn aset-object [^AtomicReferenceArray arr ^long idx o]
39+
(.set arr idx o))
40+
41+
(defn aget-object [^AtomicReferenceArray arr ^long idx]
42+
(.get arr idx))
43+
44+
(defmacro aset-all!
45+
[arr & more]
46+
(assert (even? (count more)) "Must give an even number of args to aset-all!")
47+
(let [bindings (partition 2 more)
48+
arr-sym (gensym "statearr-")]
49+
`(let [~arr-sym ~arr]
50+
~@(map
51+
(fn [[idx val]]
52+
`(aset-object ~arr-sym ~idx ~val))
53+
bindings)
54+
~arr-sym)))
55+
3056
;; State monad stuff, used only in SSA construction
3157

3258
(defmacro gen-plan
@@ -191,7 +217,7 @@
191217
IEmittableInstruction
192218
(emit-instruction [this state-sym]
193219
(if (= value ::value)
194-
`[~(:id this) (rt/aget-object ~state-sym ~rt/VALUE-IDX)]
220+
`[~(:id this) (aget-object ~state-sym ~VALUE-IDX)]
195221
`[~(:id this) ~value])))
196222

197223
(defrecord RawCode [ast locals]
@@ -291,10 +317,10 @@
291317
(terminate-block [_this state-sym _]
292318
`(do (case ~val-id
293319
~@(concat (mapcat (fn [test blk]
294-
`[~test (rt/aset-all! ~state-sym ~rt/STATE-IDX ~blk)])
320+
`[~test (aset-all! ~state-sym ~STATE-IDX ~blk)])
295321
test-vals jmp-blocks)
296322
(when default-block
297-
`[(do (rt/aset-all! ~state-sym ~rt/STATE-IDX ~default-block)
323+
`[(do (aset-all! ~state-sym ~STATE-IDX ~default-block)
298324
:recur)])))
299325
:recur)))
300326

@@ -325,7 +351,7 @@
325351
(block-references [_this] [block])
326352
ITerminator
327353
(terminate-block [_this state-sym _]
328-
`(do (rt/aset-all! ~state-sym ~rt/VALUE-IDX ~value ~rt/STATE-IDX ~block)
354+
`(do (aset-all! ~state-sym ~VALUE-IDX ~value ~STATE-IDX ~block)
329355
:recur)))
330356

331357
(defrecord Return [value]
@@ -338,7 +364,7 @@
338364
(terminate-block [this state-sym custom-terminators]
339365
(if-let [f (get custom-terminators (terminator-code this))]
340366
`(~f ~state-sym ~value)
341-
`(do (rt/aset-all! ~state-sym ~rt/VALUE-IDX ~value ~rt/STATE-IDX ::finished)
367+
`(do (aset-all! ~state-sym ~VALUE-IDX ~value ~STATE-IDX ::finished)
342368
nil))))
343369

344370
(defrecord CondBr [test then-block else-block]
@@ -349,8 +375,8 @@
349375
ITerminator
350376
(terminate-block [_this state-sym _]
351377
`(do (if ~test
352-
(rt/aset-all! ~state-sym ~rt/STATE-IDX ~then-block)
353-
(rt/aset-all! ~state-sym ~rt/STATE-IDX ~else-block))
378+
(aset-all! ~state-sym ~STATE-IDX ~then-block)
379+
(aset-all! ~state-sym ~STATE-IDX ~else-block))
354380
:recur)))
355381

356382
(defrecord PushTry [catch-block]
@@ -360,7 +386,7 @@
360386
(block-references [_this] [catch-block])
361387
IEmittableInstruction
362388
(emit-instruction [_this state-sym]
363-
`[~'_ (rt/aset-all! ~state-sym ~rt/EXCEPTION-FRAMES (cons ~catch-block (rt/aget-object ~state-sym ~rt/EXCEPTION-FRAMES)))]))
389+
`[~'_ (aset-all! ~state-sym ~EXCEPTION-FRAMES (cons ~catch-block (aget-object ~state-sym ~EXCEPTION-FRAMES)))]))
364390

365391
(defrecord PopTry []
366392
IInstruction
@@ -369,7 +395,7 @@
369395
(block-references [_this] [])
370396
IEmittableInstruction
371397
(emit-instruction [_this state-sym]
372-
`[~'_ (rt/aset-all! ~state-sym ~rt/EXCEPTION-FRAMES (rest (rt/aget-object ~state-sym ~rt/EXCEPTION-FRAMES)))]))
398+
`[~'_ (aset-all! ~state-sym ~EXCEPTION-FRAMES (rest (aget-object ~state-sym ~EXCEPTION-FRAMES)))]))
373399

374400
(defrecord CatchHandler [catches]
375401
IInstruction
@@ -379,10 +405,10 @@
379405
ITerminator
380406
(terminate-block [_this state-sym _]
381407
(let [ex (gensym 'ex)]
382-
`(let [~ex (rt/aget-object ~state-sym ~rt/VALUE-IDX)]
408+
`(let [~ex (aget-object ~state-sym ~VALUE-IDX)]
383409
(cond
384410
~@(for [[handler-idx type] catches
385-
i [`(instance? ~type ~ex) `(rt/aset-all! ~state-sym ~rt/STATE-IDX ~handler-idx)]]
411+
i [`(instance? ~type ~ex) `(aset-all! ~state-sym ~STATE-IDX ~handler-idx)]]
386412
i)
387413
:else (throw ~ex))
388414
:recur))))
@@ -862,7 +888,7 @@
862888
(if (empty? args)
863889
[]
864890
(mapcat (fn [sym]
865-
`[~sym (rt/aget-object ~state-sym ~(id-for-inst local-map sym))])
891+
`[~sym (aget-object ~state-sym ~(id-for-inst local-map sym))])
866892
args))))
867893

868894
(defn- build-block-body [state-sym blk]
@@ -879,27 +905,27 @@
879905
blk)
880906
results (interleave (map (partial id-for-inst local-map) results) results)]
881907
(if-not (empty? results)
882-
[state-sym `(rt/aset-all! ~state-sym ~@results)]
908+
[state-sym `(aset-all! ~state-sym ~@results)]
883909
[])))
884910

885911
(defn- emit-state-machine [machine num-user-params custom-terminators]
886912
(let [index (index-state-machine machine)
887913
state-sym (with-meta (gensym "state_")
888914
{:tag 'objects})
889-
local-start-idx (+ num-user-params rt/USER-START-IDX)
915+
local-start-idx (+ num-user-params USER-START-IDX)
890916
state-arr-size (+ local-start-idx (count-persistent-values index))
891917
local-map (atom {::next-idx local-start-idx})
892918
block-catches (:block-catches machine)]
893919
`(fn state-machine#
894-
([] (rt/aset-all! (AtomicReferenceArray. ~state-arr-size)
895-
~rt/FN-IDX state-machine#
896-
~rt/STATE-IDX ~(:start-block machine)))
920+
([] (aset-all! (AtomicReferenceArray. ~state-arr-size)
921+
~FN-IDX state-machine#
922+
~STATE-IDX ~(:start-block machine)))
897923
([~state-sym]
898924
(let [old-frame# (clojure.lang.Var/getThreadBindingFrame)
899925
ret-value# (try
900-
(clojure.lang.Var/resetThreadBindingFrame (rt/aget-object ~state-sym ~rt/BINDINGS-IDX))
926+
(clojure.lang.Var/resetThreadBindingFrame (aget-object ~state-sym ~BINDINGS-IDX))
901927
(loop []
902-
(let [result# (case (int (rt/aget-object ~state-sym ~rt/STATE-IDX))
928+
(let [result# (case (int (aget-object ~state-sym ~STATE-IDX))
903929
~@(mapcat
904930
(fn [[id blk]]
905931
[id `(let [~@(concat (build-block-preamble local-map index state-sym blk)
@@ -911,18 +937,77 @@
911937
(recur)
912938
result#)))
913939
(catch Throwable ex#
914-
(rt/aset-all! ~state-sym ~rt/VALUE-IDX ex#)
915-
(if (seq (rt/aget-object ~state-sym ~rt/EXCEPTION-FRAMES))
916-
(rt/aset-all! ~state-sym ~rt/STATE-IDX (first (rt/aget-object ~state-sym ~rt/EXCEPTION-FRAMES)))
940+
(aset-all! ~state-sym ~VALUE-IDX ex#)
941+
(if (seq (aget-object ~state-sym ~EXCEPTION-FRAMES))
942+
(aset-all! ~state-sym ~STATE-IDX (first (aget-object ~state-sym ~EXCEPTION-FRAMES)))
917943
(throw ex#))
918944
:recur)
919945
(finally
920-
(rt/aset-object ~state-sym ~rt/BINDINGS-IDX (clojure.lang.Var/getThreadBindingFrame))
946+
(aset-object ~state-sym ~BINDINGS-IDX (clojure.lang.Var/getThreadBindingFrame))
921947
(clojure.lang.Var/resetThreadBindingFrame old-frame#)))]
922948
(if (identical? ret-value# :recur)
923949
(recur ~state-sym)
924950
ret-value#))))))
925951

952+
(defn finished?
953+
"Returns true if the machine is in a finished state"
954+
[state-array]
955+
(identical? (aget-object state-array STATE-IDX) ::finished))
956+
957+
(defn- fn-handler
958+
[f]
959+
(reify
960+
Lock
961+
(lock [_])
962+
(unlock [_])
963+
964+
impl/Handler
965+
(active? [_] true)
966+
(blockable? [_] true)
967+
(lock-id [_] 0)
968+
(commit [_] f)))
969+
970+
971+
(defn run-state-machine [state]
972+
((aget-object state FN-IDX) state))
973+
974+
(defn run-state-machine-wrapped [state]
975+
(try
976+
(run-state-machine state)
977+
(catch Throwable ex
978+
(impl/close! (aget-object state USER-START-IDX))
979+
(throw ex))))
980+
981+
(defn take! [state blk c]
982+
(if-let [cb (impl/take! c (fn-handler
983+
(fn [x]
984+
(aset-all! state VALUE-IDX x STATE-IDX blk)
985+
(run-state-machine-wrapped state))))]
986+
(do (aset-all! state VALUE-IDX @cb STATE-IDX blk)
987+
:recur)
988+
nil))
989+
990+
(defn put! [state blk c val]
991+
(if-let [cb (impl/put! c val (fn-handler (fn [ret-val]
992+
(aset-all! state VALUE-IDX ret-val STATE-IDX blk)
993+
(run-state-machine-wrapped state))))]
994+
(do (aset-all! state VALUE-IDX @cb STATE-IDX blk)
995+
:recur)
996+
nil))
997+
998+
(defn return-chan [state value]
999+
(let [c (aget-object state USER-START-IDX)]
1000+
(when-not (nil? value)
1001+
(impl/put! c value (fn-handler (fn [_] nil))))
1002+
(impl/close! c)
1003+
c))
1004+
1005+
(def async-custom-terminators
1006+
{'clojure.core.async/<! `take!
1007+
'clojure.core.async/>! `put!
1008+
'clojure.core.async/alts! 'clojure.core.async/ioc-alts!
1009+
:Return `return-chan})
1010+
9261011
(defn mark-transitions
9271012
{:pass-info {:walk :post :depends #{} :after an-jvm/default-passes}}
9281013
[{:keys [op fn] :as ast}]

‎src/test/clojure/clojure/core/async/ioc_macros_test.clj

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
(ns clojure.core.async.ioc-macros-test
22
(:refer-clojure :exclude [map into reduce transduce merge take partition
33
partition-by])
4-
(:require [clojure.core.async.impl.runtime :as ioc]
4+
(:require [clojure.core.async.impl.ioc-macros :as ioc]
55
[clojure.core.async :refer :all :as async]
66
[clojure.set :as set]
77
[clojure.test :refer :all])
@@ -24,7 +24,7 @@
2424
crossing-env (zipmap (keys &env) (repeatedly gensym))]
2525
`(let [captured-bindings# (clojure.lang.Var/getThreadBindingFrame)
2626
~@(mapcat (fn [[l sym]] [sym `(^:once fn* [] ~l)]) crossing-env)
27-
state# (~(clojure.core.async.impl.ioc-macros/state-machine `(do ~@body) 0 [crossing-env &env] terminators))]
27+
state# (~(ioc/state-machine `(do ~@body) 0 [crossing-env &env] terminators))]
2828
(ioc/aset-all! state# ~ioc/BINDINGS-IDX captured-bindings#)
2929
(ioc/run-state-machine state#)
3030
(ioc/aget-object state# ioc/VALUE-IDX))))
@@ -553,7 +553,7 @@
553553
crossing-env (zipmap (keys &env) (repeatedly gensym))]
554554
`(let [captured-bindings# (clojure.lang.Var/getThreadBindingFrame)
555555
~@(mapcat (fn [[l sym]] [sym `(^:once fn* [] ~(vary-meta l dissoc :tag))]) crossing-env)
556-
state# (~(clojure.core.async.impl.ioc-macros/state-machine
556+
state# (~(ioc/state-machine
557557
`(do ~@body)
558558
0
559559
[crossing-env &env]

0 commit comments

Comments
 (0)