1 /*
2 * %CopyrightBegin%
3 *
4 * Copyright Ericsson AB 1996-2020. All Rights Reserved.
5 *
6 * Licensed under the Apache License, Version 2.0 (the "License");
7 * you may not use this file except in compliance with the License.
8 * You may obtain a copy of the License at
9 *
10 * http://www.apache.org/licenses/LICENSE-2.0
11 *
12 * Unless required by applicable law or agreed to in writing, software
13 * distributed under the License is distributed on an "AS IS" BASIS,
14 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 * See the License for the specific language governing permissions and
16 * limitations under the License.
17 *
18 * %CopyrightEnd%
19 */
20
21 #ifdef HAVE_CONFIG_H
22 # include "config.h"
23 #endif
24
25 #include <stddef.h> /* offsetof() */
26 #include "sys.h"
27 #include "erl_vm.h"
28 #include "erl_sys_driver.h"
29 #include "global.h"
30 #include "erl_process.h"
31 #include "error.h"
32 #include "bif.h"
33 #include "big.h"
34 #include "dist.h"
35 #include "erl_version.h"
36 #include "erl_binary.h"
37 #include "beam_bp.h"
38 #include "erl_db_util.h"
39 #include "register.h"
40 #include "erl_thr_progress.h"
41 #define ERTS_PTAB_WANT_BIF_IMPL__
42 #include "erl_ptab.h"
43 #include "erl_bits.h"
44 #include "erl_bif_unique.h"
45 #include "erl_map.h"
46 #include "erl_msacc.h"
47 #include "erl_proc_sig_queue.h"
48 #include "jit/beam_asm.h"
49
50 Export *erts_await_result;
51 static Export await_exit_trap;
52 static Export* flush_monitor_messages_trap = NULL;
53 static Export* set_cpu_topology_trap = NULL;
54 static Export* await_port_send_result_trap = NULL;
55 Export* erts_format_cpu_topology_trap = NULL;
56 static Export dsend_continue_trap_export;
57 Export *erts_convert_time_unit_trap = NULL;
58
59 static Export *await_msacc_mod_trap = NULL;
60 static erts_atomic32_t msacc;
61
62 static Export *system_flag_scheduler_wall_time_trap;
63 static Export *await_sched_wall_time_mod_trap;
64 static erts_atomic32_t sched_wall_time;
65
66 #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
67
68 /*
69 * The BIF's now follow, see the Erlang Manual for a description of what
70 * each individual BIF does.
71 */
72
spawn_3(BIF_ALIST_3)73 BIF_RETTYPE spawn_3(BIF_ALIST_3)
74 {
75 ErlSpawnOpts so;
76 Eterm pid;
77
78 ERTS_SET_DEFAULT_SPAWN_OPTS(&so);
79
80 pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so);
81 if (is_non_value(pid)) {
82 BIF_ERROR(BIF_P, so.error_code);
83 } else {
84 if (ERTS_USE_MODIFIED_TIMING()) {
85 BIF_TRAP2(erts_delay_trap, BIF_P, pid, ERTS_MODIFIED_TIMING_DELAY);
86 }
87 BIF_RET(pid);
88 }
89 }
90
91 /**********************************************************************/
92
93 /* Utility to add a new link between processes p and another internal
94 * process (rpid). Process p must be the currently executing process.
95 */
96
97 /* create a link to the process */
link_1(BIF_ALIST_1)98 BIF_RETTYPE link_1(BIF_ALIST_1)
99 {
100 if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) {
101 trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN, BIF_P, am_link, BIF_ARG_1);
102 }
103 /* check that the pid or port which is our argument is OK */
104
105 if (is_internal_pid(BIF_ARG_1)) {
106 int created;
107 ErtsLink *lnk, *rlnk;
108
109 if (BIF_P->common.id == BIF_ARG_1)
110 BIF_RET(am_true);
111
112 if (!erts_proc_lookup(BIF_ARG_1))
113 goto res_no_proc;
114
115 lnk = erts_link_internal_tree_lookup_create(&ERTS_P_LINKS(BIF_P),
116 &created,
117 ERTS_LNK_TYPE_PROC,
118 BIF_ARG_1);
119 if (!created) {
120 ErtsILink *ilnk = (ErtsILink *) lnk;
121 if (!ilnk->unlinking)
122 BIF_RET(am_true);
123 ilnk->unlinking = 0;
124 }
125
126 rlnk = erts_link_internal_create(ERTS_LNK_TYPE_PROC, BIF_P->common.id);
127
128 if (erts_proc_sig_send_link(BIF_P, BIF_ARG_1, rlnk))
129 BIF_RET(am_true);
130
131 erts_link_tree_delete(&ERTS_P_LINKS(BIF_P), lnk);
132 erts_link_internal_release(lnk);
133 erts_link_internal_release(rlnk);
134 goto res_no_proc;
135 }
136
137 if (is_internal_port(BIF_ARG_1)) {
138 int created;
139 ErtsLink *lnk, *rlnk;
140 Eterm ref;
141 Eterm *refp;
142 Port *prt = erts_port_lookup(BIF_ARG_1,
143 (erts_port_synchronous_ops
144 ? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP
145 : ERTS_PORT_SFLGS_INVALID_LOOKUP));
146 if (!prt)
147 goto res_no_proc;
148
149 lnk = erts_link_internal_tree_lookup_create(&ERTS_P_LINKS(BIF_P),
150 &created,
151 ERTS_LNK_TYPE_PORT,
152 BIF_ARG_1);
153 if (!created) {
154 ErtsILink *ilnk = (ErtsILink *) lnk;
155 if (!ilnk->unlinking)
156 BIF_RET(am_true);
157 ilnk->unlinking = 0;
158 }
159
160 rlnk = erts_link_internal_create(ERTS_LNK_TYPE_PROC, BIF_P->common.id);
161 refp = erts_port_synchronous_ops ? &ref : NULL;
162
163 switch (erts_port_link(BIF_P, prt, rlnk, refp)) {
164 case ERTS_PORT_OP_BADARG:
165 erts_link_internal_release(rlnk);
166 erts_link_tree_delete(&ERTS_P_LINKS(BIF_P), lnk);
167 erts_link_internal_release(lnk);
168 goto res_no_proc;
169 case ERTS_PORT_OP_DROPPED:
170 case ERTS_PORT_OP_SCHEDULED:
171 if (refp) {
172 ASSERT(is_internal_ordinary_ref(ref));
173 BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true);
174 }
175 default:
176 break;
177 }
178 BIF_RET(am_true);
179 }
180 else if (is_external_port(BIF_ARG_1)
181 && external_port_dist_entry(BIF_ARG_1) == erts_this_dist_entry) {
182 goto res_no_proc;
183 }
184
185 if (is_external_pid(BIF_ARG_1)) {
186 ErtsELink *elnk, *relnk, *pelnk;
187 int created, replace;
188 DistEntry *dep;
189 ErtsLink *lnk, *rlnk;
190 int code;
191 ErtsDSigSendContext ctx;
192
193 dep = external_pid_dist_entry(BIF_ARG_1);
194 if (dep == erts_this_dist_entry)
195 goto res_no_proc;
196
197 lnk = erts_link_external_tree_lookup_create(&ERTS_P_LINKS(BIF_P),
198 &created,
199 ERTS_LNK_TYPE_DIST_PROC,
200 BIF_P->common.id,
201 BIF_ARG_1);
202
203 elnk = erts_link_to_elink(lnk);
204
205 if (created) {
206 pelnk = NULL;
207 relnk = NULL;
208 rlnk = NULL;
209 }
210 else {
211 if (!elnk->unlinking)
212 BIF_RET(am_true); /* Already present... */
213 /*
214 * We need to replace the link if the connection has changed.
215 * Prepare a link...
216 */
217 pelnk = (ErtsELink *) erts_link_external_create(ERTS_LNK_TYPE_DIST_PROC,
218 BIF_P->common.id,
219 BIF_ARG_1);
220 ASSERT(eq(pelnk->ld.proc.other.item, BIF_ARG_1));
221 ASSERT(pelnk->ld.dist.other.item == BIF_P->common.id);
222 /* Release pelnk if not used as replacement... */
223 relnk = pelnk;
224 rlnk = &pelnk->ld.proc;
225 }
226 replace = 0;
227
228 ASSERT(eq(elnk->ld.proc.other.item, BIF_ARG_1));
229 ASSERT(elnk->ld.dist.other.item == BIF_P->common.id);
230
231 code = erts_dsig_prepare(&ctx, dep, BIF_P,
232 ERTS_PROC_LOCK_MAIN,
233 ERTS_DSP_RLOCK, 0, 1, 1);
234 switch (code) {
235 case ERTS_DSIG_PREP_NOT_ALIVE:
236 case ERTS_DSIG_PREP_NOT_CONNECTED:
237 if (created || elnk->unlinking) {
238 if (elnk->unlinking) {
239 /*
240 * Currently unlinking an old link from an old connection; replace
241 * old link with the prepared one...
242 */
243 relnk = NULL;
244 rlnk = lnk;
245 elnk = pelnk;
246 replace = !0;
247 }
248 erts_link_set_dead_dist(&elnk->ld.dist, dep->sysname);
249 }
250 erts_proc_sig_send_link_exit(NULL, THE_NON_VALUE, &elnk->ld.dist,
251 am_noconnection, NIL);
252 break;
253
254 case ERTS_DSIG_PREP_PENDING:
255 case ERTS_DSIG_PREP_CONNECTED: {
256 /*
257 * We have a connection (or a pending connection).
258 * Setup link and enqueue link signal.
259 */
260 if (created
261 || (elnk->unlinking
262 && elnk->dist->connection_id != ctx.connection_id)) {
263 int inserted;
264 if (!created) {
265 /*
266 * Currently unlinking an old link from an old connection; replace
267 * old link with the prepared one...
268 */
269 rlnk = lnk;
270 if (erts_link_dist_delete(&elnk->ld.dist))
271 relnk = elnk;
272 else
273 relnk = NULL;
274 elnk = pelnk;
275 replace = !0;
276 }
277 inserted = erts_link_dist_insert(&elnk->ld.dist, dep->mld);
278 ASSERT(inserted); (void)inserted;
279 }
280
281 erts_de_runlock(dep);
282
283 code = erts_dsig_send_link(&ctx, BIF_P->common.id, BIF_ARG_1);
284 if (code == ERTS_DSIG_SEND_YIELD)
285 ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
286 ASSERT(code == ERTS_DSIG_SEND_OK);
287 break;
288 }
289 default:
290 ERTS_ASSERT(! "Invalid dsig prepare result");
291 }
292
293 if (replace) {
294 ASSERT(pelnk);
295 erts_link_tree_replace(&ERTS_P_LINKS(BIF_P), rlnk, &pelnk->ld.proc);
296 }
297
298 if (relnk)
299 erts_link_release_both(&relnk->ld);
300 else if (rlnk)
301 erts_link_release(rlnk);
302
303 elnk->unlinking = 0;
304
305 BIF_RET(am_true);
306 }
307
308 BIF_ERROR(BIF_P, BADARG);
309
310 res_no_proc:
311 if (BIF_P->flags & F_TRAP_EXIT) {
312 ErtsProcLocks locks = ERTS_PROC_LOCK_MAIN;
313 erts_deliver_exit_message(BIF_ARG_1, BIF_P, &locks, am_noproc, NIL);
314 erts_proc_unlock(BIF_P, ~ERTS_PROC_LOCK_MAIN & locks);
315 BIF_RET(am_true);
316 }
317 else {
318 /*
319 * This behaviour is *really* sad but link/1 has
320 * behaved like this for ages (and this behaviour is
321 * actually documented)... :'-(
322 *
323 * The proper behavior would have been to
324 * send calling process an exit signal..
325 */
326 BIF_ERROR(BIF_P, EXC_NOPROC);
327 }
328 }
329
330 static Eterm
demonitor(Process * c_p,Eterm ref,Eterm * multip)331 demonitor(Process *c_p, Eterm ref, Eterm *multip)
332 {
333 ErtsMonitor *mon; /* The monitor entry to delete */
334
335 *multip = am_false;
336
337 if (is_not_internal_ref(ref)) {
338 if (is_external_ref(ref)
339 && (erts_this_dist_entry
340 == external_ref_dist_entry(ref))) {
341 return am_false;
342 }
343 return am_badarg; /* Not monitored by this monitor's ref */
344 }
345
346 mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(c_p), ref);
347 if (!mon)
348 return am_false;
349
350 if (!erts_monitor_is_origin(mon))
351 return am_badarg;
352
353 if (mon->type == ERTS_MON_TYPE_ALIAS)
354 return am_false; /* Not a monitor (may have been...) */
355
356 switch (mon->flags & ERTS_ML_STATE_ALIAS_MASK) {
357 case ERTS_ML_STATE_ALIAS_UNALIAS: {
358 ErtsMonitorData *amdp = erts_monitor_create(ERTS_MON_TYPE_ALIAS,
359 ref,
360 c_p->common.id,
361 NIL,
362 NIL,
363 THE_NON_VALUE);
364 amdp->origin.flags = mon->flags & ERTS_ML_STATE_ALIAS_MASK;
365 erts_monitor_tree_replace(&ERTS_P_MONITORS(c_p), mon, &amdp->origin);
366 break;
367 }
368 case ERTS_ML_STATE_ALIAS_ONCE:
369 case ERTS_ML_STATE_ALIAS_DEMONITOR:
370 erts_pid_ref_delete(ref);
371 /* fall through... */
372 default:
373 erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), mon);
374 break;
375 }
376
377 switch (mon->type) {
378
379 case ERTS_MON_TYPE_TIME_OFFSET:
380 *multip = am_true;
381 erts_demonitor_time_offset(mon);
382 return am_true;
383
384 case ERTS_MON_TYPE_PORT: {
385 Port *prt;
386 ASSERT(is_internal_port(mon->other.item));
387 prt = erts_port_lookup(mon->other.item, ERTS_PORT_SFLGS_DEAD);
388 if (!prt || erts_port_demonitor(c_p, prt, mon) == ERTS_PORT_OP_DROPPED)
389 erts_monitor_release(mon);
390 return am_true;
391 }
392
393 case ERTS_MON_TYPE_PROC:
394 erts_proc_sig_send_demonitor(mon);
395 return am_true;
396
397 case ERTS_MON_TYPE_DIST_PROC: {
398 ErtsMonitorData *mdp = erts_monitor_to_data(mon);
399 Eterm to = mon->other.item;
400 DistEntry *dep;
401 int code = ERTS_DSIG_SEND_OK;
402 int deleted;
403 ErtsDSigSendContext ctx;
404
405 if (mon->flags & ERTS_ML_FLG_SPAWN_PENDING) {
406 /*
407 * Not allowed to remove this until spawn
408 * operation has succeeded; restore monitor...
409 */
410 erts_monitor_tree_insert(&ERTS_P_MONITORS(c_p), mon);
411 return am_false;
412 }
413
414 ASSERT(is_external_pid(to) || is_node_name_atom(to));
415
416 if (is_external_pid(to))
417 dep = external_pid_dist_entry(to);
418 else {
419 /* Monitoring a name at node to */
420 dep = erts_sysname_to_connected_dist_entry(to);
421 ASSERT(dep != erts_this_dist_entry);
422 if (!dep) {
423 erts_monitor_release(mon);
424 return am_false;
425 }
426 }
427
428 code = erts_dsig_prepare(&ctx, dep, c_p, ERTS_PROC_LOCK_MAIN,
429 ERTS_DSP_RLOCK, 0, 1, 0);
430
431 deleted = erts_monitor_dist_delete(&mdp->u.target);
432
433 switch (code) {
434 case ERTS_DSIG_PREP_NOT_ALIVE:
435 case ERTS_DSIG_PREP_NOT_CONNECTED:
436 /*
437 * In the smp case this is possible if the node goes
438 * down just before the call to demonitor.
439 */
440 break;
441
442 case ERTS_DSIG_PREP_PENDING:
443 case ERTS_DSIG_PREP_CONNECTED: {
444 Eterm watched;
445
446 erts_de_runlock(dep);
447
448 if (mon->flags & ERTS_ML_FLG_NAME)
449 watched = ((ErtsMonitorDataExtended *) mdp)->u.name;
450 else
451 watched = to;
452
453 /*
454 * Soft (no force) send, use ->data in dist slot
455 * monitor list since in case of monitor name
456 * the atom is stored there. Yield if necessary.
457 */
458 code = erts_dsig_send_demonitor(&ctx, c_p->common.id,
459 watched, mdp->ref);
460 break;
461 }
462
463 default:
464 ERTS_INTERNAL_ERROR("invalid result from erts_dsig_prepare()");
465 break;
466 }
467
468 if (deleted)
469 erts_monitor_release(&mdp->u.target);
470
471 erts_monitor_release(mon);
472 return code == ERTS_DSIG_SEND_YIELD ? am_yield : am_true;
473 }
474
475 default:
476 ERTS_INTERNAL_ERROR("Unexpected monitor type");
477 return am_false;
478 }
479 }
480
demonitor_1(BIF_ALIST_1)481 BIF_RETTYPE demonitor_1(BIF_ALIST_1)
482 {
483 Eterm multi;
484 switch (demonitor(BIF_P, BIF_ARG_1, &multi)) {
485 case am_false:
486 case am_true:
487 BIF_RET(am_true);
488 case am_yield:
489 ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
490 case am_badarg:
491 default:
492 BIF_ERROR(BIF_P, BADARG);
493 }
494 }
495
demonitor_2(BIF_ALIST_2)496 BIF_RETTYPE demonitor_2(BIF_ALIST_2)
497 {
498 BIF_RETTYPE res;
499 Eterm multi = am_false;
500 int info = 0;
501 int flush = 0;
502 Eterm list = BIF_ARG_2;
503
504 while (is_list(list)) {
505 Eterm* consp = list_val(list);
506 switch (CAR(consp)) {
507 case am_flush:
508 flush = 1;
509 break;
510 case am_info:
511 info = 1;
512 break;
513 default:
514 goto badarg;
515 }
516 list = CDR(consp);
517 }
518
519 if (is_not_nil(list))
520 goto badarg;
521
522 res = am_true;
523 switch (demonitor(BIF_P, BIF_ARG_1, &multi)) {
524
525 case am_false:
526 if (info)
527 res = am_false;
528 if (flush) {
529 flush_messages:
530 BIF_TRAP3(flush_monitor_messages_trap, BIF_P,
531 BIF_ARG_1, multi, res);
532 }
533 /* Fall through... */
534
535 case am_true:
536 if (multi == am_true && flush)
537 goto flush_messages;
538 BIF_RET(res);
539
540 case am_yield:
541 /* return true after yield... */
542 if (flush) {
543 ERTS_VBUMP_ALL_REDS(BIF_P);
544 goto flush_messages;
545 }
546 ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
547
548 case am_badarg:
549 default:
550 break;
551
552 }
553
554 badarg:
555 BIF_ERROR(BIF_P, BADARG);
556 }
557
558 /* Type must be atomic object! */
559 void
erts_queue_monitor_message(Process * p,ErtsProcLocks * p_locksp,Eterm ref,Eterm type,Eterm item,Eterm reason)560 erts_queue_monitor_message(Process *p,
561 ErtsProcLocks *p_locksp,
562 Eterm ref,
563 Eterm type,
564 Eterm item,
565 Eterm reason)
566 {
567 Eterm tup;
568 Eterm* hp;
569 Eterm reason_copy, ref_copy, item_copy;
570 Uint reason_size, ref_size, item_size, heap_size;
571 ErlOffHeap *ohp;
572 ErtsMessage *msgp;
573
574 reason_size = IS_CONST(reason) ? 0 : size_object(reason);
575 item_size = IS_CONST(item) ? 0 : size_object(item);
576 ref_size = size_object(ref);
577
578 heap_size = 6+reason_size+ref_size+item_size;
579
580 msgp = erts_alloc_message_heap(p, p_locksp, heap_size,
581 &hp, &ohp);
582
583 reason_copy = (IS_CONST(reason)
584 ? reason
585 : copy_struct(reason, reason_size, &hp, ohp));
586 item_copy = (IS_CONST(item)
587 ? item
588 : copy_struct(item, item_size, &hp, ohp));
589 ref_copy = copy_struct(ref, ref_size, &hp, ohp);
590
591 tup = TUPLE5(hp, am_DOWN, ref_copy, type, item_copy, reason_copy);
592 erts_queue_message(p, *p_locksp, msgp, tup, am_system);
593 }
594
595 Uint16
erts_monitor_opts(Eterm opts,Eterm * tag)596 erts_monitor_opts(Eterm opts, Eterm *tag)
597 {
598 Uint16 add_oflags = 0;
599
600 *tag = THE_NON_VALUE;
601
602 while (is_list(opts)) {
603 Eterm *tpl, *cons, opt;
604 cons = list_val(opts);
605 opt = CAR(cons);
606 if (is_not_tuple(opt))
607 return (Uint16) ~0;
608 tpl = tuple_val(opt);
609 switch (arityval(tpl[0])) {
610 case 2:
611 switch (tpl[1]) {
612 case am_alias:
613 add_oflags &= ~ERTS_ML_STATE_ALIAS_MASK;
614 switch (tpl[2]) {
615 case am_explicit_unalias:
616 add_oflags |= ERTS_ML_STATE_ALIAS_UNALIAS;
617 break;
618 case am_demonitor:
619 add_oflags |= ERTS_ML_STATE_ALIAS_DEMONITOR;
620 break;
621 case am_reply_demonitor:
622 add_oflags |= ERTS_ML_STATE_ALIAS_ONCE;
623 break;
624 default:
625 return (Uint16) ~0;
626 }
627 break;
628 case am_tag:
629 *tag = tpl[2];
630 break;
631 default:
632 return (Uint16) ~0;
633 }
634 break;
635 default:
636 return (Uint16) ~0;
637 }
638 opts = CDR(cons);
639 }
640 if (is_not_nil(opts))
641 return (Uint16) ~0;
642 return add_oflags;
643 }
644
monitor(Process * c_p,Eterm type,Eterm target,Uint16 add_oflags,Eterm tag)645 static BIF_RETTYPE monitor(Process *c_p, Eterm type, Eterm target,
646 Uint16 add_oflags, Eterm tag)
647 {
648 Eterm tmp_heap[3];
649 Eterm ref, id, name;
650 ErtsMonitorData *mdp;
651 BIF_RETTYPE ret_val;
652
653 ref = ((add_oflags & ERTS_ML_STATE_ALIAS_MASK)
654 ? erts_make_pid_ref(c_p)
655 : erts_make_ref(c_p));
656
657 ERTS_BIF_PREP_RET(ret_val, ref); /* Prepare for success... */
658
659 if (type == am_process) {
660 DistEntry *dep;
661 int byname;
662
663 if (is_internal_pid(target)) {
664 name = NIL;
665 id = target;
666
667 local_process:
668
669 if (id != c_p->common.id) {
670 mdp = erts_monitor_create(ERTS_MON_TYPE_PROC,
671 ref, c_p->common.id,
672 id, name, tag);
673 mdp->origin.flags |= add_oflags;
674 erts_monitor_tree_insert(&ERTS_P_MONITORS(c_p),
675 &mdp->origin);
676 if (!erts_proc_sig_send_monitor(&mdp->u.target, id))
677 erts_proc_sig_send_monitor_down(&mdp->u.target,
678 am_noproc);
679 }
680
681 goto done;
682 }
683
684 if (is_atom(target)) {
685 local_named_process:
686 name = target;
687 id = erts_whereis_name_to_id(c_p, target);
688 if (is_internal_pid(id))
689 goto local_process;
690 target = TUPLE2(&tmp_heap[0], name,
691 erts_this_dist_entry->sysname);
692 goto noproc;
693 }
694
695 if (is_external_pid(target)) {
696 ErtsDSigSendContext ctx;
697 int code;
698
699 dep = external_pid_dist_entry(target);
700 if (dep == erts_this_dist_entry)
701 goto noproc;
702
703 id = target;
704 name = NIL;
705 byname = 0;
706
707 remote_process:
708
709 mdp = erts_monitor_create(ERTS_MON_TYPE_DIST_PROC, ref,
710 c_p->common.id, id, name, tag);
711 mdp->origin.flags |= add_oflags;
712 erts_monitor_tree_insert(&ERTS_P_MONITORS(c_p), &mdp->origin);
713
714 code = erts_dsig_prepare(&ctx, dep,
715 c_p, ERTS_PROC_LOCK_MAIN,
716 ERTS_DSP_RLOCK, 0, 1, 1);
717 switch (code) {
718 case ERTS_DSIG_PREP_NOT_ALIVE:
719 case ERTS_DSIG_PREP_NOT_CONNECTED:
720 erts_monitor_set_dead_dist(&mdp->u.target, dep->sysname);
721 erts_proc_sig_send_monitor_down(&mdp->u.target, am_noconnection);
722 code = ERTS_DSIG_SEND_OK;
723 break;
724
725 case ERTS_DSIG_PREP_PENDING:
726 case ERTS_DSIG_PREP_CONNECTED: {
727 int inserted = erts_monitor_dist_insert(&mdp->u.target, dep->mld);
728 ASSERT(inserted); (void)inserted;
729 erts_de_runlock(dep);
730
731 code = erts_dsig_send_monitor(&ctx, c_p->common.id, target, ref);
732 break;
733 }
734
735 default:
736 ERTS_ASSERT(! "Invalid dsig prepare result");
737 code = ERTS_DSIG_SEND_OK;
738 break;
739 }
740
741 if (byname)
742 erts_deref_dist_entry(dep);
743
744 if (code == ERTS_DSIG_SEND_YIELD)
745 ERTS_BIF_PREP_YIELD_RETURN(ret_val, c_p, ref);
746 goto done;
747 }
748
749 if (is_tuple(target)) {
750 Eterm *tpl = tuple_val(target);
751 if (arityval(tpl[0]) != 2)
752 goto badarg;
753 if (is_not_atom(tpl[1]) || is_not_atom(tpl[2]))
754 goto badarg;
755 if (!erts_is_alive && tpl[2] != am_Noname)
756 goto badarg;
757 target = tpl[1];
758 dep = erts_find_or_insert_dist_entry(tpl[2]);
759 if (dep == erts_this_dist_entry) {
760 erts_deref_dist_entry(dep);
761 goto local_named_process;
762 }
763
764 id = dep->sysname;
765 name = target;
766 byname = 1;
767 goto remote_process;
768 }
769
770 /* badarg... */
771 }
772 else if (type == am_port) {
773
774 if (is_internal_port(target)) {
775 Port *prt;
776 name = NIL;
777 id = target;
778 local_port:
779 mdp = erts_monitor_create(ERTS_MON_TYPE_PORT, ref,
780 c_p->common.id, id,
781 name, tag);
782 mdp->origin.flags |= add_oflags;
783 erts_monitor_tree_insert(&ERTS_P_MONITORS(c_p), &mdp->origin);
784 prt = erts_port_lookup(id, ERTS_PORT_SFLGS_INVALID_LOOKUP);
785 if (!prt || erts_port_monitor(c_p, prt, &mdp->u.target) == ERTS_PORT_OP_DROPPED)
786 erts_proc_sig_send_monitor_down(&mdp->u.target, am_noproc);
787 goto done;
788 }
789
790 if (is_atom(target)) {
791 local_named_port:
792 name = target;
793 id = erts_whereis_name_to_id(c_p, target);
794 if (is_internal_port(id))
795 goto local_port;
796 target = TUPLE2(&tmp_heap[0], name,
797 erts_this_dist_entry->sysname);
798 goto noproc;
799 }
800
801 if (is_external_port(target)) {
802 if (erts_this_dist_entry == external_port_dist_entry(target))
803 goto noproc;
804 goto badarg;
805 }
806
807 if (is_tuple(target)) {
808 Eterm *tpl = tuple_val(target);
809 if (arityval(tpl[0]) != 2)
810 goto badarg;
811 if (is_not_atom(tpl[1]) || is_not_atom(tpl[2]))
812 goto badarg;
813 if (tpl[2] == erts_this_dist_entry->sysname) {
814 target = tpl[1];
815 goto local_named_port;
816 }
817 }
818
819 /* badarg... */
820 }
821 else if (type == am_time_offset) {
822
823 if (target != am_clock_service)
824 goto badarg;
825 mdp = erts_monitor_create(ERTS_MON_TYPE_TIME_OFFSET,
826 ref, c_p->common.id,
827 am_clock_service, NIL, tag);
828 mdp->origin.flags |= add_oflags;
829 erts_monitor_tree_insert(&ERTS_P_MONITORS(c_p), &mdp->origin);
830
831 erts_monitor_time_offset(&mdp->u.target);
832
833 goto done;
834 } else {
835 c_p->fvalue = am_badtype;
836 BIF_ERROR(c_p, BADARG | EXF_HAS_EXT_INFO);
837 }
838
839 badarg:
840
841 ERTS_BIF_PREP_ERROR(ret_val, c_p, BADARG);
842
843 if (0) {
844 ErtsProcLocks locks;
845 noproc:
846 locks = ERTS_PROC_LOCK_MAIN;
847
848 erts_queue_monitor_message(c_p,
849 &locks,
850 ref,
851 type,
852 target,
853 am_noproc);
854 if (locks != ERTS_PROC_LOCK_MAIN)
855 erts_proc_unlock(c_p, locks & ~ERTS_PROC_LOCK_MAIN);
856
857 ERTS_BIF_PREP_RET(ret_val, ref);
858 }
859
860 done:
861
862 return ret_val;
863 }
864
monitor_2(BIF_ALIST_2)865 BIF_RETTYPE monitor_2(BIF_ALIST_2)
866 {
867 return monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, (Uint16) 0, THE_NON_VALUE);
868 }
869
monitor_3(BIF_ALIST_3)870 BIF_RETTYPE monitor_3(BIF_ALIST_3)
871 {
872 Eterm tag;
873 Uint16 oflags = erts_monitor_opts(BIF_ARG_3, &tag);
874 if (oflags == (Uint16) ~0) {
875 BIF_P->fvalue = am_badopt;
876 BIF_ERROR(BIF_P, BADARG | EXF_HAS_EXT_INFO);
877 }
878 return monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, oflags, tag);
879 }
880
881
882 /**********************************************************************/
883 /* this is a combination of the spawn and link BIFs */
884
spawn_link_3(BIF_ALIST_3)885 BIF_RETTYPE spawn_link_3(BIF_ALIST_3)
886 {
887 ErlSpawnOpts so;
888 Eterm pid;
889 Eterm tmp_heap[2];
890
891 ERTS_SET_DEFAULT_SPAWN_OPTS(&so);
892
893 so.flags |= SPO_LINK;
894 so.opts = CONS(&tmp_heap[0], am_link, so.opts);
895
896 pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so);
897 if (is_non_value(pid)) {
898 BIF_ERROR(BIF_P, so.error_code);
899 } else {
900 if (ERTS_USE_MODIFIED_TIMING()) {
901 BIF_TRAP2(erts_delay_trap, BIF_P, pid, ERTS_MODIFIED_TIMING_DELAY);
902 }
903 BIF_RET(pid);
904 }
905 }
906
907 /**********************************************************************/
908
spawn_opt_4(BIF_ALIST_4)909 BIF_RETTYPE spawn_opt_4(BIF_ALIST_4)
910 {
911 ErlSpawnOpts so;
912 Eterm pid;
913 Eterm res;
914 int opts_error;
915
916 /*
917 * Fail order:
918 * - Bad types
919 * - Bad options
920 */
921 opts_error = erts_parse_spawn_opts(&so, BIF_ARG_4, NULL, 0);
922 if (opts_error) {
923 Sint arity;
924 BIF_P->fvalue = am_badopt;
925 if (is_not_atom(BIF_ARG_1) || is_not_atom(BIF_ARG_2))
926 BIF_ERROR(BIF_P, BADARG | EXF_HAS_EXT_INFO);
927 arity = erts_list_length(BIF_ARG_3);
928 if (arity < 0)
929 BIF_ERROR(BIF_P, BADARG | EXF_HAS_EXT_INFO);
930 if (arity > MAX_SMALL)
931 BIF_ERROR(BIF_P, SYSTEM_LIMIT | EXF_HAS_EXT_INFO);
932 BIF_ERROR(BIF_P, BADARG | EXF_HAS_EXT_INFO);
933 }
934
935 /*
936 * Spawn the process.
937 */
938 so.opts = BIF_ARG_4;
939 so.tag = am_spawn_reply;
940 pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so);
941 if (is_non_value(pid)) {
942 BIF_ERROR(BIF_P, so.error_code);
943 } else if (so.flags & SPO_MONITOR) {
944 Eterm* hp = HAlloc(BIF_P, 3);
945 res = TUPLE2(hp, pid, so.mref);
946 } else {
947 res = pid;
948 }
949
950 if (ERTS_USE_MODIFIED_TIMING()) {
951 BIF_TRAP2(erts_delay_trap, BIF_P, res, ERTS_MODIFIED_TIMING_DELAY);
952 }
953 else {
954 BIF_RET(res);
955 }
956 }
957
958 /**********************************************************************/
959
erts_internal_spawn_request_4(BIF_ALIST_4)960 BIF_RETTYPE erts_internal_spawn_request_4(BIF_ALIST_4)
961 {
962 ErlSpawnOpts so;
963 Eterm tmp_heap_mfna[4];
964 Eterm tmp_heap_alist[4 + 2];
965 Sint arity;
966 int opts_error;
967 Eterm tag, tmp, error;
968
969 if (!is_atom(BIF_ARG_1))
970 goto badarg;
971 if (!is_atom(BIF_ARG_2))
972 goto badarg;
973 arity = erts_list_length(BIF_ARG_3);
974 if (arity < 0)
975 goto badarg;
976
977 /*
978 * Fail order:
979 * - Bad types
980 * - Bad options
981 */
982 opts_error = erts_parse_spawn_opts(&so, BIF_ARG_4, &tag, !0);
983 if (arity > MAX_SMALL)
984 goto system_limit;
985 if (opts_error) {
986 if (opts_error > 0) {
987 /* Return `badopt`, meaning that the Options argument
988 * is not a proper list. */
989 BIF_RET(am_badopt);
990 }
991 goto badopt;
992 }
993
994 /* Make argument list for erts_internal:spawn_init/1 */
995 tmp = TUPLE3(&tmp_heap_alist[0], BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
996 tmp = CONS(&tmp_heap_alist[4], tmp, NIL);
997
998 so.mfa = TUPLE3(&tmp_heap_mfna[0], BIF_ARG_1, BIF_ARG_2, make_small(arity));
999 so.flags |= SPO_ASYNC;
1000 so.mref = THE_NON_VALUE;
1001 so.tag = tag;
1002 so.opts = BIF_ARG_4;
1003
1004 /*
1005 * Spawn the process.
1006 */
1007 tmp = erl_create_process(BIF_P, am_erts_internal, am_spawn_init, tmp, &so);
1008 if (is_non_value(tmp)) {
1009 switch (so.error_code) {
1010 case SYSTEM_LIMIT:
1011 goto system_limit;
1012 case BADARG:
1013 default:
1014 ERTS_INTERNAL_ERROR("Unexpected error from erl_create_process()");
1015 BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
1016 }
1017 }
1018
1019 ASSERT(is_internal_pid(tmp));
1020
1021 if (ERTS_USE_MODIFIED_TIMING()) {
1022 BIF_TRAP2(erts_delay_trap, BIF_P, so.mref, ERTS_MODIFIED_TIMING_DELAY);
1023 }
1024 else {
1025 BIF_RET(so.mref);
1026 }
1027
1028 badarg:
1029 BIF_RET(am_badarg);
1030 system_limit:
1031 error = am_system_limit;
1032 goto send_error;
1033 badopt:
1034 error = am_badopt;
1035 /* fall through... */
1036 send_error: {
1037 Eterm ref = erts_make_ref(BIF_P);
1038 if (!(so.flags & SPO_NO_EMSG))
1039 erts_send_local_spawn_reply(BIF_P, ERTS_PROC_LOCK_MAIN, NULL,
1040 tag, ref, error, am_undefined);
1041 BIF_RET(ref);
1042 }
1043
1044 }
1045
spawn_request_abandon_1(BIF_ALIST_1)1046 BIF_RETTYPE spawn_request_abandon_1(BIF_ALIST_1)
1047 {
1048 ErtsMonitor *omon;
1049
1050 if (is_not_internal_ref(BIF_ARG_1)) {
1051 if (is_not_ref(BIF_ARG_1))
1052 BIF_ERROR(BIF_P, BADARG);
1053 /* Not an outstanding spawn_request of this process... */
1054 BIF_RET(am_false);
1055 }
1056
1057 omon = erts_monitor_tree_lookup(ERTS_P_MONITORS(BIF_P), BIF_ARG_1);
1058 if (!omon
1059 || ((omon->flags & (ERTS_ML_FLG_SPAWN_PENDING
1060 | ERTS_ML_FLG_SPAWN_ABANDONED))
1061 != ERTS_ML_FLG_SPAWN_PENDING)) {
1062 /* Not an outstanding spawn_request of this process... */
1063 BIF_RET(am_false);
1064 }
1065
1066 ASSERT(erts_monitor_is_origin(omon));
1067
1068 if (omon->flags & ERTS_ML_FLG_SPAWN_LINK) {
1069 /* Leave it for reply... */
1070 omon->flags |= ERTS_ML_FLG_SPAWN_ABANDONED;
1071 }
1072 else {
1073 /* We don't need it anymore; remove it... */
1074 ErtsMonitorData *mdp;
1075 erts_monitor_tree_delete(&ERTS_P_MONITORS(BIF_P), omon);
1076 mdp = erts_monitor_to_data(omon);
1077 if (erts_monitor_dist_delete(&mdp->u.target))
1078 erts_monitor_release_both(mdp);
1079 else
1080 erts_monitor_release(omon);
1081 }
1082 BIF_RET(am_true);
1083 }
1084
1085
1086 /**********************************************************************/
1087 /* remove a link from a process */
unlink_1(BIF_ALIST_1)1088 BIF_RETTYPE unlink_1(BIF_ALIST_1)
1089 {
1090 if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) {
1091 trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN,
1092 BIF_P, am_unlink, BIF_ARG_1);
1093 }
1094
1095 if (is_internal_pid(BIF_ARG_1)) {
1096 ErtsILink *ilnk;
1097 ilnk = (ErtsILink *) erts_link_tree_lookup(ERTS_P_LINKS(BIF_P),
1098 BIF_ARG_1);
1099 if (ilnk && !ilnk->unlinking) {
1100 Uint64 id = erts_proc_sig_send_unlink(BIF_P,
1101 BIF_P->common.id,
1102 &ilnk->link);
1103 if (id)
1104 ilnk->unlinking = id;
1105 else {
1106 erts_link_tree_delete(&ERTS_P_LINKS(BIF_P), &ilnk->link);
1107 erts_link_internal_release(&ilnk->link);
1108 }
1109 }
1110 BIF_RET(am_true);
1111 }
1112
1113 if (is_internal_port(BIF_ARG_1)) {
1114 ErtsILink *ilnk;
1115 ilnk = (ErtsILink *) erts_link_tree_lookup(ERTS_P_LINKS(BIF_P),
1116 BIF_ARG_1);
1117
1118 if (ilnk && !ilnk->unlinking) {
1119 Eterm ref;
1120 Eterm *refp = erts_port_synchronous_ops ? &ref : NULL;
1121 ErtsPortOpResult res = ERTS_PORT_OP_DROPPED;
1122 Port *prt;
1123
1124 /* Send unlink signal */
1125 prt = erts_port_lookup(BIF_ARG_1, ERTS_PORT_SFLGS_DEAD);
1126 if (!prt) {
1127 erts_link_tree_delete(&ERTS_P_LINKS(BIF_P), &ilnk->link);
1128 erts_link_internal_release(&ilnk->link);
1129 }
1130 else {
1131 ErtsSigUnlinkOp *sulnk;
1132
1133 sulnk = erts_proc_sig_make_unlink_op(BIF_P, BIF_P->common.id);
1134 ilnk->unlinking = sulnk->id;
1135 #ifdef DEBUG
1136 ref = NIL;
1137 #endif
1138 res = erts_port_unlink(BIF_P, prt, sulnk, refp);
1139 }
1140
1141 if (refp && res == ERTS_PORT_OP_SCHEDULED) {
1142 ASSERT(is_internal_ordinary_ref(ref));
1143 BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true);
1144 }
1145 }
1146
1147 BIF_RET(am_true);
1148 }
1149
1150 if (is_external_pid(BIF_ARG_1)) {
1151 ErtsLink *lnk;
1152 ErtsELink *elnk;
1153 DistEntry *dep;
1154 Uint64 unlink_id;
1155 int code;
1156 ErtsDSigSendContext ctx;
1157
1158 dep = external_pid_dist_entry(BIF_ARG_1);
1159 if (dep == erts_this_dist_entry)
1160 BIF_RET(am_true);
1161
1162 lnk = erts_link_tree_lookup(ERTS_P_LINKS(BIF_P), BIF_ARG_1);
1163 if (!lnk)
1164 BIF_RET(am_true);
1165
1166 elnk = erts_link_to_elink(lnk);
1167
1168 if (elnk->unlinking)
1169 BIF_RET(am_true);
1170
1171 unlink_id = erts_proc_sig_new_unlink_id(BIF_P);
1172 elnk->unlinking = unlink_id;
1173
1174 code = erts_dsig_prepare(&ctx, dep, BIF_P, ERTS_PROC_LOCK_MAIN,
1175 ERTS_DSP_NO_LOCK, 0, 1, 0);
1176 switch (code) {
1177 case ERTS_DSIG_PREP_NOT_ALIVE:
1178 case ERTS_DSIG_PREP_NOT_CONNECTED:
1179 BIF_RET(am_true);
1180 case ERTS_DSIG_PREP_PENDING:
1181 case ERTS_DSIG_PREP_CONNECTED:
1182 /*
1183 * Do not send unlink signal on another connection than
1184 * the one which the link was set up on.
1185 */
1186 if (elnk->dist->connection_id == ctx.connection_id) {
1187 code = erts_dsig_send_unlink(&ctx, BIF_P->common.id, BIF_ARG_1,
1188 unlink_id);
1189 if (code == ERTS_DSIG_SEND_YIELD)
1190 ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
1191 }
1192 break;
1193 default:
1194 ASSERT(! "Invalid dsig prepare result");
1195 BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
1196 }
1197
1198 BIF_RET(am_true);
1199 }
1200
1201 if (is_external_port(BIF_ARG_1)) {
1202 if (external_port_dist_entry(BIF_ARG_1) == erts_this_dist_entry)
1203 BIF_RET(am_true);
1204 /* Links to Remote ports not supported... */
1205 }
1206
1207 BIF_ERROR(BIF_P, BADARG);
1208 }
1209
hibernate_3(BIF_ALIST_3)1210 BIF_RETTYPE hibernate_3(BIF_ALIST_3)
1211 {
1212 /*
1213 * hibernate/3 is usually translated to an instruction; therefore
1214 * this function is only called when the call could not be translated.
1215 */
1216 Eterm reg[3];
1217
1218 reg[0] = BIF_ARG_1;
1219 reg[1] = BIF_ARG_2;
1220 reg[2] = BIF_ARG_3;
1221
1222 if (erts_hibernate(BIF_P, reg)) {
1223 /*
1224 * If hibernate succeeded, TRAP. The process will be wait in a
1225 * hibernated state if its state is inactive (!ERTS_PSFLG_ACTIVE);
1226 * otherwise, continue executing (if any message was in the queue).
1227 */
1228 BIF_TRAP_CODE_PTR(BIF_P, BIF_P->i, 3);
1229 }
1230
1231 return THE_NON_VALUE;
1232 }
1233
1234 /**********************************************************************/
1235 /*
1236 * This is like exit/1, except that errors are logged if they terminate
1237 * the process, and the final error value will be {Term,StackTrace}.
1238 */
1239
error_1(BIF_ALIST_1)1240 BIF_RETTYPE error_1(BIF_ALIST_1)
1241 {
1242 BIF_P->fvalue = BIF_ARG_1;
1243 BIF_ERROR(BIF_P, EXC_ERROR);
1244 }
1245
1246 /**********************************************************************/
1247 /*
1248 * This is like error/1, except that the given 'args' will be included
1249 * in the stacktrace.
1250 */
1251
error_2(BIF_ALIST_2)1252 BIF_RETTYPE error_2(BIF_ALIST_2)
1253 {
1254 Eterm* hp = HAlloc(BIF_P, 3);
1255
1256 BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2);
1257 BIF_ERROR(BIF_P, EXC_ERROR_2);
1258 }
1259
1260 /**********************************************************************/
1261 /*
1262 * This is like error/1, except that the given 'args' and 'error_info'
1263 * will be included in the stacktrace.
1264 */
1265
error_3(BIF_ALIST_3)1266 BIF_RETTYPE error_3(BIF_ALIST_3)
1267 {
1268 Eterm error_info = THE_NON_VALUE;
1269 Eterm list = BIF_ARG_3;
1270
1271 while (is_list(list)) {
1272 Eterm* tuple;
1273 Eterm term = CAR(list_val(list));
1274
1275 if (is_not_tuple(term)) {
1276 break;
1277 }
1278 tuple = tuple_val(term);
1279 if (arityval(tuple[0]) != 2 || tuple[1] != am_error_info) {
1280 break;
1281 }
1282 error_info = tuple[2];
1283 if (is_not_map(error_info)) {
1284 break;
1285 }
1286 list = CDR(list_val(list));
1287 }
1288
1289 if (is_not_nil(list)) {
1290 /* Improper list. Invalidate any error info. */
1291 error_info = THE_NON_VALUE;
1292 }
1293
1294 if (is_value(error_info)) {
1295 Eterm* hp = HAlloc(BIF_P, 4);
1296 BIF_P->fvalue = TUPLE3(hp, BIF_ARG_1, BIF_ARG_2, error_info);
1297 BIF_ERROR(BIF_P, EXC_ERROR_3);
1298 } else {
1299 /*
1300 * Either the option argument was an empty list, an improper
1301 * list, or a list with an illegal term. Fall back to error/2.
1302 */
1303 Eterm* hp = HAlloc(BIF_P, 3);
1304 BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2);
1305 BIF_ERROR(BIF_P, EXC_ERROR_2);
1306 }
1307 }
1308
1309 /**********************************************************************/
1310 /*
1311 * This is like exactly like error/1. The only difference is
1312 * that Dialyzer thinks that it it will return an arbitrary term.
1313 * It is useful in stub functions for NIFs.
1314 */
1315
nif_error_1(BIF_ALIST_1)1316 BIF_RETTYPE nif_error_1(BIF_ALIST_1)
1317 {
1318 BIF_P->fvalue = BIF_ARG_1;
1319 BIF_ERROR(BIF_P, EXC_ERROR);
1320 }
1321
1322 /**********************************************************************/
1323 /*
1324 * This is like exactly like error/2. The only difference is
1325 * that Dialyzer thinks that it it will return an arbitrary term.
1326 * It is useful in stub functions for NIFs.
1327 */
1328
nif_error_2(BIF_ALIST_2)1329 BIF_RETTYPE nif_error_2(BIF_ALIST_2)
1330 {
1331 Eterm* hp = HAlloc(BIF_P, 3);
1332
1333 BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2);
1334 BIF_ERROR(BIF_P, EXC_ERROR_2);
1335 }
1336
1337 /**********************************************************************/
1338 /* this is like throw/1 except that we set freason to EXC_EXIT */
1339
exit_1(BIF_ALIST_1)1340 BIF_RETTYPE exit_1(BIF_ALIST_1)
1341 {
1342 BIF_P->fvalue = BIF_ARG_1; /* exit value */
1343 BIF_ERROR(BIF_P, EXC_EXIT);
1344 }
1345
1346
1347 /**********************************************************************/
1348 /* raise an exception of given class, value and stacktrace.
1349 *
1350 * If there is an error in the argument format,
1351 * return the atom 'badarg' instead.
1352 */
raise_3(BIF_ALIST_3)1353 BIF_RETTYPE raise_3(BIF_ALIST_3)
1354 {
1355 Process *c_p = BIF_P;
1356 Eterm class = BIF_ARG_1;
1357 Eterm value = BIF_ARG_2;
1358 Eterm stacktrace = BIF_ARG_3;
1359 Eterm reason;
1360 Eterm l, *hp, *hp_end, *tp;
1361 int depth, cnt;
1362 size_t sz;
1363 size_t alloc_size;
1364 int must_copy = 0;
1365 struct StackTrace *s;
1366
1367 if (class == am_error) {
1368 c_p->fvalue = value;
1369 reason = EXC_ERROR;
1370 } else if (class == am_exit) {
1371 c_p->fvalue = value;
1372 reason = EXC_EXIT;
1373 } else if (class == am_throw) {
1374 c_p->fvalue = value;
1375 reason = EXC_THROWN;
1376 } else goto error;
1377 reason &= ~EXF_SAVETRACE;
1378
1379 /* Check syntax of stacktrace, and count depth. Accept anything
1380 * that can be returned from a stacktrace from try/catch, as well
1381 * as a 2-tuple with a fun as first element that the error_handler
1382 * may need to give us. Also allow old-style MFA three-tuples.
1383 */
1384 for (l = stacktrace, depth = 0;
1385 is_list(l);
1386 l = CDR(list_val(l)), depth++) {
1387 Eterm t = CAR(list_val(l));
1388 Eterm location = NIL;
1389
1390 if (is_not_tuple(t)) goto error;
1391 tp = tuple_val(t);
1392 switch (arityval(tp[0])) {
1393 case 2:
1394 /* {Fun,Args} */
1395 if (is_fun(tp[1])) {
1396 must_copy = 1;
1397 } else {
1398 goto error;
1399 }
1400 break;
1401 case 3:
1402 /*
1403 * One of:
1404 * {Fun,Args,Location}
1405 * {M,F,A}
1406 */
1407 if (is_fun(tp[1])) {
1408 location = tp[3];
1409 } else if (is_atom(tp[1]) && is_atom(tp[2])) {
1410 must_copy = 1;
1411 } else {
1412 goto error;
1413 }
1414 break;
1415 case 4:
1416 if (!(is_atom(tp[1]) && is_atom(tp[2]))) {
1417 goto error;
1418 }
1419 location = tp[4];
1420 break;
1421 default:
1422 goto error;
1423 }
1424 if (is_not_list(location) && is_not_nil(location)) {
1425 goto error;
1426 }
1427 }
1428 if (is_not_nil(l)) goto error;
1429
1430 /* Create stacktrace and store */
1431 if (erts_backtrace_depth < depth) {
1432 depth = erts_backtrace_depth;
1433 if (depth == 0) {
1434 /*
1435 * For consistency with stacktraces generated
1436 * automatically, always include one element.
1437 */
1438 depth = 1;
1439 }
1440 must_copy = 1;
1441 }
1442 if (must_copy) {
1443 cnt = depth;
1444 c_p->ftrace = NIL;
1445 } else {
1446 /* No need to copy the stacktrace */
1447 cnt = 0;
1448 c_p->ftrace = stacktrace;
1449 }
1450
1451 tp = &c_p->ftrace;
1452 sz = (offsetof(struct StackTrace, trace) + sizeof(Eterm) - 1)
1453 / sizeof(Eterm);
1454 alloc_size = sz + 4 + (2+6) * (cnt + 1);
1455 hp = HAlloc(c_p, alloc_size);
1456 hp_end = hp + alloc_size;
1457 s = (struct StackTrace *) hp;
1458 s->header = make_neg_bignum_header(sz - 1);
1459 s->freason = reason;
1460 s->pc = NULL;
1461 s->current = NULL;
1462 s->depth = 0;
1463 hp += sz;
1464 if (must_copy) {
1465 int cnt;
1466
1467 /* Copy list up to depth */
1468 for (cnt = 0, l = stacktrace;
1469 cnt < depth;
1470 cnt++, l = CDR(list_val(l))) {
1471 Eterm t;
1472 Eterm *tpp;
1473 int arity;
1474
1475 ASSERT(*tp == NIL);
1476 t = CAR(list_val(l));
1477 tpp = tuple_val(t);
1478 arity = arityval(tpp[0]);
1479 if (arity == 2) {
1480 t = TUPLE3(hp, tpp[1], tpp[2], NIL);
1481 hp += 4;
1482 } else if (arity == 3 && is_atom(tpp[1])) {
1483 t = TUPLE4(hp, tpp[1], tpp[2], tpp[3], NIL);
1484 hp += 5;
1485 }
1486 *tp = CONS(hp, t, *tp);
1487 tp = &CDR(list_val(*tp));
1488 hp += 2;
1489 }
1490 }
1491 c_p->ftrace = TUPLE3(hp, make_big((Eterm *) s), c_p->ftrace, NIL);
1492 hp += 4;
1493 ASSERT(hp <= hp_end);
1494 HRelease(c_p, hp_end, hp);
1495 BIF_ERROR(c_p, reason);
1496
1497 error:
1498 return am_badarg;
1499 }
1500
1501 static BIF_RETTYPE
erts_internal_await_exit_trap(BIF_ALIST_0)1502 erts_internal_await_exit_trap(BIF_ALIST_0)
1503 {
1504 /*
1505 * We have sent ourselves an exit signal which will
1506 * terminate ourselves. Handle all signals until
1507 * terminated in order to ensure that signal order
1508 * is preserved. Yield if necessary.
1509 */
1510 erts_aint32_t state;
1511 int reds = ERTS_BIF_REDS_LEFT(BIF_P);
1512 (void) erts_proc_sig_handle_incoming(BIF_P, &state, &reds,
1513 reds, !0);
1514 BUMP_REDS(BIF_P, reds);
1515 if (state & ERTS_PSFLG_EXITING)
1516 ERTS_BIF_EXITED(BIF_P);
1517
1518 ERTS_BIF_YIELD0(&await_exit_trap, BIF_P);
1519 }
1520
1521 /**********************************************************************/
1522 /* send an exit signal to another process */
1523
send_exit_signal_bif(Process * c_p,Eterm id,Eterm reason,int exit2)1524 static BIF_RETTYPE send_exit_signal_bif(Process *c_p, Eterm id, Eterm reason, int exit2)
1525 {
1526 BIF_RETTYPE ret_val;
1527
1528 /*
1529 * 'id' not a process id, nor a local port id is a 'badarg' error.
1530 */
1531
1532 if (is_internal_pid(id)) {
1533 /*
1534 * Preserve the very old and *very strange* behaviour
1535 * of erlang:exit/2...
1536 *
1537 * - terminate ourselves even though exit reason
1538 * is normal (unless we trap exit)
1539 * - terminate ourselves before exit/2 return
1540 */
1541 int exit2_suicide = (exit2
1542 && c_p->common.id == id
1543 && (reason == am_kill
1544 || !(c_p->flags & F_TRAP_EXIT)));
1545 erts_proc_sig_send_exit(c_p, c_p->common.id, id,
1546 reason, NIL, exit2_suicide);
1547 if (!exit2_suicide)
1548 ERTS_BIF_PREP_RET(ret_val, am_true);
1549 else {
1550 erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
1551 erts_proc_sig_fetch(c_p);
1552 erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
1553 ERTS_BIF_PREP_TRAP0(ret_val, &await_exit_trap, c_p);
1554 }
1555 }
1556 else if (is_internal_port(id)) {
1557 Eterm ref, *refp;
1558 Uint32 invalid_flags;
1559 Port *prt;
1560 ErtsPortOpResult res = ERTS_PORT_OP_DONE;
1561 #ifdef DEBUG
1562 ref = NIL;
1563 #endif
1564
1565 if (erts_port_synchronous_ops) {
1566 refp = &ref;
1567 invalid_flags = ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP;
1568 }
1569 else {
1570 refp = NULL;
1571 invalid_flags = ERTS_PORT_SFLGS_INVALID_LOOKUP;
1572 }
1573
1574 prt = erts_port_lookup(id, invalid_flags);
1575 if (prt)
1576 res = erts_port_exit(c_p, 0, prt, c_p->common.id, reason, refp);
1577
1578 if (!refp || res != ERTS_PORT_OP_SCHEDULED)
1579 ERTS_BIF_PREP_RET(ret_val, am_true);
1580 else {
1581 ASSERT(is_internal_ordinary_ref(ref));
1582 ERTS_BIF_PREP_TRAP3(ret_val, await_port_send_result_trap,
1583 c_p, ref, am_true, am_true);
1584 }
1585 }
1586 else if (is_external_pid(id)) {
1587 DistEntry *dep = external_pid_dist_entry(id);
1588 if (dep == erts_this_dist_entry)
1589 ERTS_BIF_PREP_RET(ret_val, am_true); /* Old incarnation of this node... */
1590 else {
1591 int code;
1592 ErtsDSigSendContext ctx;
1593
1594 code = erts_dsig_prepare(&ctx, dep, c_p, ERTS_PROC_LOCK_MAIN,
1595 ERTS_DSP_NO_LOCK, 0, 0, 1);
1596
1597 switch (code) {
1598 case ERTS_DSIG_PREP_NOT_ALIVE:
1599 case ERTS_DSIG_PREP_NOT_CONNECTED:
1600 ERTS_BIF_PREP_RET(ret_val, am_true);
1601 break;
1602 case ERTS_DSIG_PREP_PENDING:
1603 case ERTS_DSIG_PREP_CONNECTED:
1604 code = erts_dsig_send_exit2(&ctx, c_p->common.id, id, reason);
1605 switch (code) {
1606 case ERTS_DSIG_SEND_YIELD:
1607 ERTS_BIF_PREP_YIELD_RETURN(ret_val, c_p, am_true);
1608 break;
1609 case ERTS_DSIG_SEND_CONTINUE:
1610 BUMP_ALL_REDS(c_p);
1611 erts_set_gc_state(c_p, 0);
1612 ERTS_BIF_PREP_TRAP1(ret_val, &dsend_continue_trap_export, c_p,
1613 erts_dsend_export_trap_context(c_p, &ctx));
1614 break;
1615 case ERTS_DSIG_SEND_OK:
1616 ERTS_BIF_PREP_RET(ret_val, am_true);
1617 break;
1618 case ERTS_DSIG_SEND_TOO_LRG:
1619 erts_set_gc_state(c_p, 1);
1620 ERTS_BIF_PREP_ERROR(ret_val, c_p, SYSTEM_LIMIT);
1621 break;
1622 default:
1623 ASSERT(! "Invalid dsig send exit2 result");
1624 ERTS_BIF_PREP_ERROR(ret_val, c_p, EXC_INTERNAL_ERROR);
1625 break;
1626 }
1627 break;
1628 default:
1629 ASSERT(! "Invalid dsig prepare result");
1630 ERTS_BIF_PREP_ERROR(ret_val, c_p, EXC_INTERNAL_ERROR);
1631 break;
1632 }
1633 }
1634 }
1635 else if (is_external_port(id)) {
1636 DistEntry *dep = external_port_dist_entry(id);
1637 if(dep == erts_this_dist_entry)
1638 ERTS_BIF_PREP_RET(ret_val, am_true); /* Old incarnation of this node... */
1639 else
1640 ERTS_BIF_PREP_ERROR(ret_val, c_p, BADARG);
1641 }
1642 else {
1643 /* Not an id of a process or a port... */
1644
1645 ERTS_BIF_PREP_ERROR(ret_val, c_p, BADARG);
1646 }
1647
1648 return ret_val;
1649 }
1650
exit_2(BIF_ALIST_2)1651 BIF_RETTYPE exit_2(BIF_ALIST_2)
1652 {
1653 return send_exit_signal_bif(BIF_P, BIF_ARG_1, BIF_ARG_2, !0);
1654 }
1655
exit_signal_2(BIF_ALIST_2)1656 BIF_RETTYPE exit_signal_2(BIF_ALIST_2)
1657 {
1658 return send_exit_signal_bif(BIF_P, BIF_ARG_1, BIF_ARG_2, 0);
1659 }
1660
1661
1662 /**********************************************************************/
1663 /* this sets some process info- trapping exits or the error handler */
1664
1665
1666 /* Handle flags common to both process_flag_2 and process_flag_3. */
process_flag_aux(Process * c_p,int * redsp,Eterm flag,Eterm val)1667 static Eterm process_flag_aux(Process *c_p, int *redsp, Eterm flag, Eterm val)
1668 {
1669 Eterm old_value = NIL; /* shut up warning about use before set */
1670 Sint i;
1671
1672 c_p->fvalue = am_badopt;
1673
1674 if (redsp)
1675 *redsp = 1;
1676
1677 if (flag == am_save_calls) {
1678 struct saved_calls *scb;
1679
1680 c_p->fvalue = am_none;
1681 if (!is_small(val))
1682 goto error;
1683 i = signed_val(val);
1684 if (i < 0 || i > 10000)
1685 goto error;
1686
1687 if (i == 0)
1688 scb = NULL;
1689 else {
1690 Uint sz = sizeof(*scb) + (i-1) * sizeof(*scb->ct);
1691 scb = erts_alloc(ERTS_ALC_T_CALLS_BUF, sz);
1692 scb->len = i;
1693 scb->cur = 0;
1694 scb->n = 0;
1695 }
1696
1697 {
1698 scb = ERTS_PROC_SET_SAVED_CALLS_BUF(c_p, scb);
1699
1700 if (((scb && i == 0) || (!scb && i != 0))) {
1701
1702 /*
1703 * Make sure we reschedule immediately so the
1704 * change take effect at once.
1705 */
1706 if (!redsp) {
1707 /* Executed via BIF call.. */
1708 via_bif:
1709
1710 /* BEAMASM doesn't use negative reductions for save_calls */
1711 #ifndef BEAMASM
1712 /* Adjust fcalls to match save calls setting... */
1713 if (i == 0)
1714 c_p->fcalls += CONTEXT_REDS; /* disabled it */
1715 else
1716 c_p->fcalls -= CONTEXT_REDS; /* enabled it */
1717 #endif
1718
1719 ERTS_VBUMP_ALL_REDS(c_p);
1720 }
1721 else {
1722 erts_aint32_t state;
1723 /*
1724 * Executed via signal handler. Try to figure
1725 * out in what context we are executing...
1726 */
1727
1728 state = erts_atomic32_read_nob(&c_p->state);
1729 if (state & (ERTS_PSFLG_RUNNING_SYS
1730 | ERTS_PSFLG_DIRTY_RUNNING_SYS
1731 | ERTS_PSFLG_DIRTY_RUNNING)) {
1732 /*
1733 * We are either processing signals before
1734 * being executed or executing dirty. That
1735 * is, no need to adjust anything...
1736 */
1737 *redsp = 1;
1738 }
1739 else {
1740 ASSERT(state & ERTS_PSFLG_RUNNING);
1741
1742 /*
1743 * F_DELAY_GC is currently only set when
1744 * we handle signals in state running via
1745 * receive helper...
1746 */
1747
1748 if (!(c_p->flags & F_DELAY_GC)) {
1749 *redsp = 1;
1750 goto via_bif;
1751 }
1752
1753 /*
1754 * Executing via receive helper...
1755 *
1756 * We utilize the virtual reds counter
1757 * in order to get correct calculation
1758 * of reductions consumed when scheduling
1759 * out the process...
1760 */
1761
1762
1763 /* BEAMASM doesn't use negative reductions for save_calls */
1764 #ifndef BEAMASM
1765 {
1766 ErtsSchedulerData *esdp;
1767
1768 esdp = erts_get_scheduler_data();
1769
1770 if (i == 0) {
1771 /* disabled it */
1772 esdp->virtual_reds += CONTEXT_REDS;
1773 } else {
1774 /* enabled it */
1775 esdp->virtual_reds -= CONTEXT_REDS;
1776 }
1777 }
1778 #endif
1779
1780 *redsp = -1;
1781 }
1782 }
1783 }
1784 }
1785
1786 if (!scb)
1787 old_value = make_small(0);
1788 else {
1789 old_value = make_small(scb->len);
1790 erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb);
1791 }
1792
1793 ASSERT(is_immed(old_value));
1794 return old_value;
1795 }
1796
1797 error:
1798 return am_badarg;
1799 }
1800
process_flag_2(BIF_ALIST_2)1801 BIF_RETTYPE process_flag_2(BIF_ALIST_2)
1802 {
1803 Eterm old_value;
1804 if (BIF_ARG_1 == am_error_handler) {
1805 if (is_not_atom(BIF_ARG_2)) {
1806 goto error;
1807 }
1808 old_value = erts_proc_set_error_handler(BIF_P, BIF_ARG_2);
1809 BIF_RET(old_value);
1810 }
1811 else if (BIF_ARG_1 == am_priority) {
1812 old_value = erts_set_process_priority(BIF_P, BIF_ARG_2);
1813 if (old_value == THE_NON_VALUE)
1814 goto error;
1815 BIF_RET(old_value);
1816 }
1817 else if (BIF_ARG_1 == am_trap_exit) {
1818 old_value = (BIF_P->flags & F_TRAP_EXIT) ? am_true : am_false;
1819 if (BIF_ARG_2 == am_true)
1820 BIF_P->flags |= F_TRAP_EXIT;
1821 else if (BIF_ARG_2 == am_false)
1822 BIF_P->flags &= ~F_TRAP_EXIT;
1823 else
1824 goto error;
1825 BIF_RET(old_value);
1826 }
1827 else if (BIF_ARG_1 == am_scheduler) {
1828 ErtsRunQueue *old, *new, *curr;
1829 Sint sched;
1830
1831 if (!is_small(BIF_ARG_2))
1832 goto error;
1833 sched = signed_val(BIF_ARG_2);
1834 if (sched < 0 || erts_no_schedulers < sched)
1835 goto error;
1836
1837 if (sched == 0) {
1838 old = erts_bind_runq_proc(BIF_P, 0);
1839 new = NULL;
1840 }
1841 else {
1842 int bound = !0;
1843 new = erts_schedid2runq(sched);
1844 old = erts_set_runq_proc(BIF_P, new, &bound);
1845 if (!bound)
1846 old = NULL;
1847 }
1848
1849 old_value = old ? make_small(old->ix+1) : make_small(0);
1850
1851 curr = erts_proc_sched_data(BIF_P)->run_queue;
1852
1853 ASSERT(!old || old == curr);
1854
1855 if (new && new != curr)
1856 ERTS_BIF_YIELD_RETURN_X(BIF_P, old_value, am_scheduler);
1857 else
1858 BIF_RET(old_value);
1859 }
1860 else if (BIF_ARG_1 == am_fullsweep_after) {
1861 Sint i;
1862 if (!is_small(BIF_ARG_2)) {
1863 goto error;
1864 }
1865 i = signed_val(BIF_ARG_2);
1866 if (i < 0) {
1867 goto error;
1868 }
1869 old_value = make_small(BIF_P->max_gen_gcs);
1870 BIF_P->max_gen_gcs = i;
1871 BIF_RET(old_value);
1872 }
1873 else if (BIF_ARG_1 == am_min_heap_size) {
1874 Sint i;
1875 if (!is_small(BIF_ARG_2)) {
1876 goto error;
1877 }
1878 i = signed_val(BIF_ARG_2);
1879 if (i < 0) {
1880 goto error;
1881 }
1882 old_value = make_small(BIF_P->min_heap_size);
1883 if (i < H_MIN_SIZE) {
1884 BIF_P->min_heap_size = H_MIN_SIZE;
1885 } else {
1886 BIF_P->min_heap_size = erts_next_heap_size(i, 0);
1887 }
1888 BIF_RET(old_value);
1889 }
1890 else if (BIF_ARG_1 == am_min_bin_vheap_size) {
1891 Sint i;
1892 if (!is_small(BIF_ARG_2)) {
1893 goto error;
1894 }
1895 i = signed_val(BIF_ARG_2);
1896 if (i < 0) {
1897 goto error;
1898 }
1899 old_value = make_small(BIF_P->min_vheap_size);
1900 if (i < BIN_VH_MIN_SIZE) {
1901 BIF_P->min_vheap_size = BIN_VH_MIN_SIZE;
1902 } else {
1903 BIF_P->min_vheap_size = erts_next_heap_size(i, 0);
1904 }
1905 BIF_RET(old_value);
1906 }
1907 else if (BIF_ARG_1 == am_max_heap_size) {
1908 Eterm *hp;
1909 Uint sz = 0, max_heap_size, max_heap_flags;
1910
1911 if (!erts_max_heap_size(BIF_ARG_2, &max_heap_size, &max_heap_flags))
1912 goto error;
1913
1914 if ((max_heap_size < MIN_HEAP_SIZE(BIF_P) && max_heap_size != 0))
1915 goto error;
1916
1917 erts_max_heap_size_map(MAX_HEAP_SIZE_GET(BIF_P), MAX_HEAP_SIZE_FLAGS_GET(BIF_P), NULL, &sz);
1918 hp = HAlloc(BIF_P, sz);
1919 old_value = erts_max_heap_size_map(MAX_HEAP_SIZE_GET(BIF_P), MAX_HEAP_SIZE_FLAGS_GET(BIF_P), &hp, NULL);
1920 MAX_HEAP_SIZE_SET(BIF_P, max_heap_size);
1921 MAX_HEAP_SIZE_FLAGS_SET(BIF_P, max_heap_flags);
1922 BIF_RET(old_value);
1923 }
1924 else if (BIF_ARG_1 == am_message_queue_data) {
1925 old_value = erts_change_message_queue_management(BIF_P, BIF_ARG_2);
1926 if (is_non_value(old_value))
1927 goto error;
1928 BIF_RET(old_value);
1929 }
1930 else if (BIF_ARG_1 == am_sensitive) {
1931 Uint is_sensitive;
1932 if (BIF_ARG_2 == am_true) {
1933 is_sensitive = 1;
1934 } else if (BIF_ARG_2 == am_false) {
1935 is_sensitive = 0;
1936 } else {
1937 goto error;
1938 }
1939 erts_proc_lock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR);
1940 old_value = (ERTS_TRACE_FLAGS(BIF_P) & F_SENSITIVE
1941 ? am_true
1942 : am_false);
1943 if (is_sensitive) {
1944 ERTS_TRACE_FLAGS(BIF_P) |= F_SENSITIVE;
1945 } else {
1946 ERTS_TRACE_FLAGS(BIF_P) &= ~F_SENSITIVE;
1947 }
1948 erts_proc_unlock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR);
1949 /* make sure to bump all reds so that we get
1950 rescheduled immediately so setting takes effect */
1951 BIF_RET2(old_value, CONTEXT_REDS);
1952 }
1953 else if (BIF_ARG_1 == am_monitor_nodes) {
1954 /*
1955 * This argument is intentionally *not* documented. It is intended
1956 * to be used by net_kernel:monitor_nodes/1.
1957 */
1958 old_value = erts_monitor_nodes(BIF_P, BIF_ARG_2, NIL);
1959 if (old_value == THE_NON_VALUE)
1960 goto error;
1961 BIF_RET(old_value);
1962 }
1963 else if (is_tuple(BIF_ARG_1)) {
1964 /*
1965 * This argument is intentionally *not* documented. It is intended
1966 * to be used by net_kernel:monitor_nodes/2.
1967 */
1968 Eterm *tp = tuple_val(BIF_ARG_1);
1969 if (arityval(tp[0]) == 2) {
1970 if (tp[1] == am_monitor_nodes) {
1971 old_value = erts_monitor_nodes(BIF_P, BIF_ARG_2, tp[2]);
1972 if (old_value == THE_NON_VALUE)
1973 goto error;
1974 BIF_RET(old_value);
1975 }
1976 }
1977 /* Fall through and try process_flag_aux() ... */
1978 }
1979
1980 old_value = process_flag_aux(BIF_P, NULL, BIF_ARG_1, BIF_ARG_2);
1981 if (old_value != am_badarg)
1982 BIF_RET(old_value);
1983
1984 BIF_ERROR(BIF_P, BADARG | EXF_HAS_EXT_INFO);
1985
1986 error:
1987 BIF_ERROR(BIF_P, BADARG);
1988 }
1989
1990 typedef struct {
1991 Eterm flag;
1992 Eterm value;
1993 ErlOffHeap oh;
1994 Eterm heap[1];
1995 } ErtsProcessFlag3Args;
1996
1997 static Eterm
exec_process_flag_3(Process * c_p,void * arg,int * redsp,ErlHeapFragment ** bpp)1998 exec_process_flag_3(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp)
1999 {
2000 ErtsProcessFlag3Args *pf3a = arg;
2001 Eterm res;
2002
2003 if (ERTS_PROC_IS_EXITING(c_p))
2004 res = am_badarg;
2005 else
2006 res = process_flag_aux(c_p, redsp, pf3a->flag, pf3a->value);
2007 erts_cleanup_offheap(&pf3a->oh);
2008 erts_free(ERTS_ALC_T_PF3_ARGS, arg);
2009 return res;
2010 }
2011
2012
erts_internal_process_flag_3(BIF_ALIST_3)2013 BIF_RETTYPE erts_internal_process_flag_3(BIF_ALIST_3)
2014 {
2015 Eterm res, *hp;
2016 ErlOffHeap *ohp;
2017 ErtsProcessFlag3Args *pf3a;
2018 Uint flag_sz, value_sz;
2019
2020 if (BIF_P->common.id == BIF_ARG_1) {
2021 res = process_flag_aux(BIF_P, NULL, BIF_ARG_2, BIF_ARG_3);
2022 BIF_RET(res);
2023 }
2024
2025 if (is_not_internal_pid(BIF_ARG_1))
2026 BIF_RET(am_badtype);
2027
2028 flag_sz = is_immed(BIF_ARG_2) ? 0 : size_object(BIF_ARG_2);
2029 value_sz = is_immed(BIF_ARG_3) ? 0 : size_object(BIF_ARG_3);
2030
2031 pf3a = erts_alloc(ERTS_ALC_T_PF3_ARGS,
2032 sizeof(ErtsProcessFlag3Args)
2033 + sizeof(Eterm)*(flag_sz+value_sz-1));
2034
2035 ohp = &pf3a->oh;
2036 ERTS_INIT_OFF_HEAP(&pf3a->oh);
2037
2038 hp = &pf3a->heap[0];
2039
2040 pf3a->flag = copy_struct(BIF_ARG_2, flag_sz, &hp, ohp);
2041 pf3a->value = copy_struct(BIF_ARG_3, value_sz, &hp, ohp);
2042
2043 res = erts_proc_sig_send_rpc_request(BIF_P, BIF_ARG_1,
2044 !0,
2045 exec_process_flag_3,
2046 (void *) pf3a);
2047
2048 if (is_non_value(res)) {
2049 erts_free(ERTS_ALC_T_PF3_ARGS, pf3a);
2050 BIF_RET(am_badtype);
2051 }
2052
2053 return res;
2054 }
2055
2056 /**********************************************************************/
2057
2058 /* register(atom, Process|Port) registers a global process or port
2059 (for this node) */
2060
register_2(BIF_ALIST_2)2061 BIF_RETTYPE register_2(BIF_ALIST_2) /* (Atom, Pid|Port) */
2062 {
2063 if (erts_register_name(BIF_P, BIF_ARG_1, BIF_ARG_2)) {
2064 BIF_RET(am_true);
2065 } else {
2066 BIF_ERROR(BIF_P, BADARG | EXF_HAS_EXT_INFO);
2067 }
2068 }
2069
2070
2071 /**********************************************************************/
2072
2073 /* removes the registration of a process or port */
2074
unregister_1(BIF_ALIST_1)2075 BIF_RETTYPE unregister_1(BIF_ALIST_1)
2076 {
2077 int res;
2078 if (is_not_atom(BIF_ARG_1)) {
2079 BIF_ERROR(BIF_P, BADARG);
2080 }
2081 res = erts_unregister_name(BIF_P, ERTS_PROC_LOCK_MAIN, NULL, BIF_ARG_1);
2082 if (res == 0) {
2083 BIF_ERROR(BIF_P, BADARG);
2084 }
2085 BIF_RET(am_true);
2086 }
2087
2088 /**********************************************************************/
2089
2090 /* find out the pid of a registered process */
2091 /* this is a rather unsafe BIF as it allows users to do nasty things. */
2092
whereis_1(BIF_ALIST_1)2093 BIF_RETTYPE whereis_1(BIF_ALIST_1)
2094 {
2095 Eterm res;
2096
2097 if (is_not_atom(BIF_ARG_1)) {
2098 BIF_ERROR(BIF_P, BADARG);
2099 }
2100 res = erts_whereis_name_to_id(BIF_P, BIF_ARG_1);
2101 BIF_RET(res);
2102 }
2103
2104 /**********************************************************************/
2105
2106 /*
2107 * erlang:'!'/2
2108 */
2109
2110 BIF_RETTYPE
ebif_bang_2(BIF_ALIST_2)2111 ebif_bang_2(BIF_ALIST_2)
2112 {
2113 return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2);
2114 }
2115
2116
2117 /*
2118 * Send a message to Process, Port or Registered Process.
2119 * Returns non-negative reduction bump or negative result code.
2120 */
2121 #define SEND_NOCONNECT (-1)
2122 #define SEND_YIELD (-2)
2123 #define SEND_YIELD_RETURN (-3)
2124 #define SEND_BADARG (-4)
2125 #define SEND_USER_ERROR (-5)
2126 #define SEND_INTERNAL_ERROR (-6)
2127 #define SEND_AWAIT_RESULT (-7)
2128 #define SEND_YIELD_CONTINUE (-8)
2129 #define SEND_SYSTEM_LIMIT (-9)
2130
2131
remote_send(Process * p,DistEntry * dep,Eterm to,Eterm node,Eterm full_to,Eterm msg,Eterm return_term,Eterm * ctxpp,int connect,int suspend)2132 static Sint remote_send(Process *p, DistEntry *dep,
2133 Eterm to, Eterm node, Eterm full_to, Eterm msg,
2134 Eterm return_term, Eterm *ctxpp,
2135 int connect, int suspend)
2136 {
2137 Sint res;
2138 int code;
2139 ErtsDSigSendContext ctx;
2140 ASSERT(is_atom(to) || is_external_pid(to) || is_external_ref(to));
2141
2142 code = erts_dsig_prepare(&ctx, dep, p, ERTS_PROC_LOCK_MAIN,
2143 ERTS_DSP_NO_LOCK,
2144 !suspend, 0, connect);
2145 ctx.return_term = return_term;
2146 ctx.node = node;
2147 switch (code) {
2148 case ERTS_DSIG_PREP_NOT_ALIVE:
2149 case ERTS_DSIG_PREP_NOT_CONNECTED:
2150 res = SEND_NOCONNECT;
2151 break;
2152 case ERTS_DSIG_PREP_WOULD_SUSPEND:
2153 ASSERT(!suspend);
2154 res = SEND_YIELD;
2155 break;
2156 case ERTS_DSIG_PREP_CONNECTED:
2157 if (!(ctx.dflags & DFLAG_ALIAS) && is_external_ref(to)) {
2158 /*
2159 * Receiver does not support alias, so the alias is
2160 * obviously not present at the receiver. Just drop
2161 * it...
2162 */
2163 res = 0;
2164 break;
2165 }
2166 /* Fall through... */
2167 case ERTS_DSIG_PREP_PENDING: {
2168
2169 if (is_atom(to))
2170 code = erts_dsig_send_reg_msg(&ctx, to, full_to, msg);
2171 else
2172 code = erts_dsig_send_msg(&ctx, to, msg);
2173 /*
2174 * Note that reductions have been bumped on calling
2175 * process by erts_dsig_send_reg_msg() or
2176 * erts_dsig_send_msg().
2177 */
2178 if (code == ERTS_DSIG_SEND_YIELD)
2179 res = SEND_YIELD_RETURN;
2180 else if (code == ERTS_DSIG_SEND_CONTINUE) {
2181 erts_set_gc_state(p, 0);
2182
2183 /* Keep a reference to the dist entry if the
2184 name is an not a pid. */
2185 if (is_atom(to)) {
2186 erts_ref_dist_entry(ctx.dep);
2187 ctx.deref_dep = 1;
2188 }
2189
2190 *ctxpp = erts_dsend_export_trap_context(p, &ctx);
2191 res = SEND_YIELD_CONTINUE;
2192 } else if (code == ERTS_DSIG_SEND_TOO_LRG)
2193 res = SEND_SYSTEM_LIMIT;
2194 else
2195 res = 0;
2196 break;
2197 }
2198 default:
2199 ASSERT(! "Invalid dsig prepare result");
2200 res = SEND_INTERNAL_ERROR;
2201 }
2202
2203 if (res >= 0) {
2204 if (IS_TRACED_FL(p, F_TRACE_SEND))
2205 trace_send(p, full_to, msg);
2206 if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
2207 save_calls(p, &exp_send);
2208 }
2209
2210 return res;
2211 }
2212
2213 static Sint
do_send(Process * p,Eterm to,Eterm msg,Eterm return_term,Eterm * refp,Eterm * dist_ctx,int connect,int suspend)2214 do_send(Process *p, Eterm to, Eterm msg, Eterm return_term, Eterm *refp,
2215 Eterm *dist_ctx, int connect, int suspend)
2216 {
2217 Eterm portid;
2218 Port *pt;
2219 Process* rp;
2220 DistEntry *dep;
2221 Eterm* tp;
2222
2223 if (is_internal_pid(to)) {
2224 if (IS_TRACED_FL(p, F_TRACE_SEND))
2225 trace_send(p, to, msg);
2226 if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
2227 save_calls(p, &exp_send);
2228
2229 rp = erts_proc_lookup_raw(to);
2230 if (!rp)
2231 return 0;
2232 }
2233 else if (is_internal_ref(to)) {
2234 erts_proc_sig_send_to_alias(p, p->common.id, to,
2235 msg, SEQ_TRACE_TOKEN(p));
2236 return 0;
2237 } else if (is_external_pid(to) || is_external_ref(to)) {
2238 dep = external_dist_entry(to);
2239 if(dep == erts_this_dist_entry) {
2240 erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
2241 erts_dsprintf(dsbufp,
2242 "Discarding message %T from %T to %T in an old "
2243 "incarnation (%u) of this node (%u)\n",
2244 msg,
2245 p->common.id,
2246 to,
2247 external_pid_creation(to),
2248 erts_this_node->creation);
2249 erts_send_error_to_logger(p->group_leader, dsbufp);
2250 return 0;
2251 }
2252 return remote_send(p, dep, to, dep->sysname, to, msg, return_term,
2253 dist_ctx, connect, suspend);
2254 } else if (is_atom(to)) {
2255 Eterm id = erts_whereis_name_to_id(p, to);
2256
2257 rp = erts_proc_lookup_raw(id);
2258 if (rp) {
2259 if (IS_TRACED_FL(p, F_TRACE_SEND))
2260 trace_send(p, to, msg);
2261 if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
2262 save_calls(p, &exp_send);
2263 goto send_message;
2264 }
2265
2266 pt = erts_port_lookup(id,
2267 (erts_port_synchronous_ops
2268 ? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP
2269 : ERTS_PORT_SFLGS_INVALID_LOOKUP));
2270 if (pt) {
2271 portid = id;
2272 goto port_common;
2273 }
2274
2275 if (IS_TRACED_FL(p, F_TRACE_SEND))
2276 trace_send(p, to, msg);
2277 if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
2278 save_calls(p, &exp_send);
2279
2280 return SEND_BADARG;
2281 } else if (is_external_port(to)
2282 && (external_port_dist_entry(to)
2283 == erts_this_dist_entry)) {
2284 erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
2285 erts_dsprintf(dsbufp,
2286 "Discarding message %T from %T to %T in an old "
2287 "incarnation (%u) of this node (%u)\n",
2288 msg,
2289 p->common.id,
2290 to,
2291 external_port_creation(to),
2292 erts_this_node->creation);
2293 erts_send_error_to_logger(p->group_leader, dsbufp);
2294 return 0;
2295 } else if (is_internal_port(to)) {
2296 int ret_val;
2297 portid = to;
2298
2299 pt = erts_port_lookup(portid,
2300 (erts_port_synchronous_ops
2301 ? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP
2302 : ERTS_PORT_SFLGS_INVALID_LOOKUP));
2303
2304 port_common:
2305 ret_val = 0;
2306
2307 if (pt) {
2308 int ps_flags = suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND;
2309 *refp = NIL;
2310
2311 if (IS_TRACED_FL(p, F_TRACE_SEND)) /* trace once only !! */
2312 trace_send(p, portid, msg);
2313
2314 if (have_seqtrace(SEQ_TRACE_TOKEN(p))) {
2315 seq_trace_update_serial(p);
2316 seq_trace_output(SEQ_TRACE_TOKEN(p), msg,
2317 SEQ_TRACE_SEND, portid, p);
2318 }
2319
2320 switch (erts_port_command(p, ps_flags, pt, msg, refp)) {
2321 case ERTS_PORT_OP_BUSY:
2322 /* Nothing has been sent */
2323 if (suspend)
2324 erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt);
2325 return SEND_YIELD;
2326 case ERTS_PORT_OP_BUSY_SCHEDULED:
2327 /* Message was sent */
2328 if (suspend) {
2329 erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt);
2330 ret_val = SEND_YIELD_RETURN;
2331 break;
2332 }
2333 /* Fall through */
2334 case ERTS_PORT_OP_SCHEDULED:
2335 if (is_not_nil(*refp)) {
2336 ASSERT(is_internal_ordinary_ref(*refp));
2337 ret_val = SEND_AWAIT_RESULT;
2338 }
2339 break;
2340 case ERTS_PORT_OP_DROPPED:
2341 case ERTS_PORT_OP_BADARG:
2342 case ERTS_PORT_OP_DONE:
2343 break;
2344 default:
2345 ERTS_INTERNAL_ERROR("Unexpected erts_port_command() result");
2346 break;
2347 }
2348 }
2349
2350 if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
2351 save_calls(p, &exp_send);
2352
2353 if (ERTS_PROC_IS_EXITING(p)) {
2354 KILL_CATCHES(p); /* Must exit */
2355 return SEND_USER_ERROR;
2356 }
2357 return ret_val;
2358 } else if (is_tuple(to)) { /* Remote send */
2359 int deref_dep = 0;
2360 int ret;
2361 tp = tuple_val(to);
2362 if (*tp != make_arityval(2))
2363 return SEND_BADARG;
2364 if (is_not_atom(tp[1]) || is_not_atom(tp[2]))
2365 return SEND_BADARG;
2366
2367 /* erts_find_dist_entry will return NULL if there is no dist_entry
2368 but remote_send() will handle that. */
2369
2370 dep = erts_find_dist_entry(tp[2]);
2371
2372 if (dep == erts_this_dist_entry) {
2373 Eterm id;
2374 if (IS_TRACED_FL(p, F_TRACE_SEND))
2375 trace_send(p, to, msg);
2376 if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
2377 save_calls(p, &exp_send);
2378
2379 id = erts_whereis_name_to_id(p, tp[1]);
2380
2381 rp = erts_proc_lookup_raw(id);
2382 if (rp)
2383 goto send_message;
2384 pt = erts_port_lookup(id,
2385 (erts_port_synchronous_ops
2386 ? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP
2387 : ERTS_PORT_SFLGS_INVALID_LOOKUP));
2388 if (pt) {
2389 portid = id;
2390 goto port_common;
2391 }
2392 return 0;
2393 }
2394 if (dep == NULL) {
2395 dep = erts_find_or_insert_dist_entry(tp[2]);
2396 ASSERT(dep != erts_this_dist_entry);
2397 deref_dep = 1;
2398 }
2399
2400 ret = remote_send(p, dep, tp[1], tp[2], to, msg, return_term,
2401 dist_ctx, connect, suspend);
2402
2403 if (deref_dep)
2404 erts_deref_dist_entry(dep);
2405 return ret;
2406 } else {
2407 if (IS_TRACED_FL(p, F_TRACE_SEND))
2408 trace_send(p, to, msg);
2409 if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
2410 save_calls(p, &exp_send);
2411 return SEND_BADARG;
2412 }
2413
2414 send_message: {
2415 ErtsProcLocks rp_locks = 0;
2416 if (p == rp)
2417 rp_locks |= ERTS_PROC_LOCK_MAIN;
2418 /* send to local process */
2419 erts_send_message(p, rp, &rp_locks, msg);
2420 erts_proc_unlock(rp,
2421 p == rp
2422 ? (rp_locks & ~ERTS_PROC_LOCK_MAIN)
2423 : rp_locks);
2424 return 0;
2425 }
2426 }
2427
send_3(BIF_ALIST_3)2428 BIF_RETTYPE send_3(BIF_ALIST_3)
2429 {
2430 BIF_RETTYPE retval;
2431 Eterm ref;
2432 Process *p = BIF_P;
2433 Eterm to = BIF_ARG_1;
2434 Eterm msg = BIF_ARG_2;
2435 Eterm opts = BIF_ARG_3;
2436
2437 Eterm l = opts;
2438 Sint result;
2439 int connect = 1, suspend = 1;
2440 Eterm ctx;
2441
2442 ERTS_MSACC_PUSH_STATE_M_X();
2443
2444 while (is_list(l)) {
2445 if (CAR(list_val(l)) == am_noconnect) {
2446 connect = 0;
2447 } else if (CAR(list_val(l)) == am_nosuspend) {
2448 suspend = 0;
2449 } else {
2450 BIF_P->fvalue = am_badopt;
2451 ERTS_BIF_PREP_ERROR(retval, p, BADARG | EXF_HAS_EXT_INFO);
2452 goto done;
2453 }
2454 l = CDR(list_val(l));
2455 }
2456 if(!is_nil(l)) {
2457 BIF_P->fvalue = am_badopt;
2458 ERTS_BIF_PREP_ERROR(retval, p, BADARG | EXF_HAS_EXT_INFO);
2459 goto done;
2460 }
2461
2462 #ifdef DEBUG
2463 ref = NIL;
2464 #endif
2465
2466 ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_SEND);
2467 result = do_send(p, to, msg, am_ok, &ref, &ctx, connect, suspend);
2468 ERTS_MSACC_POP_STATE_M_X();
2469
2470 if (result >= 0) {
2471 ERTS_VBUMP_REDS(p, 4);
2472 if (ERTS_IS_PROC_OUT_OF_REDS(p))
2473 goto yield_return;
2474 ERTS_BIF_PREP_RET(retval, am_ok);
2475 goto done;
2476 }
2477
2478 switch (result) {
2479 case SEND_NOCONNECT:
2480 if (connect) {
2481 ERTS_BIF_PREP_RET(retval, am_ok);
2482 } else {
2483 ERTS_BIF_PREP_RET(retval, am_noconnect);
2484 }
2485 break;
2486 case SEND_YIELD:
2487 if (suspend) {
2488 ERTS_BIF_PREP_YIELD3(retval, BIF_TRAP_EXPORT(BIF_send_3), p, to, msg, opts);
2489 } else {
2490 ERTS_BIF_PREP_RET(retval, am_nosuspend);
2491 }
2492 break;
2493 case SEND_YIELD_RETURN:
2494 if (!suspend) {
2495 ERTS_BIF_PREP_RET(retval, am_nosuspend);
2496 break;
2497 }
2498 yield_return:
2499 ERTS_BIF_PREP_YIELD_RETURN(retval, p, am_ok);
2500 break;
2501 case SEND_AWAIT_RESULT:
2502 ASSERT(is_internal_ordinary_ref(ref));
2503 ERTS_BIF_PREP_TRAP3(retval, await_port_send_result_trap, p, ref, am_nosuspend, am_ok);
2504 break;
2505 case SEND_BADARG:
2506 ERTS_BIF_PREP_ERROR(retval, p, BADARG);
2507 break;
2508 case SEND_SYSTEM_LIMIT:
2509 ERTS_BIF_PREP_ERROR(retval, p, SYSTEM_LIMIT);
2510 break;
2511 case SEND_USER_ERROR:
2512 ERTS_BIF_PREP_ERROR(retval, p, EXC_ERROR);
2513 break;
2514 case SEND_INTERNAL_ERROR:
2515 ERTS_BIF_PREP_ERROR(retval, p, EXC_INTERNAL_ERROR);
2516 break;
2517 case SEND_YIELD_CONTINUE:
2518 BUMP_ALL_REDS(p);
2519 ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, ctx);
2520 break;
2521 default:
2522 erts_exit(ERTS_ABORT_EXIT, "send_3 invalid result %d\n", (int)result);
2523 break;
2524 }
2525
2526 done:
2527 return retval;
2528 }
2529
send_2(BIF_ALIST_2)2530 BIF_RETTYPE send_2(BIF_ALIST_2)
2531 {
2532 return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2);
2533 }
2534
dsend_continue_trap_1(BIF_ALIST_1)2535 static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1)
2536 {
2537 Binary* bin = erts_magic_ref2bin(BIF_ARG_1);
2538 ErtsDSigSendContext *ctx = (ErtsDSigSendContext*) ERTS_MAGIC_BIN_DATA(bin);
2539 Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(BIF_P) * TERM_TO_BINARY_LOOP_FACTOR);
2540 int result;
2541
2542 ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_dsend_context_dtor);
2543
2544 ctx->reds = initial_reds;
2545 result = erts_dsig_send(ctx);
2546
2547 switch (result) {
2548 case ERTS_DSIG_SEND_OK:
2549 erts_set_gc_state(BIF_P, 1);
2550 BIF_RET(ctx->return_term);
2551 break;
2552 case ERTS_DSIG_SEND_YIELD: /*SEND_YIELD_RETURN*/
2553 erts_set_gc_state(BIF_P, 1);
2554 if (ctx->no_suspend)
2555 BIF_RET(am_nosuspend);
2556 ERTS_BIF_YIELD_RETURN(BIF_P, ctx->return_term);
2557
2558 case ERTS_DSIG_SEND_CONTINUE: { /*SEND_YIELD_CONTINUE*/
2559 BUMP_ALL_REDS(BIF_P);
2560 BIF_TRAP1(&dsend_continue_trap_export, BIF_P, BIF_ARG_1);
2561 }
2562 case ERTS_DSIG_SEND_TOO_LRG: { /*SEND_SYSTEM_LIMIT*/
2563 erts_set_gc_state(BIF_P, 1);
2564 BIF_ERROR(BIF_P, SYSTEM_LIMIT);
2565 }
2566 default:
2567 erts_exit(ERTS_ABORT_EXIT, "dsend_continue_trap invalid result %d\n", (int)result);
2568 break;
2569 }
2570 ASSERT(! "Can not arrive here");
2571 BIF_ERROR(BIF_P, BADARG);
2572 }
2573
erl_send(Process * p,Eterm to,Eterm msg)2574 Eterm erl_send(Process *p, Eterm to, Eterm msg)
2575 {
2576 Eterm retval;
2577 Eterm ref;
2578 Sint result;
2579 Eterm ctx;
2580 ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_SEND);
2581
2582 #ifdef DEBUG
2583 ref = NIL;
2584 #endif
2585
2586 result = do_send(p, to, msg, msg, &ref, &ctx, 1, 1);
2587
2588 ERTS_MSACC_POP_STATE_M_X();
2589
2590 if (result >= 0) {
2591 ERTS_VBUMP_REDS(p, 4);
2592 if (ERTS_IS_PROC_OUT_OF_REDS(p))
2593 goto yield_return;
2594 ERTS_BIF_PREP_RET(retval, msg);
2595 goto done;
2596 }
2597
2598 switch (result) {
2599 case SEND_NOCONNECT:
2600 ERTS_BIF_PREP_RET(retval, msg);
2601 break;
2602 case SEND_YIELD:
2603 ERTS_BIF_PREP_YIELD2(retval, BIF_TRAP_EXPORT(BIF_send_2), p, to, msg);
2604 break;
2605 case SEND_YIELD_RETURN:
2606 yield_return:
2607 ERTS_BIF_PREP_YIELD_RETURN(retval, p, msg);
2608 break;
2609 case SEND_AWAIT_RESULT:
2610 ASSERT(is_internal_ordinary_ref(ref));
2611 ERTS_BIF_PREP_TRAP3(retval,
2612 await_port_send_result_trap, p, ref, msg, msg);
2613 break;
2614 case SEND_BADARG:
2615 ERTS_BIF_PREP_ERROR(retval, p, BADARG);
2616 break;
2617 case SEND_SYSTEM_LIMIT:
2618 ERTS_BIF_PREP_ERROR(retval, p, SYSTEM_LIMIT);
2619 break;
2620 case SEND_USER_ERROR:
2621 ERTS_BIF_PREP_ERROR(retval, p, EXC_ERROR);
2622 break;
2623 case SEND_INTERNAL_ERROR:
2624 ERTS_BIF_PREP_ERROR(retval, p, EXC_INTERNAL_ERROR);
2625 break;
2626 case SEND_YIELD_CONTINUE:
2627 BUMP_ALL_REDS(p);
2628 ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, ctx);
2629 break;
2630 default:
2631 erts_exit(ERTS_ABORT_EXIT, "invalid send result %d\n", (int)result);
2632 break;
2633 }
2634
2635 done:
2636 return retval;
2637 }
2638
2639 /**********************************************************************/
2640
2641 /* integer to float */
2642
2643 /**********************************************************************/
2644
2645 /* returns the head of a list - this function is unecessary
2646 and is only here to keep Robert happy (Even more, since it's OP as well) */
hd_1(BIF_ALIST_1)2647 BIF_RETTYPE hd_1(BIF_ALIST_1)
2648 {
2649 if (is_not_list(BIF_ARG_1)) {
2650 BIF_ERROR(BIF_P, BADARG);
2651 }
2652 BIF_RET(CAR(list_val(BIF_ARG_1)));
2653 }
2654
2655 /**********************************************************************/
2656
2657 /* returns the tails of a list - same comment as above */
2658
tl_1(BIF_ALIST_1)2659 BIF_RETTYPE tl_1(BIF_ALIST_1)
2660 {
2661 if (is_not_list(BIF_ARG_1)) {
2662 BIF_ERROR(BIF_P, BADARG);
2663 }
2664 BIF_RET(CDR(list_val(BIF_ARG_1)));
2665 }
2666
2667
2668 /**********************************************************************/
2669 /* return the size of an I/O list */
2670
2671 static Eterm
accumulate(Eterm acc,Uint size)2672 accumulate(Eterm acc, Uint size)
2673 {
2674 if (is_non_value(acc)) {
2675 /*
2676 * There is no pre-existing accumulator. Allocate a
2677 * bignum buffer with one extra word to be used if
2678 * the bignum grows in the future.
2679 */
2680 Eterm* hp = (Eterm *) erts_alloc(ERTS_ALC_T_SHORT_LIVED_TERM,
2681 (BIG_UINT_HEAP_SIZE+1) *
2682 sizeof(Eterm));
2683 return uint_to_big(size, hp);
2684 } else {
2685 Eterm* big;
2686 int need_heap;
2687
2688 /*
2689 * Add 'size' to 'acc' in place. There is always one
2690 * extra word allocated in case the bignum grows by one word.
2691 */
2692 big = big_val(acc);
2693 need_heap = BIG_NEED_SIZE(BIG_SIZE(big));
2694 acc = big_plus_small(acc, size, big);
2695 if (BIG_NEED_SIZE(big_size(acc)) > need_heap) {
2696 /*
2697 * The extra word has been consumed. Grow the
2698 * allocation by one word.
2699 */
2700 big = (Eterm *) erts_realloc(ERTS_ALC_T_SHORT_LIVED_TERM,
2701 big_val(acc),
2702 (need_heap+1) * sizeof(Eterm));
2703 acc = make_big(big);
2704 }
2705 return acc;
2706 }
2707 }
2708
2709 static Eterm
consolidate(Process * p,Eterm acc,Uint size)2710 consolidate(Process* p, Eterm acc, Uint size)
2711 {
2712 Eterm* hp;
2713
2714 if (is_non_value(acc)) {
2715 return erts_make_integer(size, p);
2716 } else {
2717 Eterm* big;
2718 Uint sz;
2719 Eterm res;
2720
2721 acc = accumulate(acc, size);
2722 big = big_val(acc);
2723 sz = BIG_NEED_SIZE(BIG_SIZE(big));
2724 hp = HAlloc(p, sz);
2725 res = make_big(hp);
2726 while (sz--) {
2727 *hp++ = *big++;
2728 }
2729 erts_free(ERTS_ALC_T_SHORT_LIVED_TERM, (void *) big_val(acc));
2730 return res;
2731 }
2732 }
2733
2734 typedef struct {
2735 Eterm obj;
2736 Uint size;
2737 Eterm acc;
2738 Eterm input_list;
2739 ErtsEStack stack;
2740 int is_trap_at_L_iter_list;
2741 } ErtsIOListSizeContext;
2742
iolist_size_ctx_bin_dtor(Binary * context_bin)2743 static int iolist_size_ctx_bin_dtor(Binary *context_bin) {
2744 ErtsIOListSizeContext* context = ERTS_MAGIC_BIN_DATA(context_bin);
2745 DESTROY_SAVED_ESTACK(&context->stack);
2746 if (context->acc != THE_NON_VALUE) {
2747 erts_free(ERTS_ALC_T_SHORT_LIVED_TERM, (void *) big_val(context->acc));
2748 }
2749 return 1;
2750 }
2751
iolist_size_1(BIF_ALIST_1)2752 BIF_RETTYPE iolist_size_1(BIF_ALIST_1)
2753 {
2754 static const Uint ITERATIONS_PER_RED = 64;
2755 Eterm input_list, obj, hd;
2756 Eterm* objp;
2757 Uint size = 0;
2758 Uint cur_size;
2759 Uint new_size;
2760 Eterm acc = THE_NON_VALUE;
2761 DECLARE_ESTACK(s);
2762 Uint max_iterations;
2763 Uint iterations_until_trap = max_iterations =
2764 ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(BIF_P);
2765 ErtsIOListSizeContext* context = NULL;
2766 Eterm state_mref;
2767 int is_trap_at_L_iter_list;
2768 ERTS_UNDEF(state_mref, THE_NON_VALUE);
2769 ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
2770 #ifdef DEBUG
2771 iterations_until_trap = iterations_until_trap / 10;
2772 #endif
2773 input_list = obj = BIF_ARG_1;
2774 if (is_internal_magic_ref(obj)) {
2775 /* Restore state after a trap */
2776 Binary* state_bin;
2777 state_mref = obj;
2778 state_bin = erts_magic_ref2bin(state_mref);
2779 if (ERTS_MAGIC_BIN_DESTRUCTOR(state_bin) != iolist_size_ctx_bin_dtor) {
2780 BIF_ERROR(BIF_P, BADARG);
2781 }
2782 context = ERTS_MAGIC_BIN_DATA(state_bin);
2783 obj = context->obj;
2784 size = context->size;
2785 acc = context->acc;
2786 input_list = context->input_list;
2787 ESTACK_RESTORE(s, &context->stack);
2788 ASSERT(BIF_P->flags & F_DISABLE_GC);
2789 erts_set_gc_state(BIF_P, 1);
2790 if (context->is_trap_at_L_iter_list) {
2791 goto L_iter_list;
2792 }
2793 }
2794 goto L_again;
2795
2796 while (!ESTACK_ISEMPTY(s)) {
2797 obj = ESTACK_POP(s);
2798 if (iterations_until_trap == 0) {
2799 is_trap_at_L_iter_list = 0;
2800 goto L_save_state_and_trap;
2801 }
2802 L_again:
2803 if (is_list(obj)) {
2804 L_iter_list:
2805 if (iterations_until_trap == 0) {
2806 is_trap_at_L_iter_list = 1;
2807 goto L_save_state_and_trap;
2808 }
2809 objp = list_val(obj);
2810 hd = CAR(objp);
2811 obj = CDR(objp);
2812 /* Head */
2813 if (is_byte(hd)) {
2814 size++;
2815 if (size == 0) {
2816 acc = accumulate(acc, (Uint) -1);
2817 size = 1;
2818 }
2819 } else if (is_binary(hd) && binary_bitsize(hd) == 0) {
2820 cur_size = binary_size(hd);
2821 if ((new_size = size + cur_size) >= size) {
2822 size = new_size;
2823 } else {
2824 acc = accumulate(acc, size);
2825 size = cur_size;
2826 }
2827 } else if (is_list(hd)) {
2828 ESTACK_PUSH(s, obj);
2829 obj = hd;
2830 iterations_until_trap--;
2831 goto L_iter_list;
2832 } else if (is_not_nil(hd)) {
2833 goto L_type_error;
2834 }
2835 /* Tail */
2836 if (is_list(obj)) {
2837 iterations_until_trap--;
2838 goto L_iter_list;
2839 } else if (is_binary(obj) && binary_bitsize(obj) == 0) {
2840 cur_size = binary_size(obj);
2841 if ((new_size = size + cur_size) >= size) {
2842 size = new_size;
2843 } else {
2844 acc = accumulate(acc, size);
2845 size = cur_size;
2846 }
2847 } else if (is_not_nil(obj)) {
2848 goto L_type_error;
2849 }
2850 } else if (is_binary(obj) && binary_bitsize(obj) == 0) {
2851 cur_size = binary_size(obj);
2852 if ((new_size = size + cur_size) >= size) {
2853 size = new_size;
2854 } else {
2855 acc = accumulate(acc, size);
2856 size = cur_size;
2857 }
2858 } else if (is_not_nil(obj)) {
2859 goto L_type_error;
2860 }
2861 iterations_until_trap--;
2862 }
2863
2864 DESTROY_ESTACK(s);
2865 BUMP_REDS(BIF_P, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED);
2866 ASSERT(!(BIF_P->flags & F_DISABLE_GC));
2867 if (context != NULL) {
2868 /* context->acc needs to be reset so that
2869 iolist_size_ctx_bin_dtor does not deallocate twice */
2870 context->acc = THE_NON_VALUE;
2871 }
2872 BIF_RET(consolidate(BIF_P, acc, size));
2873
2874 L_type_error:
2875 DESTROY_ESTACK(s);
2876 if (acc != THE_NON_VALUE) {
2877 erts_free(ERTS_ALC_T_SHORT_LIVED_TERM, (void *) big_val(acc));
2878 if (context != NULL) {
2879 context->acc = THE_NON_VALUE;
2880 }
2881 }
2882 BUMP_REDS(BIF_P, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED);
2883 ASSERT(!(BIF_P->flags & F_DISABLE_GC));
2884 if (context == NULL) {
2885 BIF_ERROR(BIF_P, BADARG);
2886 } else {
2887 ERTS_BIF_ERROR_TRAPPED1(BIF_P,
2888 BADARG,
2889 BIF_TRAP_EXPORT(BIF_iolist_size_1),
2890 input_list);
2891 }
2892
2893 L_save_state_and_trap:
2894 if (context == NULL) {
2895 Binary *state_bin = erts_create_magic_binary(sizeof(ErtsIOListSizeContext),
2896 iolist_size_ctx_bin_dtor);
2897 Eterm* hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE);
2898 state_mref = erts_mk_magic_ref(&hp, &MSO(BIF_P), state_bin);
2899 context = ERTS_MAGIC_BIN_DATA(state_bin);
2900 }
2901 context->obj = obj;
2902 context->size = size;
2903 context->acc = acc;
2904 context->is_trap_at_L_iter_list = is_trap_at_L_iter_list;
2905 context->input_list = input_list;
2906 ESTACK_SAVE(s, &context->stack);
2907 erts_set_gc_state(BIF_P, 0);
2908 BUMP_ALL_REDS(BIF_P);
2909 BIF_TRAP1(BIF_TRAP_EXPORT(BIF_iolist_size_1), BIF_P, state_mref);
2910 }
2911
2912 /**********************************************************************/
2913
2914 /* return the N'th element of a tuple */
2915
element_2(BIF_ALIST_2)2916 BIF_RETTYPE element_2(BIF_ALIST_2)
2917 {
2918 if (is_not_small(BIF_ARG_1)) {
2919 BIF_ERROR(BIF_P, BADARG);
2920 }
2921 if (is_tuple(BIF_ARG_2)) {
2922 Eterm* tuple_ptr = tuple_val(BIF_ARG_2);
2923 Sint ix = signed_val(BIF_ARG_1);
2924
2925 if ((ix >= 1) && (ix <= arityval(*tuple_ptr)))
2926 BIF_RET(tuple_ptr[ix]);
2927 }
2928 BIF_ERROR(BIF_P, BADARG);
2929 }
2930
2931 /**********************************************************************/
2932
2933 /* return the arity of a tuple */
2934
tuple_size_1(BIF_ALIST_1)2935 BIF_RETTYPE tuple_size_1(BIF_ALIST_1)
2936 {
2937 if (is_tuple(BIF_ARG_1)) {
2938 return make_small(arityval(*tuple_val(BIF_ARG_1)));
2939 }
2940 BIF_ERROR(BIF_P, BADARG);
2941 }
2942
2943 /**********************************************************************/
2944
2945 /* set the n'th element in a tuple */
2946
setelement_3(BIF_ALIST_3)2947 BIF_RETTYPE setelement_3(BIF_ALIST_3)
2948 {
2949 Eterm* ptr;
2950 Eterm* hp;
2951 Eterm* resp;
2952 Uint ix;
2953 Uint size;
2954
2955 if (is_not_small(BIF_ARG_1) || is_not_tuple(BIF_ARG_2)) {
2956 error:
2957 BIF_ERROR(BIF_P, BADARG);
2958 }
2959 ptr = tuple_val(BIF_ARG_2);
2960 ix = signed_val(BIF_ARG_1);
2961 size = arityval(*ptr) + 1; /* include arity */
2962 if ((ix < 1) || (ix >= size)) {
2963 goto error;
2964 }
2965
2966 hp = HAlloc(BIF_P, size);
2967
2968 /* copy the tuple */
2969 resp = hp;
2970 sys_memcpy(hp, ptr, sizeof(Eterm)*size);
2971 resp[ix] = BIF_ARG_3;
2972 BIF_RET(make_tuple(resp));
2973 }
2974
2975 /**********************************************************************/
2976
make_tuple_2(BIF_ALIST_2)2977 BIF_RETTYPE make_tuple_2(BIF_ALIST_2)
2978 {
2979 Sint n;
2980 Eterm* hp;
2981 Eterm res;
2982
2983 if (is_not_small(BIF_ARG_1) || (n = signed_val(BIF_ARG_1)) < 0 || n > ERTS_MAX_TUPLE_SIZE) {
2984 BIF_ERROR(BIF_P, BADARG);
2985 }
2986 hp = HAlloc(BIF_P, n+1);
2987 res = make_tuple(hp);
2988 *hp++ = make_arityval(n);
2989 while (n--) {
2990 *hp++ = BIF_ARG_2;
2991 }
2992 BIF_RET(res);
2993 }
2994
make_tuple_3(BIF_ALIST_3)2995 BIF_RETTYPE make_tuple_3(BIF_ALIST_3)
2996 {
2997 Sint n;
2998 Uint limit;
2999 Eterm* hp;
3000 Eterm res;
3001 Eterm list = BIF_ARG_3;
3002 Eterm* tup;
3003
3004 if (is_not_small(BIF_ARG_1) || (n = signed_val(BIF_ARG_1)) < 0 || n > ERTS_MAX_TUPLE_SIZE) {
3005 error:
3006 BIF_ERROR(BIF_P, BADARG);
3007 }
3008 limit = (Uint) n;
3009 hp = HAlloc(BIF_P, n+1);
3010 res = make_tuple(hp);
3011 *hp++ = make_arityval(n);
3012 tup = hp;
3013 while (n--) {
3014 *hp++ = BIF_ARG_2;
3015 }
3016 while(is_list(list)) {
3017 Eterm* cons;
3018 Eterm hd;
3019 Eterm* tp;
3020 Eterm index;
3021 Uint index_val;
3022
3023 cons = list_val(list);
3024 hd = CAR(cons);
3025 list = CDR(cons);
3026 if (is_not_tuple_arity(hd, 2)) {
3027 goto error;
3028 }
3029 tp = tuple_val(hd);
3030 if (is_not_small(index = tp[1])) {
3031 goto error;
3032 }
3033 if ((index_val = unsigned_val(index) - 1) < limit) {
3034 tup[index_val] = tp[2];
3035 } else {
3036 goto error;
3037 }
3038 }
3039 if (is_not_nil(list)) {
3040 goto error;
3041 }
3042 BIF_RET(res);
3043 }
3044
3045
3046 /**********************************************************************/
3047
append_element_2(BIF_ALIST_2)3048 BIF_RETTYPE append_element_2(BIF_ALIST_2)
3049 {
3050 Eterm* ptr;
3051 Eterm* hp;
3052 Uint arity;
3053 Eterm res;
3054
3055 if (is_not_tuple(BIF_ARG_1)) {
3056 error:
3057 BIF_ERROR(BIF_P, BADARG);
3058 }
3059 ptr = tuple_val(BIF_ARG_1);
3060 arity = arityval(*ptr);
3061
3062 if (arity + 1 > ERTS_MAX_TUPLE_SIZE)
3063 goto error;
3064
3065 hp = HAlloc(BIF_P, arity + 2);
3066 res = make_tuple(hp);
3067 *hp = make_arityval(arity+1);
3068 while (arity--) {
3069 *++hp = *++ptr;
3070 }
3071 *++hp = BIF_ARG_2;
3072 BIF_RET(res);
3073 }
3074
insert_element_3(BIF_ALIST_3)3075 BIF_RETTYPE insert_element_3(BIF_ALIST_3)
3076 {
3077 Eterm* ptr;
3078 Eterm* hp;
3079 Uint arity;
3080 Eterm res;
3081 Sint ix, c1, c2;
3082
3083 if (is_not_tuple(BIF_ARG_2) || is_not_small(BIF_ARG_1)) {
3084 BIF_ERROR(BIF_P, BADARG);
3085 }
3086
3087 ptr = tuple_val(BIF_ARG_2);
3088 arity = arityval(*ptr);
3089 ix = signed_val(BIF_ARG_1);
3090
3091 if ((ix < 1) || (ix > (arity + 1))) {
3092 BIF_ERROR(BIF_P, BADARG);
3093 }
3094
3095 hp = HAlloc(BIF_P, arity + 1 + 1);
3096 res = make_tuple(hp);
3097 *hp = make_arityval(arity + 1);
3098
3099 c1 = ix - 1;
3100 c2 = arity - ix + 1;
3101
3102 while (c1--) { *++hp = *++ptr; }
3103 *++hp = BIF_ARG_3;
3104 while (c2--) { *++hp = *++ptr; }
3105
3106 BIF_RET(res);
3107 }
3108
delete_element_2(BIF_ALIST_3)3109 BIF_RETTYPE delete_element_2(BIF_ALIST_3)
3110 {
3111 Eterm* ptr;
3112 Eterm* hp;
3113 Uint arity;
3114 Eterm res;
3115 Sint ix, c1, c2;
3116
3117 if (is_not_tuple(BIF_ARG_2) || is_not_small(BIF_ARG_1)) {
3118 BIF_ERROR(BIF_P, BADARG);
3119 }
3120
3121 ptr = tuple_val(BIF_ARG_2);
3122 arity = arityval(*ptr);
3123 ix = signed_val(BIF_ARG_1);
3124
3125 if ((ix < 1) || (ix > arity) || (arity == 0)) {
3126 BIF_ERROR(BIF_P, BADARG);
3127 }
3128
3129 hp = HAlloc(BIF_P, arity + 1 - 1);
3130 res = make_tuple(hp);
3131 *hp = make_arityval(arity - 1);
3132
3133 c1 = ix - 1;
3134 c2 = arity - ix;
3135
3136 while (c1--) { *++hp = *++ptr; }
3137 ++ptr;
3138 while (c2--) { *++hp = *++ptr; }
3139
3140 BIF_RET(res);
3141 }
3142
3143 /**********************************************************************/
3144
3145 /* convert an atom to a list of ascii integer */
3146
atom_to_list_1(BIF_ALIST_1)3147 BIF_RETTYPE atom_to_list_1(BIF_ALIST_1)
3148 {
3149 Atom* ap;
3150 Uint num_chars, num_built, num_eaten;
3151 byte* err_pos;
3152 Eterm res;
3153 int ares;
3154
3155 if (is_not_atom(BIF_ARG_1))
3156 BIF_ERROR(BIF_P, BADARG);
3157
3158 /* read data from atom table */
3159 ap = atom_tab(atom_val(BIF_ARG_1));
3160 if (ap->len == 0)
3161 BIF_RET(NIL); /* the empty atom */
3162
3163 ares =
3164 erts_analyze_utf8(ap->name, ap->len, &err_pos, &num_chars, NULL);
3165 ASSERT(ares == ERTS_UTF8_OK); (void)ares;
3166
3167 res = erts_utf8_to_list(BIF_P, num_chars, ap->name, ap->len, ap->len,
3168 &num_built, &num_eaten, NIL);
3169 ASSERT(num_built == num_chars);
3170 ASSERT(num_eaten == ap->len);
3171 BIF_RET(res);
3172 }
3173
3174 /**********************************************************************/
3175
3176 /* convert a list of ascii integers to an atom */
3177
list_to_atom_1(BIF_ALIST_1)3178 BIF_RETTYPE list_to_atom_1(BIF_ALIST_1)
3179 {
3180 Eterm res;
3181 byte *buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_SZ_LIMIT);
3182 Sint written;
3183 int i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS,
3184 &written);
3185 if (i < 0) {
3186 erts_free(ERTS_ALC_T_TMP, (void *) buf);
3187 if (i == -2) {
3188 BIF_ERROR(BIF_P, SYSTEM_LIMIT);
3189 }
3190 BIF_ERROR(BIF_P, BADARG);
3191 }
3192 res = erts_atom_put(buf, written, ERTS_ATOM_ENC_UTF8, 1);
3193 ASSERT(is_atom(res));
3194 erts_free(ERTS_ALC_T_TMP, (void *) buf);
3195 BIF_RET(res);
3196 }
3197
3198 /* conditionally convert a list of ascii integers to an atom */
3199
list_to_existing_atom_1(BIF_ALIST_1)3200 BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1)
3201 {
3202 byte *buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_SZ_LIMIT);
3203 Sint written;
3204 int i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS,
3205 &written);
3206 if (i < 0) {
3207 error:
3208 erts_free(ERTS_ALC_T_TMP, (void *) buf);
3209 BIF_ERROR(BIF_P, BADARG);
3210 } else {
3211 Eterm a;
3212
3213 if (erts_atom_get((char *) buf, written, &a, ERTS_ATOM_ENC_UTF8)) {
3214 erts_free(ERTS_ALC_T_TMP, (void *) buf);
3215 BIF_RET(a);
3216 } else {
3217 goto error;
3218 }
3219 }
3220 }
3221
3222
3223 /**********************************************************************/
3224
3225 /* convert an integer to a list of ascii integers */
3226
integer_to_list(Process * c_p,Eterm num,int base)3227 static Eterm integer_to_list(Process *c_p, Eterm num, int base)
3228 {
3229 Eterm *hp;
3230 Eterm res;
3231 Uint need;
3232
3233 if (is_small(num)) {
3234 char s[128];
3235 char *c = s;
3236 Uint digits;
3237
3238 digits = Sint_to_buf(signed_val(num), base, &c, sizeof(s));
3239 need = 2 * digits;
3240
3241 hp = HAlloc(c_p, need);
3242 res = buf_to_intlist(&hp, c, digits, NIL);
3243 } else {
3244 const int DIGITS_PER_RED = 16;
3245 Eterm *hp_end;
3246 Uint digits;
3247
3248 digits = big_integer_estimate(num, base);
3249
3250 if ((digits / DIGITS_PER_RED) > ERTS_BIF_REDS_LEFT(c_p)) {
3251 ErtsSchedulerData *esdp = erts_get_scheduler_data();
3252
3253 /* This could take a very long time, tell the caller to reschedule
3254 * us to a dirty CPU scheduler if we aren't already on one. */
3255 if (esdp->type == ERTS_SCHED_NORMAL) {
3256 return THE_NON_VALUE;
3257 }
3258 } else {
3259 BUMP_REDS(c_p, digits / DIGITS_PER_RED);
3260 }
3261
3262 need = 2 * digits;
3263
3264 hp = HAlloc(c_p, need);
3265 hp_end = hp + need;
3266
3267 res = erts_big_to_list(num, base, &hp);
3268 HRelease(c_p, hp_end, hp);
3269 }
3270
3271 return res;
3272 }
3273
integer_to_list_1(BIF_ALIST_1)3274 BIF_RETTYPE integer_to_list_1(BIF_ALIST_1)
3275 {
3276 Eterm res;
3277
3278 if (is_not_integer(BIF_ARG_1)) {
3279 BIF_ERROR(BIF_P, BADARG);
3280 }
3281
3282 res = integer_to_list(BIF_P, BIF_ARG_1, 10);
3283
3284 if (is_non_value(res)) {
3285 ErtsCodeMFA *mfa = &BIF_TRAP_EXPORT(BIF_integer_to_list_1)->info.mfa;
3286 Eterm args[1];
3287 args[0] = BIF_ARG_1;
3288 return erts_schedule_bif(BIF_P,
3289 args,
3290 BIF_I,
3291 mfa,
3292 integer_to_list_1,
3293 ERTS_SCHED_DIRTY_CPU,
3294 am_erlang,
3295 am_integer_to_list,
3296 1);
3297 }
3298
3299 return res;
3300 }
3301
integer_to_list_2(BIF_ALIST_2)3302 BIF_RETTYPE integer_to_list_2(BIF_ALIST_2)
3303 {
3304 Eterm res;
3305 SWord base;
3306
3307 if (is_not_integer(BIF_ARG_1) || is_not_small(BIF_ARG_2)) {
3308 BIF_ERROR(BIF_P, BADARG);
3309 }
3310
3311 base = signed_val(BIF_ARG_2);
3312 if (base < 2 || base > 36) {
3313 BIF_ERROR(BIF_P, BADARG);
3314 }
3315
3316 res = integer_to_list(BIF_P, BIF_ARG_1, base);
3317
3318 if (is_non_value(res)) {
3319 ErtsCodeMFA *mfa = &BIF_TRAP_EXPORT(BIF_integer_to_list_2)->info.mfa;
3320 Eterm args[2];
3321 args[0] = BIF_ARG_1;
3322 args[1] = BIF_ARG_2;
3323 return erts_schedule_bif(BIF_P,
3324 args,
3325 BIF_I,
3326 mfa,
3327 integer_to_list_2,
3328 ERTS_SCHED_DIRTY_CPU,
3329 am_erlang,
3330 am_integer_to_list,
3331 2);
3332 }
3333
3334 return res;
3335 }
3336
3337 /**********************************************************************/
3338
3339 /*
3340 * Converts a list of ascii base10 digits to an integer fully or partially.
3341 * Returns result and the remaining tail.
3342 * On error returns: {error,not_a_list}, or {error, no_integer}
3343 */
3344
string_list_to_integer_1(BIF_ALIST_1)3345 BIF_RETTYPE string_list_to_integer_1(BIF_ALIST_1)
3346 {
3347 Eterm res;
3348 Eterm tail;
3349 Eterm *hp;
3350 /* must be a list */
3351 switch (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, &res, &tail)) {
3352 /* HAlloc after erts_list_to_integer as it might HAlloc itself (bignum) */
3353 case LTI_BAD_STRUCTURE:
3354 hp = HAlloc(BIF_P,3);
3355 BIF_RET(TUPLE2(hp, am_error, am_not_a_list));
3356 case LTI_NO_INTEGER:
3357 hp = HAlloc(BIF_P,3);
3358 BIF_RET(TUPLE2(hp, am_error, am_no_integer));
3359 default:
3360 hp = HAlloc(BIF_P,3);
3361 BIF_RET(TUPLE2(hp, res, tail));
3362 }
3363 }
3364
list_to_integer_1(BIF_ALIST_1)3365 BIF_RETTYPE list_to_integer_1(BIF_ALIST_1)
3366 {
3367 /* Using erts_list_to_integer is about twice as fast as using
3368 erts_chars_to_integer because we do not have to copy the
3369 entire list */
3370 Eterm res;
3371 Eterm dummy;
3372 /* must be a list */
3373 if (erts_list_to_integer(BIF_P, BIF_ARG_1, 10,
3374 &res, &dummy) != LTI_ALL_INTEGER) {
3375 BIF_ERROR(BIF_P,BADARG);
3376 }
3377 BIF_RET(res);
3378 }
3379
list_to_integer_2(BIF_ALIST_2)3380 BIF_RETTYPE list_to_integer_2(BIF_ALIST_2)
3381 {
3382 /* Bif implementation is about 50% faster than pure erlang,
3383 and since we have erts_chars_to_integer now it is simpler
3384 as well. This could be optmized further if we did not have to
3385 copy the list to buf. */
3386 Sint i;
3387 Eterm res, dummy;
3388 int base;
3389
3390 i = erts_list_length(BIF_ARG_1);
3391 if (i < 0 || is_not_small(BIF_ARG_2)) {
3392 BIF_ERROR(BIF_P, BADARG);
3393 }
3394
3395 base = signed_val(BIF_ARG_2);
3396
3397 if (base < 2 || base > 36) {
3398 BIF_ERROR(BIF_P, BADARG);
3399 }
3400
3401 if (erts_list_to_integer(BIF_P, BIF_ARG_1, base,
3402 &res, &dummy) != LTI_ALL_INTEGER) {
3403 BIF_ERROR(BIF_P,BADARG);
3404 }
3405 BIF_RET(res);
3406 }
3407
3408 /**********************************************************************/
3409
do_float_to_charbuf(Process * p,Eterm efloat,Eterm list,char * fbuf,int sizeof_fbuf)3410 static int do_float_to_charbuf(Process *p, Eterm efloat, Eterm list,
3411 char *fbuf, int sizeof_fbuf) {
3412
3413 Eterm arity_two = make_arityval(2);
3414 int decimals = SYS_DEFAULT_FLOAT_DECIMALS;
3415 int compact = 0;
3416 enum fmt_type_ {
3417 FMT_LEGACY,
3418 FMT_FIXED,
3419 FMT_SCIENTIFIC
3420 } fmt_type = FMT_LEGACY;
3421 Eterm arg;
3422 FloatDef f;
3423
3424 /* check the arguments */
3425 if (is_not_float(efloat))
3426 goto badarg;
3427
3428 for(; is_list(list); list = CDR(list_val(list))) {
3429 arg = CAR(list_val(list));
3430 if (arg == am_compact) {
3431 compact = 1;
3432 continue;
3433 } else if (is_tuple(arg)) {
3434 Eterm* tp = tuple_val(arg);
3435 if (*tp == arity_two && is_small(tp[2])) {
3436 decimals = signed_val(tp[2]);
3437 switch (tp[1]) {
3438 case am_decimals:
3439 fmt_type = FMT_FIXED;
3440 continue;
3441 case am_scientific:
3442 fmt_type = FMT_SCIENTIFIC;
3443 continue;
3444 }
3445 }
3446 }
3447 goto badarg;
3448 }
3449 if (is_not_nil(list)) {
3450 goto badarg;
3451 }
3452
3453 GET_DOUBLE(efloat, f);
3454
3455 if (fmt_type == FMT_FIXED) {
3456 return sys_double_to_chars_fast(f.fd, fbuf, sizeof_fbuf,
3457 decimals, compact);
3458 } else {
3459 return sys_double_to_chars_ext(f.fd, fbuf, sizeof_fbuf, decimals);
3460 }
3461
3462 badarg:
3463 return -1;
3464 }
3465
3466 /* convert a float to a list of ascii characters */
3467
do_float_to_list(Process * BIF_P,Eterm arg,Eterm opts)3468 static BIF_RETTYPE do_float_to_list(Process *BIF_P, Eterm arg, Eterm opts) {
3469 int used;
3470 Eterm* hp;
3471 char fbuf[256];
3472
3473 if ((used = do_float_to_charbuf(BIF_P,arg,opts,fbuf,sizeof(fbuf))) <= 0) {
3474 BIF_ERROR(BIF_P, BADARG);
3475 }
3476 hp = HAlloc(BIF_P, (Uint)used*2);
3477 BIF_RET(buf_to_intlist(&hp, fbuf, (Uint)used, NIL));
3478 }
3479
3480
float_to_list_1(BIF_ALIST_1)3481 BIF_RETTYPE float_to_list_1(BIF_ALIST_1)
3482 {
3483 return do_float_to_list(BIF_P,BIF_ARG_1,NIL);
3484 }
3485
float_to_list_2(BIF_ALIST_2)3486 BIF_RETTYPE float_to_list_2(BIF_ALIST_2)
3487 {
3488 return do_float_to_list(BIF_P,BIF_ARG_1,BIF_ARG_2);
3489 }
3490
3491 /* convert a float to a binary of ascii characters */
3492
do_float_to_binary(Process * BIF_P,Eterm arg,Eterm opts)3493 static BIF_RETTYPE do_float_to_binary(Process *BIF_P, Eterm arg, Eterm opts) {
3494 int used;
3495 char fbuf[256];
3496
3497 if ((used = do_float_to_charbuf(BIF_P,arg,opts,fbuf,sizeof(fbuf))) <= 0) {
3498 BIF_ERROR(BIF_P, BADARG);
3499 }
3500 BIF_RET(new_binary(BIF_P, (byte*)fbuf, (Uint)used));
3501 }
3502
float_to_binary_1(BIF_ALIST_1)3503 BIF_RETTYPE float_to_binary_1(BIF_ALIST_1)
3504 {
3505 return do_float_to_binary(BIF_P,BIF_ARG_1,NIL);
3506 }
3507
float_to_binary_2(BIF_ALIST_2)3508 BIF_RETTYPE float_to_binary_2(BIF_ALIST_2)
3509 {
3510 return do_float_to_binary(BIF_P,BIF_ARG_1,BIF_ARG_2);
3511 }
3512
3513 /**********************************************************************/
3514
3515 /* convert a list of ascii integer values e's +'s and -'s to a float */
3516
3517
3518 #define SIGN 0
3519 #define INT 1
3520 #define FRAC 2
3521 #define EXP_SIGN 3
3522 #define EXP0 4
3523 #define EXP1 5
3524 #define END 6
3525
3526 #define IS_DOT(x) (unsigned_val((x)) == '.' || unsigned_val((x)) == ',')
3527 #define IS_E(x) (unsigned_val((x)) == 'e' || unsigned_val((x)) == 'E')
3528 #define IS_DIGIT(x) (unsigned_val((x)) >= '0' && unsigned_val((x)) <= '9')
3529 #define SAVE_E(xi,xim,xl,xlm) ((xim)=(xi), (xlm)=(xl))
3530 #define LOAD_E(xi,xim,xl,xlm) ((xi)=(xim), (xl)=(xlm))
3531
3532 #define STRING_TO_FLOAT_BUF_INC_SZ (128)
string_list_to_float_1(BIF_ALIST_1)3533 BIF_RETTYPE string_list_to_float_1(BIF_ALIST_1)
3534 {
3535 Eterm orig = BIF_ARG_1;
3536 Eterm list = orig;
3537 Eterm list_mem = list;
3538 int i = 0;
3539 int i_mem = 0;
3540 Eterm* hp;
3541 Eterm error_res = NIL;
3542 int part = SIGN; /* expect a + or - (or a digit) first */
3543 FloatDef f;
3544 Eterm tup;
3545 byte *buf = NULL;
3546 Uint bufsz = STRING_TO_FLOAT_BUF_INC_SZ;
3547
3548 /* check it's a valid list to start with */
3549 if (is_nil(list)) {
3550 error_res = am_no_float;
3551 error:
3552 if (buf)
3553 erts_free(ERTS_ALC_T_TMP, (void *) buf);
3554 hp = HAlloc(BIF_P, 3);
3555 BIF_RET(TUPLE2(hp, am_error, error_res));
3556 }
3557 if (is_not_list(list)) {
3558 error_res = am_not_a_list;
3559 goto error;
3560 }
3561
3562 buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, bufsz);
3563
3564 /*
3565 The float might start with a SIGN (+ | -). It must contain an integer
3566 part, INT, followed by a delimiter (. | ,) and a fractional, FRAC,
3567 part. The float might also contain an exponent. If e or E indicates
3568 this we will look for a possible EXP_SIGN (+ | -) followed by the
3569 exponential number, EXP. (EXP0 is the first digit and EXP1 the rest).
3570
3571 When we encounter an expected e or E, we can't tell if it's part of
3572 the float or the rest of the string. We save the current position
3573 with SAVE_E. If we later find out it was not part of the float, we
3574 restore the position (end of the float) with LOAD_E.
3575 */
3576 while(1) {
3577 if (is_not_small(CAR(list_val(list))))
3578 goto back_to_e;
3579 if (CAR(list_val(list)) == make_small('-')) {
3580 switch (part) {
3581 case SIGN: /* expect integer part next */
3582 part = INT;
3583 break;
3584 case EXP_SIGN: /* expect first digit in exp */
3585 part = EXP0;
3586 break;
3587 case EXP0: /* example: "2.3e--" */
3588 LOAD_E(i, i_mem, list, list_mem);
3589 default: /* unexpected - done */
3590 part = END;
3591 }
3592 } else if (CAR(list_val(list)) == make_small('+')) {
3593 switch (part) {
3594 case SIGN: /* expect integer part next */
3595 part = INT;
3596 goto skip;
3597 case EXP_SIGN: /* expect first digit in exp */
3598 part = EXP0;
3599 break;
3600 case EXP0: /* example: "2.3e++" */
3601 LOAD_E(i, i_mem, list, list_mem);
3602 default: /* unexpected - done */
3603 part = END;
3604 }
3605 } else if (IS_DOT(CAR(list_val(list)))) { /* . or , */
3606 switch (part) {
3607 case INT: /* expect fractional part next */
3608 part = FRAC;
3609 break;
3610 case EXP_SIGN: /* example: "2.3e." */
3611 LOAD_E(i, i_mem, list, list_mem);
3612 case EXP0: /* example: "2.3e+." */
3613 LOAD_E(i, i_mem, list, list_mem);
3614 default: /* unexpected - done */
3615 part = END;
3616 }
3617 } else if (IS_E(CAR(list_val(list)))) { /* e or E */
3618 switch (part) {
3619 case FRAC: /* expect a + or - (or a digit) next */
3620 /*
3621 remember the position of e in case we find out later
3622 that it was not part of the float, e.g. "2.3eh?"
3623 */
3624 SAVE_E(i, i_mem, list, list_mem);
3625 part = EXP_SIGN;
3626 break;
3627 case EXP0: /* example: "2.3e+e" */
3628 case EXP_SIGN: /* example: "2.3ee" */
3629 LOAD_E(i, i_mem, list, list_mem);
3630 case INT: /* would like this to be ok, example "2e2",
3631 but it's not compatible with list_to_float */
3632 default: /* unexpected - done */
3633 part = END;
3634 }
3635 } else if (IS_DIGIT(CAR(list_val(list)))) { /* digit */
3636 switch (part) {
3637 case SIGN: /* got initial digit in integer part */
3638 part = INT; /* expect more digits to follow */
3639 break;
3640 case EXP_SIGN: /* expect exponential part */
3641 case EXP0: /* expect rest of exponential */
3642 part = EXP1;
3643 break;
3644 }
3645 } else /* character not part of float - done */
3646 goto back_to_e;
3647
3648 if (part == END) {
3649 if (i < 3) { /* we require a fractional part */
3650 error_res = am_no_float;
3651 goto error;
3652 }
3653 break;
3654 }
3655
3656 buf[i++] = unsigned_val(CAR(list_val(list)));
3657
3658 if (i == bufsz - 1)
3659 buf = (byte *) erts_realloc(ERTS_ALC_T_TMP,
3660 (void *) buf,
3661 bufsz += STRING_TO_FLOAT_BUF_INC_SZ);
3662 skip:
3663 list = CDR(list_val(list)); /* next element */
3664
3665 if (is_nil(list))
3666 goto back_to_e;
3667
3668 if (is_not_list(list)) {
3669 back_to_e:
3670 if (part == EXP_SIGN || part == EXP0) {
3671 LOAD_E(i, i_mem, list, list_mem);
3672 }
3673 break;
3674 }
3675 }
3676
3677 if (i == 0) { /* no float first in list */
3678 error_res = am_no_float;
3679 goto error;
3680 }
3681
3682 buf[i] = '\0'; /* null terminal */
3683 ASSERT(bufsz >= i + 1);
3684 if (sys_chars_to_double((char*) buf, &f.fd) != 0) {
3685 error_res = am_no_float;
3686 goto error;
3687 }
3688 hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT + 3);
3689 tup = TUPLE2(hp+FLOAT_SIZE_OBJECT, make_float(hp), list);
3690 PUT_DOUBLE(f, hp);
3691 erts_free(ERTS_ALC_T_TMP, (void *) buf);
3692 BIF_RET(tup);
3693 }
3694
do_charbuf_to_float(Process * BIF_P,char * buf)3695 static BIF_RETTYPE do_charbuf_to_float(Process *BIF_P,char *buf) {
3696 FloatDef f;
3697 Eterm res;
3698 Eterm* hp;
3699
3700 if (sys_chars_to_double(buf, &f.fd) != 0)
3701 BIF_ERROR(BIF_P, BADARG);
3702
3703 hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT);
3704 res = make_float(hp);
3705 PUT_DOUBLE(f, hp);
3706 BIF_RET(res);
3707
3708 }
3709
list_to_float_1(BIF_ALIST_1)3710 BIF_RETTYPE list_to_float_1(BIF_ALIST_1)
3711 {
3712 Sint i;
3713 Eterm res;
3714 char *buf = NULL;
3715
3716 i = erts_list_length(BIF_ARG_1);
3717 if (i < 0)
3718 BIF_ERROR(BIF_P, BADARG);
3719
3720 buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1);
3721
3722 if (intlist_to_buf(BIF_ARG_1, buf, i) < 0)
3723 goto list_to_float_1_error;
3724 buf[i] = '\0'; /* null terminal */
3725
3726 if ((res = do_charbuf_to_float(BIF_P,buf)) == THE_NON_VALUE)
3727 goto list_to_float_1_error;
3728
3729 erts_free(ERTS_ALC_T_TMP, (void *) buf);
3730 BIF_RET(res);
3731
3732 list_to_float_1_error:
3733 erts_free(ERTS_ALC_T_TMP, (void *) buf);
3734 BIF_ERROR(BIF_P, BADARG);
3735
3736 }
3737
binary_to_float_1(BIF_ALIST_1)3738 BIF_RETTYPE binary_to_float_1(BIF_ALIST_1)
3739 {
3740 Eterm res;
3741 Eterm binary = BIF_ARG_1;
3742 Sint size;
3743 byte* bytes, *buf;
3744 Eterm* real_bin;
3745 Uint offs = 0;
3746 Uint bit_offs = 0;
3747
3748 if (is_not_binary(binary) || (size = binary_size(binary)) == 0)
3749 BIF_ERROR(BIF_P, BADARG);
3750
3751 /*
3752 * Unfortunately we have to copy the binary because we have to insert
3753 * the '\0' at the end of the binary for strtod to work
3754 * (there is no nstrtod :( )
3755 */
3756
3757 buf = erts_alloc(ERTS_ALC_T_TMP, size + 1);
3758
3759 real_bin = binary_val(binary);
3760 if (*real_bin == HEADER_SUB_BIN) {
3761 ErlSubBin* sb = (ErlSubBin *) real_bin;
3762 if (sb->bitsize) {
3763 goto binary_to_float_1_error;
3764 }
3765 offs = sb->offs;
3766 bit_offs = sb->bitoffs;
3767 real_bin = binary_val(sb->orig);
3768 }
3769 if (*real_bin == HEADER_PROC_BIN) {
3770 bytes = ((ProcBin *) real_bin)->bytes + offs;
3771 } else {
3772 bytes = (byte *)(&(((ErlHeapBin *) real_bin)->data)) + offs;
3773 }
3774 if (bit_offs)
3775 erts_copy_bits(bytes, bit_offs, 1, buf, 0, 1, size*8);
3776 else
3777 sys_memcpy(buf, bytes, size);
3778
3779 buf[size] = '\0';
3780
3781 if ((res = do_charbuf_to_float(BIF_P,(char*)buf)) == THE_NON_VALUE)
3782 goto binary_to_float_1_error;
3783
3784 erts_free(ERTS_ALC_T_TMP, (void *) buf);
3785 BIF_RET(res);
3786
3787 binary_to_float_1_error:
3788 erts_free(ERTS_ALC_T_TMP, (void *) buf);
3789 BIF_ERROR(BIF_P, BADARG);
3790 }
3791
3792 /**********************************************************************/
3793
3794 /* convert a tuple to a list */
3795
tuple_to_list_1(BIF_ALIST_1)3796 BIF_RETTYPE tuple_to_list_1(BIF_ALIST_1)
3797 {
3798 Uint n;
3799 Eterm *tupleptr;
3800 Eterm list = NIL;
3801 Eterm* hp;
3802
3803 if (is_not_tuple(BIF_ARG_1)) {
3804 BIF_ERROR(BIF_P, BADARG);
3805 }
3806
3807 tupleptr = tuple_val(BIF_ARG_1);
3808 n = arityval(*tupleptr);
3809 hp = HAlloc(BIF_P, 2 * n);
3810 tupleptr++;
3811
3812 while(n--) {
3813 list = CONS(hp, tupleptr[n], list);
3814 hp += 2;
3815 }
3816 BIF_RET(list);
3817 }
3818
3819 /**********************************************************************/
3820
3821 /* convert a list to a tuple */
3822
list_to_tuple_1(BIF_ALIST_1)3823 BIF_RETTYPE list_to_tuple_1(BIF_ALIST_1)
3824 {
3825 Eterm list = BIF_ARG_1;
3826 Eterm* cons;
3827 Eterm res;
3828 Eterm* hp;
3829 Sint len;
3830
3831 if ((len = erts_list_length(list)) < 0 || len > ERTS_MAX_TUPLE_SIZE) {
3832 BIF_ERROR(BIF_P, BADARG);
3833 }
3834
3835 hp = HAlloc(BIF_P, len+1);
3836 res = make_tuple(hp);
3837 *hp++ = make_arityval(len);
3838 while(is_list(list)) {
3839 cons = list_val(list);
3840 *hp++ = CAR(cons);
3841 list = CDR(cons);
3842 }
3843 BIF_RET(res);
3844 }
3845
3846 /**********************************************************************/
3847
3848 /* return the pid of our own process, in most cases this has been replaced by
3849 a machine instruction */
3850
self_0(BIF_ALIST_0)3851 BIF_RETTYPE self_0(BIF_ALIST_0)
3852 {
3853 BIF_RET(BIF_P->common.id);
3854 }
3855
3856 /**********************************************************************/
3857
3858 /* return the time of day */
3859
time_0(BIF_ALIST_0)3860 BIF_RETTYPE time_0(BIF_ALIST_0)
3861 {
3862 int hour, minute, second;
3863 Eterm* hp;
3864
3865 get_time(&hour, &minute, &second);
3866 hp = HAlloc(BIF_P, 4); /* {hour, minute, second} + arity */
3867 BIF_RET(TUPLE3(hp, make_small(hour), make_small(minute),
3868 make_small(second)));
3869 }
3870 /**********************************************************************/
3871
3872 /* return the date */
3873
date_0(BIF_ALIST_0)3874 BIF_RETTYPE date_0(BIF_ALIST_0)
3875 {
3876 int year, month, day;
3877 Eterm* hp;
3878
3879 get_date(&year, &month, &day);
3880 hp = HAlloc(BIF_P, 4); /* {year, month, day} + arity */
3881 BIF_RET(TUPLE3(hp, make_small(year), make_small(month), make_small(day)));
3882 }
3883
3884 /**********************************************************************/
3885
3886 /* return the universal time */
3887
universaltime_0(BIF_ALIST_0)3888 BIF_RETTYPE universaltime_0(BIF_ALIST_0)
3889 {
3890 int year, month, day;
3891 int hour, minute, second;
3892 Eterm res1, res2;
3893 Eterm* hp;
3894
3895 /* read the clock */
3896 get_universaltime(&year, &month, &day, &hour, &minute, &second);
3897
3898 hp = HAlloc(BIF_P, 4+4+3);
3899
3900 /* and return the tuple */
3901 res1 = TUPLE3(hp,make_small(year),make_small(month),make_small(day));
3902 hp += 4;
3903 res2 = TUPLE3(hp,make_small(hour),make_small(minute),make_small(second));
3904 hp += 4;
3905 BIF_RET(TUPLE2(hp, res1, res2));
3906 }
3907
3908 /**********************************************************************/
3909
3910 /* return the universal time */
3911
localtime_0(BIF_ALIST_0)3912 BIF_RETTYPE localtime_0(BIF_ALIST_0)
3913 {
3914 int year, month, day;
3915 int hour, minute, second;
3916 Eterm res1, res2;
3917 Eterm* hp;
3918
3919 /* read the clock */
3920 get_localtime(&year, &month, &day, &hour, &minute, &second);
3921
3922 hp = HAlloc(BIF_P, 4+4+3);
3923
3924 /* and return the tuple */
3925 res1 = TUPLE3(hp,make_small(year),make_small(month),make_small(day));
3926 hp += 4;
3927 res2 = TUPLE3(hp,make_small(hour),make_small(minute),make_small(second));
3928 hp += 4;
3929 BIF_RET(TUPLE2(hp, res1, res2));
3930 }
3931 /**********************************************************************/
3932
3933 /* type check and extract components from a tuple on form: {{Y,M,D},{H,M,S}} */
3934 static int
time_to_parts(Eterm date,Sint * year,Sint * month,Sint * day,Sint * hour,Sint * minute,Sint * second)3935 time_to_parts(Eterm date, Sint* year, Sint* month, Sint* day,
3936 Sint* hour, Sint* minute, Sint* second)
3937 {
3938 Eterm* t1;
3939 Eterm* t2;
3940
3941 if (is_not_tuple(date)) {
3942 return 0;
3943 }
3944 t1 = tuple_val(date);
3945 if (arityval(t1[0]) !=2 ||
3946 is_not_tuple(t1[1]) || is_not_tuple(t1[2]))
3947 return 0;
3948 t2 = tuple_val(t1[1]);
3949 t1 = tuple_val(t1[2]);
3950 if (arityval(t2[0]) != 3 ||
3951 is_not_small(t2[1]) || is_not_small(t2[2]) || is_not_small(t2[3]))
3952 return 0;
3953 *year = signed_val(t2[1]);
3954 *month = signed_val(t2[2]);
3955 *day = signed_val(t2[3]);
3956 if (arityval(t1[0]) != 3 ||
3957 is_not_small(t1[1]) || is_not_small(t1[2]) || is_not_small(t1[3]))
3958 return 0;
3959 *hour = signed_val(t1[1]);
3960 *minute = signed_val(t1[2]);
3961 *second = signed_val(t1[3]);
3962 return 1;
3963 }
3964
3965
3966 /* return the universal time */
3967
3968 BIF_RETTYPE
localtime_to_universaltime_2(BIF_ALIST_2)3969 localtime_to_universaltime_2(BIF_ALIST_2)
3970 {
3971 Process *p = BIF_P;
3972 Eterm localtime = BIF_ARG_1;
3973 Eterm dst = BIF_ARG_2;
3974 Sint year, month, day;
3975 Sint hour, minute, second;
3976 int isdst;
3977 Eterm res1, res2;
3978 Eterm* hp;
3979
3980 if (dst == am_true) isdst = 1;
3981 else if (dst == am_false) isdst = 0;
3982 else if (dst == am_undefined) isdst = -1;
3983 else goto error;
3984
3985 if (!time_to_parts(localtime, &year, &month, &day,
3986 &hour, &minute, &second)) goto error;
3987 if (!local_to_univ(&year, &month, &day,
3988 &hour, &minute, &second, isdst)) goto error;
3989
3990 hp = HAlloc(p, 4+4+3);
3991 res1 = TUPLE3(hp,make_small(year),make_small(month),
3992 make_small(day));
3993 hp += 4;
3994 res2 = TUPLE3(hp,make_small(hour),make_small(minute),
3995 make_small(second));
3996 hp += 4;
3997 BIF_RET(TUPLE2(hp, res1, res2));
3998 error:
3999 BIF_ERROR(p, BADARG);
4000 }
4001
4002
4003 /**********************************************************************/
4004
4005 /* return the universal time */
4006
universaltime_to_localtime_1(BIF_ALIST_1)4007 BIF_RETTYPE universaltime_to_localtime_1(BIF_ALIST_1)
4008 {
4009 Sint year, month, day;
4010 Sint hour, minute, second;
4011 Eterm res1, res2;
4012 Eterm* hp;
4013
4014 if (!time_to_parts(BIF_ARG_1, &year, &month, &day,
4015 &hour, &minute, &second))
4016 BIF_ERROR(BIF_P, BADARG);
4017 if (!univ_to_local(&year, &month, &day,
4018 &hour, &minute, &second))
4019 BIF_ERROR(BIF_P, BADARG);
4020
4021 hp = HAlloc(BIF_P, 4+4+3);
4022 res1 = TUPLE3(hp,make_small(year),make_small(month),
4023 make_small(day));
4024 hp += 4;
4025 res2 = TUPLE3(hp,make_small(hour),make_small(minute),
4026 make_small(second));
4027 hp += 4;
4028 BIF_RET(TUPLE2(hp, res1, res2));
4029 }
4030
4031 /* convert calendar:universaltime_to_seconds/1 */
4032
universaltime_to_posixtime_1(BIF_ALIST_1)4033 BIF_RETTYPE universaltime_to_posixtime_1(BIF_ALIST_1)
4034 {
4035 Sint year, month, day;
4036 Sint hour, minute, second;
4037
4038 Sint64 seconds = 0;
4039 Eterm *hp;
4040 Uint hsz = 0;
4041
4042 if (!time_to_parts(BIF_ARG_1, &year, &month, &day,
4043 &hour, &minute, &second))
4044 BIF_ERROR(BIF_P, BADARG);
4045
4046 if (!univ_to_seconds(year, month, day, hour, minute, second, &seconds)) {
4047 BIF_ERROR(BIF_P, BADARG);
4048 }
4049
4050 erts_bld_sint64(NULL, &hsz, seconds);
4051 hp = HAlloc(BIF_P, hsz);
4052 BIF_RET(erts_bld_sint64(&hp, NULL, seconds));
4053 }
4054
4055 /* convert calendar:seconds_to_universaltime/1 */
4056
posixtime_to_universaltime_1(BIF_ALIST_1)4057 BIF_RETTYPE posixtime_to_universaltime_1(BIF_ALIST_1)
4058 {
4059 Sint year, month, day;
4060 Sint hour, minute, second;
4061 Eterm res1, res2;
4062 Eterm* hp;
4063
4064 Sint64 time = 0;
4065
4066 if (!term_to_Sint64(BIF_ARG_1, &time)) {
4067 BIF_ERROR(BIF_P, BADARG);
4068 }
4069
4070 if (!seconds_to_univ(time, &year, &month, &day,
4071 &hour, &minute, &second)) {
4072 BIF_ERROR(BIF_P, BADARG);
4073 }
4074
4075 hp = HAlloc(BIF_P, 4+4+3);
4076 res1 = TUPLE3(hp,make_small(year),make_small(month),
4077 make_small(day));
4078 hp += 4;
4079 res2 = TUPLE3(hp,make_small(hour),make_small(minute),
4080 make_small(second));
4081 hp += 4;
4082 BIF_RET(TUPLE2(hp, res1, res2));
4083 }
4084
4085
4086 /**********************************************************************/
4087
4088
4089 /* return a timestamp */
now_0(BIF_ALIST_0)4090 BIF_RETTYPE now_0(BIF_ALIST_0)
4091 {
4092 Uint megasec, sec, microsec;
4093 Eterm* hp;
4094
4095 get_now(&megasec, &sec, µsec);
4096 hp = HAlloc(BIF_P, 4);
4097 BIF_RET(TUPLE3(hp, make_small(megasec), make_small(sec),
4098 make_small(microsec)));
4099 }
4100
4101 /**********************************************************************/
4102
4103 /*
4104 * Pass atom 'minor' for relaxed generational GC run. This is only
4105 * recommendation, major run may still be chosen by VM.
4106 * Pass atom 'major' for default behaviour - major GC run (fullsweep)
4107 */
4108 BIF_RETTYPE
erts_internal_garbage_collect_1(BIF_ALIST_1)4109 erts_internal_garbage_collect_1(BIF_ALIST_1)
4110 {
4111 switch (BIF_ARG_1) {
4112 case am_minor: break;
4113 case am_major: FLAGS(BIF_P) |= F_NEED_FULLSWEEP; break;
4114 default: BIF_ERROR(BIF_P, BADARG);
4115 }
4116 erts_garbage_collect(BIF_P, 0, NULL, 0);
4117 if (ERTS_PROC_IS_EXITING(BIF_P)) {
4118 /* The max heap size limit was reached. */
4119 return THE_NON_VALUE;
4120 }
4121 return am_true;
4122 }
4123
4124 /**********************************************************************/
4125 /*
4126 * The erlang:processes/0 BIF.
4127 */
4128
processes_0(BIF_ALIST_0)4129 BIF_RETTYPE processes_0(BIF_ALIST_0)
4130 {
4131 return erts_ptab_list(BIF_P, &erts_proc);
4132 }
4133
4134 /**********************************************************************/
4135 /*
4136 * The erlang:ports/0 BIF.
4137 */
4138
ports_0(BIF_ALIST_0)4139 BIF_RETTYPE ports_0(BIF_ALIST_0)
4140 {
4141 return erts_ptab_list(BIF_P, &erts_port);
4142 }
4143
4144 /**********************************************************************/
4145
throw_1(BIF_ALIST_1)4146 BIF_RETTYPE throw_1(BIF_ALIST_1)
4147 {
4148 BIF_P->fvalue = BIF_ARG_1;
4149 BIF_ERROR(BIF_P, EXC_THROWN);
4150 }
4151
4152 /**********************************************************************/
4153
4154 /*
4155 * Non-standard, undocumented, dirty BIF, meant for debugging.
4156 *
4157 */
display_1(BIF_ALIST_1)4158 BIF_RETTYPE display_1(BIF_ALIST_1)
4159 {
4160 erts_printf("%.*T\n", INT_MAX, BIF_ARG_1);
4161 BIF_RET(am_true);
4162 }
4163
4164 /*
4165 * erts_debug:display/1 is for debugging erlang:display/1
4166 */
erts_debug_display_1(BIF_ALIST_1)4167 BIF_RETTYPE erts_debug_display_1(BIF_ALIST_1)
4168 {
4169 int pres;
4170 Eterm res;
4171 Eterm *hp;
4172 erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(64);
4173 pres = erts_dsprintf(dsbufp, "%.*T\n", INT_MAX, BIF_ARG_1);
4174 if (pres < 0)
4175 erts_exit(ERTS_ERROR_EXIT, "Failed to convert term to string: %d (%s)\n",
4176 -pres, erl_errno_id(-pres));
4177 hp = HAlloc(BIF_P, 2*dsbufp->str_len); /* we need length * 2 heap words */
4178 res = buf_to_intlist(&hp, dsbufp->str, dsbufp->str_len, NIL);
4179 erts_printf("%s", dsbufp->str);
4180 erts_destroy_tmp_dsbuf(dsbufp);
4181 BIF_RET(res);
4182 }
4183
4184
display_string_1(BIF_ALIST_1)4185 BIF_RETTYPE display_string_1(BIF_ALIST_1)
4186 {
4187 Process* p = BIF_P;
4188 Eterm string = BIF_ARG_1;
4189 Sint len = erts_unicode_list_to_buf_len(string);
4190 Sint written;
4191 byte *str;
4192 int res;
4193
4194 if (len < 0) {
4195 BIF_ERROR(p, BADARG);
4196 }
4197 str = (byte *) erts_alloc(ERTS_ALC_T_TMP, sizeof(char)*(len + 1));
4198 res = erts_unicode_list_to_buf(string, str, len, &written);
4199 if (res != 0 || written != len)
4200 erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error (%d)\n", __FILE__, __LINE__, res);
4201 str[len] = '\0';
4202 erts_fprintf(stderr, "%s", str);
4203 erts_free(ERTS_ALC_T_TMP, (void *) str);
4204 BIF_RET(am_true);
4205 }
4206
display_nl_0(BIF_ALIST_0)4207 BIF_RETTYPE display_nl_0(BIF_ALIST_0)
4208 {
4209 erts_fprintf(stderr, "\n");
4210 BIF_RET(am_true);
4211 }
4212
4213 /**********************************************************************/
4214
4215
4216 /* stop the system with exit code and flags */
4217 #if defined(BEAMASM) && defined(BEAMASM_DUMP_SIZES)
4218 void beamasm_dump_sizes(void);
4219 #endif
4220
halt_2(BIF_ALIST_2)4221 BIF_RETTYPE halt_2(BIF_ALIST_2)
4222 {
4223 Uint code;
4224 Eterm optlist = BIF_ARG_2;
4225 int flush = 1;
4226
4227 for (optlist = BIF_ARG_2;
4228 is_list(optlist);
4229 optlist = CDR(list_val(optlist))) {
4230 Eterm *tp, opt = CAR(list_val(optlist));
4231 if (is_not_tuple(opt))
4232 goto bad_options;
4233 tp = tuple_val(opt);
4234 if (tp[0] != make_arityval(2))
4235 goto bad_options;
4236 if (tp[1] == am_flush) {
4237 if (tp[2] == am_true)
4238 flush = 1;
4239 else if (tp[2] == am_false)
4240 flush = 0;
4241 else
4242 goto bad_options;
4243 }
4244 else
4245 goto bad_options;
4246 }
4247 if (is_not_nil(optlist))
4248 goto bad_options;
4249
4250 #if defined(BEAMASM) && defined(BEAMASM_DUMP_SIZES)
4251 beamasm_dump_sizes();
4252 #endif
4253
4254 if (term_to_Uint_mask(BIF_ARG_1, &code)) {
4255 int pos_int_code = (int) (code & INT_MAX);
4256 VERBOSE(DEBUG_SYSTEM,
4257 ("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
4258 if (flush) {
4259 erts_halt(pos_int_code);
4260 ERTS_BIF_YIELD2(BIF_TRAP_EXPORT(BIF_halt_2), BIF_P, am_undefined, am_undefined);
4261 }
4262 else {
4263 erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
4264 erts_exit(pos_int_code, "");
4265 }
4266 }
4267 else if (ERTS_IS_ATOM_STR("abort", BIF_ARG_1)) {
4268 VERBOSE(DEBUG_SYSTEM,
4269 ("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
4270 erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
4271 erts_exit(ERTS_ABORT_EXIT, "");
4272 }
4273 else if (is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) {
4274 # define HALT_MSG_SIZE 200
4275 static byte halt_msg[4*HALT_MSG_SIZE+1];
4276 Sint written;
4277
4278 if (erts_unicode_list_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE,
4279 &written) == -1 ) {
4280 goto error;
4281 }
4282 ASSERT(written >= 0 && written < sizeof(halt_msg));
4283 halt_msg[written] = '\0';
4284 VERBOSE(DEBUG_SYSTEM,
4285 ("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
4286 erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
4287 erts_exit(ERTS_DUMP_EXIT, "%s\n", halt_msg);
4288 }
4289 else
4290 goto error;
4291 return NIL; /* Pedantic (lint does not know about erts_exit) */
4292
4293 error:
4294 BIF_ERROR(BIF_P, BADARG);
4295
4296 bad_options:
4297 BIF_P->fvalue = am_badopt;
4298 BIF_ERROR(BIF_P, BADARG | EXF_HAS_EXT_INFO);
4299 }
4300
4301 /**********************************************************************/
4302
function_exported_3(BIF_ALIST_3)4303 BIF_RETTYPE function_exported_3(BIF_ALIST_3)
4304 {
4305 int arity;
4306 if (is_not_atom(BIF_ARG_1) ||
4307 is_not_atom(BIF_ARG_2) ||
4308 is_not_small(BIF_ARG_3)) {
4309 BIF_ERROR(BIF_P, BADARG);
4310 }
4311 arity = signed_val(BIF_ARG_3);
4312 if (erts_find_function(BIF_ARG_1, BIF_ARG_2, arity,
4313 erts_active_code_ix()) != NULL ||
4314 erts_is_builtin(BIF_ARG_1, BIF_ARG_2, arity)) {
4315 BIF_RET(am_true);
4316 }
4317 BIF_RET(am_false);
4318 }
4319
4320 /**********************************************************************/
4321
is_builtin_3(BIF_ALIST_3)4322 BIF_RETTYPE is_builtin_3(BIF_ALIST_3)
4323 {
4324 Process* p = BIF_P;
4325 Eterm Mod = BIF_ARG_1;
4326 Eterm Name = BIF_ARG_2;
4327 Eterm Arity = BIF_ARG_3;
4328
4329 if (is_not_atom(Mod) || is_not_atom(Name) || is_not_small(Arity)) {
4330 BIF_ERROR(p, BADARG);
4331 }
4332 BIF_RET(erts_is_builtin(Mod, Name, signed_val(Arity)) ?
4333 am_true : am_false);
4334 }
4335
4336 /**********************************************************************/
4337
4338 /* NOTE: Cannot be used in all *_to_list() bifs. erts_dsprintf() prints
4339 * some terms on other formats than what is desired as results
4340 * from *_to_list() bifs.
4341 */
4342
4343 static Eterm
term2list_dsprintf(Process * p,Eterm term)4344 term2list_dsprintf(Process *p, Eterm term)
4345 {
4346 int pres;
4347 Eterm res;
4348 Eterm *hp;
4349 erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(64);
4350 pres = erts_dsprintf(dsbufp, "%T", term);
4351 if (pres < 0)
4352 erts_exit(ERTS_ERROR_EXIT, "Failed to convert term to list: %d (%s)\n",
4353 -pres, erl_errno_id(-pres));
4354 hp = HAlloc(p, 2*dsbufp->str_len); /* we need length * 2 heap words */
4355 res = buf_to_intlist(&hp, dsbufp->str, dsbufp->str_len, NIL);
4356 erts_destroy_tmp_dsbuf(dsbufp);
4357 return res;
4358 }
4359
ref_to_list_1(BIF_ALIST_1)4360 BIF_RETTYPE ref_to_list_1(BIF_ALIST_1)
4361 {
4362 if (is_not_ref(BIF_ARG_1))
4363 BIF_ERROR(BIF_P, BADARG);
4364 erts_magic_ref_save_bin(BIF_ARG_1);
4365 BIF_RET(term2list_dsprintf(BIF_P, BIF_ARG_1));
4366 }
4367
make_fun_3(BIF_ALIST_3)4368 BIF_RETTYPE make_fun_3(BIF_ALIST_3)
4369 {
4370 Eterm* hp;
4371 Sint arity;
4372
4373 if (is_not_atom(BIF_ARG_1) || is_not_atom(BIF_ARG_2) || is_not_small(BIF_ARG_3)) {
4374 error:
4375 BIF_ERROR(BIF_P, BADARG);
4376 }
4377 arity = signed_val(BIF_ARG_3);
4378 if (arity < 0) {
4379 goto error;
4380 }
4381 hp = HAlloc(BIF_P, 2);
4382 hp[0] = HEADER_EXPORT;
4383 hp[1] = (Eterm) erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity);
4384 BIF_RET(make_export(hp));
4385 }
4386
fun_to_list_1(BIF_ALIST_1)4387 BIF_RETTYPE fun_to_list_1(BIF_ALIST_1)
4388 {
4389 Process* p = BIF_P;
4390 Eterm fun = BIF_ARG_1;
4391
4392 if (is_not_any_fun(fun))
4393 BIF_ERROR(p, BADARG);
4394 BIF_RET(term2list_dsprintf(p, fun));
4395 }
4396
4397 /**********************************************************************/
4398
4399 /* convert a pid to an erlang list (for the linked cons cells) of the form
4400 <node.number.serial> to a PID
4401 */
4402
pid_to_list_1(BIF_ALIST_1)4403 BIF_RETTYPE pid_to_list_1(BIF_ALIST_1)
4404 {
4405 if (is_not_pid(BIF_ARG_1))
4406 BIF_ERROR(BIF_P, BADARG);
4407 BIF_RET(term2list_dsprintf(BIF_P, BIF_ARG_1));
4408 }
4409
port_to_list_1(BIF_ALIST_1)4410 BIF_RETTYPE port_to_list_1(BIF_ALIST_1)
4411 {
4412 if (is_not_port(BIF_ARG_1))
4413 BIF_ERROR(BIF_P, BADARG);
4414 BIF_RET(term2list_dsprintf(BIF_P, BIF_ARG_1));
4415 }
4416
4417 /**********************************************************************/
4418
4419 /* convert a list of ascii characeters of the form
4420 <node.number.serial> to a PID
4421 */
4422
list_to_pid_1(BIF_ALIST_1)4423 BIF_RETTYPE list_to_pid_1(BIF_ALIST_1)
4424 {
4425 Uint a = 0, b = 0, c = 0;
4426 char* cp;
4427 Sint i;
4428 DistEntry *dep = NULL;
4429 char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, 65);
4430 /*
4431 * Max 'Uint64' has 20 decimal digits. If X, Y, Z in <X.Y.Z>
4432 * are 'Uint64's. Max chars are 1 + 20 + 1 + 20 + 1 + 20 + 1 = 64,
4433 * i.e, if the input list is longer than 64 it does not represent
4434 * a pid.
4435 */
4436
4437 /* walk down the list and create a C string */
4438 if ((i = intlist_to_buf(BIF_ARG_1, buf, 64)) < 0)
4439 goto bad;
4440
4441 buf[i] = '\0'; /* null terminal */
4442
4443 cp = buf;
4444 if (*cp++ != '<') goto bad;
4445
4446 if (*cp < '0' || *cp > '9') goto bad;
4447 while(*cp >= '0' && *cp <= '9') { a = 10*a + (*cp - '0'); cp++; }
4448
4449 if (*cp++ != '.') goto bad;
4450
4451 if (*cp < '0' || *cp > '9') goto bad;
4452 while(*cp >= '0' && *cp <= '9') { b = 10*b + (*cp - '0'); cp++; }
4453
4454 if (*cp++ != '.') goto bad;
4455
4456 if (*cp < '0' || *cp > '9') goto bad;
4457 while(*cp >= '0' && *cp <= '9') { c = 10*c + (*cp - '0'); cp++; }
4458
4459 if (*cp++ != '>') goto bad;
4460 if (*cp != '\0') goto bad;
4461
4462 erts_free(ERTS_ALC_T_TMP, (void *) buf);
4463 buf = NULL;
4464
4465 /* <a.b.c> a = node, b = process number, c = serial */
4466
4467 dep = erts_channel_no_to_dist_entry(a);
4468
4469 if (!dep)
4470 goto bad;
4471
4472 if(dep == erts_this_dist_entry) {
4473 if (c > ERTS_MAX_INTERNAL_PID_SERIAL || b > ERTS_MAX_INTERNAL_PID_NUMBER)
4474 goto bad;
4475 BIF_RET(make_internal_pid(make_pid_data(c, b)));
4476 }
4477 else {
4478 ExternalThing *etp;
4479 ErlNode *enp;
4480
4481 if (is_nil(dep->cid))
4482 goto bad;
4483
4484 etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_PID_HEAP_SIZE);
4485
4486 enp = erts_find_or_insert_node(dep->sysname, dep->creation,
4487 make_boxed(&etp->header));
4488 ASSERT(enp != erts_this_node);
4489
4490 etp->header = make_external_pid_header();
4491 etp->next = MSO(BIF_P).first;
4492 etp->node = enp;
4493 etp->data.pid.num = b;
4494 etp->data.pid.ser = c;
4495
4496 MSO(BIF_P).first = (struct erl_off_heap_header*) etp;
4497 BIF_RET(make_external_pid(etp));
4498 }
4499
4500 bad:
4501 if (buf)
4502 erts_free(ERTS_ALC_T_TMP, (void *) buf);
4503 BIF_ERROR(BIF_P, BADARG);
4504 }
4505
list_to_port_1(BIF_ALIST_1)4506 BIF_RETTYPE list_to_port_1(BIF_ALIST_1)
4507 {
4508 /*
4509 * A valid port identifier is on the format
4510 * "#Port<Node.Num>" where Node is node and Num is
4511 * the port id.
4512 */
4513 Uint32 node;
4514 Uint64 num;
4515 char c, *cp;
4516 int i;
4517 DistEntry *dep = NULL;
4518 char buf[6 /* #Port< */
4519 + 11 /* Node. */
4520 + 21 /* Num> */
4521 + 1 /* \0 */];
4522
4523 /* walk down the list and create a C string */
4524 if ((i = intlist_to_buf(BIF_ARG_1, buf, sizeof(buf)-1)) < 0)
4525 goto bad;
4526
4527 buf[i] = '\0'; /* null terminal */
4528
4529 cp = &buf[0];
4530 if (sys_strncmp("#Port<", cp, 6) != 0)
4531 goto bad;
4532
4533 cp += 6; /* sys_strlen("#Port<") */
4534
4535 node = 0;
4536 c = *cp;
4537 if (!('0' <= c && c <= '9'))
4538 goto bad;
4539 do {
4540 node *= 10;
4541 node += (Uint32) (c - '0');
4542 c = *(++cp);
4543 } while ('0' <= c && c <= '9');
4544
4545 if (*(cp++) != '.')
4546 goto bad;
4547
4548 c = *cp;
4549 num = 0;
4550 if (!('0' <= c && c <= '9'))
4551 goto bad;
4552 do {
4553 num *= 10;
4554 num += (Uint64) (c - '0');
4555 c = *(++cp);
4556 } while ('0' <= c && c <= '9');
4557
4558 if (*(cp++) != '>')
4559 goto bad;
4560 if (*cp != '\0')
4561 goto bad;
4562
4563 dep = erts_channel_no_to_dist_entry(node);
4564
4565 if (!dep)
4566 goto bad;
4567
4568 if(dep == erts_this_dist_entry) {
4569 if (num > ERTS_MAX_INTERNAL_PORT_NUMBER)
4570 goto bad;
4571 BIF_RET(make_internal_port(num));
4572 }
4573 else {
4574 ExternalThing *etp;
4575 ErlNode *enp;
4576
4577 if (is_nil(dep->cid))
4578 goto bad;
4579
4580 etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_PORT_HEAP_SIZE);
4581 enp = erts_find_or_insert_node(dep->sysname, dep->creation,
4582 make_boxed(&etp->header));
4583 ASSERT(enp != erts_this_node);
4584
4585 etp->header = make_external_port_header();
4586 etp->next = MSO(BIF_P).first;
4587 etp->node = enp;
4588 #ifdef ARCH_64
4589 etp->data.port.id = num;
4590 #else
4591 etp->data.port.low = (Uint32) (num & 0xffffffff);
4592 etp->data.port.high = (Uint32) ((num >> 32) & 0xffffffff);
4593 #endif
4594
4595 MSO(BIF_P).first = (struct erl_off_heap_header*) etp;
4596 BIF_RET(make_external_port(etp));
4597 }
4598
4599 bad:
4600 BIF_ERROR(BIF_P, BADARG);
4601 }
4602
list_to_ref_1(BIF_ALIST_1)4603 BIF_RETTYPE list_to_ref_1(BIF_ALIST_1)
4604 {
4605 /*
4606 * A valid reference is on the format
4607 * "#Ref<N.X.Y.Z>" where N, X, Y, and Z are
4608 * 32-bit integers (i.e., max 10 characters).
4609 */
4610 Eterm *hp;
4611 Eterm res;
4612 Uint32 refn[ERTS_MAX_REF_NUMBERS];
4613 int n = 0;
4614 Uint ints[1 + ERTS_MAX_REF_NUMBERS] = {0};
4615 char* cp;
4616 Sint i;
4617 DistEntry *dep = NULL;
4618 char buf[5 /* #Ref< */
4619 + (1 + ERTS_MAX_REF_NUMBERS)*(10 + 1) /* N.X.Y.Z> */
4620 + 1 /* \0 */];
4621
4622 /* walk down the list and create a C string */
4623 if ((i = intlist_to_buf(BIF_ARG_1, buf, sizeof(buf)-1)) < 0)
4624 goto bad;
4625
4626 buf[i] = '\0'; /* null terminal */
4627
4628 cp = &buf[0];
4629 if (*cp++ != '#') goto bad;
4630 if (*cp++ != 'R') goto bad;
4631 if (*cp++ != 'e') goto bad;
4632 if (*cp++ != 'f') goto bad;
4633 if (*cp++ != '<') goto bad;
4634
4635 for (i = 0; i < sizeof(ints)/sizeof(Uint); i++) {
4636 if (*cp < '0' || *cp > '9') goto bad;
4637
4638 while (*cp >= '0' && *cp <= '9') {
4639 ints[i] = 10*ints[i] + (*cp - '0');
4640 cp++;
4641 }
4642
4643 n++;
4644 if (ints[i] > ~((Uint32) 0)) goto bad;
4645 if (*cp == '>') break;
4646 if (*cp++ != '.') goto bad;
4647 }
4648
4649 if (*cp++ != '>') goto bad;
4650 if (*cp != '\0') goto bad;
4651
4652 if (n < 2) goto bad;
4653
4654 for (n = 0; i > 0; i--)
4655 refn[n++] = (Uint32) ints[i];
4656
4657 ASSERT(n <= ERTS_MAX_REF_NUMBERS);
4658
4659 dep = erts_channel_no_to_dist_entry(ints[0]);
4660
4661 if (!dep)
4662 goto bad;
4663
4664 if(dep == erts_this_dist_entry) {
4665 ErtsMagicBinary *mb;
4666 Uint32 sid;
4667 if (refn[0] >= MAX_REFERENCE) goto bad;
4668 if (n != ERTS_REF_NUMBERS) goto bad;
4669 sid = erts_get_ref_numbers_thr_id(refn);
4670 if (sid > erts_no_schedulers) goto bad;
4671 if (erts_is_ordinary_ref_numbers(refn)) {
4672 make_ordinary_internal_ref:
4673 hp = HAlloc(BIF_P, ERTS_REF_THING_SIZE);
4674 write_ref_thing(hp, refn[0], refn[1], refn[2]);
4675 res = make_internal_ref(hp);
4676 }
4677 else {
4678 /* Check if it is a pid reference... */
4679 Eterm pid = erts_pid_ref_lookup(refn);
4680 if (is_internal_pid(pid)) {
4681 hp = HAlloc(BIF_P, ERTS_PID_REF_THING_SIZE);
4682 write_pid_ref_thing(hp, refn[0], refn[1], refn[2], pid);
4683 res = make_internal_ref(hp);
4684 }
4685 else {
4686 /* Check if it is a magic reference... */
4687 mb = erts_magic_ref_lookup_bin(refn);
4688 if (!mb)
4689 goto make_ordinary_internal_ref;
4690 hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE);
4691 res = erts_mk_magic_ref(&hp, &BIF_P->off_heap,
4692 (Binary *) mb);
4693 }
4694 }
4695 }
4696 else {
4697 ExternalThing *etp;
4698 ErlNode *enp;
4699 Uint hsz;
4700 int j;
4701
4702 if (is_nil(dep->cid))
4703 goto bad;
4704
4705 hsz = EXTERNAL_THING_HEAD_SIZE;
4706 #if defined(ARCH_64)
4707 hsz += n/2 + 1;
4708 #else
4709 hsz += n;
4710 #endif
4711
4712 etp = (ExternalThing *) HAlloc(BIF_P, hsz);
4713
4714 enp = erts_find_or_insert_node(dep->sysname, dep->creation,
4715 make_boxed(&etp->header));
4716 ASSERT(enp != erts_this_node);
4717
4718 #if defined(ARCH_64)
4719 etp->header = make_external_ref_header(n/2 + 1);
4720 #else
4721 etp->header = make_external_ref_header(n);
4722 #endif
4723 etp->next = BIF_P->off_heap.first;
4724 etp->node = enp;
4725 i = 0;
4726 #if defined(ARCH_64)
4727 etp->data.ui32[i++] = n;
4728 #endif
4729 for (j = 0; j < n; j++) {
4730 etp->data.ui32[i] = refn[j];
4731 i++;
4732 }
4733
4734 BIF_P->off_heap.first = (struct erl_off_heap_header*) etp;
4735 res = make_external_ref(etp);
4736 }
4737
4738 BIF_RET(res);
4739
4740 bad:
4741 BIF_ERROR(BIF_P, BADARG);
4742 }
4743
4744
4745 /**********************************************************************/
4746
group_leader_0(BIF_ALIST_0)4747 BIF_RETTYPE group_leader_0(BIF_ALIST_0)
4748 {
4749 BIF_RET(BIF_P->group_leader);
4750 }
4751
4752 /**********************************************************************/
4753 /* set group leader */
4754
4755 int
erts_set_group_leader(Process * proc,Eterm new_gl)4756 erts_set_group_leader(Process *proc, Eterm new_gl)
4757 {
4758
4759 erts_aint32_t state;
4760
4761 ASSERT(is_pid(new_gl));
4762
4763 state = erts_atomic32_read_nob(&proc->state);
4764
4765 if (state & ERTS_PSFLG_EXITING)
4766 return 0;
4767
4768 ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(proc));
4769
4770 if (!(state & ERTS_PSFLG_DIRTY_RUNNING))
4771 proc->group_leader = STORE_NC_IN_PROC(proc, new_gl);
4772 else {
4773 ErlHeapFragment *bp;
4774 Eterm *hp;
4775 /*
4776 * Currently executing on a dirty scheduler,
4777 * so we are not allowed to write to its heap.
4778 * Store group leader pid in heap fragment.
4779 */
4780 bp = new_message_buffer(NC_HEAP_SIZE(new_gl));
4781 hp = bp->mem;
4782 proc->group_leader = STORE_NC(&hp,
4783 &proc->off_heap,
4784 new_gl);
4785 bp->next = proc->mbuf;
4786 proc->mbuf = bp;
4787 proc->mbuf_sz += bp->used_size;
4788 }
4789
4790 return !0;
4791 }
4792
erts_internal_group_leader_3(BIF_ALIST_3)4793 BIF_RETTYPE erts_internal_group_leader_3(BIF_ALIST_3)
4794 {
4795 if (is_not_pid(BIF_ARG_1))
4796 BIF_ERROR(BIF_P, BADARG);
4797 if (is_not_internal_pid(BIF_ARG_2))
4798 BIF_ERROR(BIF_P, BADARG);
4799 if (is_not_internal_ref(BIF_ARG_3))
4800 BIF_ERROR(BIF_P, BADARG);
4801
4802 erts_proc_sig_send_group_leader(BIF_P,
4803 BIF_ARG_2,
4804 BIF_ARG_1,
4805 BIF_ARG_3);
4806 BIF_RET(am_ok);
4807 }
4808
erts_internal_group_leader_2(BIF_ALIST_2)4809 BIF_RETTYPE erts_internal_group_leader_2(BIF_ALIST_2)
4810 {
4811 if (is_not_pid(BIF_ARG_1))
4812 BIF_RET(am_badarg);
4813
4814 if (is_internal_pid(BIF_ARG_2)) {
4815 Process *rp;
4816 int res;
4817
4818 if (BIF_ARG_2 == BIF_P->common.id)
4819 rp = BIF_P;
4820 else {
4821 rp = erts_try_lock_sig_free_proc(BIF_ARG_2,
4822 ERTS_PROC_LOCK_MAIN,
4823 NULL);
4824 if (!rp)
4825 BIF_RET(am_badarg);
4826 if (rp == ERTS_PROC_LOCK_BUSY)
4827 BIF_RET(am_false);
4828 }
4829
4830 res = erts_set_group_leader(rp, BIF_ARG_1);
4831
4832 if (rp != BIF_P)
4833 erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
4834
4835 BIF_RET(res ? am_true : am_badarg);
4836 }
4837
4838 if (is_external_pid(BIF_ARG_2)) {
4839 DistEntry *dep;
4840 int code;
4841 ErtsDSigSendContext ctx;
4842 dep = external_pid_dist_entry(BIF_ARG_2);
4843 ERTS_ASSERT(dep);
4844 if(dep == erts_this_dist_entry)
4845 BIF_ERROR(BIF_P, BADARG);
4846
4847 code = erts_dsig_prepare(&ctx, dep, BIF_P, ERTS_PROC_LOCK_MAIN,
4848 ERTS_DSP_NO_LOCK, 0, 1, 1);
4849 switch (code) {
4850 case ERTS_DSIG_PREP_NOT_ALIVE:
4851 case ERTS_DSIG_PREP_NOT_CONNECTED:
4852 BIF_RET(am_true);
4853 case ERTS_DSIG_PREP_PENDING:
4854 case ERTS_DSIG_PREP_CONNECTED:
4855 code = erts_dsig_send_group_leader(&ctx, BIF_ARG_1, BIF_ARG_2);
4856 if (code == ERTS_DSIG_SEND_YIELD)
4857 ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
4858 BIF_RET(am_true);
4859 default:
4860 ERTS_ASSERT(! "Invalid dsig prepare result");
4861 }
4862 }
4863
4864 BIF_RET(am_badarg);
4865 }
4866
system_flag_2(BIF_ALIST_2)4867 BIF_RETTYPE system_flag_2(BIF_ALIST_2)
4868 {
4869 Sint n;
4870
4871 if (BIF_ARG_1 == am_multi_scheduling) {
4872 if (BIF_ARG_2 == am_block || BIF_ARG_2 == am_unblock
4873 || BIF_ARG_2 == am_block_normal || BIF_ARG_2 == am_unblock_normal) {
4874 int block = (BIF_ARG_2 == am_block
4875 || BIF_ARG_2 == am_block_normal);
4876 int normal = (BIF_ARG_2 == am_block_normal
4877 || BIF_ARG_2 == am_unblock_normal);
4878 switch (erts_block_multi_scheduling(BIF_P,
4879 ERTS_PROC_LOCK_MAIN,
4880 block,
4881 normal,
4882 0)) {
4883 case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED:
4884 BIF_RET(am_blocked);
4885 case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED:
4886 BIF_RET(am_blocked_normal);
4887 case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED:
4888 ERTS_BIF_YIELD_RETURN_X(BIF_P, am_blocked,
4889 am_multi_scheduling);
4890 case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED:
4891 ERTS_BIF_YIELD_RETURN_X(BIF_P, am_blocked_normal,
4892 am_multi_scheduling);
4893 case ERTS_SCHDLR_SSPND_DONE:
4894 BIF_RET(am_enabled);
4895 case ERTS_SCHDLR_SSPND_YIELD_RESTART:
4896 ERTS_VBUMP_ALL_REDS(BIF_P);
4897 BIF_TRAP2(BIF_TRAP_EXPORT(BIF_system_flag_2),
4898 BIF_P, BIF_ARG_1, BIF_ARG_2);
4899 case ERTS_SCHDLR_SSPND_YIELD_DONE:
4900 ERTS_BIF_YIELD_RETURN_X(BIF_P, am_enabled,
4901 am_multi_scheduling);
4902 case ERTS_SCHDLR_SSPND_EINVAL:
4903 goto error;
4904 default:
4905 ASSERT(0);
4906 BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
4907 break;
4908 }
4909 }
4910 } else if (BIF_ARG_1 == am_schedulers_online) {
4911 Sint old_no;
4912 if (!is_small(BIF_ARG_2))
4913 goto error;
4914 switch (erts_set_schedulers_online(BIF_P,
4915 ERTS_PROC_LOCK_MAIN,
4916 signed_val(BIF_ARG_2),
4917 &old_no, 0)) {
4918 case ERTS_SCHDLR_SSPND_DONE:
4919 BIF_RET(make_small(old_no));
4920 case ERTS_SCHDLR_SSPND_YIELD_RESTART:
4921 ERTS_VBUMP_ALL_REDS(BIF_P);
4922 BIF_TRAP2(BIF_TRAP_EXPORT(BIF_system_flag_2),
4923 BIF_P, BIF_ARG_1, BIF_ARG_2);
4924 case ERTS_SCHDLR_SSPND_YIELD_DONE:
4925 ERTS_BIF_YIELD_RETURN_X(BIF_P, make_small(old_no),
4926 am_schedulers_online);
4927 case ERTS_SCHDLR_SSPND_EINVAL:
4928 goto error;
4929 default:
4930 ASSERT(0);
4931 BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
4932 break;
4933 }
4934 } else if (BIF_ARG_1 == am_fullsweep_after) {
4935 Uint16 nval;
4936 Uint oval;
4937 if (!is_small(BIF_ARG_2) || (n = signed_val(BIF_ARG_2)) < 0) {
4938 goto error;
4939 }
4940 nval = (n > (Sint) ((Uint16) -1)) ? ((Uint16) -1) : ((Uint16) n);
4941 oval = (Uint) erts_atomic32_xchg_nob(&erts_max_gen_gcs,
4942 (erts_aint32_t) nval);
4943 BIF_RET(make_small(oval));
4944 } else if (BIF_ARG_1 == am_min_heap_size) {
4945 int oval = H_MIN_SIZE;
4946
4947 if (!is_small(BIF_ARG_2) || (n = signed_val(BIF_ARG_2)) < 0) {
4948 goto error;
4949 }
4950
4951 erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
4952 erts_thr_progress_block();
4953
4954 H_MIN_SIZE = erts_next_heap_size(n, 0);
4955
4956 erts_thr_progress_unblock();
4957 erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
4958
4959 BIF_RET(make_small(oval));
4960 } else if (BIF_ARG_1 == am_min_bin_vheap_size) {
4961 int oval = BIN_VH_MIN_SIZE;
4962
4963 if (!is_small(BIF_ARG_2) || (n = signed_val(BIF_ARG_2)) < 0) {
4964 goto error;
4965 }
4966
4967 erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
4968 erts_thr_progress_block();
4969
4970 BIN_VH_MIN_SIZE = erts_next_heap_size(n, 0);
4971
4972 erts_thr_progress_unblock();
4973 erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
4974
4975 BIF_RET(make_small(oval));
4976 } else if (BIF_ARG_1 == am_max_heap_size) {
4977
4978 Eterm *hp, old_value;
4979 Uint sz = 0, max_heap_size, max_heap_flags;
4980
4981 if (!erts_max_heap_size(BIF_ARG_2, &max_heap_size, &max_heap_flags))
4982 goto error;
4983
4984 if (max_heap_size < H_MIN_SIZE && max_heap_size != 0)
4985 goto error;
4986
4987 erts_max_heap_size_map(H_MAX_SIZE, H_MAX_FLAGS, NULL, &sz);
4988 hp = HAlloc(BIF_P, sz);
4989 old_value = erts_max_heap_size_map(H_MAX_SIZE, H_MAX_FLAGS, &hp, NULL);
4990
4991 erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
4992 erts_thr_progress_block();
4993
4994 H_MAX_SIZE = max_heap_size;
4995 H_MAX_FLAGS = max_heap_flags;
4996
4997 erts_thr_progress_unblock();
4998 erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
4999
5000 BIF_RET(old_value);
5001 } else if (BIF_ARG_1 == am_debug_flags) {
5002 BIF_RET(am_true);
5003 } else if (BIF_ARG_1 == am_backtrace_depth) {
5004 int oval = erts_backtrace_depth;
5005 if (!is_small(BIF_ARG_2) || (n = signed_val(BIF_ARG_2)) < 0) {
5006 goto error;
5007 }
5008 if (n > MAX_BACKTRACE_SIZE) n = MAX_BACKTRACE_SIZE;
5009 erts_backtrace_depth = n;
5010 BIF_RET(make_small(oval));
5011 } else if (BIF_ARG_1 == am_trace_control_word) {
5012 BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_2));
5013 } else if (BIF_ARG_1 == am_sequential_tracer) {
5014 ErtsTracer new_seq_tracer, old_seq_tracer;
5015 Eterm ret;
5016
5017 if (BIF_ARG_2 == am_false)
5018 new_seq_tracer = erts_tracer_nil;
5019 else
5020 new_seq_tracer = erts_term_to_tracer(THE_NON_VALUE, BIF_ARG_2);
5021
5022 if (new_seq_tracer == THE_NON_VALUE)
5023 goto error;
5024
5025 old_seq_tracer = erts_set_system_seq_tracer(BIF_P,
5026 ERTS_PROC_LOCK_MAIN,
5027 new_seq_tracer);
5028
5029 ERTS_TRACER_CLEAR(&new_seq_tracer);
5030
5031 if (old_seq_tracer == THE_NON_VALUE)
5032 goto error;
5033
5034 if (ERTS_TRACER_IS_NIL(old_seq_tracer))
5035 BIF_RET(am_false);
5036
5037 ret = erts_tracer_to_term(BIF_P, old_seq_tracer);
5038
5039 ERTS_TRACER_CLEAR(&old_seq_tracer);
5040
5041 BIF_RET(ret);
5042 } else if (BIF_ARG_1 == am_reset_seq_trace) {
5043 int i, max;
5044
5045 erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
5046 erts_thr_progress_block();
5047
5048 max = erts_ptab_max(&erts_proc);
5049 for (i = 0; i < max; i++) {
5050 Process *p = erts_pix2proc(i);
5051 if (p) {
5052 #ifdef USE_VM_PROBES
5053 p->seq_trace_token = (p->dt_utag != NIL) ? am_have_dt_utag : NIL;
5054 #else
5055 p->seq_trace_token = NIL;
5056 #endif
5057 p->seq_trace_clock = 0;
5058 p->seq_trace_lastcnt = 0;
5059 erts_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ);
5060 erts_proc_sig_clear_seq_trace_tokens(p);
5061 erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ);
5062 }
5063 }
5064
5065 erts_thr_progress_unblock();
5066 erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
5067
5068 BIF_RET(am_true);
5069 } else if (BIF_ARG_1 == am_scheduler_wall_time) {
5070 if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false)
5071 BIF_TRAP1(system_flag_scheduler_wall_time_trap,
5072 BIF_P, BIF_ARG_2);
5073 } else if (BIF_ARG_1 == am_dirty_cpu_schedulers_online) {
5074 Sint old_no;
5075 if (!is_small(BIF_ARG_2))
5076 goto error;
5077 switch (erts_set_schedulers_online(BIF_P,
5078 ERTS_PROC_LOCK_MAIN,
5079 signed_val(BIF_ARG_2),
5080 &old_no,
5081 1)) {
5082 case ERTS_SCHDLR_SSPND_DONE:
5083 BIF_RET(make_small(old_no));
5084 case ERTS_SCHDLR_SSPND_YIELD_RESTART:
5085 ERTS_VBUMP_ALL_REDS(BIF_P);
5086 BIF_TRAP2(BIF_TRAP_EXPORT(BIF_system_flag_2),
5087 BIF_P, BIF_ARG_1, BIF_ARG_2);
5088 case ERTS_SCHDLR_SSPND_YIELD_DONE:
5089 ERTS_BIF_YIELD_RETURN_X(BIF_P, make_small(old_no),
5090 am_dirty_cpu_schedulers_online);
5091 case ERTS_SCHDLR_SSPND_EINVAL:
5092 goto error;
5093 default:
5094 ASSERT(0);
5095 BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
5096 break;
5097 }
5098 } else if (BIF_ARG_1 == am_time_offset
5099 && ERTS_IS_ATOM_STR("finalize", BIF_ARG_2)) {
5100 ErtsTimeOffsetState res;
5101 erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
5102 res = erts_finalize_time_offset();
5103 erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
5104 switch (res) {
5105 case ERTS_TIME_OFFSET_PRELIMINARY: {
5106 DECL_AM(preliminary);
5107 BIF_RET(AM_preliminary);
5108 }
5109 case ERTS_TIME_OFFSET_FINAL: {
5110 DECL_AM(final);
5111 BIF_RET(AM_final);
5112 }
5113 case ERTS_TIME_OFFSET_VOLATILE: {
5114 DECL_AM(volatile);
5115 BIF_RET(AM_volatile);
5116 }
5117 default:
5118 ERTS_INTERNAL_ERROR("Unknown state");
5119 }
5120 #ifdef ERTS_ENABLE_MSACC
5121 } else if (BIF_ARG_1 == am_microstate_accounting) {
5122 Eterm threads;
5123 if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) {
5124 erts_aint32_t new = BIF_ARG_2 == am_true ? ERTS_MSACC_ENABLE : ERTS_MSACC_DISABLE;
5125 erts_aint32_t old = erts_atomic32_xchg_nob(&msacc, new);
5126 Eterm ref = erts_msacc_request(BIF_P, new, &threads);
5127 if (is_non_value(ref))
5128 BIF_RET(old ? am_true : am_false);
5129 BIF_TRAP3(await_msacc_mod_trap,
5130 BIF_P,
5131 ref,
5132 old ? am_true : am_false,
5133 threads);
5134 } else if (BIF_ARG_2 == am_reset) {
5135 Eterm ref = erts_msacc_request(BIF_P, ERTS_MSACC_RESET, &threads);
5136 erts_aint32_t old = erts_atomic32_read_nob(&msacc);
5137 ASSERT(is_value(ref));
5138 BIF_TRAP3(await_msacc_mod_trap,
5139 BIF_P,
5140 ref,
5141 old ? am_true : am_false,
5142 threads);
5143 }
5144 #endif
5145 } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) {
5146 int what;
5147 if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2))
5148 what = ERTS_SCHED_STAT_MODIFY_DISABLE;
5149 else if (ERTS_IS_ATOM_STR("enable", BIF_ARG_2))
5150 what = ERTS_SCHED_STAT_MODIFY_ENABLE;
5151 else if (ERTS_IS_ATOM_STR("clear", BIF_ARG_2))
5152 what = ERTS_SCHED_STAT_MODIFY_CLEAR;
5153 else
5154 goto error;
5155 erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
5156 erts_sched_stat_modify(what);
5157 erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
5158 BIF_RET(am_true);
5159 } else if (ERTS_IS_ATOM_STR("internal_cpu_topology", BIF_ARG_1)) {
5160 Eterm res = erts_set_cpu_topology(BIF_P, BIF_ARG_2);
5161 if (is_value(res))
5162 BIF_RET(res);
5163 } else if (ERTS_IS_ATOM_STR("cpu_topology", BIF_ARG_1)) {
5164 erts_send_warning_to_logger_str(
5165 BIF_P->group_leader,
5166 "A call to erlang:system_flag(cpu_topology, _) was made.\n"
5167 "The cpu_topology argument is deprecated and scheduled\n"
5168 "for removal in Erlang/OTP 18. For more information\n"
5169 "see the erlang:system_flag/2 documentation.\n");
5170 BIF_TRAP1(set_cpu_topology_trap, BIF_P, BIF_ARG_2);
5171 } else if (ERTS_IS_ATOM_STR("scheduler_bind_type", BIF_ARG_1)) {
5172 erts_send_warning_to_logger_str(
5173 BIF_P->group_leader,
5174 "A call to erlang:system_flag(scheduler_bind_type, _) was\n"
5175 "made. The scheduler_bind_type argument is deprecated and\n"
5176 "scheduled for removal in Erlang/OTP 18. For more\n"
5177 "information see the erlang:system_flag/2 documentation.\n");
5178 return erts_bind_schedulers(BIF_P, BIF_ARG_2);
5179 } else if (ERTS_IS_ATOM_STR("erts_alloc", BIF_ARG_1)) {
5180 return erts_alloc_set_dyn_param(BIF_P, BIF_ARG_2);
5181 } else if (ERTS_IS_ATOM_STR("system_logger", BIF_ARG_1)) {
5182 Eterm res = erts_set_system_logger(BIF_ARG_2);
5183 if (is_value(res)) BIF_RET(res);
5184 } else {
5185 BIF_P->fvalue = am_badopt;
5186 BIF_ERROR(BIF_P, BADARG | EXF_HAS_EXT_INFO);
5187 }
5188
5189 error:
5190 BIF_ERROR(BIF_P, BADARG);
5191 }
5192
erts_internal_scheduler_wall_time_1(BIF_ALIST_1)5193 BIF_RETTYPE erts_internal_scheduler_wall_time_1(BIF_ALIST_1)
5194 {
5195 erts_aint32_t new = BIF_ARG_1 == am_true ? 1 : 0;
5196 erts_aint32_t old = erts_atomic32_xchg_nob(&sched_wall_time,
5197 new);
5198 Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new, 0, 0);
5199 ASSERT(is_value(ref));
5200 BIF_TRAP2(await_sched_wall_time_mod_trap,
5201 BIF_P, ref, old ? am_true : am_false);
5202 }
5203
5204 /**********************************************************************/
5205
phash_2(BIF_ALIST_2)5206 BIF_RETTYPE phash_2(BIF_ALIST_2)
5207 {
5208 Uint32 hash;
5209 Uint32 final_hash;
5210 Uint32 range;
5211
5212 /* Check for special case 2^32 */
5213 if (term_equals_2pow32(BIF_ARG_2)) {
5214 range = 0;
5215 } else {
5216 Uint u;
5217 if (!term_to_Uint(BIF_ARG_2, &u) || ((u >> 16) >> 16) != 0 || !u) {
5218 BIF_ERROR(BIF_P, BADARG);
5219 }
5220 range = (Uint32) u;
5221 }
5222 hash = make_hash(BIF_ARG_1);
5223 if (range) {
5224 final_hash = 1 + (hash % range); /* [1..range] */
5225 } else if ((final_hash = hash + 1) == 0) {
5226 /*
5227 * XXX In this case, there will still be a ArithAlloc() in erts_mixed_plus().
5228 */
5229 BIF_RET(erts_mixed_plus(BIF_P,
5230 erts_make_integer(hash, BIF_P),
5231 make_small(1)));
5232 }
5233
5234 BIF_RET(erts_make_integer(final_hash, BIF_P));
5235 }
5236
phash2_1(BIF_ALIST_1)5237 BIF_RETTYPE phash2_1(BIF_ALIST_1)
5238 {
5239 Uint32 hash;
5240 Eterm trap_state = THE_NON_VALUE;
5241 hash = trapping_make_hash2(BIF_ARG_1, &trap_state, BIF_P);
5242 if (trap_state == THE_NON_VALUE) {
5243 BIF_RET(make_small(hash & ((1L << 27) - 1)));
5244 } else {
5245 BIF_TRAP1(BIF_TRAP_EXPORT(BIF_phash2_1), BIF_P, trap_state);
5246 }
5247 }
5248
phash2_2(BIF_ALIST_2)5249 BIF_RETTYPE phash2_2(BIF_ALIST_2)
5250 {
5251 Uint32 hash;
5252 Uint32 final_hash;
5253 Uint32 range;
5254 Eterm trap_state = THE_NON_VALUE;
5255
5256 /* Check for special case 2^32 */
5257 if (term_equals_2pow32(BIF_ARG_2)) {
5258 range = 0;
5259 } else {
5260 Uint u;
5261 if (!term_to_Uint(BIF_ARG_2, &u) || ((u >> 16) >> 16) != 0 || !u) {
5262 BIF_ERROR(BIF_P, BADARG);
5263 }
5264 range = (Uint32) u;
5265 }
5266 hash = trapping_make_hash2(BIF_ARG_1, &trap_state, BIF_P);
5267 if (trap_state != THE_NON_VALUE) {
5268 BIF_TRAP2(BIF_TRAP_EXPORT(BIF_phash2_2), BIF_P, trap_state, BIF_ARG_2);
5269 }
5270 if (range) {
5271 final_hash = hash % range; /* [0..range-1] */
5272 } else {
5273 final_hash = hash;
5274 }
5275 /*
5276 * Return either a small or a big. Use the heap for bigs if there is room.
5277 */
5278 #if defined(ARCH_64)
5279 BIF_RET(make_small(final_hash));
5280 #else
5281 if (IS_USMALL(0, final_hash)) {
5282 BIF_RET(make_small(final_hash));
5283 } else {
5284 Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
5285 BIF_RET(uint_to_big(final_hash, hp));
5286 }
5287 #endif
5288 }
5289
bump_reductions_1(BIF_ALIST_1)5290 BIF_RETTYPE bump_reductions_1(BIF_ALIST_1)
5291 {
5292 Sint reds;
5293
5294 if (is_not_small(BIF_ARG_1) || ((reds = signed_val(BIF_ARG_1)) < 0)) {
5295 BIF_ERROR(BIF_P, BADARG);
5296 }
5297
5298 if (reds > CONTEXT_REDS) {
5299 reds = CONTEXT_REDS;
5300 }
5301 BIF_RET2(am_true, reds);
5302 }
5303
erts_internal_cmp_term_2(BIF_ALIST_2)5304 BIF_RETTYPE erts_internal_cmp_term_2(BIF_ALIST_2) {
5305 Sint res = CMP_TERM(BIF_ARG_1,BIF_ARG_2);
5306
5307 /* ensure -1, 0, 1 result */
5308 if (res < 0) {
5309 BIF_RET(make_small(-1));
5310 } else if (res > 0) {
5311 BIF_RET(make_small(1));
5312 }
5313 BIF_RET(make_small(0));
5314 }
5315 /*
5316 * Processes doing yield on return in a bif ends up in bif_return_trap().
5317 */
bif_return_trap(BIF_ALIST_2)5318 static BIF_RETTYPE bif_return_trap(BIF_ALIST_2)
5319 {
5320 Eterm res = BIF_ARG_1;
5321
5322 switch (BIF_ARG_2) {
5323 case am_multi_scheduling: {
5324 int msb = erts_is_multi_scheduling_blocked();
5325 if (msb > 0)
5326 res = am_blocked;
5327 else if (msb < 0)
5328 res = am_blocked_normal;
5329 else
5330 ERTS_INTERNAL_ERROR("Unexpected multi scheduling block state");
5331 break;
5332 }
5333 default:
5334 break;
5335 }
5336 BIF_RET(res);
5337 }
5338
5339 static BIF_RETTYPE
bif_handle_signals_return(BIF_ALIST_1)5340 bif_handle_signals_return(BIF_ALIST_1)
5341 {
5342 int local_only = BIF_P->sig_qs.flags & FS_LOCAL_SIGS_ONLY;
5343 int sres, sreds, reds_left;
5344 erts_aint32_t state;
5345
5346 reds_left = ERTS_BIF_REDS_LEFT(BIF_P);
5347 sreds = reds_left;
5348
5349 if (!local_only) {
5350 erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MSGQ);
5351 erts_proc_sig_fetch(BIF_P);
5352 erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MSGQ);
5353 }
5354
5355 state = erts_atomic32_read_nob(&BIF_P->state);
5356 sres = erts_proc_sig_handle_incoming(BIF_P, &state, &sreds,
5357 sreds, !0);
5358
5359 BUMP_REDS(BIF_P, (int) sreds);
5360 reds_left -= sreds;
5361
5362 if (state & ERTS_PSFLG_EXITING) {
5363 BIF_P->sig_qs.flags &= ~FS_LOCAL_SIGS_ONLY;
5364 ERTS_BIF_EXITED(BIF_P);
5365 }
5366 if (!sres | (reds_left <= 0)) {
5367 /*
5368 * More signals to handle or out of reds; need
5369 * to yield and continue. Prevent fetching of
5370 * more signals by setting local-sigs-only flag.
5371 */
5372 BIF_P->sig_qs.flags |= FS_LOCAL_SIGS_ONLY;
5373 ERTS_BIF_YIELD1(&erts_bif_handle_signals_return_export,
5374 BIF_P, BIF_ARG_1);
5375 }
5376
5377 BIF_P->sig_qs.flags &= ~FS_LOCAL_SIGS_ONLY;
5378 BIF_RET(BIF_ARG_1);
5379 }
5380
5381 Export bif_return_trap_export;
5382 Export erts_bif_handle_signals_return_export;
5383
erts_init_trap_export(Export * ep,Eterm m,Eterm f,Uint a,Eterm (* bif)(BIF_ALIST))5384 void erts_init_trap_export(Export *ep, Eterm m, Eterm f, Uint a,
5385 Eterm (*bif)(BIF_ALIST))
5386 {
5387 int i;
5388
5389 sys_memset((void *) ep, 0, sizeof(Export));
5390
5391 for (i = 0; i < ERTS_NUM_CODE_IX; i++) {
5392 erts_activate_export_trampoline(ep, i);
5393 }
5394
5395 #ifdef BEAMASM
5396 ep->addresses[ERTS_SAVE_CALLS_CODE_IX] = beam_save_calls;
5397 #endif
5398
5399 ep->bif_number = -1;
5400 ep->info.op = op_i_func_info_IaaI;
5401 ep->info.mfa.module = m;
5402 ep->info.mfa.function = f;
5403 ep->info.mfa.arity = a;
5404
5405 ep->trampoline.common.op = BeamOpCodeAddr(op_call_bif_W);
5406 ep->trampoline.bif.address = (BeamInstr)bif;
5407 }
5408
erts_init_bif(void)5409 void erts_init_bif(void)
5410 {
5411 /*
5412 * bif_return_trap/2 is a hidden BIF that bifs that need to
5413 * yield the calling process traps to.
5414 */
5415 erts_init_trap_export(&bif_return_trap_export,
5416 am_erlang, am_bif_return_trap, 2,
5417 &bif_return_trap);
5418
5419 erts_init_trap_export(&erts_bif_handle_signals_return_export,
5420 am_erlang, am_bif_handle_signals_return, 1,
5421 &bif_handle_signals_return);
5422
5423 erts_await_result = erts_export_put(am_erts_internal,
5424 am_await_result,
5425 1);
5426
5427 erts_init_trap_export(&dsend_continue_trap_export,
5428 am_erts_internal, am_dsend_continue_trap, 1,
5429 dsend_continue_trap_1);
5430
5431 erts_init_trap_export(&await_exit_trap, am_erts_internal,
5432 am_await_exit, 0, erts_internal_await_exit_trap);
5433
5434 flush_monitor_messages_trap = erts_export_put(am_erts_internal,
5435 am_flush_monitor_messages,
5436 3);
5437
5438 erts_convert_time_unit_trap = erts_export_put(am_erlang,
5439 am_convert_time_unit,
5440 3);
5441
5442 set_cpu_topology_trap = erts_export_put(am_erlang,
5443 am_set_cpu_topology,
5444 1);
5445 erts_format_cpu_topology_trap = erts_export_put(am_erlang,
5446 am_format_cpu_topology,
5447 1);
5448 await_port_send_result_trap
5449 = erts_export_put(am_erts_internal, am_await_port_send_result, 3);
5450 system_flag_scheduler_wall_time_trap
5451 = erts_export_put(am_erts_internal, am_system_flag_scheduler_wall_time, 1);
5452 await_sched_wall_time_mod_trap
5453 = erts_export_put(am_erts_internal, am_await_sched_wall_time_modifications, 2);
5454 await_msacc_mod_trap
5455 = erts_export_put(am_erts_internal, am_await_microstate_accounting_modifications, 3);
5456
5457 erts_atomic32_init_nob(&sched_wall_time, 0);
5458 erts_atomic32_init_nob(&msacc, ERTS_MSACC_IS_ENABLED());
5459 }
5460
5461 /*
5462 * Scheduling of BIFs via ErtsNativeFunc...
5463 */
5464 #define ERTS_WANT_NFUNC_SCHED_INTERNALS__
5465 #include "erl_nfunc_sched.h"
5466
5467 #define ERTS_SCHED_BIF_TRAP_MARKER ((void *) (UWord) 1)
5468
5469 static ERTS_INLINE void
schedule(Process * c_p,Process * dirty_shadow_proc,const ErtsCodeMFA * mfa,ErtsCodePtr pc,ErtsBifFunc dfunc,void * ifunc,Eterm module,Eterm function,int argc,Eterm * argv)5470 schedule(Process *c_p, Process *dirty_shadow_proc,
5471 const ErtsCodeMFA *mfa, ErtsCodePtr pc,
5472 ErtsBifFunc dfunc, void *ifunc,
5473 Eterm module, Eterm function,
5474 int argc, Eterm *argv)
5475 {
5476 ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p));
5477 (void) erts_nfunc_schedule(c_p, dirty_shadow_proc,
5478 mfa, pc,
5479 #ifdef BEAMASM
5480 op_call_bif_W,
5481 #else
5482 BeamOpCodeAddr(op_call_bif_W),
5483 #endif
5484 dfunc, ifunc,
5485 module, function,
5486 argc, argv);
5487 }
5488
5489
dirty_bif_result(BIF_ALIST_1)5490 static BIF_RETTYPE dirty_bif_result(BIF_ALIST_1)
5491 {
5492 ErtsNativeFunc *nep = (ErtsNativeFunc *) ERTS_PROC_GET_NFUNC_TRAP_WRAPPER(BIF_P);
5493 erts_nfunc_restore(BIF_P, nep, BIF_ARG_1);
5494 BIF_RET(BIF_ARG_1);
5495 }
5496
dirty_bif_trap(BIF_ALIST)5497 static BIF_RETTYPE dirty_bif_trap(BIF_ALIST)
5498 {
5499 ErtsNativeFunc *nep = (ErtsNativeFunc *) ERTS_PROC_GET_NFUNC_TRAP_WRAPPER(BIF_P);
5500
5501 /*
5502 * Arity and argument registers already set
5503 * correct by call to dirty_bif_trap()...
5504 */
5505
5506 ASSERT(BIF_P->arity == nep->trampoline.info.mfa.arity);
5507
5508 erts_nfunc_restore(BIF_P, nep, THE_NON_VALUE);
5509
5510 BIF_P->i = (ErtsCodePtr) nep->func;
5511 BIF_P->freason = TRAP;
5512 return THE_NON_VALUE;
5513 }
5514
dirty_bif_exception(BIF_ALIST_2)5515 static BIF_RETTYPE dirty_bif_exception(BIF_ALIST_2)
5516 {
5517 Eterm freason;
5518
5519 ASSERT(is_small(BIF_ARG_1));
5520
5521 freason = signed_val(BIF_ARG_1);
5522
5523 /* Restore orig info for error and clear nif wrapper in handle_error() */
5524 freason |= EXF_RESTORE_NFUNC;
5525
5526 BIF_P->fvalue = BIF_ARG_2;
5527
5528 BIF_ERROR(BIF_P, freason);
5529 }
5530
5531
5532 static BIF_RETTYPE call_bif(Process *c_p, Eterm *reg, ErtsCodePtr I);
5533
5534 BIF_RETTYPE
erts_schedule_bif(Process * proc,Eterm * argv,ErtsCodePtr i,const ErtsCodeMFA * mfa,ErtsBifFunc bif,ErtsSchedType sched_type,Eterm mod,Eterm func,int argc)5535 erts_schedule_bif(Process *proc,
5536 Eterm *argv,
5537 ErtsCodePtr i,
5538 const ErtsCodeMFA *mfa,
5539 ErtsBifFunc bif,
5540 ErtsSchedType sched_type,
5541 Eterm mod,
5542 Eterm func,
5543 int argc)
5544 {
5545 Process *c_p, *dirty_shadow_proc;
5546
5547 if (proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) {
5548 dirty_shadow_proc = proc;
5549 c_p = proc->next;
5550 ASSERT(c_p->common.id == dirty_shadow_proc->common.id);
5551 erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
5552 }
5553 else
5554 {
5555 dirty_shadow_proc = NULL;
5556 c_p = proc;
5557 }
5558
5559 if (!ERTS_PROC_IS_EXITING(c_p)) {
5560 BifFunction dbif, ibif;
5561
5562 /*
5563 * dbif - direct bif
5564 * ibif - indirect bif
5565 */
5566
5567 erts_aint32_t set, mask;
5568 mask = (ERTS_PSFLG_DIRTY_CPU_PROC
5569 | ERTS_PSFLG_DIRTY_IO_PROC);
5570 switch (sched_type) {
5571 case ERTS_SCHED_DIRTY_CPU:
5572 set = ERTS_PSFLG_DIRTY_CPU_PROC;
5573 dbif = bif;
5574 ibif = NULL;
5575 break;
5576 case ERTS_SCHED_DIRTY_IO:
5577 set = ERTS_PSFLG_DIRTY_IO_PROC;
5578 dbif = bif;
5579 ibif = NULL;
5580 break;
5581 case ERTS_SCHED_NORMAL:
5582 default:
5583 set = 0;
5584 dbif = call_bif;
5585 ibif = bif;
5586 break;
5587 }
5588
5589 (void) erts_atomic32_read_bset_nob(&c_p->state, mask, set);
5590
5591 if (i == NULL) {
5592 ERTS_INTERNAL_ERROR("Missing instruction pointer");
5593 }
5594
5595 ASSERT(bif);
5596
5597 if (argc < 0) { /* reschedule original call */
5598 mod = mfa->module;
5599 func = mfa->function;
5600 argc = (int) mfa->arity;
5601 }
5602
5603 schedule(c_p, dirty_shadow_proc, mfa, i, dbif, ibif,
5604 mod, func, argc, argv);
5605 }
5606
5607 if (dirty_shadow_proc)
5608 erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
5609
5610 return THE_NON_VALUE;
5611 }
5612
5613 static BIF_RETTYPE
call_bif(Process * c_p,Eterm * reg,ErtsCodePtr I)5614 call_bif(Process *c_p, Eterm *reg, ErtsCodePtr I)
5615 {
5616 ErtsNativeFunc *nep = ERTS_I_BEAM_OP_TO_NFUNC(I);
5617 ErtsBifFunc bif = (ErtsBifFunc) nep->func;
5618 BIF_RETTYPE ret;
5619
5620 ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()));
5621
5622 nep->func = ERTS_SCHED_BIF_TRAP_MARKER;
5623
5624 ASSERT(bif);
5625
5626 ret = (*bif)(c_p, reg, I);
5627
5628 if (is_value(ret))
5629 erts_nfunc_restore(c_p, nep, ret);
5630 else if (c_p->freason != TRAP)
5631 c_p->freason |= EXF_RESTORE_NFUNC; /* restore in handle_error() */
5632 else if (nep->func == ERTS_SCHED_BIF_TRAP_MARKER) {
5633 /* BIF did an ordinary trap... */
5634 erts_nfunc_restore(c_p, nep, ret);
5635 }
5636 /* else:
5637 * BIF rescheduled itself using erts_schedule_bif().
5638 */
5639
5640 return ret;
5641 }
5642
5643
5644 int
erts_call_dirty_bif(ErtsSchedulerData * esdp,Process * c_p,ErtsCodePtr I,Eterm * reg)5645 erts_call_dirty_bif(ErtsSchedulerData *esdp,
5646 Process *c_p,
5647 ErtsCodePtr I,
5648 Eterm *reg)
5649 {
5650 BIF_RETTYPE result;
5651 int exiting;
5652 Process *dirty_shadow_proc;
5653 ErtsBifFunc bf;
5654 ErtsNativeFunc *nep;
5655 #ifdef DEBUG
5656 Eterm *c_p_htop;
5657 erts_aint32_t state;
5658
5659 ASSERT(!c_p->scheduler_data);
5660 state = erts_atomic32_read_nob(&c_p->state);
5661 ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING)
5662 && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)));
5663 ASSERT(esdp);
5664
5665 #endif
5666
5667 nep = ERTS_I_BEAM_OP_TO_NFUNC(I);
5668 ASSERT(nep == ERTS_PROC_GET_NFUNC_TRAP_WRAPPER(c_p));
5669
5670 nep->func = ERTS_SCHED_BIF_TRAP_MARKER;
5671
5672 bf = (ErtsBifFunc) nep->trampoline.dfunc;
5673
5674 erts_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC
5675 | ERTS_PSFLG_DIRTY_IO_PROC));
5676
5677 dirty_shadow_proc = erts_make_dirty_shadow_proc(esdp, c_p);
5678
5679 dirty_shadow_proc->freason = c_p->freason;
5680 dirty_shadow_proc->fvalue = c_p->fvalue;
5681 dirty_shadow_proc->ftrace = c_p->ftrace;
5682 dirty_shadow_proc->i = c_p->i;
5683
5684 #ifdef DEBUG
5685 c_p_htop = c_p->htop;
5686 #endif
5687
5688 erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
5689
5690 result = (*bf)(dirty_shadow_proc, reg, I);
5691
5692 erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
5693
5694 ASSERT(c_p_htop == c_p->htop);
5695 ASSERT(dirty_shadow_proc->static_flags & ERTS_STC_FLG_SHADOW_PROC);
5696 ASSERT(dirty_shadow_proc->next == c_p);
5697
5698 exiting = ERTS_PROC_IS_EXITING(c_p);
5699
5700 if (!exiting) {
5701 if (is_value(result))
5702 schedule(c_p, dirty_shadow_proc, NULL, NULL, dirty_bif_result,
5703 NULL, am_erts_internal, am_dirty_bif_result, 1, &result);
5704 else if (dirty_shadow_proc->freason != TRAP) {
5705 Eterm argv[2];
5706 ASSERT(dirty_shadow_proc->freason <= MAX_SMALL);
5707 argv[0] = make_small(dirty_shadow_proc->freason);
5708 argv[1] = dirty_shadow_proc->fvalue;
5709 schedule(c_p, dirty_shadow_proc, NULL, NULL,
5710 dirty_bif_exception, NULL, am_erts_internal,
5711 am_dirty_bif_exception, 2, argv);
5712 }
5713 else if (nep->func == ERTS_SCHED_BIF_TRAP_MARKER) {
5714 /* Dirty BIF did an ordinary trap... */
5715 ASSERT(!(erts_atomic32_read_nob(&c_p->state)
5716 & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)));
5717 schedule(c_p, dirty_shadow_proc, NULL, NULL,
5718 dirty_bif_trap, (void *) dirty_shadow_proc->i,
5719 am_erts_internal, am_dirty_bif_trap,
5720 dirty_shadow_proc->arity, reg);
5721 }
5722 /* else:
5723 * BIF rescheduled itself using erts_schedule_bif().
5724 */
5725 c_p->freason = dirty_shadow_proc->freason;
5726 c_p->fvalue = dirty_shadow_proc->fvalue;
5727 c_p->ftrace = dirty_shadow_proc->ftrace;
5728 c_p->i = dirty_shadow_proc->i;
5729 c_p->arity = dirty_shadow_proc->arity;
5730 }
5731
5732 erts_flush_dirty_shadow_proc(dirty_shadow_proc);
5733
5734 return exiting;
5735 }
5736
alias_1(BIF_ALIST_1)5737 BIF_RETTYPE alias_1(BIF_ALIST_1)
5738 {
5739 Eterm ref, opts = BIF_ARG_1;
5740 ErtsMonitorData *mdp;
5741 Uint16 flags = ERTS_ML_STATE_ALIAS_UNALIAS;
5742
5743 while (is_list(opts)) {
5744 Eterm *cons = list_val(opts);
5745 switch (CAR(cons)) {
5746 case am_explicit_unalias:
5747 flags = ERTS_ML_STATE_ALIAS_UNALIAS;
5748 break;
5749 case am_reply:
5750 flags = ERTS_ML_STATE_ALIAS_ONCE;
5751 break;
5752 default:
5753 BIF_ERROR(BIF_P, BADARG);
5754 }
5755 opts = CDR(cons);
5756 }
5757 if (is_not_nil(opts)) {
5758 BIF_ERROR(BIF_P, BADARG);
5759 }
5760
5761 ref = erts_make_pid_ref(BIF_P);
5762 mdp = erts_monitor_create(ERTS_MON_TYPE_ALIAS, ref,
5763 BIF_P->common.id, NIL, NIL,
5764 THE_NON_VALUE);
5765 mdp->origin.flags |= flags;
5766 erts_monitor_tree_insert(&ERTS_P_MONITORS(BIF_P),
5767 &mdp->origin);
5768 BIF_RET(ref);
5769
5770 }
5771
unalias_1(BIF_ALIST_1)5772 BIF_RETTYPE unalias_1(BIF_ALIST_1)
5773 {
5774 ErtsMonitor *mon;
5775 Eterm pid;
5776
5777 pid = erts_get_pid_of_ref(BIF_ARG_1);
5778 if (BIF_P->common.id != pid) {
5779 if (is_non_value(pid))
5780 BIF_ERROR(BIF_P, BADARG);
5781 BIF_RET(am_false);
5782 }
5783
5784 mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(BIF_P),
5785 BIF_ARG_1);
5786 if (!mon || !(mon->flags & ERTS_ML_STATE_ALIAS_MASK))
5787 BIF_RET(am_false);
5788
5789 ASSERT(erts_monitor_is_origin(mon));
5790
5791 erts_pid_ref_delete(BIF_ARG_1);
5792
5793 mon->flags &= ~ERTS_ML_STATE_ALIAS_MASK;
5794 if (mon->type == ERTS_MON_TYPE_ALIAS) {
5795 erts_monitor_tree_delete(&ERTS_P_MONITORS(BIF_P), mon);
5796 erts_monitor_release(mon);
5797 }
5798 BIF_RET(am_true);
5799 }
5800
dt_put_tag_1(BIF_ALIST_1)5801 BIF_RETTYPE dt_put_tag_1(BIF_ALIST_1)
5802 {
5803 #ifdef USE_VM_PROBES
5804 Eterm otag;
5805 if (BIF_ARG_1 == am_undefined) {
5806 otag = (DT_UTAG(BIF_P) == NIL) ? am_undefined : DT_UTAG(BIF_P);
5807 DT_UTAG(BIF_P) = NIL;
5808 DT_UTAG_FLAGS(BIF_P) = 0;
5809 if (SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag) {
5810 SEQ_TRACE_TOKEN(BIF_P) = NIL;
5811 }
5812 BIF_RET(otag);
5813 }
5814 if (!is_binary(BIF_ARG_1)) {
5815 BIF_ERROR(BIF_P,BADARG);
5816 }
5817 otag = (DT_UTAG(BIF_P) == NIL) ? am_undefined : DT_UTAG(BIF_P);
5818 DT_UTAG(BIF_P) = BIF_ARG_1;
5819 DT_UTAG_FLAGS(BIF_P) |= DT_UTAG_PERMANENT;
5820 if (SEQ_TRACE_TOKEN(BIF_P) == NIL) {
5821 SEQ_TRACE_TOKEN(BIF_P) = am_have_dt_utag;
5822 }
5823 BIF_RET(otag);
5824 #else
5825 BIF_RET(am_undefined);
5826 #endif
5827 }
5828
dt_get_tag_0(BIF_ALIST_0)5829 BIF_RETTYPE dt_get_tag_0(BIF_ALIST_0)
5830 {
5831 #ifdef USE_VM_PROBES
5832 BIF_RET((DT_UTAG(BIF_P) == NIL || !(DT_UTAG_FLAGS(BIF_P) & DT_UTAG_PERMANENT)) ? am_undefined : DT_UTAG(BIF_P));
5833 #else
5834 BIF_RET(am_undefined);
5835 #endif
5836 }
dt_get_tag_data_0(BIF_ALIST_0)5837 BIF_RETTYPE dt_get_tag_data_0(BIF_ALIST_0)
5838 {
5839 #ifdef USE_VM_PROBES
5840 BIF_RET((DT_UTAG(BIF_P) == NIL) ? am_undefined : DT_UTAG(BIF_P));
5841 #else
5842 BIF_RET(am_undefined);
5843 #endif
5844 }
dt_prepend_vm_tag_data_1(BIF_ALIST_1)5845 BIF_RETTYPE dt_prepend_vm_tag_data_1(BIF_ALIST_1)
5846 {
5847 #ifdef USE_VM_PROBES
5848 Eterm b;
5849 Eterm *hp;
5850 if (is_binary((DT_UTAG(BIF_P)))) {
5851 Uint sz = binary_size(DT_UTAG(BIF_P));
5852 int i;
5853 unsigned char *p,*q;
5854 byte *temp_alloc = NULL;
5855 b = new_binary(BIF_P,NULL,sz+1);
5856 q = binary_bytes(b);
5857 p = erts_get_aligned_binary_bytes(DT_UTAG(BIF_P),&temp_alloc);
5858 for(i=0;i<sz;++i) {
5859 q[i] = p[i];
5860 }
5861 erts_free_aligned_binary_bytes(temp_alloc);
5862 q[sz] = '\0';
5863 } else {
5864 b = new_binary(BIF_P,(byte *)"\0",1);
5865 }
5866 hp = HAlloc(BIF_P,2);
5867 BIF_RET(CONS(hp,b,BIF_ARG_1));
5868 #else
5869 BIF_RET(BIF_ARG_1);
5870 #endif
5871 }
dt_append_vm_tag_data_1(BIF_ALIST_1)5872 BIF_RETTYPE dt_append_vm_tag_data_1(BIF_ALIST_1)
5873 {
5874 #ifdef USE_VM_PROBES
5875 Eterm b;
5876 Eterm *hp;
5877 if (is_binary((DT_UTAG(BIF_P)))) {
5878 Uint sz = binary_size(DT_UTAG(BIF_P));
5879 int i;
5880 unsigned char *p,*q;
5881 byte *temp_alloc = NULL;
5882 b = new_binary(BIF_P,NULL,sz+1);
5883 q = binary_bytes(b);
5884 p = erts_get_aligned_binary_bytes(DT_UTAG(BIF_P),&temp_alloc);
5885 for(i=0;i<sz;++i) {
5886 q[i] = p[i];
5887 }
5888 erts_free_aligned_binary_bytes(temp_alloc);
5889 q[sz] = '\0';
5890 } else {
5891 b = new_binary(BIF_P,(byte *)"\0",1);
5892 }
5893 hp = HAlloc(BIF_P,2);
5894 BIF_RET(CONS(hp,BIF_ARG_1,b));
5895 #else
5896 BIF_RET(BIF_ARG_1);
5897 #endif
5898 }
dt_spread_tag_1(BIF_ALIST_1)5899 BIF_RETTYPE dt_spread_tag_1(BIF_ALIST_1)
5900 {
5901 #ifdef USE_VM_PROBES
5902 Eterm ret;
5903 Eterm *hp;
5904 #endif
5905 if (BIF_ARG_1 != am_true && BIF_ARG_1 != am_false) {
5906 BIF_ERROR(BIF_P,BADARG);
5907 }
5908 #ifdef USE_VM_PROBES
5909 hp = HAlloc(BIF_P,3);
5910 ret = TUPLE2(hp,make_small(DT_UTAG_FLAGS(BIF_P)),DT_UTAG(BIF_P));
5911 if (DT_UTAG(BIF_P) != NIL) {
5912 if (BIF_ARG_1 == am_true) {
5913 DT_UTAG_FLAGS(BIF_P) |= DT_UTAG_SPREADING;
5914 #ifdef DTRACE_TAG_HARDDEBUG
5915 erts_fprintf(stderr,
5916 "Dtrace -> (%T) start spreading tag %T\r\n",
5917 BIF_P->common.id,DT_UTAG(BIF_P));
5918 #endif
5919 } else {
5920 DT_UTAG_FLAGS(BIF_P) &= ~DT_UTAG_SPREADING;
5921 #ifdef DTRACE_TAG_HARDDEBUG
5922 erts_fprintf(stderr,
5923 "Dtrace -> (%T) stop spreading tag %T\r\n",
5924 BIF_P->common.id,DT_UTAG(BIF_P));
5925 #endif
5926 }
5927 }
5928 BIF_RET(ret);
5929 #else
5930 BIF_RET(am_true);
5931 #endif
5932 }
dt_restore_tag_1(BIF_ALIST_1)5933 BIF_RETTYPE dt_restore_tag_1(BIF_ALIST_1)
5934 {
5935 #ifdef USE_VM_PROBES
5936 Eterm *tpl;
5937 Uint x;
5938 if (is_not_tuple(BIF_ARG_1)) {
5939 BIF_ERROR(BIF_P,BADARG);
5940 }
5941 tpl = tuple_val(BIF_ARG_1);
5942 if(arityval(*tpl) != 2 || is_not_small(tpl[1]) || (is_not_binary(tpl[2]) && tpl[2] != NIL)) {
5943 BIF_ERROR(BIF_P,BADARG);
5944 }
5945 if (tpl[2] == NIL) {
5946 if (DT_UTAG(BIF_P) != NIL) {
5947 #ifdef DTRACE_TAG_HARDDEBUG
5948 erts_fprintf(stderr,
5949 "Dtrace -> (%T) restore Killing tag!\r\n",
5950 BIF_P->common.id);
5951 #endif
5952 }
5953 DT_UTAG(BIF_P) = NIL;
5954 if (SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag) {
5955 SEQ_TRACE_TOKEN(BIF_P) = NIL;
5956 }
5957 DT_UTAG_FLAGS(BIF_P) = 0;
5958 } else {
5959 x = unsigned_val(tpl[1]) & (DT_UTAG_SPREADING | DT_UTAG_PERMANENT);
5960 #ifdef DTRACE_TAG_HARDDEBUG
5961
5962 if (!(x & DT_UTAG_SPREADING) && (DT_UTAG_FLAGS(BIF_P) &
5963 DT_UTAG_SPREADING)) {
5964 erts_fprintf(stderr,
5965 "Dtrace -> (%T) restore stop spreading "
5966 "tag %T\r\n",
5967 BIF_P->common.id, tpl[2]);
5968 } else if ((x & DT_UTAG_SPREADING) &&
5969 !(DT_UTAG_FLAGS(BIF_P) & DT_UTAG_SPREADING)) {
5970 erts_fprintf(stderr,
5971 "Dtrace -> (%T) restore start spreading "
5972 "tag %T\r\n",BIF_P->common.id,tpl[2]);
5973 }
5974 #endif
5975 DT_UTAG_FLAGS(BIF_P) = x;
5976 DT_UTAG(BIF_P) = tpl[2];
5977 if (SEQ_TRACE_TOKEN(BIF_P) == NIL) {
5978 SEQ_TRACE_TOKEN(BIF_P) = am_have_dt_utag;
5979 }
5980 }
5981 #else
5982 if (BIF_ARG_1 != am_true) {
5983 BIF_ERROR(BIF_P,BADARG);
5984 }
5985 #endif
5986 BIF_RET(am_true);
5987 }
5988