Skip to content

Commit 7319f6a

Browse files
committed
Edit in changes from a commit on JVM that caught me in the middle
1 parent baf10bc commit 7319f6a

File tree

6 files changed

+618
-122
lines changed

6 files changed

+618
-122
lines changed

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -458,7 +458,7 @@ to catch and handle."
458458
[& body]
459459
(let [crossing-env (zipmap (keys &env) (repeatedly gensym))]
460460
`(let [c# (chan 1)
461-
captured-bindings# (Var/getThreadBindingFrame)]
461+
captured-bindings# (clojure.lang.Var/getThreadBindingFrame)]
462462
(dispatch/run
463463
(^:once fn* []
464464
(let [~@(mapcat (fn [[l sym]] [sym `(^:once fn* [] ~(vary-meta l dissoc :tag))]) crossing-env)
@@ -479,7 +479,7 @@ to catch and handle."
479479
f when completed, then close."
480480
[f]
481481
(let [c (chan 1)]
482-
(let [binds (Var/getThreadBindingFrame)]
482+
(let [binds (clojure.lang.Var/getThreadBindingFrame)]
483483
(.newThread counted-thread-factory ;;; .execute thread-macro-executor
484484
(fn []
485485
(Var/resetThreadBindingFrame binds)
@@ -1016,7 +1016,7 @@ to catch and handle."
10161016
(fn [ret]
10171017
(aset rets i ret)
10181018
(when (zero? (swap! dctr dec))
1019-
(put! dchan (let [a (System.Array/CreateInstance Object cnt)] (.CopyTo rets a 0) a))))) ;;; (Arrays/copyOf rets cnt)
1019+
(put! dchan (let [a (System.Array/CreateInstance System.Object (int cnt))] (.CopyTo rets a 0) a))))) ;;; (Arrays/copyOf rets cnt)
10201020
(range cnt))]
10211021
(if (zero? cnt)
10221022
(close! out)

src/main/clojure/clojure/core/async/impl/channels.clj

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -388,8 +388,8 @@
388388
nil))))
389389

390390
(defn- ex-handler [ex]
391-
;;;(-> (Thread/currentThread) ------------we have no equivalant of this
392-
;;; .getUncaughtExceptionHandler
391+
;;;(-> (Thread/currentThread)
392+
;;; .getUncaughtExceptionHandler ------------we have no equivalent of this
393393
;;; (.uncaughtException (Thread/currentThread) ex))
394394
nil)
395395

src/main/clojure/clojure/core/async/impl/dispatch.clj

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
21
;; Copyright (c) Rich Hickey and contributors. All rights reserved.
32
;; The use and distribution terms for this software are covered by the
43
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

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

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

2726
(defn debug [x]
2827
(pprint x)
2928
x)
3029

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 [^System.Array arr ^long idx o] ;;; ^AtomicReferenceArray -- for now, replace with a regular array. We'll work on the atomic version eventully.
39-
(.SetValue arr o idx)) ;;; (.set arr idx o)
40-
41-
(defn aget-object [^System.Array arr ^long idx] ;;; ^AtomicReferenceArray -- for now, replace with a regular array. We'll work on the atomic version eventully.
42-
(.GetValue arr idx)) ;;; .get
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-
5630
;; State monad stuff, used only in SSA construction
5731

5832
(defmacro gen-plan
@@ -217,7 +191,7 @@
217191
IEmittableInstruction
218192
(emit-instruction [this state-sym]
219193
(if (= value ::value)
220-
`[~(:id this) (aget-object ~state-sym ~VALUE-IDX)]
194+
`[~(:id this) (rt/aget-object ~state-sym ~rt/VALUE-IDX)]
221195
`[~(:id this) ~value])))
222196

223197
(defrecord RawCode [ast locals]
@@ -317,11 +291,10 @@
317291
(terminate-block [_this state-sym _]
318292
`(do (case ~val-id
319293
~@(concat (mapcat (fn [test blk]
320-
`[~test (aset-all! ~state-sym
321-
~STATE-IDX ~blk)])
294+
`[~test (rt/aset-all! ~state-sym ~rt/STATE-IDX ~blk)])
322295
test-vals jmp-blocks)
323296
(when default-block
324-
`[(do (aset-all! ~state-sym ~STATE-IDX ~default-block)
297+
`[(do (rt/aset-all! ~state-sym ~rt/STATE-IDX ~default-block)
325298
:recur)])))
326299
:recur)))
327300

@@ -352,7 +325,7 @@
352325
(block-references [_this] [block])
353326
ITerminator
354327
(terminate-block [_this state-sym _]
355-
`(do (aset-all! ~state-sym ~VALUE-IDX ~value ~STATE-IDX ~block)
328+
`(do (rt/aset-all! ~state-sym ~rt/VALUE-IDX ~value ~rt/STATE-IDX ~block)
356329
:recur)))
357330

358331
(defrecord Return [value]
@@ -365,9 +338,7 @@
365338
(terminate-block [this state-sym custom-terminators]
366339
(if-let [f (get custom-terminators (terminator-code this))]
367340
`(~f ~state-sym ~value)
368-
`(do (aset-all! ~state-sym
369-
~VALUE-IDX ~value
370-
~STATE-IDX ::finished)
341+
`(do (rt/aset-all! ~state-sym ~rt/VALUE-IDX ~value ~rt/STATE-IDX ::finished)
371342
nil))))
372343

373344
(defrecord CondBr [test then-block else-block]
@@ -378,10 +349,8 @@
378349
ITerminator
379350
(terminate-block [_this state-sym _]
380351
`(do (if ~test
381-
(aset-all! ~state-sym
382-
~STATE-IDX ~then-block)
383-
(aset-all! ~state-sym
384-
~STATE-IDX ~else-block))
352+
(rt/aset-all! ~state-sym ~rt/STATE-IDX ~then-block)
353+
(rt/aset-all! ~state-sym ~rt/STATE-IDX ~else-block))
385354
:recur)))
386355

387356
(defrecord PushTry [catch-block]
@@ -391,7 +360,7 @@
391360
(block-references [_this] [catch-block])
392361
IEmittableInstruction
393362
(emit-instruction [_this state-sym]
394-
`[~'_ (aset-all! ~state-sym ~EXCEPTION-FRAMES (cons ~catch-block (aget-object ~state-sym ~EXCEPTION-FRAMES)))]))
363+
`[~'_ (rt/aset-all! ~state-sym ~rt/EXCEPTION-FRAMES (cons ~catch-block (rt/aget-object ~state-sym ~rt/EXCEPTION-FRAMES)))]))
395364

396365
(defrecord PopTry []
397366
IInstruction
@@ -400,7 +369,7 @@
400369
(block-references [_this] [])
401370
IEmittableInstruction
402371
(emit-instruction [_this state-sym]
403-
`[~'_ (aset-all! ~state-sym ~EXCEPTION-FRAMES (rest (aget-object ~state-sym ~EXCEPTION-FRAMES)))]))
372+
`[~'_ (rt/aset-all! ~state-sym ~rt/EXCEPTION-FRAMES (rest (rt/aget-object ~state-sym ~rt/EXCEPTION-FRAMES)))]))
404373

405374
(defrecord CatchHandler [catches]
406375
IInstruction
@@ -410,10 +379,10 @@
410379
ITerminator
411380
(terminate-block [_this state-sym _]
412381
(let [ex (gensym 'ex)]
413-
`(let [~ex (aget-object ~state-sym ~VALUE-IDX)]
382+
`(let [~ex (rt/aget-object ~state-sym ~rt/VALUE-IDX)]
414383
(cond
415384
~@(for [[handler-idx type] catches
416-
i [`(instance? ~type ~ex) `(aset-all! ~state-sym ~STATE-IDX ~handler-idx)]]
385+
i [`(instance? ~type ~ex) `(rt/aset-all! ~state-sym ~rt/STATE-IDX ~handler-idx)]]
417386
i)
418387
:else (throw ~ex))
419388
:recur))))
@@ -893,7 +862,7 @@
893862
(if (empty? args)
894863
[]
895864
(mapcat (fn [sym]
896-
`[~sym (aget-object ~state-sym ~(id-for-inst local-map sym))])
865+
`[~sym (rt/aget-object ~state-sym ~(id-for-inst local-map sym))])
897866
args))))
898867

899868
(defn- build-block-body [state-sym blk]
@@ -910,27 +879,27 @@
910879
blk)
911880
results (interleave (map (partial id-for-inst local-map) results) results)]
912881
(if-not (empty? results)
913-
[state-sym `(aset-all! ~state-sym ~@results)]
882+
[state-sym `(rt/aset-all! ~state-sym ~@results)]
914883
[])))
915884

916885
(defn- emit-state-machine [machine num-user-params custom-terminators]
917886
(let [index (index-state-machine machine)
918887
state-sym (with-meta (gensym "state_")
919888
{:tag 'objects})
920-
local-start-idx (+ num-user-params USER-START-IDX)
889+
local-start-idx (+ num-user-params rt/USER-START-IDX)
921890
state-arr-size (+ local-start-idx (count-persistent-values index))
922891
local-map (atom {::next-idx local-start-idx})
923892
block-catches (:block-catches machine)]
924893
`(fn state-machine#
925-
([] (aset-all! (System.Array/CreateInstance Object ~state-arr-size) ;;; (AtomicReferenceArray. ~state-arr-size) -- use an Array for now
926-
~FN-IDX state-machine#
927-
~STATE-IDX ~(:start-block machine)))
894+
([] (rt/aset-all! (System.Array/CreateInstance System.Object (int ~state-arr-size)) ;;; (AtomicReferenceArray. ~state-arr-size) -- use an Array for now TODO -- fix!
895+
~rt/FN-IDX state-machine#
896+
~rt/STATE-IDX ~(:start-block machine)))
928897
([~state-sym]
929898
(let [old-frame# (clojure.lang.Var/getThreadBindingFrame)
930899
ret-value# (try
931-
(clojure.lang.Var/resetThreadBindingFrame (aget-object ~state-sym ~BINDINGS-IDX))
900+
(clojure.lang.Var/resetThreadBindingFrame (rt/aget-object ~state-sym ~rt/BINDINGS-IDX))
932901
(loop []
933-
(let [result# (case (int (aget-object ~state-sym ~STATE-IDX))
902+
(let [result# (case (int (rt/aget-object ~state-sym ~rt/STATE-IDX))
934903
~@(mapcat
935904
(fn [[id blk]]
936905
[id `(let [~@(concat (build-block-preamble local-map index state-sym blk)
@@ -942,77 +911,18 @@
942911
(recur)
943912
result#)))
944913
(catch Exception ex# ;;; Throwable
945-
(aset-all! ~state-sym ~VALUE-IDX ex#)
946-
(if (seq (aget-object ~state-sym ~EXCEPTION-FRAMES))
947-
(aset-all! ~state-sym ~STATE-IDX (first (aget-object ~state-sym ~EXCEPTION-FRAMES)))
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)))
948917
(throw ex#))
949918
:recur)
950919
(finally
951-
(aset-object ~state-sym ~BINDINGS-IDX (clojure.lang.Var/getThreadBindingFrame))
920+
(rt/aset-object ~state-sym ~rt/BINDINGS-IDX (clojure.lang.Var/getThreadBindingFrame))
952921
(clojure.lang.Var/resetThreadBindingFrame old-frame#)))]
953922
(if (identical? ret-value# :recur)
954923
(recur ~state-sym)
955924
ret-value#))))))
956925

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

src/main/clojure/clojure/core/async/impl/runtime.clj

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@
2626
(defn aget-object [^System.Array arr ^long idx] ;;; ^AtomicReferenceArray -- for now, replace with a regular array. We'll work on the atomic version eventully.
2727
(.GetValue arr idx)) ;;; .get
2828

29-
3029
(defmacro aset-all!
3130
[arr & more]
3231
(assert (even? (count more)) "Must give an even number of args to aset-all!")

0 commit comments

Comments
 (0)