File 1493-erts-Optimize-fun-calls.patch of Package erlang (Revision 207f7f4af996eb233b0f6f37352d3304)
Currently displaying revision 207f7f4af996eb233b0f6f37352d3304 , Show latest
xxxxxxxxxx
1
From 0685f97a78f175d8c409429c9894592ecb0c7ac9 Mon Sep 17 00:00:00 2001
2
From: =?UTF-8?q?John=20H=C3=B6gberg?= <john@erlang.org>
3
Date: Mon, 27 Sep 2021 16:32:44 +0200
4
Subject: [PATCH 3/3] erts: Optimize fun calls
5
6
By making local and external funs share the same structure, we can
7
remove a substantial amount of code from the `call_fun` family of
8
instructions.
9
10
As a result fun calls are now about 15% faster with the interpreter
11
on my machine, 10% faster with the x64 JIT on that same machine,
12
and 15% faster with the AArch64 JIT on my M1 Mac. The improvement
13
is a bit less pronounced for funs with free variables, and a bit
14
more for those without (including external funs).
15
---
16
erts/emulator/beam/beam_bif_load.c | 3 +-
17
erts/emulator/beam/beam_common.c | 293 ++++++--------
18
erts/emulator/beam/beam_common.h | 77 ++--
19
erts/emulator/beam/beam_debug.c | 2 +-
20
erts/emulator/beam/beam_load.c | 9 +-
21
erts/emulator/beam/bif.c | 38 +-
22
erts/emulator/beam/bif.h | 2 +-
23
erts/emulator/beam/code_ix.h | 14 +
24
erts/emulator/beam/copy.c | 112 ++++--
25
erts/emulator/beam/dist.c | 2 +-
26
erts/emulator/beam/emu/beam_emu.c | 18 +-
27
erts/emulator/beam/emu/emu_load.c | 8 +-
28
erts/emulator/beam/emu/instrs.tab | 6 +-
29
erts/emulator/beam/emu/macros.tab | 4 +-
30
erts/emulator/beam/emu/trace_instrs.tab | 2 +-
31
erts/emulator/beam/erl_bif_info.c | 214 +++++-----
32
erts/emulator/beam/erl_bif_op.c | 9 +-
33
erts/emulator/beam/erl_bif_trace.c | 6 +-
34
erts/emulator/beam/erl_db_util.c | 40 +-
35
erts/emulator/beam/erl_fun.c | 183 ++++++---
36
erts/emulator/beam/erl_fun.h | 70 +++-
37
erts/emulator/beam/erl_gc.c | 68 +++-
38
erts/emulator/beam/erl_map.c | 13 +-
39
erts/emulator/beam/erl_message.c | 9 +-
40
erts/emulator/beam/erl_nif.c | 3 +-
41
erts/emulator/beam/erl_printf_term.c | 101 ++---
42
erts/emulator/beam/erl_process_dump.c | 2 +-
43
erts/emulator/beam/erl_term.c | 3 +-
44
erts/emulator/beam/erl_term.h | 28 +-
45
erts/emulator/beam/export.c | 31 +-
46
erts/emulator/beam/export.h | 21 +-
47
erts/emulator/beam/external.c | 255 ++++++------
48
erts/emulator/beam/global.h | 8 +-
49
erts/emulator/beam/jit/arm/beam_asm.hpp | 23 +-
50
.../emulator/beam/jit/arm/beam_asm_global.cpp | 4 +-
51
erts/emulator/beam/jit/arm/instr_bif.cpp | 2 +-
52
erts/emulator/beam/jit/arm/instr_call.cpp | 10 +-
53
erts/emulator/beam/jit/arm/instr_common.cpp | 21 +-
54
erts/emulator/beam/jit/arm/instr_fun.cpp | 73 ++--
55
erts/emulator/beam/jit/arm/instr_trace.cpp | 2 +-
56
erts/emulator/beam/jit/asm_load.c | 4 +-
57
erts/emulator/beam/jit/beam_jit_common.cpp | 4 +-
58
erts/emulator/beam/jit/x86/beam_asm.hpp | 25 +-
59
.../emulator/beam/jit/x86/beam_asm_global.cpp | 4 +-
60
erts/emulator/beam/jit/x86/instr_bif.cpp | 2 +-
61
erts/emulator/beam/jit/x86/instr_call.cpp | 12 +-
62
erts/emulator/beam/jit/x86/instr_common.cpp | 27 +-
63
erts/emulator/beam/jit/x86/instr_fun.cpp | 59 ++-
64
erts/emulator/beam/jit/x86/instr_trace.cpp | 2 +-
65
erts/emulator/beam/utils.c | 371 ++++++++++--------
66
erts/emulator/internal_doc/BeamAsm.md | 10 +-
67
erts/emulator/test/erts_debug_SUITE.erl | 3 +-
68
52 files changed, 1210 insertions(+), 1102 deletions(-)
69
70
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
71
index e982ef5a7d..744e8723ee 100644
72
--- a/erts/emulator/beam/beam_bif_load.c
73
+++ b/erts/emulator/beam/beam_bif_load.c
74
75
DBG_CHECK_EXPORT(ep, code_ix);
76
77
if (ep->trampoline.not_loaded.deferred != 0) {
78
- ep->addresses[code_ix] = (void*)ep->trampoline.not_loaded.deferred;
79
+ ep->dispatch.addresses[code_ix] =
80
+ (void*)ep->trampoline.not_loaded.deferred;
81
ep->trampoline.not_loaded.deferred = 0;
82
} else {
83
if (ep->bif_number != -1) {
84
diff --git a/erts/emulator/beam/beam_common.c b/erts/emulator/beam/beam_common.c
85
index c9b8dfb51d..2f713bb4d5 100644
86
--- a/erts/emulator/beam/beam_common.c
87
+++ b/erts/emulator/beam/beam_common.c
88
89
if (ERTS_PROC_IS_EXITING(c_p)) {
90
sys_strcpy(fun_buf, "<exiting>");
91
} else {
92
- ErtsCodeMFA *cmfa = erts_find_function_from_pc(c_p->i);
93
+ const ErtsCodeMFA *cmfa = erts_find_function_from_pc(c_p->i);
94
if (cmfa) {
95
dtrace_fun_decode(c_p, cmfa, NULL, fun_buf);
96
} else {
97
98
Eterm* reg, /* Contents of registers. */
99
Eterm args) /* THE_NON_VALUE or pre-built list of arguments. */
100
{
101
- Eterm fun = reg[arity];
102
- Eterm hdr;
103
- int i;
104
- Eterm* hp;
105
+ ErtsCodeIndex code_ix;
106
+ ErtsCodePtr code_ptr;
107
+ ErlFunThing *funp;
108
+ Eterm fun;
109
110
- if (!is_boxed(fun)) {
111
- goto badfun;
112
+ fun = reg[arity];
113
+
114
+ if (is_not_any_fun(fun)) {
115
+ p->current = NULL;
116
+ p->freason = EXC_BADFUN;
117
+ p->fvalue = fun;
118
+ return NULL;
119
}
120
- hdr = *boxed_val(fun);
121
122
- if (is_fun_header(hdr)) {
123
- ErlFunThing* funp = (ErlFunThing *) fun_val(fun);
124
- ErlFunEntry* fe = funp->fe;
125
- ErtsCodePtr code_ptr = fe->address;
126
- Eterm* var_ptr;
127
- unsigned num_free = funp->num_free;
128
- const ErtsCodeMFA *mfa = erts_code_to_codemfa(code_ptr);
129
- int actual_arity = mfa->arity;
130
+ funp = (ErlFunThing*)fun_val(fun);
131
132
- if (actual_arity == arity+num_free) {
133
- DTRACE_LOCAL_CALL(p, mfa);
134
- if (num_free == 0) {
135
- return code_ptr;
136
- } else {
137
- var_ptr = funp->env;
138
- reg += arity;
139
- i = 0;
140
- do {
141
- reg[i] = var_ptr[i];
142
- i++;
143
- } while (i < num_free);
144
- reg[i] = fun;
145
- return code_ptr;
146
- }
147
- return code_ptr;
148
- } else {
149
- /*
150
- * Something wrong here. First build a list of the arguments.
151
- */
152
+ code_ix = erts_active_code_ix();
153
+ code_ptr = (funp->entry.disp)->addresses[code_ix];
154
155
- if (is_non_value(args)) {
156
- Uint sz = 2 * arity;
157
- args = NIL;
158
- if (HeapWordsLeft(p) < sz) {
159
- erts_garbage_collect(p, sz, reg, arity+1);
160
- fun = reg[arity];
161
- }
162
- hp = HEAP_TOP(p);
163
- HEAP_TOP(p) += sz;
164
- for (i = arity-1; i >= 0; i--) {
165
- args = CONS(hp, reg[i], args);
166
- hp += 2;
167
- }
168
- }
169
+ if (ERTS_LIKELY(code_ptr != beam_unloaded_fun && funp->arity == arity)) {
170
+ for (int i = 0, num_free = funp->num_free; i < num_free; i++) {
171
+ reg[i + arity] = funp->env[i];
172
+ }
173
174
- if (actual_arity >= 0) {
175
- /*
176
- * There is a fun defined, but the call has the wrong arity.
177
- */
178
- hp = HAlloc(p, 3);
179
- p->freason = EXC_BADARITY;
180
- p->fvalue = TUPLE2(hp, fun, args);
181
- return NULL;
182
- } else {
183
- Export* ep;
184
- Module* modp;
185
- Eterm module;
186
- ErtsCodeIndex code_ix = erts_active_code_ix();
187
-
188
- /*
189
- * No arity. There is no module loaded that defines the fun,
190
- * either because the fun is newly created from the external
191
- * representation (the module has never been loaded),
192
- * or the module defining the fun has been unloaded.
193
- */
194
-
195
- module = fe->module;
196
-
197
- ERTS_THR_READ_MEMORY_BARRIER;
198
- if (fe->pend_purge_address) {
199
- /*
200
- * The system is currently trying to purge the
201
- * module containing this fun. Suspend the process
202
- * and let it try again when the purge operation is
203
- * done (may succeed or not).
204
- */
205
- ep = erts_suspend_process_on_pending_purge_lambda(p, fe);
206
- ASSERT(ep);
207
- }
208
- else {
209
- if ((modp = erts_get_module(module, code_ix)) != NULL
210
- && modp->curr.code_hdr != NULL) {
211
- /*
212
- * There is a module loaded, but obviously the fun is not
213
- * defined in it. We must not call the error_handler
214
- * (or we will get into an infinite loop).
215
- */
216
- goto badfun;
217
- }
218
+#ifdef USE_VM_CALL_PROBES
219
+ if (is_local_fun(funp)) {
220
+ DTRACE_LOCAL_CALL(p, erts_code_to_codemfa(code_ptr));
221
+ } else {
222
+ Export *ep = funp->entry.exp;
223
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
224
+ DTRACE_GLOBAL_CALL(p, &ep->info.mfa);
225
+ }
226
+#endif
227
228
- /*
229
- * No current code for this module. Call the error_handler module
230
- * to attempt loading the module.
231
- */
232
-
233
- ep = erts_find_function(erts_proc_get_error_handler(p),
234
- am_undefined_lambda, 3, code_ix);
235
- if (ep == NULL) { /* No error handler */
236
- p->current = NULL;
237
- p->freason = EXC_UNDEF;
238
- return NULL;
239
- }
240
- }
241
- reg[0] = module;
242
- reg[1] = fun;
243
- reg[2] = args;
244
- reg[3] = NIL;
245
- return ep->addresses[code_ix];
246
- }
247
- }
248
- } else if (is_export_header(hdr)) {
249
- Export *ep;
250
- int actual_arity;
251
+ return code_ptr;
252
+ } else {
253
+ /* Something wrong here. First build a list of the arguments. */
254
+ if (is_non_value(args)) {
255
+ Uint sz = 2 * arity;
256
+ Eterm *hp;
257
258
- ep = *((Export **) (export_val(fun) + 1));
259
- actual_arity = ep->info.mfa.arity;
260
+ args = NIL;
261
262
- if (arity == actual_arity) {
263
- DTRACE_GLOBAL_CALL(p, &ep->info.mfa);
264
- return ep->addresses[erts_active_code_ix()];
265
- } else {
266
- /*
267
- * Wrong arity. First build a list of the arguments.
268
- */
269
+ if (HeapWordsLeft(p) < sz) {
270
+ erts_garbage_collect(p, sz, reg, arity+1);
271
272
- if (is_non_value(args)) {
273
- args = NIL;
274
- hp = HAlloc(p, arity*2);
275
- for (i = arity-1; i >= 0; i--) {
276
- args = CONS(hp, reg[i], args);
277
- hp += 2;
278
- }
279
- }
280
+ fun = reg[arity];
281
+ funp = (ErlFunThing*)fun_val(fun);
282
+ }
283
284
- hp = HAlloc(p, 3);
285
- p->freason = EXC_BADARITY;
286
- p->fvalue = TUPLE2(hp, fun, args);
287
- return NULL;
288
- }
289
- } else {
290
- badfun:
291
- p->current = NULL;
292
- p->freason = EXC_BADFUN;
293
- p->fvalue = fun;
294
- return NULL;
295
+ hp = HEAP_TOP(p);
296
+ HEAP_TOP(p) += sz;
297
+
298
+ for (int i = arity - 1; i >= 0; i--) {
299
+ args = CONS(hp, reg[i], args);
300
+ hp += 2;
301
+ }
302
+ }
303
+
304
+ if (funp->arity != arity) {
305
+ /* There is a fun defined, but the call has the wrong arity. */
306
+ Eterm *hp = HAlloc(p, 3);
307
+ p->freason = EXC_BADARITY;
308
+ p->fvalue = TUPLE2(hp, fun, args);
309
+ return NULL;
310
+ } else {
311
+ ErlFunEntry *fe;
312
+ Eterm module;
313
+ Module *modp;
314
+ Export *ep;
315
+
316
+ /* There is no module loaded that defines the fun, either because
317
+ * the fun is newly created from the external representation (the
318
+ * module has never been loaded), or the module defining the fun
319
+ * has been unloaded. */
320
+ ASSERT(is_local_fun(funp) && code_ptr == beam_unloaded_fun);
321
+ fe = funp->entry.fun;
322
+ module = fe->module;
323
+
324
+ ERTS_THR_READ_MEMORY_BARRIER;
325
+ if (fe->pend_purge_address) {
326
+ /* The system is currently trying to purge the
327
+ * module containing this fun. Suspend the process
328
+ * and let it try again when the purge operation is
329
+ * done (may succeed or not). */
330
+ ep = erts_suspend_process_on_pending_purge_lambda(p, fe);
331
+ } else {
332
+ if ((modp = erts_get_module(module, code_ix)) != NULL
333
+ && modp->curr.code_hdr != NULL) {
334
+ /* There is a module loaded, but obviously the fun is
335
+ * not defined in it. We must not call the error_handler
336
+ * (or we will get into an infinite loop). */
337
+ p->current = NULL;
338
+ p->freason = EXC_BADFUN;
339
+ p->fvalue = fun;
340
+ return NULL;
341
+ }
342
+
343
+ /* No current code for this module. Call the error_handler
344
+ * module to attempt loading the module. */
345
+
346
+ ep = erts_find_function(erts_proc_get_error_handler(p),
347
+ am_undefined_lambda, 3, code_ix);
348
+ if (ep == NULL) {
349
+ /* No error handler */
350
+ p->current = NULL;
351
+ p->freason = EXC_UNDEF;
352
+ return NULL;
353
+ }
354
+ }
355
+
356
+ ASSERT(ep);
357
+
358
+ reg[0] = module;
359
+ reg[1] = fun;
360
+ reg[2] = args;
361
+ reg[3] = NIL;
362
+
363
+ return ep->dispatch.addresses[code_ix];
364
+ }
365
}
366
}
367
368
369
return call_fun(p, arity, reg, args);
370
}
371
372
-ErlFunThing*
373
-new_fun_thing(Process* p, ErlFunEntry* fe, int arity, int num_free)
374
-{
375
- ErlFunThing* funp;
376
-
377
- funp = (ErlFunThing*) p->htop;
378
- p->htop += ERL_FUN_SIZE + num_free;
379
- erts_refc_inc(&fe->refc, 2);
380
-
381
- funp->thing_word = HEADER_FUN;
382
- funp->next = MSO(p).first;
383
- MSO(p).first = (struct erl_off_heap_header*) funp;
384
- funp->fe = fe;
385
- funp->num_free = num_free;
386
- funp->creator = p->common.id;
387
- funp->arity = arity;
388
-
389
-#ifdef DEBUG
390
- {
391
- const ErtsCodeMFA *mfa = erts_get_fun_mfa(fe);
392
- ASSERT(funp->arity == mfa->arity - num_free);
393
- ASSERT(arity == fe->arity);
394
- }
395
-#endif
396
-
397
- return funp;
398
-}
399
-
400
int
401
is_function2(Eterm Term, Uint arity)
402
{
403
- if (is_fun(Term)) {
404
- ErlFunThing* funp = (ErlFunThing *) fun_val(Term);
405
- return funp->arity == arity;
406
- } else if (is_export(Term)) {
407
- Export* exp = (Export *) (export_val(Term)[1]);
408
- return exp->info.mfa.arity == arity;
409
+ if (is_any_fun(Term)) {
410
+ ErlFunThing *funp = (ErlFunThing*)fun_val(Term);
411
+ return funp->arity == arity;
412
}
413
+
414
return 0;
415
}
416
417
diff --git a/erts/emulator/beam/beam_common.h b/erts/emulator/beam/beam_common.h
418
index 15bad673d0..8d453044e2 100644
419
--- a/erts/emulator/beam/beam_common.h
420
+++ b/erts/emulator/beam/beam_common.h
421
422
423
#ifdef USE_VM_CALL_PROBES
424
425
-#define DTRACE_LOCAL_CALL(p, mfa) \
426
- if (DTRACE_ENABLED(local_function_entry)) { \
427
- DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
428
- DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
429
- int depth = STACK_START(p) - STACK_TOP(p); \
430
- dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
431
- DTRACE3(local_function_entry, process_name, mfa_buf, depth); \
432
+#define DTRACE_LOCAL_CALL(p, cmfa) \
433
+ if (DTRACE_ENABLED(local_function_entry)) { \
434
+ DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
435
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
436
+ int depth = STACK_START(p) - STACK_TOP(p); \
437
+ dtrace_fun_decode(p, cmfa, process_name, mfa_buf); \
438
+ DTRACE3(local_function_entry, process_name, mfa_buf, depth); \
439
}
440
441
-#define DTRACE_GLOBAL_CALL(p, mfa) \
442
- if (DTRACE_ENABLED(global_function_entry)) { \
443
- DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
444
- DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
445
- int depth = STACK_START(p) - STACK_TOP(p); \
446
- dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
447
+#define DTRACE_GLOBAL_CALL(p, cmfa) \
448
+ if (DTRACE_ENABLED(global_function_entry)) { \
449
+ DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
450
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
451
+ int depth = STACK_START(p) - STACK_TOP(p); \
452
+ dtrace_fun_decode(p, cmfa, process_name, mfa_buf); \
453
DTRACE3(global_function_entry, process_name, mfa_buf, depth); \
454
}
455
456
-#define DTRACE_RETURN(p, mfa) \
457
+#define DTRACE_RETURN(p, cmfa) \
458
if (DTRACE_ENABLED(function_return)) { \
459
DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
460
DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
461
int depth = STACK_START(p) - STACK_TOP(p); \
462
- dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
463
+ dtrace_fun_decode(p, cmfa, process_name, mfa_buf); \
464
DTRACE3(function_return, process_name, mfa_buf, depth); \
465
}
466
467
-#define DTRACE_BIF_ENTRY(p, mfa) \
468
+#define DTRACE_BIF_ENTRY(p, cmfa) \
469
if (DTRACE_ENABLED(bif_entry)) { \
470
DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
471
DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
472
- dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
473
+ dtrace_fun_decode(p, cmfa, process_name, mfa_buf); \
474
DTRACE2(bif_entry, process_name, mfa_buf); \
475
}
476
477
-#define DTRACE_BIF_RETURN(p, mfa) \
478
+#define DTRACE_BIF_RETURN(p, cmfa) \
479
if (DTRACE_ENABLED(bif_return)) { \
480
DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
481
DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
482
- dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
483
+ dtrace_fun_decode(p, cmfa, process_name, mfa_buf); \
484
DTRACE2(bif_return, process_name, mfa_buf); \
485
}
486
487
-#define DTRACE_NIF_ENTRY(p, mfa) \
488
+#define DTRACE_NIF_ENTRY(p, cmfa) \
489
if (DTRACE_ENABLED(nif_entry)) { \
490
DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
491
DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
492
- dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
493
+ dtrace_fun_decode(p, cmfa, process_name, mfa_buf); \
494
DTRACE2(nif_entry, process_name, mfa_buf); \
495
}
496
497
-#define DTRACE_NIF_RETURN(p, mfa) \
498
+#define DTRACE_NIF_RETURN(p, cmfa) \
499
if (DTRACE_ENABLED(nif_return)) { \
500
DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
501
DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
502
- dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
503
+ dtrace_fun_decode(p, cmfa, process_name, mfa_buf); \
504
DTRACE2(nif_return, process_name, mfa_buf); \
505
}
506
507
-#define DTRACE_GLOBAL_CALL_FROM_EXPORT(p,e) \
508
- do { \
509
- if (DTRACE_ENABLED(global_function_entry)) { \
510
- ErtsCodePtr fp__ = (((Export *) (e))->addresses[erts_active_code_ix()]); \
511
- DTRACE_GLOBAL_CALL((p), erts_code_to_codemfa(fp__)); \
512
- } \
513
+#define DTRACE_GLOBAL_CALL_FROM_EXPORT(p,e) \
514
+ do { \
515
+ if (DTRACE_ENABLED(global_function_entry)) { \
516
+ ErtsDispatchable *disp__ = &(e)->dispatch; \
517
+ ErtsCodePtr fp__ = disp__->addresses[erts_active_code_ix()]; \
518
+ DTRACE_GLOBAL_CALL((p), erts_code_to_codemfa(fp__)); \
519
+ } \
520
} while(0)
521
522
-#define DTRACE_RETURN_FROM_PC(p, i) \
523
- do { \
524
- const ErtsCodeMFA* cmfa; \
525
- if (DTRACE_ENABLED(function_return) && (cmfa = erts_find_function_from_pc(i))) { \
526
- DTRACE_RETURN((p), cmfa); \
527
- } \
528
- } while(0)
529
+#define DTRACE_RETURN_FROM_PC(p, i) \
530
+ if (DTRACE_ENABLED(function_return)) { \
531
+ const ErtsCodeMFA* cmfa = erts_find_function_from_pc(i); \
532
+ if (cmfa) { \
533
+ DTRACE_RETURN((p), cmfa); \
534
+ } \
535
+ }
536
537
#else /* USE_VM_PROBES */
538
#define DTRACE_LOCAL_CALL(p, mfa) do {} while (0)
539
540
Export* apply(Process* p, Eterm* reg, ErtsCodePtr I, Uint offs);
541
ErtsCodePtr call_fun(Process* p, int arity, Eterm* reg, Eterm args);
542
ErtsCodePtr apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg);
543
-ErlFunThing* new_fun_thing(Process* p,
544
- ErlFunEntry* fe,
545
- int arity,
546
- int num_free);
547
int is_function2(Eterm Term, Uint arity);
548
Eterm erts_gc_new_map(Process* p, Eterm* reg, Uint live,
549
Uint n, const Eterm* data);
550
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
551
index e995ca28db..6716ef92bd 100644
552
--- a/erts/emulator/beam/beam_debug.c
553
+++ b/erts/emulator/beam/beam_debug.c
554
555
* But this code_ptr will point to the start of the Export,
556
* not the function's func_info instruction. BOOM !?
557
*/
558
- cmfa = erts_code_to_codemfa(ep->addresses[code_ix]);
559
+ cmfa = erts_code_to_codemfa(ep->dispatch.addresses[code_ix]);
560
} else if (modp == NULL || (code_hdr = modp->curr.code_hdr) == NULL) {
561
BIF_RET(am_undef);
562
} else {
563
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
564
index e2de7e751f..bd38bb4eb0 100644
565
--- a/erts/emulator/beam/beam_load.c
566
+++ b/erts/emulator/beam/beam_load.c
567
568
569
erts_clear_export_break(mod_tab_p, ep);
570
571
- ep->addresses[code_ix] =
572
+ ep->dispatch.addresses[code_ix] =
573
(ErtsCodePtr)ep->trampoline.breakpoint.address;
574
ep->trampoline.breakpoint.address = 0;
575
576
577
}
578
case FUN_SUBTAG:
579
{
580
- ErlFunEntry* fe = ((ErlFunThing*)oh)->fe;
581
+ /* We _KNOW_ that this is a local fun, otherwise it would not
582
+ * be part of the off-heap list. */
583
+ ErlFunEntry* fe = ((ErlFunThing*)oh)->entry.fun;
584
+
585
+ ASSERT(is_local_fun((ErlFunThing*)oh));
586
+
587
if (erts_refc_dectest(&fe->refc, 0) == 0) {
588
erts_erase_fun_entry(fe);
589
}
590
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
591
index a38aa6d022..ba2bf6df4c 100644
592
--- a/erts/emulator/beam/bif.c
593
+++ b/erts/emulator/beam/bif.c
594
595
#include "erl_map.h"
596
#include "erl_msacc.h"
597
#include "erl_proc_sig_queue.h"
598
+#include "erl_fun.h"
599
#include "ryu.h"
600
#include "jit/beam_asm.h"
601
602
603
switch (arityval(tp[0])) {
604
case 2:
605
/* {Fun,Args} */
606
- if (is_fun(tp[1])) {
607
+ if (is_any_fun(tp[1])) {
608
must_copy = 1;
609
} else {
610
goto error;
611
612
* {Fun,Args,Location}
613
* {M,F,A}
614
*/
615
- if (is_fun(tp[1])) {
616
+ if (is_any_fun(tp[1])) {
617
location = tp[3];
618
} else if (is_atom(tp[1]) && is_atom(tp[2])) {
619
must_copy = 1;
620
621
622
BIF_RETTYPE make_fun_3(BIF_ALIST_3)
623
{
624
- Eterm* hp;
625
+ ErlFunThing *funp;
626
+ Eterm *hp;
627
+ Export *ep;
628
Sint arity;
629
630
- if (is_not_atom(BIF_ARG_1) || is_not_atom(BIF_ARG_2) || is_not_small(BIF_ARG_3)) {
631
- error:
632
- BIF_ERROR(BIF_P, BADARG);
633
+ if (is_not_atom(BIF_ARG_1) ||
634
+ is_not_atom(BIF_ARG_2) ||
635
+ is_not_small(BIF_ARG_3)) {
636
+ BIF_ERROR(BIF_P, BADARG);
637
}
638
+
639
arity = signed_val(BIF_ARG_3);
640
if (arity < 0) {
641
- goto error;
642
+ BIF_ERROR(BIF_P, BADARG);
643
}
644
- hp = HAlloc(BIF_P, 2);
645
- hp[0] = HEADER_EXPORT;
646
- hp[1] = (Eterm) erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity);
647
- BIF_RET(make_export(hp));
648
+
649
+ hp = HAlloc(BIF_P, ERL_FUN_SIZE);
650
+
651
+ ep = erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity);
652
+ funp = erts_new_export_fun_thing(&hp, ep, arity);
653
+
654
+ BIF_RET(make_fun(funp));
655
}
656
657
BIF_RETTYPE fun_to_list_1(BIF_ALIST_1)
658
659
Process* p = BIF_P;
660
Eterm fun = BIF_ARG_1;
661
662
- if (is_not_any_fun(fun))
663
- BIF_ERROR(p, BADARG);
664
+ if (is_not_any_fun(fun)) {
665
+ BIF_ERROR(p, BADARG);
666
+ }
667
+
668
BIF_RET(term2list_dsprintf(p, fun));
669
}
670
671
672
}
673
674
#ifdef BEAMASM
675
- ep->addresses[ERTS_SAVE_CALLS_CODE_IX] = beam_save_calls;
676
+ ep->dispatch.addresses[ERTS_SAVE_CALLS_CODE_IX] = beam_save_calls;
677
#endif
678
679
ep->bif_number = -1;
680
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
681
index 5f68ba2ad3..e285126780 100644
682
--- a/erts/emulator/beam/bif.h
683
+++ b/erts/emulator/beam/bif.h
684
685
686
#define ERTS_BIF_PREP_TRAP(Export, Proc, Arity) \
687
do { \
688
- (Proc)->i = (Export)->addresses[erts_active_code_ix()]; \
689
+ (Proc)->i = (Export)->dispatch.addresses[erts_active_code_ix()]; \
690
(Proc)->arity = (Arity); \
691
(Proc)->freason = TRAP; \
692
} while(0);
693
diff --git a/erts/emulator/beam/code_ix.h b/erts/emulator/beam/code_ix.h
694
index 6e328e4a76..8412ff8304 100644
695
--- a/erts/emulator/beam/code_ix.h
696
+++ b/erts/emulator/beam/code_ix.h
697
698
699
700
#define ERTS_NUM_CODE_IX 3
701
+
702
+#ifdef BEAMASM
703
+#define ERTS_ADDRESSV_SIZE (ERTS_NUM_CODE_IX + 1)
704
+#define ERTS_SAVE_CALLS_CODE_IX (ERTS_ADDRESSV_SIZE - 1)
705
+#else
706
+#define ERTS_ADDRESSV_SIZE ERTS_NUM_CODE_IX
707
+#endif
708
+
709
+/* This structure lets `Export` entries and `ErlFunEntry` share dispatch code,
710
+ * which greatly improves the performance of fun calls. */
711
+typedef struct ErtsDispatchable_ {
712
+ ErtsCodePtr addresses[ERTS_ADDRESSV_SIZE];
713
+} ErtsDispatchable;
714
+
715
typedef unsigned ErtsCodeIndex;
716
717
typedef struct ErtsCodeMFA_ {
718
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
719
index 23335fe595..cdcaec1038 100644
720
--- a/erts/emulator/beam/copy.c
721
+++ b/erts/emulator/beam/copy.c
722
723
*htop++ = *objp++;
724
}
725
funp = (ErlFunThing *) tp;
726
- funp->next = off_heap->first;
727
- off_heap->first = (struct erl_off_heap_header*) funp;
728
- erts_refc_inc(&funp->fe->refc, 2);
729
+
730
+ if (is_local_fun(funp)) {
731
+ funp->next = off_heap->first;
732
+ off_heap->first = (struct erl_off_heap_header*) funp;
733
+ erts_refc_inc(&funp->entry.fun->refc, 2);
734
+ } else {
735
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
736
+ }
737
+
738
*argp = make_fun(tp);
739
}
740
break;
741
742
*hp++ = HEAP_ELEM_TO_BE_FILLED;
743
}
744
}
745
- funp->next = off_heap->first;
746
- off_heap->first = (struct erl_off_heap_header*) funp;
747
- erts_refc_inc(&funp->fe->refc, 2);
748
+
749
+ if (is_local_fun(funp)) {
750
+ funp->next = off_heap->first;
751
+ off_heap->first = (struct erl_off_heap_header*) funp;
752
+ erts_refc_inc(&funp->entry.fun->refc, 2);
753
+ } else {
754
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
755
+ }
756
+
757
goto cleanup_next;
758
}
759
case MAP_SUBTAG:
760
761
}
762
goto off_heap_common;
763
764
- case FUN_SUBTAG:
765
- {
766
- ErlFunThing* funp = (ErlFunThing *) (tp-1);
767
- erts_refc_inc(&funp->fe->refc, 2);
768
- }
769
- goto off_heap_common;
770
+ case FUN_SUBTAG:
771
+ {
772
+ ErlFunThing* funp = (ErlFunThing *) (tp-1);
773
+
774
+ if (is_local_fun(funp)) {
775
+ erts_refc_inc(&funp->entry.fun->refc, 2);
776
+ goto off_heap_common;
777
+ } else {
778
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
779
+ goto default_copy;
780
+ }
781
+ }
782
case EXTERNAL_PID_SUBTAG:
783
case EXTERNAL_PORT_SUBTAG:
784
case EXTERNAL_REF_SUBTAG:
785
786
}
787
/* Fall through... */
788
}
789
+ default_copy:
790
default:
791
{
792
int tari = header_arity(val);
793
794
Eterm* hp = *hpp;
795
796
while (ptr != end) {
797
- Eterm val;
798
- ASSERT(ptr < end);
799
- val = *ptr;
800
- ASSERT(val != ERTS_HOLE_MARKER);
801
- if (is_header(val)) {
802
- struct erl_off_heap_header* hdr = (struct erl_off_heap_header*)hp;
803
- ASSERT(ptr + header_arity(val) < end);
804
- ptr = move_boxed(ptr, val, &hp, &dummy_ref);
805
- switch (val & _HEADER_SUBTAG_MASK) {
806
- case REF_SUBTAG:
807
- if (!is_magic_ref_thing(hdr))
808
- break;
809
- case REFC_BINARY_SUBTAG:
810
- case FUN_SUBTAG:
811
- case EXTERNAL_PID_SUBTAG:
812
- case EXTERNAL_PORT_SUBTAG:
813
- case EXTERNAL_REF_SUBTAG:
814
- hdr->next = off_heap->first;
815
- off_heap->first = hdr;
816
- break;
817
- }
818
- }
819
- else { /* must be a cons cell */
820
- ASSERT(ptr+1 < end);
821
- move_cons(ptr, val, &hp, &dummy_ref);
822
- ptr += 2;
823
- }
824
+ Eterm val;
825
+ ASSERT(ptr < end);
826
+ val = *ptr;
827
+ ASSERT(val != ERTS_HOLE_MARKER);
828
+
829
+ if (is_header(val)) {
830
+ struct erl_off_heap_header* hdr = (struct erl_off_heap_header*)hp;
831
+
832
+ ASSERT(ptr + header_arity(val) < end);
833
+ ptr = move_boxed(ptr, val, &hp, &dummy_ref);
834
+
835
+ switch (val & _HEADER_SUBTAG_MASK) {
836
+ case REF_SUBTAG:
837
+ if (!is_magic_ref_thing(hdr)) {
838
+ break;
839
+ }
840
+ case REFC_BINARY_SUBTAG:
841
+ case EXTERNAL_PID_SUBTAG:
842
+ case EXTERNAL_PORT_SUBTAG:
843
+ case EXTERNAL_REF_SUBTAG:
844
+ hdr->next = off_heap->first;
845
+ off_heap->first = hdr;
846
+ break;
847
+ case FUN_SUBTAG:
848
+ {
849
+ ErlFunThing *funp = (ErlFunThing*)hdr;
850
+
851
+ if (is_local_fun(funp)) {
852
+ hdr->next = off_heap->first;
853
+ off_heap->first = hdr;
854
+ } else {
855
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
856
+ }
857
+ }
858
+ break;
859
+ }
860
+ } else { /* must be a cons cell */
861
+ ASSERT(ptr+1 < end);
862
+ move_cons(ptr, val, &hp, &dummy_ref);
863
+ ptr += 2;
864
+ }
865
}
866
+
867
*hpp = hp;
868
OH_OVERHEAD(off_heap, frag->off_heap.overhead);
869
frag->off_heap.first = NULL;
870
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
871
index e8392cd486..7bdbd6673e 100644
872
--- a/erts/emulator/beam/dist.c
873
+++ b/erts/emulator/beam/dist.c
874
875
goto error;
876
877
/* Check that all trap functions are defined !! */
878
- if (dmonitor_node_trap->addresses[0] == NULL) {
879
+ if (dmonitor_node_trap->dispatch.addresses[0] == NULL) {
880
goto error;
881
}
882
883
diff --git a/erts/emulator/beam/emu/beam_emu.c b/erts/emulator/beam/emu/beam_emu.c
884
index b16e23c61e..b1ba6d8e51 100644
885
--- a/erts/emulator/beam/emu/beam_emu.c
886
+++ b/erts/emulator/beam/emu/beam_emu.c
887
888
if (ERTS_PROC_IS_EXITING(c_p)) {
889
sys_strcpy(fun_buf, "<exiting>");
890
} else {
891
- ErtsCodeMFA *cmfa = erts_find_function_from_pc(c_p->i);
892
+ const ErtsCodeMFA *cmfa = erts_find_function_from_pc(c_p->i);
893
if (cmfa) {
894
dtrace_fun_decode(c_p, cmfa,
895
NULL, fun_buf);
896
897
* can get the module, function, and arity for the function being
898
* called from I[-3], I[-2], and I[-1] respectively.
899
*/
900
- context_switch_fun:
901
- /* Add one for the environment of the fun */
902
- c_p->arity = erts_code_to_codemfa(I)->arity + 1;
903
- goto context_switch2;
904
-
905
context_switch:
906
- c_p->arity = erts_code_to_codemfa(I)->arity;
907
-
908
- context_switch2: /* Entry for fun calls. */
909
- c_p->current = erts_code_to_codemfa(I);
910
+ {
911
+ const ErtsCodeMFA *mfa = erts_code_to_codemfa(I);
912
+ c_p->arity = mfa->arity;
913
+ c_p->current = mfa;
914
+ }
915
916
context_switch3:
917
918
919
HEAVY_SWAPIN;
920
921
if (error_handler) {
922
- I = error_handler->addresses[erts_active_code_ix()];
923
+ I = error_handler->dispatch.addresses[erts_active_code_ix()];
924
Goto(*I);
925
}
926
}
927
diff --git a/erts/emulator/beam/emu/emu_load.c b/erts/emulator/beam/emu/emu_load.c
928
index 6ca9f28f4c..418721894a 100644
929
--- a/erts/emulator/beam/emu/emu_load.c
930
+++ b/erts/emulator/beam/emu/emu_load.c
931
932
erts_refc_dectest(&fun_entry->refc, 1);
933
}
934
935
- fun_entry->address = stp->codev + stp->labels[lambda->label].value;
936
+ erts_set_fun_code(fun_entry,
937
+ stp->codev + stp->labels[lambda->label].value);
938
}
939
940
lp = stp->lambda_patches;
941
942
*/
943
ep->trampoline.not_loaded.deferred = (BeamInstr) address;
944
} else {
945
- ep->addresses[erts_staging_code_ix()] = address;
946
+ ep->dispatch.addresses[erts_staging_code_ix()] = address;
947
}
948
}
949
950
951
Export *ep = erts_export_put(entry->module,
952
entry->name,
953
entry->arity);
954
- const BeamInstr *addr = ep->addresses[erts_staging_code_ix()];
955
+ const BeamInstr *addr =
956
+ ep->dispatch.addresses[erts_staging_code_ix()];
957
958
if (!ErtsInArea(addr, stp->codev, stp->ci * sizeof(BeamInstr))) {
959
erts_exit(ERTS_ABORT_EXIT,
960
diff --git a/erts/emulator/beam/emu/instrs.tab b/erts/emulator/beam/emu/instrs.tab
961
index 74f75ff1ce..7ff36b8473 100644
962
--- a/erts/emulator/beam/emu/instrs.tab
963
+++ b/erts/emulator/beam/emu/instrs.tab
964
965
save_calls(c_p, ep);
966
}
967
968
- $Next = ep->addresses[erts_active_code_ix()];
969
+ $Next = ep->dispatch.addresses[erts_active_code_ix()];
970
}
971
972
HANDLE_APPLY_ERROR() {
973
974
save_calls(c_p, ep);
975
}
976
977
- $Next = ep->addresses[erts_active_code_ix()];
978
+ $Next = ep->dispatch.addresses[erts_active_code_ix()];
979
}
980
981
apply(Arity) {
982
983
int i, num_free = $NumFree;
984
//| -no_next
985
SWAPOUT;
986
- funp = new_fun_thing(c_p, fe, $Arity, num_free);
987
+ funp = erts_new_local_fun_thing(c_p, fe, $Arity, num_free);
988
SWAPIN;
989
I = $NEXT_INSTRUCTION;
990
for (i = 0; i < num_free; i++) {
991
diff --git a/erts/emulator/beam/emu/macros.tab b/erts/emulator/beam/emu/macros.tab
992
index f7aa49634a..efbd9b73b7 100644
993
--- a/erts/emulator/beam/emu/macros.tab
994
+++ b/erts/emulator/beam/emu/macros.tab
995
996
997
DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, ep);
998
999
- SET_I(ep->addresses[erts_active_code_ix()]);
1000
+ SET_I(ep->dispatch.addresses[erts_active_code_ix()]);
1001
CHECK_ARGS(I);
1002
dis_next = *I;
1003
1004
1005
FCALLS--;
1006
Goto(dis_next);
1007
} else {
1008
- goto context_switch_fun;
1009
+ goto context_switch;
1010
}
1011
}
1012
1013
diff --git a/erts/emulator/beam/emu/trace_instrs.tab b/erts/emulator/beam/emu/trace_instrs.tab
1014
index 630a9eb2d9..f3263318d9 100644
1015
--- a/erts/emulator/beam/emu/trace_instrs.tab
1016
+++ b/erts/emulator/beam/emu/trace_instrs.tab
1017
1018
HEAVY_SWAPIN;
1019
1020
if (breakpoint_handler) {
1021
- I = breakpoint_handler->addresses[erts_active_code_ix()];
1022
+ I = breakpoint_handler->dispatch.addresses[erts_active_code_ix()];
1023
Goto(*I);
1024
}
1025
1026
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
1027
index 8e29f126a9..b6f925bc52 100644
1028
--- a/erts/emulator/beam/erl_bif_info.c
1029
+++ b/erts/emulator/beam/erl_bif_info.c
1030
1031
Process* p = BIF_P;
1032
Eterm fun = BIF_ARG_1;
1033
Eterm what = BIF_ARG_2;
1034
+
1035
+ const ErtsCodeMFA *mfa;
1036
+ ErlFunThing *funp;
1037
+ ErlFunEntry *fe;
1038
Eterm* hp;
1039
Eterm val;
1040
1041
- if (is_fun(fun)) {
1042
- ErlFunThing* funp = (ErlFunThing *) fun_val(fun);
1043
+ if (is_not_any_fun(fun)) {
1044
+ BIF_ERROR(p, BADARG);
1045
+ }
1046
1047
- switch (what) {
1048
- case am_type:
1049
- hp = HAlloc(p, 3);
1050
- val = am_local;
1051
- break;
1052
- case am_pid:
1053
- hp = HAlloc(p, 3);
1054
- val = funp->creator;
1055
- break;
1056
- case am_module:
1057
- hp = HAlloc(p, 3);
1058
- val = funp->fe->module;
1059
- break;
1060
- case am_new_index:
1061
- hp = HAlloc(p, 3);
1062
- val = make_small(funp->fe->index);
1063
- break;
1064
- case am_new_uniq:
1065
- val = new_binary(p, funp->fe->uniq, 16);
1066
- hp = HAlloc(p, 3);
1067
- break;
1068
- case am_index:
1069
- hp = HAlloc(p, 3);
1070
- val = make_small(funp->fe->old_index);
1071
- break;
1072
- case am_uniq:
1073
- hp = HAlloc(p, 3);
1074
- val = make_small(funp->fe->old_uniq);
1075
- break;
1076
- case am_env:
1077
- {
1078
- Uint num_free = funp->num_free;
1079
- int i;
1080
-
1081
- hp = HAlloc(p, 3 + 2*num_free);
1082
- val = NIL;
1083
- for (i = num_free-1; i >= 0; i--) {
1084
- val = CONS(hp, funp->env[i], val);
1085
- hp += 2;
1086
- }
1087
- }
1088
- break;
1089
- case am_refc:
1090
- val = erts_make_integer(erts_atomic_read_nob(&funp->fe->refc), p);
1091
- hp = HAlloc(p, 3);
1092
- break;
1093
- case am_arity:
1094
- hp = HAlloc(p, 3);
1095
- val = make_small(funp->arity);
1096
- break;
1097
- case am_name:
1098
- {
1099
- const ErtsCodeMFA *mfa = erts_get_fun_mfa(funp->fe);
1100
- hp = HAlloc(p, 3);
1101
- val = mfa->function;
1102
- }
1103
- break;
1104
- default:
1105
- goto error;
1106
- }
1107
- } else if (is_export(fun)) {
1108
- Export* exp = (Export *) ((UWord) (export_val(fun))[1]);
1109
- switch (what) {
1110
- case am_type:
1111
- hp = HAlloc(p, 3);
1112
- val = am_external;
1113
- break;
1114
- case am_pid:
1115
- hp = HAlloc(p, 3);
1116
- val = am_undefined;
1117
- break;
1118
- case am_module:
1119
- hp = HAlloc(p, 3);
1120
- val = exp->info.mfa.module;
1121
- break;
1122
- case am_new_index:
1123
- hp = HAlloc(p, 3);
1124
- val = am_undefined;
1125
- break;
1126
- case am_new_uniq:
1127
- hp = HAlloc(p, 3);
1128
- val = am_undefined;
1129
- break;
1130
- case am_index:
1131
- hp = HAlloc(p, 3);
1132
- val = am_undefined;
1133
- break;
1134
- case am_uniq:
1135
- hp = HAlloc(p, 3);
1136
- val = am_undefined;
1137
- break;
1138
- case am_env:
1139
- hp = HAlloc(p, 3);
1140
- val = NIL;
1141
- break;
1142
- case am_refc:
1143
- hp = HAlloc(p, 3);
1144
- val = am_undefined;
1145
- break;
1146
- case am_arity:
1147
- hp = HAlloc(p, 3);
1148
- val = make_small(exp->info.mfa.arity);
1149
- break;
1150
- case am_name:
1151
- hp = HAlloc(p, 3);
1152
- val = exp->info.mfa.function;
1153
- break;
1154
- default:
1155
- goto error;
1156
- }
1157
+ funp = (ErlFunThing *) fun_val(fun);
1158
+
1159
+ if (is_local_fun(funp)) {
1160
+ fe = funp->entry.fun;
1161
+ mfa = erts_get_fun_mfa(fe);
1162
} else {
1163
- error:
1164
- BIF_ERROR(p, BADARG);
1165
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
1166
+ mfa = &(funp->entry.exp)->info.mfa;
1167
+ fe = NULL;
1168
}
1169
+
1170
+ switch (what) {
1171
+ case am_type:
1172
+ val = is_local_fun(funp) ? am_local : am_external;
1173
+ hp = HAlloc(p, 3);
1174
+ break;
1175
+ case am_pid:
1176
+ val = is_local_fun(funp) ? funp->creator : am_undefined;
1177
+ hp = HAlloc(p, 3);
1178
+ break;
1179
+ case am_module:
1180
+ val = mfa->module;
1181
+ hp = HAlloc(p, 3);
1182
+ break;
1183
+ case am_new_index:
1184
+ val = is_local_fun(funp) ? make_small(fe->index) : am_undefined;
1185
+ hp = HAlloc(p, 3);
1186
+ break;
1187
+ case am_new_uniq:
1188
+ val = is_local_fun(funp) ? new_binary(p, fe->uniq, 16) :
1189
+ am_undefined;
1190
+ hp = HAlloc(p, 3);
1191
+ break;
1192
+ case am_index:
1193
+ val = is_local_fun(funp) ? make_small(fe->old_index) : am_undefined;
1194
+ hp = HAlloc(p, 3);
1195
+ break;
1196
+ case am_uniq:
1197
+ val = is_local_fun(funp) ? make_small(fe->old_uniq) : am_undefined;
1198
+ hp = HAlloc(p, 3);
1199
+ break;
1200
+ case am_env:
1201
+ {
1202
+ Uint num_free = funp->num_free;
1203
+ int i;
1204
+
1205
+ hp = HAlloc(p, 3 + 2 * num_free);
1206
+ val = NIL;
1207
+
1208
+ for (i = num_free - 1; i >= 0; i--) {
1209
+ val = CONS(hp, funp->env[i], val);
1210
+ hp += 2;
1211
+ }
1212
+ }
1213
+ break;
1214
+ case am_refc:
1215
+ if (is_local_fun(funp)) {
1216
+ val = erts_make_integer(erts_atomic_read_nob(&fe->refc), p);
1217
+ } else {
1218
+ val = am_undefined;
1219
+ }
1220
+
1221
+ hp = HAlloc(p, 3);
1222
+ break;
1223
+ case am_arity:
1224
+ val = make_small(funp->arity);
1225
+ hp = HAlloc(p, 3);
1226
+ break;
1227
+ case am_name:
1228
+ hp = HAlloc(p, 3);
1229
+ val = mfa->function;
1230
+ break;
1231
+ default:
1232
+ BIF_ERROR(p, BADARG);
1233
+ }
1234
+
1235
return TUPLE2(hp, what, val);
1236
}
1237
1238
1239
Eterm fun = BIF_ARG_1;
1240
Eterm* hp;
1241
1242
- if (is_fun(fun)) {
1243
+ if (is_any_fun(fun)) {
1244
const ErtsCodeMFA *mfa;
1245
ErlFunThing* funp;
1246
1247
funp = (ErlFunThing *) fun_val(fun);
1248
- mfa = erts_get_fun_mfa(funp->fe);
1249
+
1250
+ if (is_local_fun(funp)) {
1251
+ mfa = erts_get_fun_mfa(funp->entry.fun);
1252
+ } else {
1253
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
1254
+ mfa = &(funp->entry.exp)->info.mfa;
1255
+ }
1256
1257
hp = HAlloc(p, 4);
1258
BIF_RET(TUPLE3(hp,
1259
- (funp->fe)->module,
1260
+ mfa->module,
1261
mfa->function,
1262
make_small(funp->arity)));
1263
- } else if (is_export(fun)) {
1264
- Export* exp = (Export *) ((UWord) (export_val(fun))[1]);
1265
- hp = HAlloc(p, 4);
1266
- BIF_RET(TUPLE3(hp,exp->info.mfa.module,
1267
- exp->info.mfa.function,
1268
- make_small(exp->info.mfa.arity)));
1269
}
1270
+
1271
BIF_ERROR(p, BADARG);
1272
}
1273
1274
diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c
1275
index a594ec1493..d925acf3da 100644
1276
--- a/erts/emulator/beam/erl_bif_op.c
1277
+++ b/erts/emulator/beam/erl_bif_op.c
1278
1279
goto error;
1280
}
1281
1282
- if (is_fun(arg1)) {
1283
+ if (is_any_fun(arg1)) {
1284
ErlFunThing* funp = (ErlFunThing *) fun_val(arg1);
1285
1286
if (funp->arity == (Uint) arity) {
1287
BIF_RET(am_true);
1288
}
1289
- } else if (is_export(arg1)) {
1290
- Export* exp = (Export *) (export_val(arg1)[1]);
1291
-
1292
- if (exp->info.mfa.arity == (Uint) arity) {
1293
- BIF_RET(am_true);
1294
- }
1295
}
1296
+
1297
BIF_RET(am_false);
1298
}
1299
1300
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
1301
index fc30c7457c..e6d11966fb 100644
1302
--- a/erts/emulator/beam/erl_bif_trace.c
1303
+++ b/erts/emulator/beam/erl_bif_trace.c
1304
1305
ep->info.op = BeamOpCodeAddr(op_i_func_info_IaaI);
1306
#endif
1307
ep->trampoline.common.op = BeamOpCodeAddr(op_trace_jump_W);
1308
- ep->trampoline.trace.address = (BeamInstr) ep->addresses[code_ix];
1309
+ ep->trampoline.trace.address =
1310
+ (BeamInstr) ep->dispatch.addresses[code_ix];
1311
}
1312
1313
erts_set_export_trace(ci_rw, match_prog_set, 0);
1314
1315
1316
if (erts_is_export_trampoline_active(ep, code_ix)) {
1317
ASSERT(BeamIsOpCode(ep->trampoline.common.op, op_trace_jump_W));
1318
- ep->addresses[code_ix] = (ErtsCodePtr)ep->trampoline.trace.address;
1319
+ ep->dispatch.addresses[code_ix] =
1320
+ (ErtsCodePtr)ep->trampoline.trace.address;
1321
}
1322
}
1323
}
1324
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
1325
index df977fea61..87a66b6085 100644
1326
--- a/erts/emulator/beam/erl_db_util.c
1327
+++ b/erts/emulator/beam/erl_db_util.c
1328
1329
1330
for (u.hdr = obj->first_oh; u.hdr; u.hdr = u.hdr->next) {
1331
erts_align_offheap(&u, &tmp);
1332
- switch (thing_subtag(u.hdr->thing_word)) {
1333
- case REFC_BINARY_SUBTAG:
1334
+ switch (thing_subtag(u.hdr->thing_word)) {
1335
+ case REFC_BINARY_SUBTAG:
1336
erts_bin_release(u.pb->val);
1337
- break;
1338
- case FUN_SUBTAG:
1339
- if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) {
1340
- erts_erase_fun_entry(u.fun->fe);
1341
- }
1342
- break;
1343
- case REF_SUBTAG:
1344
- ASSERT(is_magic_ref_thing(u.hdr));
1345
+ break;
1346
+ case FUN_SUBTAG:
1347
+ /* We _KNOW_ that this is a local fun, otherwise it would not
1348
+ * be part of the off-heap list. */
1349
+ ASSERT(is_local_fun(u.fun));
1350
+ if (erts_refc_dectest(&u.fun->entry.fun->refc, 0) == 0) {
1351
+ erts_erase_fun_entry(u.fun->entry.fun);
1352
+ }
1353
+ break;
1354
+ case REF_SUBTAG:
1355
+ ASSERT(is_magic_ref_thing(u.hdr));
1356
erts_bin_release((Binary *)u.mref->mb);
1357
- break;
1358
- default:
1359
- ASSERT(is_external_header(u.hdr->thing_word));
1360
- erts_deref_node_entry(u.ext->node, make_boxed(u.ep));
1361
- break;
1362
- }
1363
+ break;
1364
+ default:
1365
+ ASSERT(is_external_header(u.hdr->thing_word));
1366
+ erts_deref_node_entry(u.ext->node, make_boxed(u.ep));
1367
+ break;
1368
+ }
1369
}
1370
+
1371
#ifdef DEBUG_CLONE
1372
if (obj->debug_clone != NULL) {
1373
- erts_free(ERTS_ALC_T_DB_TERM, obj->debug_clone);
1374
- obj->debug_clone = NULL;
1375
+ erts_free(ERTS_ALC_T_DB_TERM, obj->debug_clone);
1376
+ obj->debug_clone = NULL;
1377
}
1378
#endif
1379
}
1380
diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c
1381
index 4267cbed63..7c288d8c14 100644
1382
--- a/erts/emulator/beam/erl_fun.c
1383
+++ b/erts/emulator/beam/erl_fun.c
1384
1385
#include "hash.h"
1386
#include "beam_common.h"
1387
1388
+/* Container structure for fun entries, allowing us to start `ErlFunEntry` with
1389
+ * a field other than its `HashBucket`. */
1390
+typedef struct erl_fun_entry_container {
1391
+ /* !! MUST BE THE FIRST FIELD !! */
1392
+ HashBucket bucket;
1393
+
1394
+ ErlFunEntry entry;
1395
+} ErlFunEntryContainer;
1396
+
1397
static Hash erts_fun_table;
1398
1399
static erts_rwmtx_t erts_fun_table_lock;
1400
1401
#define erts_fun_write_lock() erts_rwmtx_rwlock(&erts_fun_table_lock)
1402
#define erts_fun_write_unlock() erts_rwmtx_rwunlock(&erts_fun_table_lock)
1403
1404
-static HashValue fun_hash(ErlFunEntry* obj);
1405
-static int fun_cmp(ErlFunEntry* obj1, ErlFunEntry* obj2);
1406
-static ErlFunEntry* fun_alloc(ErlFunEntry* template);
1407
-static void fun_free(ErlFunEntry* obj);
1408
+static HashValue fun_hash(ErlFunEntryContainer* obj);
1409
+static int fun_cmp(ErlFunEntryContainer* obj1, ErlFunEntryContainer* obj2);
1410
+static ErlFunEntryContainer* fun_alloc(ErlFunEntryContainer* template);
1411
+static void fun_free(ErlFunEntryContainer* obj);
1412
1413
void
1414
erts_init_fun_table(void)
1415
1416
erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index,
1417
const byte* uniq, int index, int arity)
1418
{
1419
- ErlFunEntry template;
1420
- ErlFunEntry* fe;
1421
+ ErlFunEntryContainer template;
1422
+ ErlFunEntryContainer *fc;
1423
+ ErlFunEntry *tp;
1424
erts_aint_t refc;
1425
1426
+ tp = &template.entry;
1427
+
1428
/* All fields are copied from the template when inserting a new entry. */
1429
ASSERT(is_atom(mod));
1430
- template.old_index = old_index;
1431
- template.old_uniq = old_uniq;
1432
- template.index = index;
1433
- template.module = mod;
1434
- template.arity = arity;
1435
- sys_memcpy(template.uniq, uniq, sizeof(template.uniq));
1436
+ tp->old_index = old_index;
1437
+ tp->old_uniq = old_uniq;
1438
+ tp->index = index;
1439
+ tp->module = mod;
1440
+ tp->arity = arity;
1441
+
1442
+ sys_memcpy(tp->uniq, uniq, sizeof(tp->uniq));
1443
1444
erts_fun_write_lock();
1445
- fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template);
1446
- refc = erts_refc_inctest(&fe->refc, 0);
1447
+ fc = (ErlFunEntryContainer*)hash_put(&erts_fun_table, (void*)&template);
1448
+ refc = erts_refc_inctest(&fc->entry.refc, 0);
1449
if (refc < 2) {
1450
/* New or pending delete */
1451
- erts_refc_inc(&fe->refc, 1);
1452
+ erts_refc_inc(&fc->entry.refc, 1);
1453
}
1454
erts_fun_write_unlock();
1455
1456
- return fe;
1457
+ return &fc->entry;
1458
}
1459
1460
const ErtsCodeMFA *erts_get_fun_mfa(const ErlFunEntry *fe) {
1461
static const ErtsCodeMFA unloaded_mfa = {NIL, NIL, ERTS_UINT_MAX};
1462
- ErtsCodePtr address = fe->address;
1463
+ ErtsCodePtr address = fe->dispatch.addresses[0];
1464
1465
if (address != beam_unloaded_fun) {
1466
return erts_find_function_from_pc(address);
1467
1468
return &unloaded_mfa;
1469
}
1470
1471
+void erts_set_fun_code(ErlFunEntry *fe, ErtsCodePtr address) {
1472
+ int i;
1473
+
1474
+ for (i = 0; i < ERTS_ADDRESSV_SIZE; i++) {
1475
+ fe->dispatch.addresses[i] = address;
1476
+ }
1477
+}
1478
+
1479
int erts_is_fun_loaded(const ErlFunEntry* fe) {
1480
- return fe->address != beam_unloaded_fun;
1481
+ return fe->dispatch.addresses[0] != beam_unloaded_fun;
1482
}
1483
1484
static void
1485
erts_erase_fun_entry_unlocked(ErlFunEntry* fe)
1486
{
1487
- hash_erase(&erts_fun_table, (void *) fe);
1488
+ ErlFunEntryContainer *fc = ErtsContainerStruct(fe, ErlFunEntryContainer,
1489
+ entry);
1490
+
1491
+ hash_erase(&erts_fun_table, (void *) fc);
1492
}
1493
1494
void
1495
1496
erts_fun_write_unlock();
1497
}
1498
1499
-static void fun_purge_foreach(ErlFunEntry *fe, struct erl_module_instance* modp)
1500
+static void fun_purge_foreach(ErlFunEntryContainer *fc,
1501
+ struct erl_module_instance* modp)
1502
{
1503
const char *fun_addr, *mod_start;
1504
+ ErlFunEntry *fe = &fc->entry;
1505
1506
- fun_addr = (const char*)fe->address;
1507
+ fun_addr = (const char*)fe->dispatch.addresses[0];
1508
mod_start = (const char*)modp->code_hdr;
1509
1510
if (ErtsInArea(fun_addr, mod_start, modp->code_length)) {
1511
- fe->pend_purge_address = fe->address;
1512
+ fe->pend_purge_address = fe->dispatch.addresses[0];
1513
ERTS_THR_WRITE_MEMORY_BARRIER;
1514
- fe->address = beam_unloaded_fun;
1515
+
1516
+ erts_set_fun_code(fe, beam_unloaded_fun);
1517
+
1518
erts_purge_state_add_fun(fe);
1519
}
1520
}
1521
1522
for (ix = 0; ix < no; ix++) {
1523
ErlFunEntry *fe = funs[ix];
1524
1525
- if (fe->address == beam_unloaded_fun) {
1526
- fe->address = fe->pend_purge_address;
1527
+ if (fe->dispatch.addresses[0] == beam_unloaded_fun) {
1528
+ erts_set_fun_code(fe, fe->pend_purge_address);
1529
}
1530
}
1531
}
1532
1533
ERTS_THR_WRITE_MEMORY_BARRIER;
1534
}
1535
1536
+
1537
+ErlFunThing *erts_new_export_fun_thing(Eterm **hpp, Export *exp, int arity)
1538
+{
1539
+ ErlFunThing *funp;
1540
+
1541
+ funp = (ErlFunThing*)(*hpp);
1542
+ *hpp += ERL_FUN_SIZE;
1543
+
1544
+ funp->thing_word = HEADER_FUN;
1545
+ funp->next = NULL;
1546
+ funp->entry.exp = exp;
1547
+ funp->num_free = 0;
1548
+ funp->creator = am_external;
1549
+ funp->arity = arity;
1550
+
1551
+#ifdef DEBUG
1552
+ {
1553
+ const ErtsCodeMFA *mfa = &exp->info.mfa;
1554
+ ASSERT(arity == mfa->arity);
1555
+ }
1556
+#endif
1557
+
1558
+ return funp;
1559
+}
1560
+
1561
+ErlFunThing *erts_new_local_fun_thing(Process *p, ErlFunEntry *fe,
1562
+ int arity, int num_free)
1563
+{
1564
+ ErlFunThing *funp;
1565
+
1566
+ funp = (ErlFunThing*) p->htop;
1567
+ p->htop += ERL_FUN_SIZE + num_free;
1568
+ erts_refc_inc(&fe->refc, 2);
1569
+
1570
+ funp->thing_word = HEADER_FUN;
1571
+ funp->next = MSO(p).first;
1572
+ MSO(p).first = (struct erl_off_heap_header*) funp;
1573
+ funp->entry.fun = fe;
1574
+ funp->num_free = num_free;
1575
+ funp->creator = p->common.id;
1576
+ funp->arity = arity;
1577
+
1578
+#ifdef DEBUG
1579
+ {
1580
+ const ErtsCodeMFA *mfa = erts_get_fun_mfa(fe);
1581
+ ASSERT(funp->arity == mfa->arity - num_free);
1582
+ ASSERT(arity == fe->arity);
1583
+ }
1584
+#endif
1585
+
1586
+ return funp;
1587
+}
1588
+
1589
+
1590
struct dump_fun_foreach_args {
1591
fmtfn_t to;
1592
void *to_arg;
1593
};
1594
1595
static void
1596
-dump_fun_foreach(ErlFunEntry *fe, struct dump_fun_foreach_args *args)
1597
+dump_fun_foreach(ErlFunEntryContainer *fc, struct dump_fun_foreach_args *args)
1598
{
1599
+ ErlFunEntry *fe = &fc->entry;
1600
+
1601
erts_print(args->to, args->to_arg, "=fun\n");
1602
erts_print(args->to, args->to_arg, "Module: %T\n", fe->module);
1603
erts_print(args->to, args->to_arg, "Uniq: %d\n", fe->old_uniq);
1604
erts_print(args->to, args->to_arg, "Index: %d\n",fe->old_index);
1605
- erts_print(args->to, args->to_arg, "Address: %p\n", fe->address);
1606
+ erts_print(args->to, args->to_arg, "Address: %p\n", fe->dispatch.addresses[0]);
1607
erts_print(args->to, args->to_arg, "Refc: %ld\n", erts_refc_read(&fe->refc, 1));
1608
}
1609
1610
1611
}
1612
1613
static HashValue
1614
-fun_hash(ErlFunEntry* obj)
1615
+fun_hash(ErlFunEntryContainer* obj)
1616
{
1617
- return (HashValue) (obj->old_uniq ^ obj->index ^ atom_val(obj->module));
1618
+ ErlFunEntry *fe = &obj->entry;
1619
+
1620
+ return (HashValue) (fe->old_uniq ^ fe->index ^ atom_val(fe->module));
1621
}
1622
1623
static int
1624
-fun_cmp(ErlFunEntry* obj1, ErlFunEntry* obj2)
1625
+fun_cmp(ErlFunEntryContainer* obj1, ErlFunEntryContainer* obj2)
1626
{
1627
- return !(obj1->old_index == obj2->old_index &&
1628
- obj1->old_uniq == obj2->old_uniq &&
1629
- obj1->module == obj2->module &&
1630
- obj1->index == obj2->index &&
1631
- obj1->arity == obj2->arity &&
1632
- !sys_memcmp(obj1->uniq, obj2->uniq, sizeof(obj1->uniq)));
1633
+ ErlFunEntry* fe1 = &obj1->entry;
1634
+ ErlFunEntry* fe2 = &obj2->entry;
1635
+
1636
+ return !(fe1->old_index == fe2->old_index &&
1637
+ fe1->old_uniq == fe2->old_uniq &&
1638
+ fe1->module == fe2->module &&
1639
+ fe1->index == fe2->index &&
1640
+ fe1->arity == fe2->arity &&
1641
+ !sys_memcmp(fe1->uniq, fe2->uniq, sizeof(fe1->uniq)));
1642
}
1643
1644
-static ErlFunEntry*
1645
-fun_alloc(ErlFunEntry* template)
1646
+static ErlFunEntryContainer*
1647
+fun_alloc(ErlFunEntryContainer* template)
1648
{
1649
- ErlFunEntry* obj = (ErlFunEntry *) erts_alloc(ERTS_ALC_T_FUN_ENTRY,
1650
- sizeof(ErlFunEntry));
1651
+ ErlFunEntryContainer* obj;
1652
+
1653
+ obj = (ErlFunEntryContainer *) erts_alloc(ERTS_ALC_T_FUN_ENTRY,
1654
+ sizeof(ErlFunEntryContainer));
1655
+
1656
+ sys_memcpy(obj, template, sizeof(ErlFunEntryContainer));
1657
+
1658
+ erts_refc_init(&obj->entry.refc, -1);
1659
1660
- sys_memcpy(obj, template, sizeof(ErlFunEntry));
1661
+ erts_set_fun_code(&obj->entry, beam_unloaded_fun);
1662
1663
- erts_refc_init(&obj->refc, -1);
1664
- obj->address = beam_unloaded_fun;
1665
- obj->pend_purge_address = NULL;
1666
+ obj->entry.pend_purge_address = NULL;
1667
1668
return obj;
1669
}
1670
1671
static void
1672
-fun_free(ErlFunEntry* obj)
1673
+fun_free(ErlFunEntryContainer* obj)
1674
{
1675
erts_free(ERTS_ALC_T_FUN_ENTRY, (void *) obj);
1676
}
1677
diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h
1678
index 1f5e8669d7..c226c27a31 100644
1679
--- a/erts/emulator/beam/erl_fun.h
1680
+++ b/erts/emulator/beam/erl_fun.h
1681
1682
* Fun entry.
1683
*/
1684
typedef struct erl_fun_entry {
1685
- HashBucket bucket;
1686
-
1687
- ErtsCodePtr address; /* Pointer to code for actual function */
1688
+ /* We start with an `ErtsDispatchable`, similar to export entries, so that
1689
+ * we can mostly use the same code for both. This greatly reduces the
1690
+ * complexity of instructions like `call_fun` and `is_function2`. */
1691
+ ErtsDispatchable dispatch;
1692
1693
/* These fields identify the function and must not be altered after fun
1694
* creation. */
1695
1696
ErtsCodePtr pend_purge_address; /* Address during a pending purge */
1697
} ErlFunEntry;
1698
1699
-/*
1700
- * This structure represents a 'fun' (lambda). It is stored on
1701
- * process heaps. It has variable size depending on the size
1702
- * of the environment.
1703
- */
1704
+/* This structure represents a 'fun' (lambda), whether local or external. It is
1705
+ * stored on process heaps, and has variable size depending on the size of the
1706
+ * environment. */
1707
1708
typedef struct erl_fun_thing {
1709
- Eterm thing_word; /* Subtag FUN_SUBTAG. */
1710
- ErlFunEntry* fe; /* Pointer to fun entry. */
1711
- struct erl_off_heap_header* next;
1712
- Uint arity; /* The arity of the fun. */
1713
- Uint num_free; /* Number of free variables (in env). */
1714
- /* -- The following may be compound Erlang terms ---------------------- */
1715
- Eterm creator; /* Pid of creator process (contains node). */
1716
- Eterm env[1]; /* Environment (free variables). */
1717
+ Eterm thing_word; /* Subtag FUN_SUBTAG. */
1718
+
1719
+ union {
1720
+ /* Both `ErlFunEntry` and `Export` begin with an `ErtsDispatchable`, so
1721
+ * code that doesn't really care which (e.g. calls) can use this
1722
+ * pointer to improve performance. */
1723
+ ErtsDispatchable *disp;
1724
+
1725
+ /* Pointer to function entry, valid iff `creator != am_external`.*/
1726
+ ErlFunEntry *fun;
1727
+
1728
+ /* Pointer to export entry, valid iff `creator == am_external`.*/
1729
+ Export *exp;
1730
+ } entry;
1731
+
1732
+ /* Next off-heap object, must be NULL when this is an external fun. */
1733
+ struct erl_off_heap_header *next;
1734
+
1735
+ Uint arity; /* The _apparent_ arity of the fun. */
1736
+ Uint num_free; /* Number of free variables (in env). */
1737
+
1738
+ /* -- The following may be compound Erlang terms ---------------------- */
1739
+ Eterm creator; /* Pid of creator process (contains node). */
1740
+ Eterm env[1]; /* Environment (free variables). */
1741
} ErlFunThing;
1742
1743
+#define is_local_fun(FunThing) ((FunThing)->creator != am_external)
1744
+#define is_external_fun(FunThing) ((FunThing)->creator == am_external)
1745
+
1746
/* ERL_FUN_SIZE does _not_ include space for the environment */
1747
#define ERL_FUN_SIZE ((sizeof(ErlFunThing)/sizeof(Eterm))-1)
1748
1749
+ErlFunThing *erts_new_export_fun_thing(Eterm **hpp, Export *exp, int arity);
1750
+ErlFunThing *erts_new_local_fun_thing(Process *p,
1751
+ ErlFunEntry *fe,
1752
+ int arity,
1753
+ int num_free);
1754
+
1755
void erts_init_fun_table(void);
1756
void erts_fun_info(fmtfn_t, void *);
1757
int erts_fun_table_sz(void);
1758
1759
1760
const ErtsCodeMFA *erts_get_fun_mfa(const ErlFunEntry *fe);
1761
1762
+void erts_set_fun_code(ErlFunEntry *fe, ErtsCodePtr address);
1763
+
1764
+ERTS_GLB_INLINE
1765
+ErtsCodePtr erts_get_fun_code(ErlFunEntry *fe, ErtsCodeIndex ix);
1766
+
1767
int erts_is_fun_loaded(const ErlFunEntry* fe);
1768
1769
void erts_erase_fun_entry(ErlFunEntry* fe);
1770
1771
void erts_fun_purge_complete(ErlFunEntry **funs, Uint no);
1772
void erts_dump_fun_entries(fmtfn_t, void *);
1773
1774
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
1775
+
1776
+ERTS_GLB_INLINE
1777
+ErtsCodePtr erts_get_fun_code(ErlFunEntry *fe, ErtsCodeIndex ix) {
1778
+ return fe->dispatch.addresses[ix];
1779
+}
1780
+
1781
+#endif
1782
+
1783
#endif
1784
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
1785
index 55d3379905..7128761534 100644
1786
--- a/erts/emulator/beam/erl_gc.c
1787
+++ b/erts/emulator/beam/erl_gc.c
1788
1789
*/
1790
1791
while (oh) {
1792
- if (IS_MOVED_BOXED(oh->thing_word)) {
1793
- struct erl_off_heap_header* ptr;
1794
+ if (IS_MOVED_BOXED(oh->thing_word)) {
1795
+ struct erl_off_heap_header* ptr;
1796
1797
- /*
1798
- * This off-heap object has been copied to the heap.
1799
- * We must increment its reference count and
1800
- * link it into the MSO list for the process.
1801
- */
1802
+ /* This off-heap object has been copied to the heap.
1803
+ * We must increment its reference count and
1804
+ * link it into the MSO list for the process.*/
1805
1806
- ptr = (struct erl_off_heap_header*) boxed_val(oh->thing_word);
1807
+ ptr = (struct erl_off_heap_header*) boxed_val(oh->thing_word);
1808
switch (thing_subtag(ptr->thing_word)) {
1809
case REFC_BINARY_SUBTAG:
1810
{
1811
1812
}
1813
case FUN_SUBTAG:
1814
{
1815
- ErlFunEntry* fe = ((ErlFunThing*)ptr)->fe;
1816
+ /* We _KNOW_ that this is a local fun, otherwise it would
1817
+ * not be part of the off-heap list. */
1818
+ ErlFunEntry* fe = ((ErlFunThing*)ptr)->entry.fun;
1819
+ ASSERT(is_local_fun((ErlFunThing*)ptr));
1820
erts_refc_inc(&fe->refc, 2);
1821
break;
1822
}
1823
1824
break;
1825
}
1826
}
1827
- *prev = ptr;
1828
- prev = &ptr->next;
1829
- }
1830
- oh = oh->next;
1831
+
1832
+ *prev = ptr;
1833
+ prev = &ptr->next;
1834
+ }
1835
+
1836
+ oh = oh->next;
1837
}
1838
1839
if (prev) {
1840
1841
if (!is_magic_ref_thing(fhp - 1))
1842
goto the_default;
1843
case REFC_BINARY_SUBTAG:
1844
- case FUN_SUBTAG:
1845
case EXTERNAL_PID_SUBTAG:
1846
case EXTERNAL_PORT_SUBTAG:
1847
case EXTERNAL_REF_SUBTAG:
1848
oh = (struct erl_off_heap_header*) (hp-1);
1849
cpy_sz = thing_arityval(val);
1850
goto cpy_words;
1851
+ case FUN_SUBTAG:
1852
+ {
1853
+ ErlFunThing *funp = (ErlFunThing*) (fhp - 1);
1854
+
1855
+ if (is_local_fun(funp)) {
1856
+ oh = (struct erl_off_heap_header*) (hp - 1);
1857
+ } else {
1858
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
1859
+ }
1860
+
1861
+ cpy_sz = thing_arityval(val);
1862
+ goto cpy_words;
1863
+ }
1864
default:
1865
the_default:
1866
cpy_sz = header_arity(val);
1867
1868
}
1869
case FUN_SUBTAG:
1870
{
1871
- ErlFunEntry* fe = ((ErlFunThing*)ptr)->fe;
1872
- if (erts_refc_dectest(&fe->refc, 0) == 0) {
1873
- erts_erase_fun_entry(fe);
1874
- }
1875
+ ErlFunThing* funp = ((ErlFunThing*)ptr);
1876
+
1877
+ if (is_local_fun(funp)) {
1878
+ ErlFunEntry* fe = funp->entry.fun;
1879
+
1880
+ if (erts_refc_dectest(&fe->refc, 0) == 0) {
1881
+ erts_erase_fun_entry(fe);
1882
+ }
1883
+ } else {
1884
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
1885
+ }
1886
break;
1887
}
1888
case REF_SUBTAG:
1889
1890
case REFC_BINARY_SUBTAG:
1891
refc = erts_refc_read(&u.pb->val->intern.refc, 1);
1892
break;
1893
- case FUN_SUBTAG:
1894
- refc = erts_refc_read(&u.fun->fe->refc, 1);
1895
+ case FUN_SUBTAG:
1896
+ if (is_local_fun(u.fun)) {
1897
+ refc = erts_refc_read(&u.fun->entry.fun->refc, 1);
1898
+ } else {
1899
+ /* Export fun, fake a valid refc. */
1900
+ ASSERT(is_external_fun(u.fun) && u.fun->next == NULL);
1901
+ refc = 1;
1902
+ }
1903
break;
1904
case EXTERNAL_PID_SUBTAG:
1905
case EXTERNAL_PORT_SUBTAG:
1906
diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c
1907
index 395c4d9ca9..153d536020 100644
1908
--- a/erts/emulator/beam/erl_map.c
1909
+++ b/erts/emulator/beam/erl_map.c
1910
1911
switch (hdr & _TAG_HEADER_MASK) {
1912
case ARITYVAL_SUBTAG:
1913
BIF_RET(ERTS_MAKE_AM("tuple"));
1914
- case EXPORT_SUBTAG:
1915
- BIF_RET(ERTS_MAKE_AM("export"));
1916
case FUN_SUBTAG:
1917
- BIF_RET(ERTS_MAKE_AM("fun"));
1918
+ {
1919
+ ErlFunThing *funp = (ErlFunThing *)fun_val(obj);
1920
+
1921
+ if (is_local_fun(funp)) {
1922
+ BIF_RET(ERTS_MAKE_AM("fun"));
1923
+ } else {
1924
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
1925
+ BIF_RET(ERTS_MAKE_AM("export"));
1926
+ }
1927
+ }
1928
case MAP_SUBTAG:
1929
switch (MAP_HEADER_TYPE(hdr)) {
1930
case MAP_HEADER_TAG_FLATMAP_HEAD :
1931
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
1932
index 86b1b6f6a4..d4327d93a8 100644
1933
--- a/erts/emulator/beam/erl_message.c
1934
+++ b/erts/emulator/beam/erl_message.c
1935
1936
erts_bin_release(u.pb->val);
1937
break;
1938
case FUN_SUBTAG:
1939
- if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) {
1940
- erts_erase_fun_entry(u.fun->fe);
1941
- }
1942
+ /* We _KNOW_ that this is a local fun, otherwise it would not
1943
+ * be part of the off-heap list. */
1944
+ ASSERT(is_local_fun(u.fun));
1945
+ if (erts_refc_dectest(&u.fun->entry.fun->refc, 0) == 0) {
1946
+ erts_erase_fun_entry(u.fun->entry.fun);
1947
+ }
1948
break;
1949
case REF_SUBTAG:
1950
ASSERT(is_magic_ref_thing(u.hdr));
1951
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
1952
index bec276a393..4637db1c33 100644
1953
--- a/erts/emulator/beam/erl_nif.c
1954
+++ b/erts/emulator/beam/erl_nif.c
1955
1956
1957
int enif_is_fun(ErlNifEnv* env, ERL_NIF_TERM term)
1958
{
1959
- return is_fun(term);
1960
+ return is_any_fun(term);
1961
}
1962
1963
int enif_is_pid(ErlNifEnv* env, ERL_NIF_TERM term)
1964
1965
return ERL_NIF_TERM_TYPE_BITSTRING;
1966
case FLOAT_DEF:
1967
return ERL_NIF_TERM_TYPE_FLOAT;
1968
- case EXPORT_DEF:
1969
case FUN_DEF:
1970
return ERL_NIF_TERM_TYPE_FUN;
1971
case BIG_DEF:
1972
diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c
1973
index 47bbf588be..7fbaeb710a 100644
1974
--- a/erts/emulator/beam/erl_printf_term.c
1975
+++ b/erts/emulator/beam/erl_printf_term.c
1976
1977
}
1978
}
1979
break;
1980
- case EXPORT_DEF:
1981
- {
1982
- Export* ep = *((Export **) (export_val(wobj) + 1));
1983
- long tdcount;
1984
- int tres;
1985
-
1986
- PRINT_STRING(res, fn, arg, "fun ");
1987
-
1988
- /* We pass a temporary 'dcount' and adjust the real one later to ensure
1989
- * that the fun doesn't get split up between the module and function
1990
- * name. */
1991
- tdcount = MAX_ATOM_SZ_LIMIT;
1992
- tres = print_atom_name(fn, arg, ep->info.mfa.module, &tdcount);
1993
- if (tres < 0) {
1994
- res = tres;
1995
- goto L_done;
1996
- }
1997
- *dcount -= (MAX_ATOM_SZ_LIMIT - tdcount);
1998
- res += tres;
1999
+ case FUN_DEF:
2000
+ {
2001
+ ErlFunThing *funp = (ErlFunThing *) fun_val(wobj);
2002
+
2003
+ if (is_local_fun(funp)) {
2004
+ ErlFunEntry *fe = funp->entry.fun;
2005
+ Atom *ap = atom_tab(atom_val(fe->module));
2006
+
2007
+ PRINT_STRING(res, fn, arg, "#Fun<");
2008
+ PRINT_BUF(res, fn, arg, ap->name, ap->len);
2009
+ PRINT_CHAR(res, fn, arg, '.');
2010
+ PRINT_SWORD(res, fn, arg, 'd', 0, 1,
2011
+ (ErlPfSWord) fe->old_index);
2012
+ PRINT_CHAR(res, fn, arg, '.');
2013
+ PRINT_SWORD(res, fn, arg, 'd', 0, 1,
2014
+ (ErlPfSWord) fe->old_uniq);
2015
+ PRINT_CHAR(res, fn, arg, '>');
2016
+ } else {
2017
+ Export* ep = funp->entry.exp;
2018
+ long tdcount;
2019
+ int tres;
2020
+
2021
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
2022
+
2023
+ PRINT_STRING(res, fn, arg, "fun ");
2024
+
2025
+ /* We pass a temporary 'dcount' and adjust the real one
2026
+ * later to ensure that the fun doesn't get split up
2027
+ * between the module and function name. */
2028
+ tdcount = MAX_ATOM_SZ_LIMIT;
2029
+ tres = print_atom_name(fn, arg, ep->info.mfa.module, &tdcount);
2030
+ if (tres < 0) {
2031
+ res = tres;
2032
+ goto L_done;
2033
+ }
2034
+ *dcount -= (MAX_ATOM_SZ_LIMIT - tdcount);
2035
+ res += tres;
2036
2037
- PRINT_CHAR(res, fn, arg, ':');
2038
+ PRINT_CHAR(res, fn, arg, ':');
2039
2040
- tdcount = MAX_ATOM_SZ_LIMIT;
2041
- tres = print_atom_name(fn, arg, ep->info.mfa.function, &tdcount);
2042
- if (tres < 0) {
2043
- res = tres;
2044
- goto L_done;
2045
- }
2046
- *dcount -= (MAX_ATOM_SZ_LIMIT - tdcount);
2047
- res += tres;
2048
-
2049
- PRINT_CHAR(res, fn, arg, '/');
2050
- PRINT_SWORD(res, fn, arg, 'd', 0, 1,
2051
- (ErlPfSWord) ep->info.mfa.arity);
2052
- }
2053
- break;
2054
- case FUN_DEF:
2055
- {
2056
- ErlFunThing *funp = (ErlFunThing *) fun_val(wobj);
2057
- Atom *ap = atom_tab(atom_val(funp->fe->module));
2058
+ tdcount = MAX_ATOM_SZ_LIMIT;
2059
+ tres = print_atom_name(fn, arg, ep->info.mfa.function, &tdcount);
2060
+ if (tres < 0) {
2061
+ res = tres;
2062
+ goto L_done;
2063
+ }
2064
+ *dcount -= (MAX_ATOM_SZ_LIMIT - tdcount);
2065
+ res += tres;
2066
2067
- PRINT_STRING(res, fn, arg, "#Fun<");
2068
- PRINT_BUF(res, fn, arg, ap->name, ap->len);
2069
- PRINT_CHAR(res, fn, arg, '.');
2070
- PRINT_SWORD(res, fn, arg, 'd', 0, 1,
2071
- (ErlPfSWord) funp->fe->old_index);
2072
- PRINT_CHAR(res, fn, arg, '.');
2073
- PRINT_SWORD(res, fn, arg, 'd', 0, 1,
2074
- (ErlPfSWord) funp->fe->old_uniq);
2075
- PRINT_CHAR(res, fn, arg, '>');
2076
- }
2077
- break;
2078
+ PRINT_CHAR(res, fn, arg, '/');
2079
+ PRINT_SWORD(res, fn, arg, 'd', 0, 1,
2080
+ (ErlPfSWord) ep->info.mfa.arity);
2081
+ }
2082
+ }
2083
+ break;
2084
case MAP_DEF: {
2085
Eterm *head = boxed_val(wobj);
2086
2087
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
2088
index 58fb386f44..3f452e3b63 100644
2089
--- a/erts/emulator/beam/erl_process_dump.c
2090
+++ b/erts/emulator/beam/erl_process_dump.c
2091
2092
byte* s;
2093
byte* p;
2094
2095
- if (is_fun(term)) {
2096
+ if (is_any_fun(term)) {
2097
/*
2098
* The fun's environment used to cause trouble. There were
2099
* two kind of problems:
2100
diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c
2101
index fb48584616..12e89437db 100644
2102
--- a/erts/emulator/beam/erl_term.c
2103
+++ b/erts/emulator/beam/erl_term.c
2104
2105
ET_DEFINE_CHECKED(Uint,thing_arityval,Eterm,is_thing);
2106
ET_DEFINE_CHECKED(Uint,thing_subtag,Eterm,is_thing);
2107
ET_DEFINE_CHECKED(Eterm*,binary_val,Wterm,is_binary);
2108
-ET_DEFINE_CHECKED(Eterm*,fun_val,Wterm,is_fun);
2109
+ET_DEFINE_CHECKED(Eterm*,fun_val,Wterm,is_any_fun);
2110
ET_DEFINE_CHECKED(int,bignum_header_is_neg,Eterm,_is_bignum_header);
2111
ET_DEFINE_CHECKED(Eterm,bignum_header_neg,Eterm,_is_bignum_header);
2112
ET_DEFINE_CHECKED(Uint,bignum_header_arity,Eterm,_is_bignum_header);
2113
2114
ET_DEFINE_CHECKED(Uint,external_ref_data_words,Wterm,is_external_ref);
2115
ET_DEFINE_CHECKED(Uint32*,external_ref_data,Wterm,is_external_ref);
2116
ET_DEFINE_CHECKED(struct erl_node_*,external_ref_node,Eterm,is_external_ref);
2117
-ET_DEFINE_CHECKED(Eterm*,export_val,Wterm,is_export);
2118
ET_DEFINE_CHECKED(Uint,external_thing_data_words,ExternalThing*,is_thing_ptr);
2119
2120
ET_DEFINE_CHECKED(Eterm,make_cp,ErtsCodePtr,_is_legal_cp);
2121
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
2122
index 8b2b82e527..a2027f0ec0 100644
2123
--- a/erts/emulator/beam/erl_term.h
2124
+++ b/erts/emulator/beam/erl_term.h
2125
2126
#define REF_SUBTAG (0x4 << _TAG_PRIMARY_SIZE) /* REF */
2127
#define FUN_SUBTAG (0x5 << _TAG_PRIMARY_SIZE) /* FUN */
2128
#define FLOAT_SUBTAG (0x6 << _TAG_PRIMARY_SIZE) /* FLOAT */
2129
-#define EXPORT_SUBTAG (0x7 << _TAG_PRIMARY_SIZE) /* FLOAT */
2130
#define _BINARY_XXX_MASK (0x3 << _TAG_PRIMARY_SIZE)
2131
#define REFC_BINARY_SUBTAG (0x8 << _TAG_PRIMARY_SIZE) /* BINARY */
2132
#define HEAP_BINARY_SUBTAG (0x9 << _TAG_PRIMARY_SIZE) /* BINARY */
2133
2134
#define _TAG_HEADER_POS_BIG (TAG_PRIMARY_HEADER|POS_BIG_SUBTAG)
2135
#define _TAG_HEADER_NEG_BIG (TAG_PRIMARY_HEADER|NEG_BIG_SUBTAG)
2136
#define _TAG_HEADER_FLOAT (TAG_PRIMARY_HEADER|FLOAT_SUBTAG)
2137
-#define _TAG_HEADER_EXPORT (TAG_PRIMARY_HEADER|EXPORT_SUBTAG)
2138
#define _TAG_HEADER_REF (TAG_PRIMARY_HEADER|REF_SUBTAG)
2139
#define _TAG_HEADER_REFC_BIN (TAG_PRIMARY_HEADER|REFC_BINARY_SUBTAG)
2140
#define _TAG_HEADER_HEAP_BIN (TAG_PRIMARY_HEADER|HEAP_BINARY_SUBTAG)
2141
2142
/* process binaries stuff (special case of binaries) */
2143
#define HEADER_PROC_BIN _make_header(PROC_BIN_SIZE-1,_TAG_HEADER_REFC_BIN)
2144
2145
-/* fun & export objects */
2146
-#define is_any_fun(x) (is_fun((x)) || is_export((x)))
2147
-#define is_not_any_fun(x) (!is_any_fun((x)))
2148
-
2149
/* fun objects */
2150
-#define HEADER_FUN _make_header(ERL_FUN_SIZE-2,_TAG_HEADER_FUN)
2151
-#define is_fun_header(x) ((x) == HEADER_FUN)
2152
-#define make_fun(x) make_boxed((Eterm*)(x))
2153
-#define is_fun(x) (is_boxed((x)) && is_fun_header(*boxed_val((x))))
2154
-#define is_not_fun(x) (!is_fun((x)))
2155
+#define HEADER_FUN _make_header(ERL_FUN_SIZE-2,_TAG_HEADER_FUN)
2156
+#define is_fun_header(x) ((x) == HEADER_FUN)
2157
+#define make_fun(x) make_boxed((Eterm*)(x))
2158
+#define is_any_fun(x) (is_boxed((x)) && is_fun_header(*boxed_val((x))))
2159
+#define is_not_any_fun(x) (!is_any_fun((x)))
2160
#define _unchecked_fun_val(x) _unchecked_boxed_val((x))
2161
_ET_DECLARE_CHECKED(Eterm*,fun_val,Wterm)
2162
#define fun_val(x) _ET_APPLY(fun_val,(x))
2163
2164
-/* export access methods */
2165
-#define make_export(x) make_boxed((x))
2166
-#define is_export(x) (is_boxed((x)) && is_export_header(*boxed_val((x))))
2167
-#define is_not_export(x) (!is_export((x)))
2168
-#define _unchecked_export_val(x) _unchecked_boxed_val(x)
2169
-_ET_DECLARE_CHECKED(Eterm*,export_val,Wterm)
2170
-#define export_val(x) _ET_APPLY(export_val,(x))
2171
-#define is_export_header(x) ((x) == HEADER_EXPORT)
2172
-#define HEADER_EXPORT _make_header(1,_TAG_HEADER_EXPORT)
2173
-
2174
/* bignum access methods */
2175
#define make_pos_bignum_header(sz) _make_header((sz),_TAG_HEADER_POS_BIG)
2176
#define make_neg_bignum_header(sz) _make_header((sz),_TAG_HEADER_NEG_BIG)
2177
2178
#define EXTERNAL_PID_DEF 0x6
2179
#define PORT_DEF 0x7
2180
#define EXTERNAL_PORT_DEF 0x8
2181
-#define EXPORT_DEF 0x9
2182
#define FUN_DEF 0xa
2183
#define REF_DEF 0xb
2184
#define EXTERNAL_REF_DEF 0xc
2185
2186
case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF;
2187
case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): return REF_DEF;
2188
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): return FLOAT_DEF;
2189
- case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): return EXPORT_DEF;
2190
case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): return FUN_DEF;
2191
case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE): return EXTERNAL_PID_DEF;
2192
case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): return EXTERNAL_PORT_DEF;
2193
diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c
2194
index 40f2483937..78f84502fc 100644
2195
--- a/erts/emulator/beam/export.c
2196
+++ b/erts/emulator/beam/export.c
2197
2198
res = ee->ep;
2199
2200
#ifdef BEAMASM
2201
- res->addresses[ERTS_SAVE_CALLS_CODE_IX] = beam_save_calls;
2202
+ res->dispatch.addresses[ERTS_SAVE_CALLS_CODE_IX] = beam_save_calls;
2203
#endif
2204
2205
return res;
2206
2207
ep = entry->ep;
2208
2209
#ifdef BEAMASM
2210
- ep->addresses[ERTS_SAVE_CALLS_CODE_IX] = beam_save_calls;
2211
+ ep->dispatch.addresses[ERTS_SAVE_CALLS_CODE_IX] =
2212
+ beam_save_calls;
2213
#endif
2214
2215
ASSERT(ep);
2216
2217
ErtsCodeIndex src_ix = erts_active_code_ix();
2218
IndexTable* dst = &export_tables[dst_ix];
2219
IndexTable* src = &export_tables[src_ix];
2220
- struct export_entry* src_entry;
2221
-#ifdef DEBUG
2222
- struct export_entry* dst_entry;
2223
-#endif
2224
int i;
2225
2226
ASSERT(dst_ix != src_ix);
2227
2228
* Insert all entries in src into dst table
2229
*/
2230
for (i = 0; i < src->entries; i++) {
2231
- src_entry = (struct export_entry*) erts_index_lookup(src, i);
2232
- src_entry->ep->addresses[dst_ix] = src_entry->ep->addresses[src_ix];
2233
-#ifdef DEBUG
2234
- dst_entry = (struct export_entry*)
2235
+ struct export_entry* src_entry;
2236
+ ErtsDispatchable *disp;
2237
+
2238
+ src_entry = (struct export_entry*) erts_index_lookup(src, i);
2239
+ disp = &src_entry->ep->dispatch;
2240
+
2241
+ disp->addresses[dst_ix] = disp->addresses[src_ix];
2242
+
2243
+#ifndef DEBUG
2244
+ index_put_entry(dst, src_entry);
2245
+#else /* DEBUG */
2246
+ {
2247
+ struct export_entry* dst_entry =
2248
+ (struct export_entry*)index_put_entry(dst, src_entry);
2249
+ ASSERT(entry_to_blob(src_entry) == entry_to_blob(dst_entry));
2250
+ }
2251
#endif
2252
- index_put_entry(dst, src_entry);
2253
- ASSERT(entry_to_blob(src_entry) == entry_to_blob(dst_entry));
2254
}
2255
export_staging_unlock();
2256
2257
diff --git a/erts/emulator/beam/export.h b/erts/emulator/beam/export.h
2258
index 9a5ebd22f6..f6b09e465c 100644
2259
--- a/erts/emulator/beam/export.h
2260
+++ b/erts/emulator/beam/export.h
2261
2262
#ifdef BEAMASM
2263
#define OP_PAD BeamInstr __pad[1];
2264
#define DISPATCH_SIZE 1
2265
-#define ERTS_ADDRESSV_SIZE (ERTS_NUM_CODE_IX + 1)
2266
-#define ERTS_SAVE_CALLS_CODE_IX (ERTS_ADDRESSV_SIZE - 1)
2267
#else
2268
#define OP_PAD
2269
#define DISPATCH_SIZE 0
2270
-#define ERTS_ADDRESSV_SIZE ERTS_NUM_CODE_IX
2271
#endif
2272
2273
typedef struct export_
2274
{
2275
- /* Pointer to code for function.
2276
- *
2277
- * !! THIS WAS DELIBERATELY RENAMED TO CAUSE ERRORS WHEN MERGING !!
2278
+ /* !! WARNING !!
2279
*
2280
* The JIT has a special calling convention for export entries, assuming
2281
* the entry itself is in a certain register. Blindly setting `c_p->i` to
2282
- * one of these addresses will crash the emulator when the entry is traced,
2283
- * which is unlikely to be caught in our tests.
2284
+ * one of the addresses in `dispatch` will crash the emulator when the
2285
+ * entry is traced, which is unlikely to be caught in our tests.
2286
*
2287
* Use the `BIF_TRAP` macros if at all possible, and be _very_ careful when
2288
- * accessing these directly.
2289
+ * accessing this field directly.
2290
*
2291
- * See `BeamAssembler::emit_setup_export_call` for details. */
2292
- ErtsCodePtr addresses[ERTS_ADDRESSV_SIZE];
2293
+ * See `BeamAssembler::emit_setup_dispatchable_call` for details. */
2294
+ ErtsDispatchable dispatch;
2295
2296
/* Index into bif_table[], or -1 if not a BIF. */
2297
int bif_number;
2298
2299
trampoline_address = (ErtsCodePtr)&ep->trampoline.raw[0];
2300
#endif
2301
2302
- ep->addresses[code_ix] = trampoline_address;
2303
+ ep->dispatch.addresses[code_ix] = trampoline_address;
2304
}
2305
2306
ERTS_GLB_INLINE int erts_is_export_trampoline_active(Export *ep, int code_ix) {
2307
2308
trampoline_address = (ErtsCodePtr)&ep->trampoline.raw[0];
2309
#endif
2310
2311
- return ep->addresses[code_ix] == trampoline_address;
2312
+ return ep->dispatch.addresses[code_ix] == trampoline_address;
2313
}
2314
2315
ERTS_GLB_INLINE Export*
2316
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
2317
index aa034b4108..1e1eadf913 100644
2318
--- a/erts/emulator/beam/external.c
2319
+++ b/erts/emulator/beam/external.c
2320
2321
}
2322
}
2323
break;
2324
- case EXPORT_DEF:
2325
- {
2326
- Export* exp = *((Export **) (export_val(obj) + 1));
2327
- *ep++ = EXPORT_EXT;
2328
- ep = enc_atom(acmp, exp->info.mfa.module, ep, dflags);
2329
- ep = enc_atom(acmp, exp->info.mfa.function, ep, dflags);
2330
- ep = enc_term(acmp, make_small(exp->info.mfa.arity),
2331
- ep, dflags, off_heap);
2332
- break;
2333
- }
2334
- break;
2335
- case FUN_DEF:
2336
- {
2337
- ErlFunThing* funp = (ErlFunThing *) fun_val(obj);
2338
- int ei;
2339
-
2340
- *ep++ = NEW_FUN_EXT;
2341
- WSTACK_PUSH2(s, ENC_PATCH_FUN_SIZE,
2342
- (UWord) ep); /* Position for patching in size */
2343
- ep += 4;
2344
- *ep = funp->arity;
2345
- ep += 1;
2346
- sys_memcpy(ep, funp->fe->uniq, 16);
2347
- ep += 16;
2348
- put_int32(funp->fe->index, ep);
2349
- ep += 4;
2350
- put_int32(funp->num_free, ep);
2351
- ep += 4;
2352
- ep = enc_atom(acmp, funp->fe->module, ep, dflags);
2353
- ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap);
2354
- ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap);
2355
- ep = enc_pid(acmp, funp->creator, ep, dflags);
2356
-
2357
- for (ei = funp->num_free-1; ei >= 0; ei--) {
2358
- WSTACK_PUSH2(s, ENC_TERM, (UWord) funp->env[ei]);
2359
- }
2360
- }
2361
- break;
2362
- }
2363
+ case FUN_DEF:
2364
+ {
2365
+ ErlFunThing* funp = (ErlFunThing *) fun_val(obj);
2366
+
2367
+ if (is_local_fun(funp)) {
2368
+ ErlFunEntry* fe = funp->entry.fun;
2369
+ int ei;
2370
+
2371
+ *ep++ = NEW_FUN_EXT;
2372
+ WSTACK_PUSH2(s, ENC_PATCH_FUN_SIZE,
2373
+ (UWord) ep); /* Position for patching in size */
2374
+ ep += 4;
2375
+ *ep = funp->arity;
2376
+ ep += 1;
2377
+ sys_memcpy(ep, fe->uniq, 16);
2378
+ ep += 16;
2379
+ put_int32(fe->index, ep);
2380
+ ep += 4;
2381
+ put_int32(funp->num_free, ep);
2382
+ ep += 4;
2383
+ ep = enc_atom(acmp, fe->module, ep, dflags);
2384
+ ep = enc_term(acmp, make_small(fe->old_index), ep, dflags, off_heap);
2385
+ ep = enc_term(acmp, make_small(fe->old_uniq), ep, dflags, off_heap);
2386
+ ep = enc_pid(acmp, funp->creator, ep, dflags);
2387
+
2388
+ for (ei = funp->num_free-1; ei >= 0; ei--) {
2389
+ WSTACK_PUSH2(s, ENC_TERM, (UWord) funp->env[ei]);
2390
+ }
2391
+ } else {
2392
+ Export *exp = funp->entry.exp;
2393
+
2394
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
2395
+
2396
+ *ep++ = EXPORT_EXT;
2397
+ ep = enc_atom(acmp, exp->info.mfa.module, ep, dflags);
2398
+ ep = enc_atom(acmp, exp->info.mfa.function, ep, dflags);
2399
+ ep = enc_term(acmp, make_small(exp->info.mfa.arity),
2400
+ ep, dflags, off_heap);
2401
+
2402
+ }
2403
+ }
2404
+ break;
2405
+ }
2406
}
2407
DESTROY_WSTACK(s);
2408
if (ctx) {
2409
2410
}
2411
break;
2412
}
2413
- case EXPORT_EXT:
2414
- {
2415
- Eterm mod;
2416
- Eterm name;
2417
- Eterm temp;
2418
- Sint arity;
2419
-
2420
- if ((ep = dec_atom(edep, ep, &mod)) == NULL) {
2421
- goto error;
2422
- }
2423
- if ((ep = dec_atom(edep, ep, &name)) == NULL) {
2424
- goto error;
2425
- }
2426
- factory->hp = hp;
2427
- ep = dec_term(edep, factory, ep, &temp, NULL, 0);
2428
- hp = factory->hp;
2429
- if (ep == NULL) {
2430
- goto error;
2431
- }
2432
- if (!is_small(temp)) {
2433
- goto error;
2434
- }
2435
- arity = signed_val(temp);
2436
- if (arity < 0) {
2437
- goto error;
2438
- }
2439
- if (edep && (edep->flags & ERTS_DIST_EXT_BTT_SAFE)) {
2440
- if (!erts_active_export_entry(mod, name, arity))
2441
- goto error;
2442
+ case EXPORT_EXT:
2443
+ {
2444
+ ErlFunThing *funp;
2445
+ Export *export;
2446
+ Eterm mod;
2447
+ Eterm name;
2448
+ Eterm temp;
2449
+ Sint arity;
2450
+
2451
+ if ((ep = dec_atom(edep, ep, &mod)) == NULL) {
2452
+ goto error;
2453
}
2454
- *objp = make_export(hp);
2455
- *hp++ = HEADER_EXPORT;
2456
- *hp++ = (Eterm) erts_export_get_or_make_stub(mod, name, arity);
2457
- break;
2458
- }
2459
- break;
2460
+ if ((ep = dec_atom(edep, ep, &name)) == NULL) {
2461
+ goto error;
2462
+ }
2463
+ factory->hp = hp;
2464
+ ep = dec_term(edep, factory, ep, &temp, NULL, 0);
2465
+ if (ep == NULL) {
2466
+ goto error;
2467
+ }
2468
+ if (!is_small(temp)) {
2469
+ goto error;
2470
+ }
2471
+ arity = signed_val(temp);
2472
+ if (arity < 0) {
2473
+ goto error;
2474
+ }
2475
+ if (edep && (edep->flags & ERTS_DIST_EXT_BTT_SAFE)) {
2476
+ if (!erts_active_export_entry(mod, name, arity)) {
2477
+ goto error;
2478
+ }
2479
+ }
2480
+
2481
+ export = erts_export_get_or_make_stub(mod, name, arity);
2482
+ funp = erts_new_export_fun_thing(&factory->hp, export, arity);
2483
+ hp = factory->hp;
2484
+ *objp = make_fun(funp);
2485
+ }
2486
+ break;
2487
case MAP_EXT:
2488
{
2489
Uint32 size,n;
2490
2491
funp->next = factory->off_heap->first;
2492
factory->off_heap->first = (struct erl_off_heap_header*)funp;
2493
2494
- funp->fe = erts_put_fun_entry2(module, old_uniq, old_index,
2495
- uniq, index, arity);
2496
+ funp->entry.fun = erts_put_fun_entry2(module, old_uniq,
2497
+ old_index, uniq,
2498
+ index, arity);
2499
funp->arity = arity;
2500
hp = factory->hp;
2501
2502
2503
}
2504
break;
2505
}
2506
- case FUN_DEF:
2507
- {
2508
- ErlFunThing* funp = (ErlFunThing *) fun_val(obj);
2509
-
2510
- result += 20+1+1+4; /* New ID + Tag */
2511
- result += 4; /* Length field (number of free variables */
2512
- result += encode_size_struct2(acmp, funp->creator, dflags);
2513
- result += encode_size_struct2(acmp, funp->fe->module, dflags);
2514
- result += 2 * (1+4); /* Index, Uniq */
2515
- if (funp->num_free > 1) {
2516
- WSTACK_PUSH2(s, (UWord) (funp->env + 1),
2517
- (UWord) TERM_ARRAY_OP(funp->num_free-1));
2518
- }
2519
- if (funp->num_free != 0) {
2520
- obj = funp->env[0];
2521
- continue; /* big loop */
2522
- }
2523
- break;
2524
- }
2525
-
2526
- case EXPORT_DEF:
2527
- {
2528
- Export* ep = *((Export **) (export_val(obj) + 1));
2529
- Uint tmp_result = result;
2530
- result += 1;
2531
- result += encode_size_struct2(acmp, ep->info.mfa.module, dflags);
2532
- result += encode_size_struct2(acmp, ep->info.mfa.function, dflags);
2533
- result += encode_size_struct2(acmp, make_small(ep->info.mfa.arity), dflags);
2534
- if (dflags & DFLAG_PENDING_CONNECT) {
2535
- Uint csz;
2536
- ASSERT(ctx);
2537
-
2538
- /*
2539
- * Fallback is 1 + 1 + Module size + Function size, that is,
2540
- * the hopefull index + hopefull encoding is larger...
2541
- */
2542
- ASSERT(dflags & DFLAG_EXPORT_PTR_TAG);
2543
- csz = tmp_result - ctx->last_result;
2544
- /* potentially multiple elements leading up to hopefull entry */
2545
- vlen += (csz/MAX_SYSIOVEC_IOVLEN + 1
2546
- + 1); /* hopefull entry */
2547
- result += 4; /* hopefull index */
2548
- ctx->last_result = result;
2549
+ case FUN_DEF:
2550
+ {
2551
+ ErlFunThing *funp = (ErlFunThing *) fun_val(obj);
2552
+
2553
+ if (is_local_fun(funp)) {
2554
+ result += 20+1+1+4; /* New ID + Tag */
2555
+ result += 4; /* Length field (number of free variables */
2556
+ result += encode_size_struct2(acmp, funp->creator, dflags);
2557
+ result += encode_size_struct2(acmp, funp->entry.fun->module, dflags);
2558
+ result += 2 * (1+4); /* Index, Uniq */
2559
+ if (funp->num_free > 1) {
2560
+ WSTACK_PUSH2(s, (UWord) (funp->env + 1),
2561
+ (UWord) TERM_ARRAY_OP(funp->num_free-1));
2562
+ }
2563
+ if (funp->num_free != 0) {
2564
+ obj = funp->env[0];
2565
+ continue; /* big loop */
2566
+ }
2567
+ } else {
2568
+ Export* ep = funp->entry.exp;
2569
+ Uint tmp_result = result;
2570
+
2571
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
2572
+
2573
+ result += 1;
2574
+ result += encode_size_struct2(acmp, ep->info.mfa.module, dflags);
2575
+ result += encode_size_struct2(acmp, ep->info.mfa.function, dflags);
2576
+ result += encode_size_struct2(acmp, make_small(ep->info.mfa.arity), dflags);
2577
+
2578
+ if (dflags & DFLAG_PENDING_CONNECT) {
2579
+ Uint csz;
2580
+ ASSERT(ctx);
2581
+
2582
+ /* Fallback is 1 + 1 + Module size + Function size,
2583
+ * that is, the hopeful index + hopeful encoding is
2584
+ * larger... */
2585
+ ASSERT(dflags & DFLAG_EXPORT_PTR_TAG);
2586
+ csz = tmp_result - ctx->last_result;
2587
+
2588
+ /* Potentially multiple elements leading up to hopeful
2589
+ * entry */
2590
+ vlen += (csz/MAX_SYSIOVEC_IOVLEN + 1
2591
+ + 1); /* hopeful entry */
2592
+ result += 4; /* hopeful index */
2593
+ ctx->last_result = result;
2594
+ }
2595
}
2596
- }
2597
- break;
2598
+ break;
2599
+ }
2600
2601
default:
2602
erts_exit(ERTS_ERROR_EXIT,"Internal data structure error (in encode_size_struct_int) %x\n",
2603
2604
break;
2605
case EXPORT_EXT:
2606
terms += 3;
2607
- heap_size += 2;
2608
+ heap_size += ERL_FUN_SIZE;
2609
break;
2610
case NEW_FUN_EXT:
2611
{
2612
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
2613
index 904d394fca..cc958223bc 100644
2614
--- a/erts/emulator/beam/global.h
2615
+++ b/erts/emulator/beam/global.h
2616
2617
ERTS_GLB_INLINE void dtrace_pid_str(Eterm pid, char *process_buf);
2618
ERTS_GLB_INLINE void dtrace_proc_str(Process *process, char *process_buf);
2619
ERTS_GLB_INLINE void dtrace_port_str(Port *port, char *port_buf);
2620
-ERTS_GLB_INLINE void dtrace_fun_decode(Process *process, ErtsCodeMFA *mfa,
2621
- char *process_buf, char *mfa_buf);
2622
+ERTS_GLB_INLINE void dtrace_fun_decode(Process *process,
2623
+ const ErtsCodeMFA *mfa,
2624
+ char *process_buf,
2625
+ char *mfa_buf);
2626
2627
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
2628
2629
2630
}
2631
2632
ERTS_GLB_INLINE void
2633
-dtrace_fun_decode(Process *process, ErtsCodeMFA *mfa,
2634
+dtrace_fun_decode(Process *process, const ErtsCodeMFA *mfa,
2635
char *process_buf, char *mfa_buf)
2636
{
2637
if (process_buf) {
2638
diff --git a/erts/emulator/beam/jit/arm/beam_asm.hpp b/erts/emulator/beam/jit/arm/beam_asm.hpp
2639
index fbd42ba962..c886e37365 100644
2640
--- a/erts/emulator/beam/jit/arm/beam_asm.hpp
2641
+++ b/erts/emulator/beam/jit/arm/beam_asm.hpp
2642
2643
}
2644
}
2645
2646
- /* Returns the current code address for the export entry in `Src`
2647
+ /* Returns the current code address for the `Export` or `ErlFunEntry` in
2648
+ * `Src`.
2649
*
2650
- * Export tracing, save_calls, etc is implemented by shared fragments that
2651
- * assume that the export entry is in ARG1, so we have to copy it over if it
2652
- * isn't already. */
2653
- arm::Mem emit_setup_export_call(const arm::Gp &Src) {
2654
- return emit_setup_export_call(Src, active_code_ix);
2655
+ * Export tracing, save_calls, etc are implemented by shared fragments that
2656
+ * assume that the respective entry is in ARG1, so we have to copy it over
2657
+ * if it isn't already. */
2658
+ arm::Mem emit_setup_dispatchable_call(const arm::Gp &Src) {
2659
+ return emit_setup_dispatchable_call(Src, active_code_ix);
2660
}
2661
2662
- arm::Mem emit_setup_export_call(const arm::Gp &Src,
2663
- const arm::Gp &CodeIndex) {
2664
+ arm::Mem emit_setup_dispatchable_call(const arm::Gp &Src,
2665
+ const arm::Gp &CodeIndex) {
2666
if (ARG1 != Src) {
2667
a.mov(ARG1, Src);
2668
}
2669
- ERTS_CT_ASSERT(offsetof(Export, addresses) == 0);
2670
+
2671
+ ERTS_CT_ASSERT(offsetof(ErlFunEntry, dispatch) == 0);
2672
+ ERTS_CT_ASSERT(offsetof(Export, dispatch) == 0);
2673
+ ERTS_CT_ASSERT(offsetof(ErtsDispatchable, addresses) == 0);
2674
+
2675
return arm::Mem(ARG1, CodeIndex, arm::lsl(3));
2676
}
2677
2678
diff --git a/erts/emulator/beam/jit/arm/beam_asm_global.cpp b/erts/emulator/beam/jit/arm/beam_asm_global.cpp
2679
index 723d2199a0..efc94c49c7 100644
2680
--- a/erts/emulator/beam/jit/arm/beam_asm_global.cpp
2681
+++ b/erts/emulator/beam/jit/arm/beam_asm_global.cpp
2682
2683
2684
emit_leave_erlang_frame();
2685
2686
- branch(emit_setup_export_call(ARG1));
2687
+ branch(emit_setup_dispatchable_call(ARG1));
2688
}
2689
2690
/* Handles export breakpoints, error handler, jump tracing, and so on.
2691
2692
2693
a.cbz(ARG1, labels[process_exit]);
2694
2695
- branch(emit_setup_export_call(ARG1));
2696
+ branch(emit_setup_dispatchable_call(ARG1));
2697
}
2698
}
2699
2700
diff --git a/erts/emulator/beam/jit/arm/instr_bif.cpp b/erts/emulator/beam/jit/arm/instr_bif.cpp
2701
index 199a517e0d..6e6310fe4d 100644
2702
--- a/erts/emulator/beam/jit/arm/instr_bif.cpp
2703
+++ b/erts/emulator/beam/jit/arm/instr_bif.cpp
2704
2705
a.bind(trace);
2706
{
2707
/* Call the export entry instead of the BIF. */
2708
- branch(emit_setup_export_call(ARG4));
2709
+ branch(emit_setup_dispatchable_call(ARG4));
2710
}
2711
2712
a.bind(yield);
2713
diff --git a/erts/emulator/beam/jit/arm/instr_call.cpp b/erts/emulator/beam/jit/arm/instr_call.cpp
2714
index a141ef5fd1..8afd37fcf1 100644
2715
--- a/erts/emulator/beam/jit/arm/instr_call.cpp
2716
+++ b/erts/emulator/beam/jit/arm/instr_call.cpp
2717
2718
a.mov(TMP1, imm(&the_active_code_index));
2719
a.ldr(TMP1.w(), arm::Mem(TMP1));
2720
2721
- branch(emit_setup_export_call(ARG1, TMP1));
2722
+ branch(emit_setup_dispatchable_call(ARG1, TMP1));
2723
}
2724
2725
void BeamModuleAssembler::emit_i_call_ext(const ArgVal &Exp) {
2726
mov_arg(ARG1, Exp);
2727
2728
- arm::Mem target = emit_setup_export_call(ARG1);
2729
+ arm::Mem target = emit_setup_dispatchable_call(ARG1);
2730
erlang_call(target);
2731
}
2732
2733
void BeamModuleAssembler::emit_i_call_ext_only(const ArgVal &Exp) {
2734
mov_arg(ARG1, Exp);
2735
2736
- arm::Mem target = emit_setup_export_call(ARG1);
2737
+ arm::Mem target = emit_setup_dispatchable_call(ARG1);
2738
emit_leave_erlang_frame();
2739
branch(target);
2740
}
2741
2742
emit_raise_exception(entry, &apply3_mfa);
2743
2744
a.bind(dispatch);
2745
- return emit_setup_export_call(ARG1);
2746
+ return emit_setup_dispatchable_call(ARG1);
2747
}
2748
2749
void BeamModuleAssembler::emit_i_apply() {
2750
2751
2752
a.bind(dispatch);
2753
2754
- return emit_setup_export_call(ARG1);
2755
+ return emit_setup_dispatchable_call(ARG1);
2756
}
2757
2758
void BeamModuleAssembler::emit_apply(const ArgVal &Arity) {
2759
diff --git a/erts/emulator/beam/jit/arm/instr_common.cpp b/erts/emulator/beam/jit/arm/instr_common.cpp
2760
index adc8112a2e..17f1c4ba2f 100644
2761
--- a/erts/emulator/beam/jit/arm/instr_common.cpp
2762
+++ b/erts/emulator/beam/jit/arm/instr_common.cpp
2763
2764
arm::Gp boxed_ptr = emit_ptr_val(TMP1, src.reg);
2765
a.ldur(TMP1, emit_boxed_val(boxed_ptr));
2766
a.cmp(TMP1, imm(HEADER_FUN));
2767
- a.cond_eq().b(next);
2768
- a.cmp(TMP1, imm(HEADER_EXPORT));
2769
a.cond_ne().b(resolve_beam_label(Fail, disp1MB));
2770
2771
a.bind(next);
2772
2773
return;
2774
}
2775
2776
- Label next = a.newLabel();
2777
- Label fun = a.newLabel();
2778
-
2779
auto src = load_source(Src, TMP1);
2780
2781
emit_is_boxed(resolve_beam_label(Fail, dispUnknown), src.reg);
2782
2783
arm::Gp boxed_ptr = emit_ptr_val(TMP1, src.reg);
2784
a.ldur(TMP2, emit_boxed_val(boxed_ptr));
2785
a.cmp(TMP2, imm(HEADER_FUN));
2786
- a.cond_eq().b(fun);
2787
- a.cmp(TMP2, imm(HEADER_EXPORT));
2788
a.cond_ne().b(resolve_beam_label(Fail, disp1MB));
2789
2790
- comment("Check arity of export fun");
2791
- a.ldur(TMP2, emit_boxed_val(boxed_ptr, sizeof(Eterm)));
2792
- a.ldr(TMP2, arm::Mem(TMP2, offsetof(Export, info.mfa.arity)));
2793
+ a.ldur(TMP2, emit_boxed_val(boxed_ptr, offsetof(ErlFunThing, arity)));
2794
emit_branch_if_ne(TMP2, arity, resolve_beam_label(Fail, dispUnknown));
2795
- a.b(next);
2796
-
2797
- comment("Check arity of fun");
2798
- a.bind(fun);
2799
- {
2800
- a.ldur(TMP2, emit_boxed_val(boxed_ptr, offsetof(ErlFunThing, arity)));
2801
- emit_branch_if_ne(TMP2, arity, resolve_beam_label(Fail, dispUnknown));
2802
- }
2803
-
2804
- a.bind(next);
2805
}
2806
2807
void BeamModuleAssembler::emit_is_integer(const ArgVal &Fail,
2808
diff --git a/erts/emulator/beam/jit/arm/instr_fun.cpp b/erts/emulator/beam/jit/arm/instr_fun.cpp
2809
index bd04162ba2..345a83cf3d 100644
2810
--- a/erts/emulator/beam/jit/arm/instr_fun.cpp
2811
+++ b/erts/emulator/beam/jit/arm/instr_fun.cpp
2812
2813
* ARG3 = arity
2814
* ARG4 = fun thing
2815
* ARG5 = address of the call_fun instruction that got us here. Note that we
2816
- * can't use LR (x30) for this because tail calls point elsehwere. */
2817
+ * can't use LR (x30) for this because tail calls point elsewhere. */
2818
void BeamGlobalAssembler::emit_unloaded_fun() {
2819
Label error = a.newLabel();
2820
2821
2822
2823
a.cbz(ARG1, error);
2824
2825
- a.ldr(TMP1, emit_setup_export_call(ARG1));
2826
+ a.ldr(TMP1, emit_setup_dispatchable_call(ARG1));
2827
a.br(TMP1);
2828
2829
a.bind(error);
2830
2831
}
2832
}
2833
2834
-/* Handles errors for `call_fun` and `i_lambda_trampoline`. Assumes that we're
2835
- * running on the Erlang stack with a valid stack frame.
2836
+/* Handles errors for `call_fun`. Assumes that we're running on the Erlang
2837
+ * stack with a valid stack frame.
2838
*
2839
* ARG3 = arity
2840
* ARG4 = fun thing
2841
* ARG5 = address of the call_fun instruction that got us here. Note that we
2842
- * can't use LR (x30) for this because tail calls point elsehwere. */
2843
+ * can't use LR (x30) for this because tail calls point elsewhere. */
2844
void BeamGlobalAssembler::emit_handle_call_fun_error() {
2845
Label bad_arity = a.newLabel(), bad_fun = a.newLabel();
2846
2847
2848
a.ldur(TMP1, emit_boxed_val(fun_thing));
2849
a.cmp(TMP1, imm(HEADER_FUN));
2850
a.cond_eq().b(bad_arity);
2851
- a.cmp(TMP1, imm(HEADER_EXPORT));
2852
- a.cond_eq().b(bad_arity);
2853
2854
a.bind(bad_fun);
2855
{
2856
- /* Not a fun. This is only reachable through `call_fun` */
2857
mov_imm(TMP1, EXC_BADFUN);
2858
a.str(TMP1, arm::Mem(c_p, offsetof(Process, freason)));
2859
a.str(ARG4, arm::Mem(c_p, offsetof(Process, fvalue)));
2860
2861
2862
a.bind(bad_arity);
2863
{
2864
- /* Bad arity. This is reachable through `call_fun` when we have an
2865
- * export fun, and `i_lambda_trampoline` when we have a local one. */
2866
-
2867
a.stp(ARG4, ARG5, TMP_MEM1q);
2868
2869
emit_enter_runtime<Update::eHeap | Update::eStack | Update::eXRegs>();
2870
2871
}
2872
}
2873
2874
-/* `call_fun` instructions land here to check arity and set up their
2875
- * environment before jumping to the actual implementation.
2876
+/* `call_fun` instructions land here to set up their environment before jumping
2877
+ * to the actual implementation.
2878
*
2879
* Keep in mind that this runs in the limbo between caller and callee. It must
2880
* not clobber LR (x30).
2881
2882
const ssize_t env_offset = offsetof(ErlFunThing, env) - TAG_PRIMARY_BOXED;
2883
const ssize_t fun_arity = Arity.getValue() - NumFree.getValue();
2884
const ssize_t total_arity = Arity.getValue();
2885
- Label error = a.newLabel();
2886
2887
auto &lambda = lambdas[Index.getValue()];
2888
+
2889
+ if (NumFree.getValue() == 0) {
2890
+ /* No free variables, let the lambda jump directly to our target. */
2891
+ lambda.trampoline = rawLabels[Lbl.getValue()];
2892
+ return;
2893
+ }
2894
+
2895
lambda.trampoline = a.newLabel();
2896
a.bind(lambda.trampoline);
2897
2898
- a.cmp(ARG3, imm(fun_arity));
2899
- a.cond_ne().b(error);
2900
-
2901
if (NumFree.getValue() == 1) {
2902
auto first = init_destination(ArgVal(ArgVal::XReg, fun_arity), TMP1);
2903
2904
2905
}
2906
2907
a.b(resolve_beam_label(Lbl, disp128MB));
2908
-
2909
- a.bind(error);
2910
- {
2911
- emit_enter_erlang_frame();
2912
- a.b(resolve_fragment(ga->get_handle_call_fun_error(), disp128MB));
2913
- }
2914
}
2915
2916
void BeamModuleAssembler::emit_i_make_fun3(const ArgVal &Fun,
2917
2918
2919
ASSERT(num_free == env.size());
2920
2921
+ a.mov(ARG1, c_p);
2922
mov_arg(ARG2, Fun);
2923
mov_arg(ARG3, Arity);
2924
mov_arg(ARG4, NumFree);
2925
2926
emit_enter_runtime<Update::eHeap>();
2927
2928
- a.mov(ARG1, c_p);
2929
- runtime_call<4>(new_fun_thing);
2930
+ runtime_call<4>(erts_new_local_fun_thing);
2931
2932
emit_leave_runtime<Update::eHeap>();
2933
2934
2935
* ARG3 = arity
2936
* ARG4 = fun thing */
2937
arm::Gp BeamModuleAssembler::emit_call_fun() {
2938
- Label exported = a.newLabel(), next = a.newLabel();
2939
+ Label next = a.newLabel();
2940
+
2941
+ /* Speculatively untag the ErlFunThing. */
2942
+ emit_untag_ptr(TMP2, ARG4);
2943
2944
/* Load the error fragment into TMP3 so we can CSEL ourselves there on
2945
* error. */
2946
a.adr(TMP3, resolve_fragment(ga->get_handle_call_fun_error(), disp1MB));
2947
2948
- /* The `handle_call_fun_error` and `i_lambda_trampoline` fragments expect
2949
- * current PC in ARG5. */
2950
+ /* The `handle_call_fun_error` fragment expects current PC in ARG5. */
2951
a.adr(ARG5, next);
2952
2953
/* As emit_is_boxed(), but explicitly sets ZF so we can rely on that for
2954
2955
a.tst(ARG4, imm(_TAG_PRIMARY_MASK - TAG_PRIMARY_BOXED));
2956
a.cond_ne().b(next);
2957
2958
- arm::Gp fun_thing = emit_ptr_val(TMP2, ARG4);
2959
- a.ldur(TMP1, emit_boxed_val(fun_thing));
2960
- a.cmp(TMP1, imm(HEADER_EXPORT));
2961
- a.cond_eq().b(exported);
2962
+ /* Load header word and `ErlFunThing->entry`. We can safely do this before
2963
+ * testing the header because boxed terms are guaranteed to be at least two
2964
+ * words long. */
2965
+ a.ldp(TMP1, ARG1, arm::Mem(TMP2));
2966
+
2967
a.cmp(TMP1, imm(HEADER_FUN));
2968
a.cond_ne().b(next);
2969
2970
- a.ldur(TMP1, emit_boxed_val(fun_thing, offsetof(ErlFunThing, fe)));
2971
- a.ldr(TMP1, arm::Mem(TMP1, offsetof(ErlFunEntry, address)));
2972
- a.b(next);
2973
-
2974
- a.bind(exported);
2975
- {
2976
- a.ldur(ARG1, emit_boxed_val(fun_thing, sizeof(Eterm)));
2977
+ a.ldr(TMP2, arm::Mem(TMP2, offsetof(ErlFunThing, arity)));
2978
+ a.cmp(TMP2, ARG3);
2979
2980
- a.ldr(TMP1, arm::Mem(ARG1, offsetof(Export, info.mfa.arity)));
2981
- a.cmp(TMP1, ARG3);
2982
-
2983
- a.ldr(TMP1, emit_setup_export_call(ARG1));
2984
- }
2985
+ a.ldr(TMP1, emit_setup_dispatchable_call(ARG1));
2986
2987
/* Assumes that ZF is set on success and clear on error, overwriting our
2988
* destination with the error fragment's address. */
2989
diff --git a/erts/emulator/beam/jit/arm/instr_trace.cpp b/erts/emulator/beam/jit/arm/instr_trace.cpp
2990
index ff32ebed31..3db2dbd960 100644
2991
--- a/erts/emulator/beam/jit/arm/instr_trace.cpp
2992
+++ b/erts/emulator/beam/jit/arm/instr_trace.cpp
2993
2994
a.cbz(ARG1, error);
2995
2996
emit_leave_erlang_frame();
2997
- branch(emit_setup_export_call(ARG1));
2998
+ branch(emit_setup_dispatchable_call(ARG1));
2999
3000
a.bind(error);
3001
{
3002
diff --git a/erts/emulator/beam/jit/asm_load.c b/erts/emulator/beam/jit/asm_load.c
3003
index 744fb9bcfe..77b771926d 100644
3004
--- a/erts/emulator/beam/jit/asm_load.c
3005
+++ b/erts/emulator/beam/jit/asm_load.c
3006
3007
* code callable. */
3008
ep->trampoline.not_loaded.deferred = (BeamInstr)address;
3009
} else {
3010
- ep->addresses[staging_ix] = address;
3011
+ ep->dispatch.addresses[staging_ix] = address;
3012
}
3013
}
3014
3015
3016
erts_refc_dectest(&fun_entry->refc, 1);
3017
}
3018
3019
- fun_entry->address = beamasm_get_lambda(stp->ba, i);
3020
+ erts_set_fun_code(fun_entry, beamasm_get_lambda(stp->ba, i));
3021
3022
beamasm_patch_lambda(stp->ba,
3023
stp->native_module_rw,
3024
diff --git a/erts/emulator/beam/jit/beam_jit_common.cpp b/erts/emulator/beam/jit/beam_jit_common.cpp
3025
index 043a4739db..9d362cfc6c 100644
3026
--- a/erts/emulator/beam/jit/beam_jit_common.cpp
3027
+++ b/erts/emulator/beam/jit/beam_jit_common.cpp
3028
3029
Export *ep;
3030
3031
funp = (ErlFunThing *)fun_val(fun_thing);
3032
- fe = funp->fe;
3033
+ ASSERT(is_local_fun(funp));
3034
+
3035
+ fe = funp->entry.fun;
3036
module = fe->module;
3037
3038
ERTS_THR_READ_MEMORY_BARRIER;
3039
diff --git a/erts/emulator/beam/jit/x86/beam_asm.hpp b/erts/emulator/beam/jit/x86/beam_asm.hpp
3040
index dee1edebb5..3017e6bbb9 100644
3041
--- a/erts/emulator/beam/jit/x86/beam_asm.hpp
3042
+++ b/erts/emulator/beam/jit/x86/beam_asm.hpp
3043
3044
}
3045
}
3046
3047
- /* Returns the current code address for the export entry in `Src`
3048
+ /* Returns the current code address for the `Export` or `ErlFunEntry` in
3049
+ * `Src`.
3050
*
3051
- * Export tracing, save_calls, etc is implemented by shared fragments that
3052
- * assume that the export entry is in RET, so we have to copy it over if it
3053
- * isn't already. */
3054
- x86::Mem emit_setup_export_call(const x86::Gp &Src) {
3055
- return emit_setup_export_call(Src, active_code_ix);
3056
+ * Export tracing, save_calls, etc are implemented by shared fragments that
3057
+ * assume that the respective entry is in RET, so we have to copy it over
3058
+ * if it isn't already. */
3059
+ x86::Mem emit_setup_dispatchable_call(const x86::Gp &Src) {
3060
+ return emit_setup_dispatchable_call(Src, active_code_ix);
3061
}
3062
3063
- x86::Mem emit_setup_export_call(const x86::Gp &Src,
3064
- const x86::Gp &CodeIndex) {
3065
+ x86::Mem emit_setup_dispatchable_call(const x86::Gp &Src,
3066
+ const x86::Gp &CodeIndex) {
3067
if (RET != Src) {
3068
a.mov(RET, Src);
3069
}
3070
3071
- return x86::qword_ptr(RET, CodeIndex, 3, offsetof(Export, addresses));
3072
+ ERTS_CT_ASSERT(offsetof(ErlFunEntry, dispatch) == 0);
3073
+ ERTS_CT_ASSERT(offsetof(Export, dispatch) == 0);
3074
+
3075
+ return x86::qword_ptr(RET,
3076
+ CodeIndex,
3077
+ 3,
3078
+ offsetof(ErtsDispatchable, addresses));
3079
}
3080
3081
void emit_assert_runtime_stack() {
3082
diff --git a/erts/emulator/beam/jit/x86/beam_asm_global.cpp b/erts/emulator/beam/jit/x86/beam_asm_global.cpp
3083
index f388aefa3b..902c995227 100644
3084
--- a/erts/emulator/beam/jit/x86/beam_asm_global.cpp
3085
+++ b/erts/emulator/beam/jit/x86/beam_asm_global.cpp
3086
3087
a.sub(RET, imm(offsetof(Export, info.mfa)));
3088
3089
emit_leave_frame();
3090
- a.jmp(emit_setup_export_call(RET));
3091
+ a.jmp(emit_setup_dispatchable_call(RET));
3092
}
3093
3094
/* Handles export breakpoints, error handler, jump tracing, and so on.
3095
3096
a.je(labels[process_exit]);
3097
3098
emit_leave_frame();
3099
- a.jmp(emit_setup_export_call(RET));
3100
+ a.jmp(emit_setup_dispatchable_call(RET));
3101
}
3102
}
3103
3104
diff --git a/erts/emulator/beam/jit/x86/instr_bif.cpp b/erts/emulator/beam/jit/x86/instr_bif.cpp
3105
index e435a9e4fd..6c8160a7de 100644
3106
--- a/erts/emulator/beam/jit/x86/instr_bif.cpp
3107
+++ b/erts/emulator/beam/jit/x86/instr_bif.cpp
3108
3109
a.pop(getCPRef());
3110
#endif
3111
3112
- x86::Mem destination = emit_setup_export_call(ARG4);
3113
+ x86::Mem destination = emit_setup_dispatchable_call(ARG4);
3114
a.jmp(destination);
3115
}
3116
3117
diff --git a/erts/emulator/beam/jit/x86/instr_call.cpp b/erts/emulator/beam/jit/x86/instr_call.cpp
3118
index 466b184295..49eabfdaef 100644
3119
--- a/erts/emulator/beam/jit/x86/instr_call.cpp
3120
+++ b/erts/emulator/beam/jit/x86/instr_call.cpp
3121
3122
a.mov(ARG1, imm(&the_active_code_index));
3123
a.mov(ARG1d, x86::dword_ptr(ARG1));
3124
3125
- a.jmp(emit_setup_export_call(RET, ARG1));
3126
+ a.jmp(emit_setup_dispatchable_call(RET, ARG1));
3127
}
3128
3129
void BeamModuleAssembler::emit_i_call_ext(const ArgVal &Exp) {
3130
make_move_patch(RET, imports[Exp.getValue()].patches);
3131
- x86::Mem destination = emit_setup_export_call(RET);
3132
+ x86::Mem destination = emit_setup_dispatchable_call(RET);
3133
erlang_call(destination, ARG1);
3134
}
3135
3136
void BeamModuleAssembler::emit_i_call_ext_only(const ArgVal &Exp) {
3137
make_move_patch(RET, imports[Exp.getValue()].patches);
3138
- x86::Mem destination = emit_setup_export_call(RET);
3139
+ x86::Mem destination = emit_setup_dispatchable_call(RET);
3140
3141
emit_leave_frame();
3142
a.jmp(destination);
3143
3144
emit_deallocate(Deallocate);
3145
3146
make_move_patch(RET, imports[Exp.getValue()].patches);
3147
- x86::Mem destination = emit_setup_export_call(RET);
3148
+ x86::Mem destination = emit_setup_dispatchable_call(RET);
3149
3150
emit_leave_frame();
3151
a.jmp(destination);
3152
3153
emit_raise_exception(entry, &apply3_mfa);
3154
a.bind(dispatch);
3155
3156
- return emit_setup_export_call(RET);
3157
+ return emit_setup_dispatchable_call(RET);
3158
}
3159
3160
void BeamModuleAssembler::emit_i_apply() {
3161
3162
emit_raise_exception(entry, &apply3_mfa);
3163
a.bind(dispatch);
3164
3165
- return emit_setup_export_call(RET);
3166
+ return emit_setup_dispatchable_call(RET);
3167
}
3168
3169
void BeamModuleAssembler::emit_apply(const ArgVal &Arity) {
3170
diff --git a/erts/emulator/beam/jit/x86/instr_common.cpp b/erts/emulator/beam/jit/x86/instr_common.cpp
3171
index e0dd4d792b..1cd9c902f7 100644
3172
--- a/erts/emulator/beam/jit/x86/instr_common.cpp
3173
+++ b/erts/emulator/beam/jit/x86/instr_common.cpp
3174
3175
3176
void BeamModuleAssembler::emit_is_function(const ArgVal &Fail,
3177
const ArgVal &Src) {
3178
- Label next = a.newLabel();
3179
-
3180
mov_arg(RET, Src);
3181
3182
emit_is_boxed(labels[Fail.getValue()], RET);
3183
3184
x86::Gp boxed_ptr = emit_ptr_val(RET, RET);
3185
a.mov(RETd, emit_boxed_val(boxed_ptr, 0, sizeof(Uint32)));
3186
a.cmp(RET, imm(HEADER_FUN));
3187
- a.short_().je(next);
3188
- ERTS_CT_ASSERT(HEADER_EXPORT < 256);
3189
- a.cmp(RETb, imm(HEADER_EXPORT));
3190
a.jne(labels[Fail.getValue()]);
3191
-
3192
- a.bind(next);
3193
}
3194
3195
void BeamModuleAssembler::emit_is_function2(const ArgVal &Fail,
3196
3197
return;
3198
}
3199
3200
- Label next = a.newLabel(), fun = a.newLabel();
3201
-
3202
mov_arg(ARG1, Src);
3203
3204
emit_is_boxed(labels[Fail.getValue()], ARG1);
3205
3206
x86::Gp boxed_ptr = emit_ptr_val(ARG1, ARG1);
3207
a.mov(RETd, emit_boxed_val(boxed_ptr, 0, sizeof(Uint32)));
3208
a.cmp(RETd, imm(HEADER_FUN));
3209
- a.short_().je(fun);
3210
- ERTS_CT_ASSERT(HEADER_EXPORT < 256);
3211
- a.cmp(RETb, imm(HEADER_EXPORT));
3212
a.jne(labels[Fail.getValue()]);
3213
3214
- comment("Check arity of export fun");
3215
- a.mov(ARG2, emit_boxed_val(boxed_ptr, sizeof(Eterm)));
3216
- a.cmp(x86::qword_ptr(ARG2, offsetof(Export, info.mfa.arity)), imm(arity));
3217
+ a.cmp(emit_boxed_val(boxed_ptr, offsetof(ErlFunThing, arity)), imm(arity));
3218
a.jne(labels[Fail.getValue()]);
3219
- a.short_().jmp(next);
3220
-
3221
- comment("Check arity of fun");
3222
- a.bind(fun);
3223
- {
3224
- a.cmp(emit_boxed_val(boxed_ptr, offsetof(ErlFunThing, arity)),
3225
- imm(arity));
3226
- a.jne(labels[Fail.getValue()]);
3227
- }
3228
-
3229
- a.bind(next);
3230
}
3231
3232
void BeamModuleAssembler::emit_is_integer(const ArgVal &Fail,
3233
diff --git a/erts/emulator/beam/jit/x86/instr_fun.cpp b/erts/emulator/beam/jit/x86/instr_fun.cpp
3234
index 1c8c1a22d9..27600cf128 100644
3235
--- a/erts/emulator/beam/jit/x86/instr_fun.cpp
3236
+++ b/erts/emulator/beam/jit/x86/instr_fun.cpp
3237
3238
a.jz(error);
3239
3240
emit_leave_frame();
3241
- a.jmp(emit_setup_export_call(RET));
3242
+ a.jmp(emit_setup_dispatchable_call(RET));
3243
3244
a.bind(error);
3245
{
3246
3247
}
3248
}
3249
3250
-/* Handles errors for `call_fun` and `i_lambda_trampoline`.
3251
+/* Handles errors for `call_fun`.
3252
*
3253
* ARG3 = arity
3254
* ARG4 = fun thing
3255
3256
emit_is_boxed(bad_fun, ARG4);
3257
3258
x86::Gp fun_thing = emit_ptr_val(RET, ARG4);
3259
- a.mov(RET, emit_boxed_val(fun_thing));
3260
- a.cmp(RET, imm(HEADER_EXPORT));
3261
- a.short_().je(bad_arity);
3262
- a.cmp(RET, imm(HEADER_FUN));
3263
+ a.cmp(emit_boxed_val(fun_thing), imm(HEADER_FUN));
3264
a.short_().je(bad_arity);
3265
3266
a.bind(bad_fun);
3267
{
3268
- /* Not a fun: this is only reachable through `call_fun` */
3269
a.mov(x86::qword_ptr(c_p, offsetof(Process, freason)), imm(EXC_BADFUN));
3270
a.mov(x86::qword_ptr(c_p, offsetof(Process, fvalue)), ARG4);
3271
3272
3273
3274
a.bind(bad_arity);
3275
{
3276
- /* Bad arity: this is reachable through `call_fun` when we have an
3277
- * export fun, and `i_lambda_trampoline` when we have a local one. */
3278
-
3279
/* Stash our fun and current PC. Note that we don't move the fun to
3280
* {x,0} straight away as that would clobber the first argument. */
3281
a.mov(TMP_MEM1q, ARG4);
3282
3283
}
3284
}
3285
3286
-/* `call_fun` instructions land here to check arity and set up their
3287
- * environment before jumping to the actual implementation.
3288
+/* `call_fun` instructions land here to set up their environment before jumping
3289
+ * to the actual implementation.
3290
*
3291
* Keep in mind that this runs in the limbo between caller and callee, so we
3292
* must not enter a frame here.
3293
3294
const ArgVal &NumFree) {
3295
const ssize_t effective_arity = Arity.getValue() - NumFree.getValue();
3296
const ssize_t num_free = NumFree.getValue();
3297
- Label error = a.newLabel();
3298
ssize_t i;
3299
3300
auto &lambda = lambdas[Index.getValue()];
3301
+
3302
+ if (NumFree.getValue() == 0) {
3303
+ /* No free variables, let the lambda jump directly to our target. */
3304
+ lambda.trampoline = labels[Lbl.getValue()];
3305
+ return;
3306
+ }
3307
+
3308
lambda.trampoline = a.newLabel();
3309
a.bind(lambda.trampoline);
3310
3311
- a.cmp(ARG3, imm(effective_arity));
3312
- a.short_().jne(error);
3313
-
3314
emit_ptr_val(ARG4, ARG4);
3315
3316
for (i = 0; i < num_free - 1; i += 2) {
3317
3318
}
3319
3320
a.jmp(labels[Lbl.getValue()]);
3321
-
3322
- a.bind(error);
3323
- abs_jmp(ga->get_handle_call_fun_error());
3324
}
3325
3326
void BeamModuleAssembler::emit_i_make_fun3(const ArgVal &Fun,
3327
3328
size_t num_free = env.size();
3329
ASSERT(NumFree.getValue() == num_free);
3330
3331
+ make_move_patch(ARG2, lambdas[Fun.getValue()].patches);
3332
mov_arg(ARG3, Arity);
3333
mov_arg(ARG4, NumFree);
3334
3335
emit_enter_runtime<Update::eHeap>();
3336
3337
a.mov(ARG1, c_p);
3338
- make_move_patch(ARG2, lambdas[Fun.getValue()].patches);
3339
- runtime_call<4>(new_fun_thing);
3340
+ runtime_call<4>(erts_new_local_fun_thing);
3341
3342
emit_leave_runtime<Update::eHeap>();
3343
3344
3345
* ARG3 = arity
3346
* ARG4 = fun thing */
3347
x86::Gp BeamModuleAssembler::emit_call_fun() {
3348
- Label exported = a.newLabel(), next = a.newLabel();
3349
+ Label next = a.newLabel();
3350
+
3351
+ /* Speculatively strip the literal tag when needed. */
3352
+ x86::Gp fun_thing = emit_ptr_val(RET, ARG4);
3353
3354
/* Load the error fragment into ARG2 so we can CMOV ourselves there on
3355
* error. */
3356
a.mov(ARG2, ga->get_handle_call_fun_error());
3357
3358
- /* The `handle_call_fun_error` and `i_lambda_trampoline` fragments expect
3359
- * current PC in ARG5. */
3360
+ /* The `handle_call_fun_error` fragment expects current PC in ARG5. */
3361
a.lea(ARG5, x86::qword_ptr(next));
3362
3363
/* As emit_is_boxed(), but explicitly sets ZF so we can rely on that for
3364
3365
a.test(ARG4d, imm(_TAG_PRIMARY_MASK - TAG_PRIMARY_BOXED));
3366
a.short_().jne(next);
3367
3368
- x86::Gp fun_thing = emit_ptr_val(RET, ARG4);
3369
- a.cmp(emit_boxed_val(fun_thing), imm(HEADER_EXPORT));
3370
- a.short_().je(exported);
3371
a.cmp(emit_boxed_val(fun_thing), imm(HEADER_FUN));
3372
a.short_().jne(next);
3373
3374
- a.mov(ARG1, emit_boxed_val(fun_thing, offsetof(ErlFunThing, fe)));
3375
- a.mov(ARG1, x86::qword_ptr(ARG1, offsetof(ErlFunEntry, address)));
3376
- a.short_().jmp(next);
3377
-
3378
- a.bind(exported);
3379
- {
3380
- a.mov(RET, emit_boxed_val(fun_thing, sizeof(Eterm)));
3381
- a.mov(ARG1, emit_setup_export_call(RET));
3382
+ a.cmp(emit_boxed_val(fun_thing, offsetof(ErlFunThing, arity)), ARG3);
3383
3384
- a.cmp(x86::qword_ptr(RET, offsetof(Export, info.mfa.arity)), ARG3);
3385
- }
3386
+ a.mov(RET, emit_boxed_val(fun_thing, offsetof(ErlFunThing, entry)));
3387
+ a.mov(ARG1, emit_setup_dispatchable_call(RET));
3388
3389
/* Assumes that ZF is set on success and clear on error, overwriting our
3390
* destination with the error fragment's address. */
3391
diff --git a/erts/emulator/beam/jit/x86/instr_trace.cpp b/erts/emulator/beam/jit/x86/instr_trace.cpp
3392
index 128fbbe615..40b5b91ea3 100644
3393
--- a/erts/emulator/beam/jit/x86/instr_trace.cpp
3394
+++ b/erts/emulator/beam/jit/x86/instr_trace.cpp
3395
3396
a.test(RET, RET);
3397
a.je(error);
3398
3399
- a.jmp(emit_setup_export_call(RET));
3400
+ a.jmp(emit_setup_dispatchable_call(RET));
3401
3402
a.bind(error);
3403
{
3404
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
3405
index 41bc23e15d..043d2e4f8c 100644
3406
--- a/erts/emulator/beam/utils.c
3407
+++ b/erts/emulator/beam/utils.c
3408
3409
hash = hash*FUNNY_NUMBER4 + sz;
3410
break;
3411
}
3412
- case EXPORT_DEF:
3413
- {
3414
- Export* ep = *((Export **) (export_val(term) + 1));
3415
+ case FUN_DEF:
3416
+ {
3417
+ ErlFunThing* funp = (ErlFunThing *) fun_val(term);
3418
3419
- hash = hash * FUNNY_NUMBER11 + ep->info.mfa.arity;
3420
- hash = hash*FUNNY_NUMBER1 +
3421
- (atom_tab(atom_val(ep->info.mfa.module))->slot.bucket.hvalue);
3422
- hash = hash*FUNNY_NUMBER1 +
3423
- (atom_tab(atom_val(ep->info.mfa.function))->slot.bucket.hvalue);
3424
- break;
3425
- }
3426
+ if (is_local_fun(funp)) {
3427
3428
- case FUN_DEF:
3429
- {
3430
- ErlFunThing* funp = (ErlFunThing *) fun_val(term);
3431
- Uint num_free = funp->num_free;
3432
-
3433
- hash = hash * FUNNY_NUMBER10 + num_free;
3434
- hash = hash*FUNNY_NUMBER1 +
3435
- (atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue);
3436
- hash = hash*FUNNY_NUMBER2 + funp->fe->index;
3437
- hash = hash*FUNNY_NUMBER2 + funp->fe->old_uniq;
3438
- if (num_free > 0) {
3439
- if (num_free > 1) {
3440
- WSTACK_PUSH3(stack, (UWord) &funp->env[1], (num_free-1), MAKE_HASH_TERM_ARRAY_OP);
3441
- }
3442
- term = funp->env[0];
3443
- goto tail_recur;
3444
- }
3445
- break;
3446
- }
3447
+ ErlFunEntry* fe = funp->entry.fun;
3448
+ Uint num_free = funp->num_free;
3449
+
3450
+ hash = hash * FUNNY_NUMBER10 + num_free;
3451
+ hash = hash*FUNNY_NUMBER1 +
3452
+ (atom_tab(atom_val(fe->module))->slot.bucket.hvalue);
3453
+ hash = hash*FUNNY_NUMBER2 + fe->index;
3454
+ hash = hash*FUNNY_NUMBER2 + fe->old_uniq;
3455
+
3456
+ if (num_free > 0) {
3457
+ if (num_free > 1) {
3458
+ WSTACK_PUSH3(stack, (UWord) &funp->env[1],
3459
+ (num_free-1), MAKE_HASH_TERM_ARRAY_OP);
3460
+ }
3461
+
3462
+ term = funp->env[0];
3463
+ goto tail_recur;
3464
+ }
3465
+ } else {
3466
+ const ErtsCodeMFA *mfa = &funp->entry.exp->info.mfa;
3467
+
3468
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
3469
+
3470
+ hash = hash * FUNNY_NUMBER11 + mfa->arity;
3471
+ hash = hash*FUNNY_NUMBER1 +
3472
+ (atom_tab(atom_val(mfa->module))->slot.bucket.hvalue);
3473
+ hash = hash*FUNNY_NUMBER1 +
3474
+ (atom_tab(atom_val(mfa->function))->slot.bucket.hvalue);
3475
+ }
3476
+ break;
3477
+ }
3478
case PID_DEF:
3479
/* only 15 bits... */
3480
UINT32_HASH_RET(internal_pid_number(term),FUNNY_NUMBER5,FUNNY_NUMBER6);
3481
3482
goto hash2_common;
3483
}
3484
break;
3485
- case EXPORT_SUBTAG:
3486
- {
3487
- Export* ep = *((Export **) (export_val(term) + 1));
3488
- UINT32_HASH_2
3489
- (ep->info.mfa.arity,
3490
- atom_tab(atom_val(ep->info.mfa.module))->slot.bucket.hvalue,
3491
- HCONST);
3492
- UINT32_HASH
3493
- (atom_tab(atom_val(ep->info.mfa.function))->slot.bucket.hvalue,
3494
- HCONST_14);
3495
- goto hash2_common;
3496
- }
3497
3498
- case FUN_SUBTAG:
3499
- {
3500
- ErlFunThing* funp = (ErlFunThing *) fun_val(term);
3501
- ErtsMakeHash2Context_FUN_SUBTAG ctx = {
3502
- .num_free = funp->num_free,
3503
- .bptr = NULL};
3504
- UINT32_HASH_2
3505
- (ctx.num_free,
3506
- atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue,
3507
- HCONST);
3508
- UINT32_HASH_2
3509
- (funp->fe->index, funp->fe->old_uniq, HCONST);
3510
- if (ctx.num_free == 0) {
3511
- goto hash2_common;
3512
- } else {
3513
- ctx.bptr = funp->env + ctx.num_free - 1;
3514
- while (ctx.num_free-- > 1) {
3515
- term = *ctx.bptr--;
3516
- ESTACK_PUSH(s, term);
3517
+ case FUN_SUBTAG:
3518
+ {
3519
+ ErlFunThing* funp = (ErlFunThing *) fun_val(term);
3520
+
3521
+ if (is_local_fun(funp)) {
3522
+ ErlFunEntry* fe = funp->entry.fun;
3523
+ ErtsMakeHash2Context_FUN_SUBTAG ctx = {
3524
+ .num_free = funp->num_free,
3525
+ .bptr = NULL};
3526
+
3527
+ UINT32_HASH_2
3528
+ (ctx.num_free,
3529
+ atom_tab(atom_val(fe->module))->slot.bucket.hvalue,
3530
+ HCONST);
3531
+ UINT32_HASH_2
3532
+ (fe->index, fe->old_uniq, HCONST);
3533
+ if (ctx.num_free == 0) {
3534
+ goto hash2_common;
3535
+ } else {
3536
+ ctx.bptr = funp->env + ctx.num_free - 1;
3537
+ while (ctx.num_free-- > 1) {
3538
+ term = *ctx.bptr--;
3539
+ ESTACK_PUSH(s, term);
3540
TRAP_LOCATION(fun_subtag);
3541
- }
3542
- term = *ctx.bptr;
3543
- }
3544
- }
3545
+ }
3546
+ term = *ctx.bptr;
3547
+ }
3548
+ } else {
3549
+ Export *ep = funp->entry.exp;
3550
+
3551
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
3552
+
3553
+ UINT32_HASH_2
3554
+ (ep->info.mfa.arity,
3555
+ atom_tab(atom_val(ep->info.mfa.module))->slot.bucket.hvalue,
3556
+ HCONST);
3557
+ UINT32_HASH
3558
+ (atom_tab(atom_val(ep->info.mfa.function))->slot.bucket.hvalue,
3559
+ HCONST_14);
3560
+
3561
+ goto hash2_common;
3562
+ }
3563
+ }
3564
break;
3565
case REFC_BINARY_SUBTAG:
3566
case HEAP_BINARY_SUBTAG:
3567
3568
goto pop_next;
3569
}
3570
break;
3571
- case EXPORT_SUBTAG:
3572
- {
3573
- Export* ep = *((Export **) (export_val(term) + 1));
3574
- /* Assumes Export entries never move */
3575
- POINTER_HASH(ep, HCONST_14);
3576
- goto pop_next;
3577
- }
3578
+ case FUN_SUBTAG:
3579
+ {
3580
+ ErlFunThing* funp = (ErlFunThing *) fun_val(term);
3581
+
3582
+ if (is_local_fun(funp)) {
3583
+ ErlFunEntry* fe = funp->entry.fun;
3584
+ Uint num_free = funp->num_free;
3585
+ UINT32_HASH_2(num_free, fe->module, HCONST_20);
3586
+ UINT32_HASH_2(fe->index, fe->old_uniq, HCONST_21);
3587
+ if (num_free == 0) {
3588
+ goto pop_next;
3589
+ } else {
3590
+ Eterm* bptr = funp->env + num_free - 1;
3591
+ while (num_free-- > 1) {
3592
+ term = *bptr--;
3593
+ ESTACK_PUSH(s, term);
3594
+ }
3595
+ term = *bptr;
3596
+ }
3597
+ } else {
3598
+ ASSERT(is_external_fun(funp) && funp->next == NULL);
3599
3600
- case FUN_SUBTAG:
3601
- {
3602
- ErlFunThing* funp = (ErlFunThing *) fun_val(term);
3603
- Uint num_free = funp->num_free;
3604
- UINT32_HASH_2(num_free, funp->fe->module, HCONST_20);
3605
- UINT32_HASH_2(funp->fe->index, funp->fe->old_uniq, HCONST_21);
3606
- if (num_free == 0) {
3607
- goto pop_next;
3608
- } else {
3609
- Eterm* bptr = funp->env + num_free - 1;
3610
- while (num_free-- > 1) {
3611
- term = *bptr--;
3612
- ESTACK_PUSH(s, term);
3613
- }
3614
- term = *bptr;
3615
- }
3616
- }
3617
- break;
3618
+ /* Assumes Export entries never move */
3619
+ POINTER_HASH(funp->entry.exp, HCONST_14);
3620
+ goto pop_next;
3621
+ }
3622
+ }
3623
+ break;
3624
case REFC_BINARY_SUBTAG:
3625
case HEAP_BINARY_SUBTAG:
3626
case SUB_BINARY_SUBTAG:
3627
3628
}
3629
break; /* not equal */
3630
}
3631
- case EXPORT_SUBTAG:
3632
- {
3633
- if (is_export(b)) {
3634
- Export* a_exp = *((Export **) (export_val(a) + 1));
3635
- Export* b_exp = *((Export **) (export_val(b) + 1));
3636
- if (a_exp == b_exp) goto pop_next;
3637
- }
3638
- break; /* not equal */
3639
- }
3640
- case FUN_SUBTAG:
3641
- {
3642
- ErlFunThing* f1;
3643
- ErlFunThing* f2;
3644
+ case FUN_SUBTAG:
3645
+ {
3646
+ ErlFunThing* f1;
3647
+ ErlFunThing* f2;
3648
3649
- if (!is_fun(b))
3650
- goto not_equal;
3651
- f1 = (ErlFunThing *) fun_val(a);
3652
- f2 = (ErlFunThing *) fun_val(b);
3653
- if (f1->fe->module != f2->fe->module ||
3654
- f1->fe->index != f2->fe->index ||
3655
- f1->fe->old_uniq != f2->fe->old_uniq ||
3656
- f1->num_free != f2->num_free) {
3657
- goto not_equal;
3658
- }
3659
- if ((sz = f1->num_free) == 0) goto pop_next;
3660
- aa = f1->env;
3661
- bb = f2->env;
3662
- goto term_array;
3663
- }
3664
+ if (is_not_any_fun(b)) {
3665
+ goto not_equal;
3666
+ }
3667
+
3668
+ f1 = (ErlFunThing *) fun_val(a);
3669
+ f2 = (ErlFunThing *) fun_val(b);
3670
+
3671
+ if (is_local_fun(f1) && is_local_fun(f2)) {
3672
+ ErlFunEntry *fe1, *fe2;
3673
+
3674
+ fe1 = f1->entry.fun;
3675
+ fe2 = f2->entry.fun;
3676
+
3677
+ if (fe1->module != fe2->module ||
3678
+ fe1->index != fe2->index ||
3679
+ fe1->old_uniq != fe2->old_uniq ||
3680
+ f1->num_free != f2->num_free) {
3681
+ goto not_equal;
3682
+ }
3683
+
3684
+ if ((sz = f1->num_free) == 0) {
3685
+ goto pop_next;
3686
+ }
3687
+
3688
+ aa = f1->env;
3689
+ bb = f2->env;
3690
+ goto term_array;
3691
+ } else if (is_external_fun(f1) && is_external_fun(f2)) {
3692
+ if (f1->entry.exp == f2->entry.exp) {
3693
+ goto pop_next;
3694
+ }
3695
+ }
3696
+
3697
+ goto not_equal;
3698
+ }
3699
3700
case EXTERNAL_PID_SUBTAG: {
3701
ExternalThing *ap;
3702
3703
goto mixed_types;
3704
}
3705
ON_CMP_GOTO(big_comp(a, b));
3706
- case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE):
3707
- if (!is_export(b)) {
3708
- a_tag = EXPORT_DEF;
3709
- goto mixed_types;
3710
- } else {
3711
- Export* a_exp = *((Export **) (export_val(a) + 1));
3712
- Export* b_exp = *((Export **) (export_val(b) + 1));
3713
3714
- if ((j = erts_cmp_atoms(a_exp->info.mfa.module,
3715
- b_exp->info.mfa.module)) != 0) {
3716
- RETURN_NEQ(j);
3717
- }
3718
- if ((j = erts_cmp_atoms(a_exp->info.mfa.function,
3719
- b_exp->info.mfa.function)) != 0) {
3720
- RETURN_NEQ(j);
3721
- }
3722
- ON_CMP_GOTO((Sint) a_exp->info.mfa.arity - (Sint) b_exp->info.mfa.arity);
3723
- }
3724
- break;
3725
- case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE):
3726
- if (!is_fun(b)) {
3727
- a_tag = FUN_DEF;
3728
- goto mixed_types;
3729
- } else {
3730
- ErlFunThing* f1 = (ErlFunThing *) fun_val(a);
3731
- ErlFunThing* f2 = (ErlFunThing *) fun_val(b);
3732
- Sint diff;
3733
+ case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE):
3734
+ if (is_not_any_fun(b)) {
3735
+ a_tag = FUN_DEF;
3736
+ goto mixed_types;
3737
+ } else {
3738
+ ErlFunThing* f1 = (ErlFunThing *) fun_val(a);
3739
+ ErlFunThing* f2 = (ErlFunThing *) fun_val(b);
3740
3741
- diff = erts_cmp_atoms((f1->fe)->module, (f2->fe)->module);
3742
- if (diff != 0) {
3743
- RETURN_NEQ(diff);
3744
- }
3745
- diff = f1->fe->index - f2->fe->index;
3746
- if (diff != 0) {
3747
- RETURN_NEQ(diff);
3748
- }
3749
- diff = f1->fe->old_uniq - f2->fe->old_uniq;
3750
- if (diff != 0) {
3751
- RETURN_NEQ(diff);
3752
- }
3753
- diff = f1->num_free - f2->num_free;
3754
- if (diff != 0) {
3755
- RETURN_NEQ(diff);
3756
- }
3757
- i = f1->num_free;
3758
- if (i == 0) goto pop_next;
3759
- aa = f1->env;
3760
- bb = f2->env;
3761
- goto term_array;
3762
- }
3763
- case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE):
3764
- if (!is_pid(b)) {
3765
+ if (is_local_fun(f1) && is_local_fun(f2)) {
3766
+ ErlFunEntry* fe1 = f1->entry.fun;
3767
+ ErlFunEntry* fe2 = f2->entry.fun;
3768
+
3769
+ Sint diff;
3770
+
3771
+ diff = erts_cmp_atoms(fe1->module, (fe2)->module);
3772
+
3773
+ if (diff != 0) {
3774
+ RETURN_NEQ(diff);
3775
+ }
3776
+
3777
+ diff = fe1->index - fe2->index;
3778
+ if (diff != 0) {
3779
+ RETURN_NEQ(diff);
3780
+ }
3781
+
3782
+ diff = fe1->old_uniq - fe2->old_uniq;
3783
+ if (diff != 0) {
3784
+ RETURN_NEQ(diff);
3785
+ }
3786
+
3787
+ diff = f1->num_free - f2->num_free;
3788
+ if (diff != 0) {
3789
+ RETURN_NEQ(diff);
3790
+ }
3791
+
3792
+ i = f1->num_free;
3793
+ if (i == 0) goto pop_next;
3794
+ aa = f1->env;
3795
+ bb = f2->env;
3796
+ goto term_array;
3797
+ } else if (is_external_fun(f1) && is_external_fun(f2)) {
3798
+ Export* a_exp = f1->entry.exp;
3799
+ Export* b_exp = f2->entry.exp;
3800
+
3801
+ if ((j = erts_cmp_atoms(a_exp->info.mfa.module,
3802
+ b_exp->info.mfa.module)) != 0) {
3803
+ RETURN_NEQ(j);
3804
+ }
3805
+ if ((j = erts_cmp_atoms(a_exp->info.mfa.function,
3806
+ b_exp->info.mfa.function)) != 0) {
3807
+ RETURN_NEQ(j);
3808
+ }
3809
+
3810
+ ON_CMP_GOTO((Sint) a_exp->info.mfa.arity -
3811
+ (Sint) b_exp->info.mfa.arity);
3812
+ } else {
3813
+ /* External funs compare greater than local ones. */
3814
+ RETURN_NEQ(is_external_fun(f1) - is_external_fun(f2));
3815
+ }
3816
+ }
3817
+ case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE):
3818
+ if (!is_pid(b)) {
3819
a_tag = EXTERNAL_PID_DEF;
3820
goto mixed_types;
3821
}
3822
diff --git a/erts/emulator/internal_doc/BeamAsm.md b/erts/emulator/internal_doc/BeamAsm.md
3823
index fa5a308a03..44f2c758c5 100644
3824
--- a/erts/emulator/internal_doc/BeamAsm.md
3825
+++ b/erts/emulator/internal_doc/BeamAsm.md
3826
3827
even when we don't know beforehand that the call is remote, such as when
3828
calling a fun.
3829
3830
-This is pretty easy to do in assembler and the `emit_setup_export_call` helper
3831
-handles it nicely for us, but we can't set registers when trapping out from C
3832
-code. When trapping to an export entry from C code one must set `c_p->current`
3833
-to the `ErtsCodeMFA` inside the export entry in question, and then set `c_p->i`
3834
-to `beam_bif_export_trap`.
3835
+This is pretty easy to do in assembler and the `emit_setup_dispatchable_call`
3836
+helper handles it nicely for us, but we can't set registers when trapping out
3837
+from C code. When trapping to an export entry from C code one must set
3838
+`c_p->current` to the `ErtsCodeMFA` inside the export entry in question, and
3839
+then set `c_p->i` to `beam_bif_export_trap`.
3840
3841
The `BIF_TRAP` macros handle this for you, so you generally don't need to
3842
think about it.
3843
diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl
3844
index 2c1e83dbdf..b0edb45af4 100644
3845
--- a/erts/emulator/test/erts_debug_SUITE.erl
3846
+++ b/erts/emulator/test/erts_debug_SUITE.erl
3847
3848
3849
FunSz1 = do_test_size(fun() -> ConsCell1 end) - do_test_size(ConsCell1),
3850
3851
- 2 = do_test_size(fun lists:sort/1),
3852
+ %% External funs are the same size as local ones without environment
3853
+ FunSz0 = do_test_size(fun lists:sort/1),
3854
3855
Arch = 8 * erlang:system_info({wordsize, external}),
3856
case {Arch, do_test_size(mk_ext_pid({a@b, 1}, 17, 42))} of
3857
--
3858
2.31.1
3859
3860