Skip to content

Commit def3b17

Browse files
mshinwellmshinwell
committed
Fix semantics
1 parent 462d19f commit def3b17

File tree

6 files changed

+88
-58
lines changed

6 files changed

+88
-58
lines changed

‎ocaml/runtime/amd64.S

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -727,7 +727,6 @@ CFI_STARTPROC
727727
movq C_ARG_2, %rbx /* closure */
728728
movq 0(C_ARG_3), %rax /* argument */
729729
movq 0(%rbx), %r12 /* code pointer */
730-
LBL(120):
731730
cmp $1, C_ARG_4
732731
je LBL(caml_start_program_async_exn)
733732
jmp LBL(caml_start_program)
@@ -744,7 +743,9 @@ CFI_STARTPROC
744743
movq 0(C_ARG_3), %rax /* first argument */
745744
movq 8(C_ARG_3), %rbx /* second argument */
746745
LEA_VAR(caml_apply2, %r12) /* code pointer */
747-
jmp LBL(120)
746+
cmp $1, C_ARG_4
747+
je LBL(caml_start_program_async_exn)
748+
jmp LBL(caml_start_program)
748749
CFI_ENDPROC
749750
ENDFUNCTION(G(caml_callback2_asm))
750751

@@ -759,7 +760,9 @@ CFI_STARTPROC
759760
movq C_ARG_2, %rsi /* closure */
760761
movq 16(C_ARG_3), %rdi /* third argument */
761762
LEA_VAR(caml_apply3, %r12) /* code pointer */
762-
jmp LBL(120)
763+
cmp $1, C_ARG_4
764+
je LBL(caml_start_program_async_exn)
765+
jmp LBL(caml_start_program)
763766
CFI_ENDPROC
764767
ENDFUNCTION(G(caml_callback3_asm))
765768

‎ocaml/runtime/callback.c

Lines changed: 72 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -51,10 +51,12 @@ static void init_callback_code(void)
5151
callback_code_inited = 1;
5252
}
5353

54+
/* Functions that return all exceptions, including asynchronous ones */
55+
5456
static value caml_callbackN_exn0(value closure, int narg, value args[],
5557
int *returning_async_exn)
5658
{
57-
int i, returning_async_exn;
59+
int i;
5860
value res;
5961

6062
CAMLassert(narg + 4 <= 256);
@@ -84,15 +86,15 @@ CAMLexport value caml_callback_exn(value closure, value arg1)
8486
{
8587
value arg[1];
8688
arg[0] = arg1;
87-
return caml_callbackN_exn(closure, 1, arg);
89+
return caml_callbackN_exn0(closure, 1, arg, NULL);
8890
}
8991

9092
CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
9193
{
9294
value arg[2];
9395
arg[0] = arg1;
9496
arg[1] = arg2;
95-
return caml_callbackN_exn0(closure, 2, arg);
97+
return caml_callbackN_exn0(closure, 2, arg, NULL);
9698
}
9799

98100
CAMLexport value caml_callback3_exn(value closure,
@@ -102,10 +104,11 @@ CAMLexport value caml_callback3_exn(value closure,
102104
arg[0] = arg1;
103105
arg[1] = arg2;
104106
arg[2] = arg3;
105-
return caml_callbackN_exn0(closure, 3, arg);
107+
return caml_callbackN_exn0(closure, 3, arg, NULL);
106108
}
107109

108-
/* Exception-propagating variants of the above */
110+
/* Functions that propagate all exceptions, with any asynchronous exceptions
111+
also being propagated asynchronously. */
109112

110113
CAMLexport value caml_callbackN(value closure, int narg, value args[])
111114
{
@@ -122,23 +125,23 @@ CAMLexport value caml_callbackN(value closure, int narg, value args[])
122125
return res;
123126
}
124127

125-
CAMLexport value caml_callback_exn(value closure, value arg1)
128+
CAMLexport value caml_callback(value closure, value arg1)
126129
{
127130
value arg[1];
128131
arg[0] = arg1;
129132
return caml_callbackN(closure, 1, arg);
130133
}
131134

132-
CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
135+
CAMLexport value caml_callback2(value closure, value arg1, value arg2)
133136
{
134137
value arg[2];
135138
arg[0] = arg1;
136139
arg[1] = arg2;
137140
return caml_callbackN(closure, 2, arg);
138141
}
139142

140-
CAMLexport value caml_callback3_exn(value closure,
141-
value arg1, value arg2, value arg3)
143+
CAMLexport value caml_callback3(value closure,
144+
value arg1, value arg2, value arg3)
142145
{
143146
value arg[3];
144147
arg[0] = arg1;
@@ -152,29 +155,34 @@ CAMLexport value caml_callback3_exn(value closure,
152155
/* Native-code callbacks. */
153156

154157
typedef value (callback_stub)(caml_domain_state* state, value closure,
155-
value* args);
158+
value* args, int catch_async_exns);
156159

157160
callback_stub caml_callback_asm, caml_callback2_asm, caml_callback3_asm;
158161

159-
CAMLexport value caml_callback_exn(value closure, value arg)
162+
/* First we build functions that allow control as to whether an asynchronous
163+
exception trap frame is installed. */
164+
165+
static value callback(value closure, value arg, int catch_async_exns)
160166
{
161-
return caml_callback_asm(Caml_state, closure, &arg);
167+
return caml_callback_asm(Caml_state, closure, &arg, catch_async_exns);
162168
}
163169

164-
CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
170+
static value callback2(value closure, value arg1, value arg2,
171+
int catch_async_exns)
165172
{
166173
value args[] = {arg1, arg2};
167-
return caml_callback2_asm(Caml_state, closure, args);
174+
return caml_callback2_asm(Caml_state, closure, args, catch_async_exns);
168175
}
169176

170-
CAMLexport value caml_callback3_exn(value closure,
171-
value arg1, value arg2, value arg3)
177+
static value callback3(value closure, value arg1, value arg2, value arg3,
178+
int catch_async_exns)
172179
{
173180
value args[] = {arg1, arg2, arg3};
174-
return caml_callback3_asm(Caml_state, closure, args);
181+
return caml_callback3_asm(Caml_state, closure, args, catch_async_exns);
175182
}
176183

177-
CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
184+
static value callbackN(value closure, int narg, value args[],
185+
int catch_async_exns)
178186
{
179187
CAMLparam1 (closure);
180188
CAMLxparamN (args, narg);
@@ -186,17 +194,17 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
186194
/* Pass as many arguments as possible */
187195
switch (narg - i) {
188196
case 1:
189-
res = caml_callback_exn(res, args[i]);
197+
res = callback(res, args[i], catch_async_exns);
190198
if (Is_exception_result(res)) CAMLreturn (res);
191199
i += 1;
192200
break;
193201
case 2:
194-
res = caml_callback2_exn(res, args[i], args[i + 1]);
202+
res = callback2(res, args[i], args[i + 1], catch_async_exns);
195203
if (Is_exception_result(res)) CAMLreturn (res);
196204
i += 2;
197205
break;
198206
default:
199-
res = caml_callback3_exn(res, args[i], args[i + 1], args[i + 2]);
207+
res = callback3(res, args[i], args[i + 1], args[i + 2], catch_async_exns);
200208
if (Is_exception_result(res)) CAMLreturn (res);
201209
i += 3;
202210
break;
@@ -205,27 +213,61 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
205213
CAMLreturn (res);
206214
}
207215

208-
/* Exception-propagating variants of the above */
216+
/* Functions that return all exceptions, including asynchronous ones */
217+
218+
CAMLexport value caml_callback_exn(value closure, value arg)
219+
{
220+
return callback(closure, arg, 1);
221+
}
222+
223+
CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
224+
{
225+
return callback2(closure, arg1, arg2, 1);
226+
}
227+
228+
CAMLexport value caml_callback3_exn(value closure,
229+
value arg1, value arg2, value arg3)
230+
{
231+
return callback3(closure, arg1, arg2, arg3, 1);
232+
}
233+
234+
CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
235+
{
236+
return callbackN(closure, narg, args, 1);
237+
}
238+
239+
/* Functions that propagate all exceptions, with any asynchronous exceptions
240+
also being propagated asynchronously. In these cases we do not install
241+
an asynchronous exception trap frame, avoiding any need to perform
242+
comparisons on exception values to determine if they represent asynchronous
243+
exceptions (which would be problematic for [Sys.Break], thus likely
244+
necessitating these being wrapped in another constructor). */
245+
246+
static value raise_if_exception(value res)
247+
{
248+
if (Is_exception_result(res)) caml_raise(Extract_exception(res));
249+
return res;
250+
}
209251

210-
CAMLexport value caml_callback (value closure, value arg)
252+
CAMLexport value caml_callback(value closure, value arg)
211253
{
212-
return caml_raise_if_exception(caml_callback_exn(closure, arg));
254+
return raise_if_exception(callback(closure, arg, 0));
213255
}
214256

215-
CAMLexport value caml_callback2 (value closure, value arg1, value arg2)
257+
CAMLexport value caml_callback2(value closure, value arg1, value arg2)
216258
{
217-
return caml_raise_if_exception(caml_callback2_exn(closure, arg1, arg2));
259+
return raise_if_exception(callback2(closure, arg1, arg2, 0));
218260
}
219261

220-
CAMLexport value caml_callback3 (value closure, value arg1, value arg2,
221-
value arg3)
262+
CAMLexport value caml_callback3(value closure,
263+
value arg1, value arg2, value arg3)
222264
{
223-
return caml_raise_if_exception(caml_callback3_exn(closure, arg1, arg2, arg3));
265+
return raise_if_exception(callback3(closure, arg1, arg2, arg3, 0));
224266
}
225267

226268
CAMLexport value caml_callbackN (value closure, int narg, value args[])
227269
{
228-
return caml_raise_if_exception(caml_callbackN_exn(closure, narg, args));
270+
return raise_if_exception(callbackN(closure, narg, args, 0));
229271
}
230272

231273
#endif

‎ocaml/runtime/caml/fail.h

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -71,7 +71,6 @@ CAMLextern value caml_check_async_exn(value res, const char *msg);
7171

7272
int caml_is_special_exception(value exn);
7373

74-
CAMLextern value caml_raise_if_exception(value res);
7574
CAMLextern value caml_raise_async_if_exception(value res);
7675

7776
CAMLnoreturn_start

‎ocaml/runtime/fail.c

Lines changed: 0 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -54,12 +54,6 @@ CAMLexport value caml_prepare_for_raise(value v, int *turned_into_async_exn)
5454
return v;
5555
}
5656

57-
CAMLexport value caml_raise_if_exception(value res)
58-
{
59-
if (Is_exception_result(res)) caml_raise(Extract_exception(res));
60-
return res;
61-
}
62-
6357
CAMLexport value caml_raise_async_if_exception(value result)
6458
{
6559
if (Is_exception_result(result)) caml_raise_async(Extract_exception(result));

‎ocaml/runtime/i386.S

Lines changed: 9 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -409,6 +409,9 @@ FUNCTION(caml_callback_asm)
409409
movl 28(%esp), %edi /* arguments array */
410410
movl 0(%edi), %eax /* arg1: argument */
411411
movl 0(%ebx), %esi /* code pointer */
412+
movl 32(%esp), %ebp
413+
cmp $1, %ebp
414+
je LBL(106a)
412415
jmp LBL(106)
413416
CFI_ENDPROC
414417
ENDFUNCTION(caml_callback_asm)
@@ -426,6 +429,9 @@ FUNCTION(caml_callback2_asm)
426429
movl 0(%edi), %eax /* arg1: first argument */
427430
movl 4(%edi), %ebx /* arg2: second argument */
428431
movl $ G(caml_apply2), %esi /* code pointer */
432+
movl 32(%esp), %ebp
433+
cmp $1, %ebp
434+
je LBL(106a)
429435
jmp LBL(106)
430436
CFI_ENDPROC
431437
ENDFUNCTION(caml_callback2_asm)
@@ -444,27 +450,13 @@ FUNCTION(caml_callback3_asm)
444450
movl 4(%edi), %ebx /* arg2: second argument */
445451
movl 8(%edi), %ecx /* arg3: third argument */
446452
movl $ G(caml_apply3), %esi /* code pointer */
453+
movl 32(%esp), %ebp
454+
cmp $1, %ebp
455+
je LBL(106a)
447456
jmp LBL(106)
448457
CFI_ENDPROC
449458
ENDFUNCTION(caml_callback3_asm)
450459

451-
/* Variant of caml_callback_asm that installs an async exn trap frame. */
452-
FUNCTION(caml_callback_asm_async_exn)
453-
CFI_STARTPROC
454-
/* Save callee-save registers */
455-
pushl %ebx; CFI_ADJUST(4)
456-
pushl %esi; CFI_ADJUST(4)
457-
pushl %edi; CFI_ADJUST(4)
458-
pushl %ebp; CFI_ADJUST(4)
459-
/* Initial loading of arguments */
460-
movl 24(%esp), %ebx /* arg2: closure */
461-
movl 28(%esp), %edi /* arguments array */
462-
movl 0(%edi), %eax /* arg1: argument */
463-
movl 0(%ebx), %esi /* code pointer */
464-
jmp LBL(106a)
465-
CFI_ENDPROC
466-
ENDFUNCTION(caml_callback_asm_async_exn)
467-
468460
FUNCTION(caml_ml_array_bound_error)
469461
CFI_STARTPROC
470462
/* Empty the floating-point stack */

‎ocaml/runtime/startup_byt.c

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -425,7 +425,7 @@ CAMLexport void caml_main(char_os **argv)
425425
caml_init_atom_table();
426426
caml_init_backtrace();
427427
/* Initialize the interpreter */
428-
caml_interprete(NULL, 0);
428+
caml_interprete(NULL, 0, NULL);
429429
/* Initialize the debugger, if needed */
430430
caml_debugger_init();
431431
/* Load the code */

0 commit comments

Comments
 (0)