1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
|
/* -----------------------------------------------------------------------------
*
* (c) The GHC Team, 2022
*
* Continuation support
*
* This file is written in a subset of C--, extended with various
* features specific to GHC. It is compiled by GHC directly. For the
* syntax of .cmm files, see the parser in ghc/compiler/GHC/Cmm/Parser.y.
*
* ---------------------------------------------------------------------------*/
#include "Cmm.h"
import CLOSURE base_ControlziExceptionziBase_noMatchingContinuationPrompt_closure;
/* --------------------------------------------------------------------------
Prompts and prompt tags
-------------------------------------------------------------------------- */
INFO_TABLE(stg_PROMPT_TAG,0,0,PRIM,"PROMPT_TAG","PROMPT_TAG")
{ foreign "C" barf("PROMPT_TAG object (%p) entered!", R1) never returns; }
stg_newPromptTagzh()
{
W_ tag;
ALLOC_PRIM_(SIZEOF_StgHeader, stg_newPromptTagzh);
tag = Hp - SIZEOF_StgHeader + WDS(1);
SET_HDR(tag,stg_PROMPT_TAG_info,CCCS);
return (tag);
}
INFO_TABLE_RET(stg_prompt_frame, RET_SMALL, W_ info_ptr, P_ tag /* :: PromptTag# a */)
return (P_ ret /* :: a */)
{
return (ret);
}
// see Note [Continuations overview] in Continuation.c
stg_promptzh(P_ tag /* :: PromptTag# a */, P_ io /* :: IO a */)
{
STK_CHK_GEN();
TICK_UNKNOWN_CALL();
TICK_SLOW_CALL_fast_v();
jump stg_ap_v_fast (stg_prompt_frame_info, tag) (io);
}
/* --------------------------------------------------------------------------
Continuation capture
-------------------------------------------------------------------------- */
// see Note [Continuations overview] in Continuation.c
stg_control0zh(P_ tag /* :: PromptTag# a */, P_ f /* :: (IO b -> IO a) -> IO a */)
{
// We receive two arguments, so we need to use a high-level Cmm entrypoint to
// receive them with the platform-specific calling convention, but we just
// jump to `stg_control0zh_ll` immediately, since we need to be in low-level
// Cmm to manipulate the stack.
R1 = tag;
R2 = f;
jump stg_control0zh_ll [R1, R2];
}
// see Note [Continuations overview] in Continuation.c
stg_control0zh_ll // explicit stack
{
P_ tag /* :: PromptTag# a */,
f /* :: (IO b -> IO a) -> IO a */,
cont /* :: IO b -> IO a */;
tag = R1;
f = R2;
SAVE_THREAD_STATE();
(cont) = ccall captureContinuationAndAbort(MyCapability() "ptr",
CurrentTSO "ptr",
tag);
LOAD_THREAD_STATE();
// see Note [When capturing the continuation fails] in Continuation.c
if (cont == NULL) (likely: False) {
jump stg_raisezh(base_ControlziExceptionziBase_noMatchingContinuationPrompt_closure);
}
W_ apply_mask_frame;
apply_mask_frame = StgContinuation_apply_mask_frame(cont);
// The stack has been updated, so it’s time to apply the input function,
// passing the captured continuation and a RealWorld token as arguments.
TICK_UNKNOWN_CALL();
TICK_SLOW_CALL_fast_pv();
// If `apply_mask_frame` is NULL, that means the captured continuation doesn’t
// make any adjustments to the async exception masking state, which means we
// don’t have any adjustments to undo, either. Therefore, we can just apply
// the function directly.
if (apply_mask_frame == NULL) {
Sp_adj(-2);
Sp(1) = cont;
R1 = f;
jump RET_LBL(stg_ap_pv) [R1];
}
// Otherwise, the continuation did adjust the masking state, so we have to
// undo it before resuming execution.
//
// Rather than deal with updating the state ourselves, we return to the
// relevant unmask frame (defined in Exception.cmm) that happens to be at the
// bottom of the captured continuation (see Note [Continuations and async
// exception masking] in Continuation.c for all the details).
//
// We start by extracting the unmask frame’s info table pointer from the chunk
// of captured stack.
P_ untagged_cont;
W_ cont_stack, mask_frame_offset, mask_frame;
untagged_cont = UNTAG(cont);
cont_stack = untagged_cont + SIZEOF_StgHeader + OFFSET_StgContinuation_stack;
mask_frame_offset = StgContinuation_mask_frame_offset(untagged_cont);
mask_frame = W_[cont_stack + WDS(mask_frame_offset)];
// Now we have the relevant info table to return to in `mask_frame`, so we
// just set up the stack to apply the function when the unmask frame returns
// and jump to the frame’s entry code.
Sp_adj(-3); // Note -3, not -2, because `mask_frame` will
// try to pop itself off the stack when it returns!
Sp(1) = stg_ap_pv_info;
Sp(2) = cont;
R1 = f;
jump %ENTRY_CODE(mask_frame) [R1];
}
/* --------------------------------------------------------------------------
Continuation restore
-------------------------------------------------------------------------- */
INFO_TABLE_FUN(stg_CONTINUATION,0,0,CONTINUATION,"CONTINUATION","CONTINUATION",2,ARG_P)
(P_ cont /* :: IO b -> IO a */, P_ io /* :: IO b */)
{
// We receive two arguments, so we need to use a high-level Cmm entrypoint to
// receive them with the platform-specific calling convention, but we just
// jump to `stg_CONTINUATION_apply` immediately, since we need to be in
// low-level Cmm to manipulate the stack.
R1 = UNTAG(cont);
R2 = io;
jump stg_CONTINUATION_apply [R1, R2];
}
// see Note [Continuations overview] in Continuation.c
stg_CONTINUATION_apply // explicit stack
{
P_ cont, io;
cont = R1;
io = R2;
IF_DEBUG(sanity, ccall checkClosure(cont "ptr"));
W_ new_stack_words, apply_mask_frame, mask_frame_offset;
new_stack_words = StgContinuation_stack_size(cont);
apply_mask_frame = StgContinuation_apply_mask_frame(cont);
mask_frame_offset = StgContinuation_mask_frame_offset(cont);
// Make sure we have enough space to restore the stack.
STK_CHK_PP_LL(WDS(new_stack_words), stg_CONTINUATION_apply, cont, io);
TICK_ENT_CONTINUATION();
LDV_ENTER(cont);
#if defined(PROFILING)
ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(cont) "ptr");
#endif
// Restore the stack.
W_ p;
p = cont + SIZEOF_StgHeader + OFFSET_StgContinuation_stack;
Sp_adj(-new_stack_words);
prim %memcpy(Sp, p, WDS(new_stack_words), SIZEOF_W);
TICK_UNKNOWN_CALL();
TICK_SLOW_CALL_fast_v();
// If `apply_mask_frame` is NULL, there’s no need to adjust the async
// exception masking state, so just apply the argument directly.
if (apply_mask_frame == NULL) {
R1 = io;
jump stg_ap_v_fast [R1];
}
// Otherwise, we need to update the masking state, but before we do, we also
// need to update the unmask frame at the bottom of the restored chunk of
// stack so that it returns the masking state to whatever it was before the
// continuation was applied (see also Note [Continuations and async exception
// masking] in Continuation.c).
if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) == 0) {
Sp(mask_frame_offset) = stg_unmaskAsyncExceptionszh_ret_info;
} else {
if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_INTERRUPTIBLE) == 0) {
Sp(mask_frame_offset) = stg_maskUninterruptiblezh_ret_info;
} else {
Sp(mask_frame_offset) = stg_maskAsyncExceptionszh_ret_info;
}
}
// Now we just set up the stack so that `apply_mask_frame` will apply `io`
// when it returns and jump to it.
Sp_adj(-2);
Sp(1) = stg_ap_v_info;
R1 = io;
jump %ENTRY_CODE(apply_mask_frame) [R1];
}
|
