Item 5's guard dropped, item 4's reached and correct
This commit is contained in:
parent
b0f21ae513
commit
939417446d
21
lib/x86.ml
21
lib/x86.ml
@ -2231,12 +2231,21 @@ let emit_fn (md : Emit.m) ~externs ~fns (fn : Tast.fn) : string * string =
|
|||||||
end
|
end
|
||||||
else begin zero_return (); jmp_lbl f.b f.retlbl end
|
else begin zero_return (); jmp_lbl f.b f.retlbl end
|
||||||
end
|
end
|
||||||
else if fn.Tast.fdefers <> [] then
|
(* And if [f.unwound] is false there is nothing to emit: the defers on the
|
||||||
(* Nothing in this function can transfer, so the second exit has no path
|
transfer exit are dead because no path names that exit. This used to be a
|
||||||
to it and the defers on it are dead. Left as a refusal rather than
|
refusal, on the theory that a function with a defer and no transfer exit
|
||||||
quietly dropped: if that reasoning is ever wrong, this says so. *)
|
was a sign the reasoning had gone wrong. It is not — it is every leaf
|
||||||
unsupported "%s has defers on a transfer path nothing reaches"
|
function with a defer, and [spike/x86/p9-dead-defers.flan] is ten lines
|
||||||
fn.Tast.name;
|
of it. [emit.ml]'s [emit_fn] writes the whole exit under the same
|
||||||
|
[if f.unwound], and so drops them too.
|
||||||
|
|
||||||
|
What makes the drop safe is that [unwound] is not an approximation.
|
||||||
|
Every site that can leave a transfer in the channel and keep going either
|
||||||
|
emits [guard] — [Signal], [bounds_call], the two [rt_signals] entry
|
||||||
|
points, and every call by name or by pointer — or jumps to [current_pad]
|
||||||
|
outright, which is [invoke-restart] and the three re-propagating pads. So
|
||||||
|
[unwound] is false exactly when no transfer can arrive. *)
|
||||||
|
;
|
||||||
|
|
||||||
(* The prologue, now that the frame size is known. *)
|
(* The prologue, now that the frame size is known. *)
|
||||||
let pb = create () in
|
let pb = create () in
|
||||||
|
|||||||
53
spike/x86/p10-defer-transfer.flan
Normal file
53
spike/x86/p10-defer-transfer.flan
Normal file
@ -0,0 +1,53 @@
|
|||||||
|
;;;; The second transfer, which the checker can only half refuse.
|
||||||
|
;;;;
|
||||||
|
;;;; spec-conditions.md §5 says a defer is the cleanup a transfer runs on its
|
||||||
|
;;;; way out. Starting a *second* transfer from inside one would leave this
|
||||||
|
;;;; frame's defers half run with two targets and no way to choose, so both
|
||||||
|
;;;; backends emit a branch into `flan_transfer_fail` for it and the runtime
|
||||||
|
;;;; dies there with the frame's location.
|
||||||
|
;;;;
|
||||||
|
;;;; `check.ml`'s `Ast.InvokeRestart` arm refuses the *lexical* case -- an
|
||||||
|
;;;; `invoke-restart` written inside the `defer` form itself -- with the same
|
||||||
|
;;;; reasoning. What it cannot see is a defer that *calls* a function that
|
||||||
|
;;;; invokes a restart, because the callee is ordinary code and knows nothing
|
||||||
|
;;;; about who called it. That is the case below, and it is the only way to
|
||||||
|
;;;; reach the branch.
|
||||||
|
;;;;
|
||||||
|
;;;; The order matters and is what makes this a real second transfer rather
|
||||||
|
;;;; than a first one: `outer` establishes both restart-cases, calls `middle`,
|
||||||
|
;;;; `deep` signals, `outer`'s handler aims at `esc-one`, and the transfer
|
||||||
|
;;;; unwinds `deep` and then `middle`. `middle`'s transfer exit clears the
|
||||||
|
;;;; channel and runs its defers -- and the defer calls `second`, which aims a
|
||||||
|
;;;; transfer at `esc-two`. Both restart frames are still pushed: `outer`'s
|
||||||
|
;;;; pad is what pops them, and `outer` has not been reached yet.
|
||||||
|
;;;;
|
||||||
|
;;;; Exits 134 with the message on stderr, both ways.
|
||||||
|
|
||||||
|
(defstruct Blip [n i32])
|
||||||
|
|
||||||
|
(defvar log i64)
|
||||||
|
|
||||||
|
(defn deep [n i32] i32
|
||||||
|
(signal (Blip {.n n}))
|
||||||
|
0)
|
||||||
|
|
||||||
|
;;; Ordinary code. The checker has nothing to object to here, because from
|
||||||
|
;;; where it stands this is a function like any other.
|
||||||
|
(defn second [] i64
|
||||||
|
(invoke-restart 'esc-two))
|
||||||
|
|
||||||
|
(defn middle [n i32] i32
|
||||||
|
(defer (set log (second)))
|
||||||
|
(deep n))
|
||||||
|
|
||||||
|
(defn outer [n i32] i32
|
||||||
|
(restart-case
|
||||||
|
(restart-case
|
||||||
|
(handler-bind [(Blip [c] (invoke-restart 'esc-one))]
|
||||||
|
(middle n))
|
||||||
|
(esc-one [] 11))
|
||||||
|
(esc-two [] 22)))
|
||||||
|
|
||||||
|
(defn main [] i32
|
||||||
|
(print (outer 1)) (println "")
|
||||||
|
0)
|
||||||
Loading…
x
Reference in New Issue
Block a user