static void srunner_run_teardown (List * l) { Fixture *f; for (list_front (l); !list_at_end (l); list_advance (l)) { f = list_val (l); send_ctx_info (CK_CTX_TEARDOWN); f->fun (); } }
BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2) { int reds = 0; Eterm res; Eterm olist = BIF_ARG_2; int allow_gc = 1; if (is_not_atom(BIF_ARG_1)) goto badarg; while (is_list(olist)) { Eterm *lp = list_val(olist); Eterm opt = CAR(lp); if (is_tuple(opt)) { Eterm* tp = tuple_val(opt); switch (arityval(tp[0])) { case 2: switch (tp[1]) { case am_allow_gc: switch (tp[2]) { case am_false: allow_gc = 0; break; case am_true: allow_gc = 1; break; default: goto badarg; } break; default: goto badarg; } break; default: goto badarg; } } else goto badarg; olist = CDR(lp); } if (is_not_nil(olist)) goto badarg; res = erts_check_process_code(BIF_P, BIF_ARG_1, allow_gc, &reds); ASSERT(is_value(res)); BIF_RET2(res, reds); badarg: BIF_ERROR(BIF_P, BADARG); }
static void suite_free (Suite *s) { List *l; if (s == NULL) return; l = s->tclst; for (list_front(l); !list_at_end(l); list_advance (l)) { tcase_free (list_val(l)); } list_free (s->tclst); free(s); }
static BIF_RETTYPE lists_reverse_onheap(Process *c_p, Eterm list_in, Eterm tail_in) { static const Uint CELLS_PER_RED = 60; Eterm *alloc_start, *alloc_top, *alloc_end; Uint cells_left, max_cells; Eterm list, tail; list = list_in; tail = tail_in; cells_left = max_cells = CELLS_PER_RED * (1 + ERTS_BIF_REDS_LEFT(c_p)); ASSERT(HEAP_LIMIT(c_p) >= HEAP_TOP(c_p) + 2); alloc_start = HEAP_TOP(c_p); alloc_end = HEAP_LIMIT(c_p) - 2; alloc_top = alloc_start; /* Don't process more cells than we have reductions for. */ alloc_end = MIN(alloc_top + (cells_left * 2), alloc_end); while (alloc_top < alloc_end && is_list(list)) { Eterm *pair = list_val(list); tail = CONS(alloc_top, CAR(pair), tail); list = CDR(pair); alloc_top += 2; } cells_left -= (alloc_top - alloc_start) / 2; HEAP_TOP(c_p) = alloc_top; ASSERT(cells_left >= 0 && cells_left <= max_cells); BUMP_REDS(c_p, (max_cells - cells_left) / CELLS_PER_RED); if (is_nil(list)) { BIF_RET(tail); } else if (is_list(list)) { ASSERT(is_list(tail)); if (cells_left > CELLS_PER_RED) { return lists_reverse_alloc(c_p, list, tail); } BUMP_ALL_REDS(c_p); BIF_TRAP2(bif_export[BIF_lists_reverse_2], c_p, list, tail); } BIF_ERROR(c_p, BADARG); }
static void srunner_send_evt (SRunner *sr, void *obj, enum cl_event evt) { List *l; Log *lg; l = sr->loglst; for (list_front(l); !list_at_end(l); list_advance(l)) { lg = list_val(l); fflush(lg->lfile); lg->lfun (sr, lg->lfile, lg->mode, obj, evt); fflush(lg->lfile); } }
void erts_check_stack(Process *p) { Eterm *elemp; Eterm *stack_start = p->heap + p->heap_sz; Eterm *stack_end = p->htop; if (p->stop > stack_start) erl_exit(1, "<%lu.%lu.%lu>: Stack underflow\n", internal_pid_channel_no(p->common.id), internal_pid_number(p->common.id), internal_pid_serial(p->common.id)); if (p->stop < stack_end) erl_exit(1, "<%lu.%lu.%lu>: Stack overflow\n", internal_pid_channel_no(p->common.id), internal_pid_number(p->common.id), internal_pid_serial(p->common.id)); for (elemp = p->stop; elemp < stack_start; elemp++) { int in_mbuf = 0; Eterm *ptr; ErlHeapFragment* mbuf; switch (primary_tag(*elemp)) { case TAG_PRIMARY_LIST: ptr = list_val(*elemp); break; case TAG_PRIMARY_BOXED: ptr = boxed_val(*elemp); break; default: /* Immediate or cp */ continue; } if (IN_HEAP(p, ptr)) continue; for (mbuf = p->mbuf; mbuf; mbuf = mbuf->next) if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->used_size)) { in_mbuf = 1; break; } if (in_mbuf) continue; erl_exit(1, "<%lu.%lu.%lu>: Wild stack pointer\n", internal_pid_channel_no(p->common.id), internal_pid_number(p->common.id), internal_pid_serial(p->common.id)); } }
static void srunner_fprint_results (FILE *file, SRunner *sr, enum print_output print_mode) { List *resultlst; resultlst = sr->resultlst; for (list_front(resultlst); !list_at_end(resultlst); list_advance(resultlst)) { TestResult *tr = list_val(resultlst); tr_fprint (file, tr, print_mode); } return; }
END_TEST START_TEST(test_add_end_and_next) { List *lp = check_list_create(); const char *tval1 = "abc"; const char *tval2 = "123"; list_add_end (lp, tval1); list_add_end (lp, tval2); list_front(lp); fail_unless (strcmp (tval1, list_val (lp)) == 0, "List head val should equal first inserted val"); list_advance (lp); fail_unless (!list_at_end (lp), "List should not be at end after two adds and one next"); fail_unless (strcmp (tval2, list_val (lp)) == 0, "List val should equal second inserted val"); list_advance(lp); fail_unless (list_at_end (lp), "List should be at and after two adds and two nexts"); list_free (lp); }
int suite_tcase (Suite *s, const char *tcname) { List *l; TCase *tc; if (s == NULL) return 0; l = s->tclst; for (list_front (l); !list_at_end (l); list_advance (l)) { tc = list_val (l); if (strcmp (tcname, tc->name) == 0) return 1; } return 0; }
/* Move all terms in heap fragments into heap. The terms must be guaranteed to * be contained within the fragments. The source terms are destructed with * move markers. * Typically used to copy a multi-fragmented message (from NIF). */ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first, Eterm* refs, unsigned nrefs) { ErlHeapFragment* bp; Eterm* hp_start = *hpp; Eterm* hp_end; Eterm* hp; unsigned i; for (bp=first; bp!=NULL; bp=bp->next) { move_one_frag(hpp, bp->mem, bp->used_size, off_heap); off_heap->overhead += bp->off_heap.overhead; } hp_end = *hpp; for (hp=hp_start; hp<hp_end; ++hp) { Eterm* ptr; Eterm val; Eterm gval = *hp; switch (primary_tag(gval)) { case TAG_PRIMARY_BOXED: ptr = boxed_val(gval); val = *ptr; if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *hp = val; } break; case TAG_PRIMARY_LIST: ptr = list_val(gval); val = *ptr; if (IS_MOVED_CONS(val)) { *hp = ptr[1]; } break; case TAG_PRIMARY_HEADER: if (header_is_thing(gval)) { hp += thing_arityval(gval); } break; } } for (i=0; i<nrefs; ++i) { refs[i] = follow_moved(refs[i]); } }
/* Destructively enqueues a term to the result list, saving us the hassle of * having to reverse it later. This is safe since GC is disabled and we never * leak the unfinished term to the outside. */ static void iol2v_enqueue_result(iol2v_state_t *state, Eterm term) { Eterm prev_tail; Eterm *hp; prev_tail = state->result_tail; hp = HAlloc(state->process, 2); state->result_tail = CONS(hp, term, NIL); if(prev_tail != NIL) { Eterm *prev_cell = list_val(prev_tail); CDR(prev_cell) = state->result_tail; } else { state->result_head = state->result_tail; } state->bytereds_spent += 1; }
static int subtract_set_build(Process *p, ErtsSubtractContext *context) { const static Sint INSERTIONS_PER_RED = 16; Sint budget, insertions; budget = INSERTIONS_PER_RED * ERTS_BIF_REDS_LEFT(p); insertions = 0; #ifdef DEBUG budget = budget / 10 + 1; #endif while (insertions < budget && is_list(context->iterator)) { subtract_tree_t *existing_node, *new_node; const Eterm *cell; Eterm value, next; cell = list_val(context->iterator); value = CAR(cell); next = CDR(cell); new_node = context->u.rhs_set.alloc; new_node->key = value; new_node->count = 1; existing_node = subtract_rbt_lookup_insert(&context->u.rhs_set.tree, new_node); if (existing_node != NULL) { existing_node->count++; } else { context->u.rhs_set.alloc++; } context->iterator = next; insertions++; } BUMP_REDS(p, insertions / INSERTIONS_PER_RED); ASSERT(is_list(context->iterator) || is_nil(context->iterator)); ASSERT(context->u.rhs_set.tree != NULL); return is_nil(context->iterator); }
void srunner_end_logging (SRunner *sr) { List *l; int rval; srunner_send_evt (sr, NULL, CLENDLOG_SR); l = sr->loglst; for (list_front(l); !list_at_end(l); list_advance(l)) { Log *lg = list_val(l); if (lg->close) { rval = fclose (lg->lfile); if (rval != 0) eprintf ("Error in call to fclose while closing log file:", __FILE__, __LINE__ - 2); } free (lg); } list_free(l); sr->loglst = NULL; }
static TestResult * tcase_run_checked_setup (SRunner *sr, TCase *tc) { TestResult *tr = NULL; List *l; Fixture *f; enum fork_status fstat = srunner_fork_status(sr); l = tc->ch_sflst; if (fstat == CK_FORK) { send_ctx_info(CK_CTX_SETUP); } for (list_front(l); !list_at_end(l); list_advance(l)) { f = list_val(l); if (fstat == CK_NOFORK) { send_ctx_info(CK_CTX_SETUP); if ( 0 == setjmp(error_jmp_buffer) ) { f->fun(); } } else { f->fun(); } /* Stop the setup and return the failure if nofork mode. */ if (fstat == CK_NOFORK) { tr = receive_result_info_nofork (tc->name, "checked_setup", 0); if (tr->rtype != CK_PASS) { break; } free(tr->file); free(tr->msg); free(tr); tr = NULL; } } return tr; }
BIF_RETTYPE port_command_3(BIF_ALIST_3) { Eterm l = BIF_ARG_3; Uint32 flags = 0; while (is_list(l)) { Eterm* cons = list_val(l); Eterm car = CAR(cons); if (car == am_force) { flags |= ERTS_PORT_COMMAND_FLAG_FORCE; } else if (car == am_nosuspend) { flags |= ERTS_PORT_COMMAND_FLAG_NOSUSPEND; } else { BIF_ERROR(BIF_P, BADARG); } l = CDR(cons); } if(!is_nil(l)) { BIF_ERROR(BIF_P, BADARG); } return do_port_command(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, flags); }
BIF_RETTYPE length_1(BIF_ALIST_1) { Eterm list; Uint i; if (is_nil(BIF_ARG_1)) BIF_RET(SMALL_ZERO); if (is_not_list(BIF_ARG_1)) { BIF_ERROR(BIF_P, BADARG); } list = BIF_ARG_1; i = 0; while (is_list(list)) { i++; list = CDR(list_val(list)); } if (is_not_nil(list)) { BIF_ERROR(BIF_P, BADARG); } BIF_RET(make_small(i)); }
int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list) { Eterm *listptr, ret = NIL, *hp; if (is_nil(term)) { *list = term; return 1; } ret = NIL; while (is_not_nil(term)) { if (is_not_list(term)) { return 0; } hp = alloc_heap(env, 2); listptr = list_val(term); ret = CONS(hp, CAR(listptr), ret); term = CDR(listptr); } *list = ret; return 1; }
static int verify_eterm(Process *p,Eterm element) { Eterm *ptr; ErlHeapFragment* mbuf; switch (primary_tag(element)) { case TAG_PRIMARY_LIST: ptr = list_val(element); break; case TAG_PRIMARY_BOXED: ptr = boxed_val(element); break; default: /* Immediate or header/cp */ return 1; } if (p) { if (IN_HEAP(p, ptr)) return 1; for (mbuf = p->mbuf; mbuf; mbuf = mbuf->next) { if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->used_size)) { return 1; } } } return 0; }
static void srunner_iterate_tcase_tfuns (SRunner *sr, TCase *tc) { List *tfl; TF *tfun; TestResult *tr = NULL; tfl = tc->tflst; for (list_front(tfl); !list_at_end (tfl); list_advance (tfl)) { int i; tfun = list_val (tfl); for (i = tfun->loop_start; i < tfun->loop_end; i++) { log_test_start (sr, tc, tfun); switch (srunner_fork_status(sr)) { case CK_FORK: #ifdef _POSIX_VERSION tr = tcase_run_tfun_fork (sr, tc, tfun, i); #else /* _POSIX_VERSION */ eprintf("This version does not support fork", __FILE__, __LINE__); #endif /* _POSIX_VERSION */ break; case CK_NOFORK: tr = tcase_run_tfun_nofork (sr, tc, tfun, i); break; default: eprintf("Bad fork status in SRunner", __FILE__, __LINE__); } if ( NULL != tr ) { srunner_add_failure (sr, tr); log_test_end(sr, tr); } } } }
BIF_RETTYPE hipe_bifs_show_term_1(BIF_ALIST_1) { Eterm obj = BIF_ARG_1; printf("0x%0*lx\r\n", 2*(int)sizeof(long), obj); do { Eterm *objp; int i, ary; if (is_list(obj)) { objp = list_val(obj); ary = 2; } else if (is_boxed(obj)) { Eterm header; objp = boxed_val(obj); header = objp[0]; if (is_thing(header)) ary = thing_arityval(header); else if (is_arity_value(header)) ary = arityval(header); else { printf("bad header %#lx\r\n", header); break; } ary += 1; } else break; for (i = 0; i < ary; ++i) printf("0x%0*lx: 0x%0*lx\r\n", 2*(int)sizeof(long), (unsigned long)&objp[i], 2*(int)sizeof(long), objp[i]); } while (0); erts_printf("%T", obj); printf("\r\n"); BIF_RET(am_true); }
static int subtract_enter_naive_lhs(Process *p, ErtsSubtractContext *context) { Eterm iterator; int i = 0; context->stage = SUBTRACT_STAGE_NAIVE_LHS; context->iterator = context->rhs_original; context->result = NIL; iterator = context->lhs_original; while (is_list(iterator)) { const Eterm *cell = list_val(iterator); ASSERT(i < SUBTRACT_LHS_THRESHOLD); context->u.lhs_elements[i++] = CAR(cell); iterator = CDR(cell); } ASSERT(i == context->lhs_remaining); return subtract_continue(p, context); }
static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls) { BeamInstr* start; char* literals; Uint lit_bsize; char* mod_start; Uint mod_size; Eterm* sp; int done_gc = 0; int need_gc = 0; ErtsMessage *msgp; ErlHeapFragment *hfrag; #define ERTS_ORDINARY_GC__ (1 << 0) #define ERTS_LITERAL_GC__ (1 << 1) /* * Pick up limits for the module. */ start = (BeamInstr*) modp->old.code_hdr; mod_start = (char *) start; mod_size = modp->old.code_length; /* * Check if current instruction or continuation pointer points into module. */ if (ErtsInArea(rp->i, mod_start, mod_size) || ErtsInArea(rp->cp, mod_start, mod_size)) { return am_true; } /* * Check all continuation pointers stored on the stack. */ for (sp = rp->stop; sp < STACK_START(rp); sp++) { if (is_CP(*sp) && ErtsInArea(cp_val(*sp), mod_start, mod_size)) { return am_true; } } /* * Check all continuation pointers stored in stackdump * and clear exception stackdump if there is a pointer * to the module. */ if (rp->ftrace != NIL) { struct StackTrace *s; ASSERT(is_list(rp->ftrace)); s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace))); if ((s->pc && ErtsInArea(s->pc, mod_start, mod_size)) || (s->current && ErtsInArea(s->current, mod_start, mod_size))) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; } else { int i; for (i = 0; i < s->depth; i++) { if (ErtsInArea(s->trace[i], mod_start, mod_size)) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; break; } } } } if (rp->flags & F_DISABLE_GC) { /* * Cannot proceed. Process has disabled gc in order to * safely leave inconsistent data on the heap and/or * off heap lists. Need to wait for gc to be enabled * again. */ return THE_NON_VALUE; } /* * Message queue can contains funs, but (at least currently) no * literals. If we got references to this module from the message * queue, a GC cannot remove these... */ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_MSGQ); ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ); literals = (char*) modp->old.code_hdr->literals_start; lit_bsize = (char*) modp->old.code_hdr->literals_end - literals; for (msgp = rp->msg.first; msgp; msgp = msgp->next) { if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) hfrag = &msgp->hfrag; else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag) hfrag = msgp->data.heap_frag; else continue; for (; hfrag; hfrag = hfrag->next) { if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)) return am_true; /* Should not contain any literals... */ ASSERT(!any_heap_refs(&hfrag->mem[0], &hfrag->mem[hfrag->used_size], literals, lit_bsize)); } } while (1) { /* Check heap, stack etc... */ if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size)) goto try_gc; if (!(flags & ERTS_CPC_COPY_LITERALS)) { /* Process ok. May contain old literals but we will be called * again before module is purged. */ return am_false; } if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; } if (any_heap_ref_ptrs(rp->stop, rp->hend, literals, lit_bsize)) goto try_literal_gc; if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize)) goto try_literal_gc; if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize)) goto try_literal_gc; /* Check dictionary */ if (rp->dictionary) { Eterm* start = ERTS_PD_START(rp->dictionary); Eterm* end = start + ERTS_PD_SIZE(rp->dictionary); if (any_heap_ref_ptrs(start, end, literals, lit_bsize)) goto try_literal_gc; } /* Check heap fragments */ for (hfrag = rp->mbuf; hfrag; hfrag = hfrag->next) { Eterm *hp, *hp_end; /* Off heap lists should already have been moved into process */ ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)); hp = &hfrag->mem[0]; hp_end = &hfrag->mem[hfrag->used_size]; if (any_heap_refs(hp, hp_end, literals, lit_bsize)) goto try_literal_gc; } #ifdef DEBUG /* * Message buffer fragments should not have any references * to literals, and off heap lists should already have * been moved into process off heap structure. */ for (msgp = rp->msg_frag; msgp; msgp = msgp->next) { if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) hfrag = &msgp->hfrag; else hfrag = msgp->data.heap_frag; for (; hfrag; hfrag = hfrag->next) { Eterm *hp, *hp_end; ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)); hp = &hfrag->mem[0]; hp_end = &hfrag->mem[hfrag->used_size]; ASSERT(!any_heap_refs(hp, hp_end, literals, lit_bsize)); } } #endif return am_false; try_literal_gc: need_gc |= ERTS_LITERAL_GC__; try_gc: need_gc |= ERTS_ORDINARY_GC__; if ((done_gc & need_gc) == need_gc) return am_true; if (!(flags & ERTS_CPC_ALLOW_GC)) return am_aborted; need_gc &= ~done_gc; /* * Try to get rid of literals by by garbage collecting. * Clear both fvalue and ftrace. */ rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; if (need_gc & ERTS_ORDINARY_GC__) { FLAGS(rp) |= F_NEED_FULLSWEEP; *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity, fcalls); done_gc |= ERTS_ORDINARY_GC__; } if (need_gc & ERTS_LITERAL_GC__) { struct erl_off_heap_header* oh; oh = modp->old.code_hdr->literals_off_heap; *redsp += lit_bsize / 64; /* Need, better value... */ erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh); done_gc |= ERTS_LITERAL_GC__; } need_gc = 0; } #undef ERTS_ORDINARY_GC__ #undef ERTS_LITERAL_GC__ }
BIF_RETTYPE finish_loading_1(BIF_ALIST_1) { Sint i; Sint n; struct m* p = NULL; Uint exceptions; Eterm res; int is_blocking = 0; int do_commit = 0; if (!erts_try_seize_code_write_permission(BIF_P)) { ERTS_BIF_YIELD1(bif_export[BIF_finish_loading_1], BIF_P, BIF_ARG_1); } /* * Validate the argument before we start loading; it must be a * proper list where each element is a magic binary containing * prepared (not previously loaded) code. * * First count the number of elements and allocate an array * to keep the elements in. */ n = erts_list_length(BIF_ARG_1); if (n < 0) { badarg: if (p) { erts_free(ERTS_ALC_T_LOADER_TMP, p); } erts_release_code_write_permission(); BIF_ERROR(BIF_P, BADARG); } p = erts_alloc(ERTS_ALC_T_LOADER_TMP, n*sizeof(struct m)); /* * We now know that the argument is a proper list. Validate * and collect the binaries into the array. */ for (i = 0; i < n; i++) { Eterm* cons = list_val(BIF_ARG_1); Eterm term = CAR(cons); ProcBin* pb; if (!ERTS_TERM_IS_MAGIC_BINARY(term)) { goto badarg; } pb = (ProcBin*) binary_val(term); p[i].code = pb->val; p[i].module = erts_module_for_prepared_code(p[i].code); if (p[i].module == NIL) { goto badarg; } BIF_ARG_1 = CDR(cons); } /* * Since we cannot handle atomic loading of a group of modules * if one or more of them uses on_load, we will only allow * more than one element in the list if none of the modules * have an on_load function. */ if (n > 1) { for (i = 0; i < n; i++) { if (erts_has_code_on_load(p[i].code) == am_true) { erts_free(ERTS_ALC_T_LOADER_TMP, p); erts_release_code_write_permission(); BIF_ERROR(BIF_P, SYSTEM_LIMIT); } } } /* * All types are correct. There cannot be a BADARG from now on. * Before we can start loading, we must check whether any of * the modules already has old code. To avoid a race, we must * not allow other process to initiate a code loading operation * from now on. */ res = am_ok; erts_start_staging_code_ix(n); for (i = 0; i < n; i++) { p[i].modp = erts_put_module(p[i].module); p[i].modp->seen = 0; } exceptions = 0; for (i = 0; i < n; i++) { p[i].exception = 0; if (p[i].modp->seen) { p[i].exception = 1; exceptions++; } p[i].modp->seen = 1; } if (exceptions) { res = exception_list(BIF_P, am_duplicated, p, exceptions); goto done; } for (i = 0; i < n; i++) { if (p[i].modp->curr.num_breakpoints > 0 || p[i].modp->curr.num_traced_exports > 0 || erts_is_default_trace_enabled()) { /* tracing involved, fallback with thread blocking */ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_smp_thr_progress_block(); is_blocking = 1; break; } } if (is_blocking) { for (i = 0; i < n; i++) { if (p[i].modp->curr.num_breakpoints) { erts_clear_module_break(p[i].modp); ASSERT(p[i].modp->curr.num_breakpoints == 0); } } } exceptions = 0; for (i = 0; i < n; i++) { p[i].exception = 0; if (p[i].modp->curr.code_hdr && p[i].modp->old.code_hdr) { p[i].exception = 1; exceptions++; } } if (exceptions) { res = exception_list(BIF_P, am_not_purged, p, exceptions); } else { /* * Now we can load all code. This can't fail. */ exceptions = 0; for (i = 0; i < n; i++) { Eterm mod; Eterm retval; erts_refc_inc(&p[i].code->refc, 1); retval = erts_finish_loading(p[i].code, BIF_P, 0, &mod); ASSERT(retval == NIL || retval == am_on_load); if (retval == am_on_load) { p[i].exception = 1; exceptions++; } } /* * Check whether any module has an on_load_handler. */ if (exceptions) { res = exception_list(BIF_P, am_on_load, p, exceptions); } do_commit = 1; } done: return staging_epilogue(BIF_P, do_commit, res, is_blocking, p, n); }
static Eterm do_chksum(ChksumFun sumfun, Process *p, Eterm ioterm, int left, void *sum, int *res, int *err) { Eterm *objp; Eterm obj; int c; DECLARE_ESTACK(stack); unsigned char *bytes = NULL; int numbytes = 0; *err = 0; if (left <= 0 || is_nil(ioterm)) { DESTROY_ESTACK(stack); *res = 0; return ioterm; } if(is_binary(ioterm)) { Uint bitoffs; Uint bitsize; Uint size; Eterm res_term = NIL; unsigned char *bytes; byte *temp_alloc = NULL; ERTS_GET_BINARY_BYTES(ioterm, bytes, bitoffs, bitsize); if (bitsize != 0) { *res = 0; *err = 1; DESTROY_ESTACK(stack); return NIL; } if (bitoffs != 0) { bytes = erts_get_aligned_binary_bytes(ioterm, &temp_alloc); /* The call to erts_get_aligned_binary_bytes cannot fail as we'we already checked bitsize and that this is a binary */ } size = binary_size(ioterm); if (size > left) { Eterm *hp; ErlSubBin *sb; Eterm orig; Uint offset; /* Split the binary in two parts, of which we only process the first */ hp = HAlloc(p, ERL_SUB_BIN_SIZE); sb = (ErlSubBin *) hp; ERTS_GET_REAL_BIN(ioterm, orig, offset, bitoffs, bitsize); sb->thing_word = HEADER_SUB_BIN; sb->size = size - left; sb->offs = offset + left; sb->orig = orig; sb->bitoffs = bitoffs; sb->bitsize = bitsize; sb->is_writable = 0; res_term = make_binary(sb); size = left; } (*sumfun)(sum, bytes, size); *res = size; DESTROY_ESTACK(stack); erts_free_aligned_binary_bytes(temp_alloc); return res_term; } if (!is_list(ioterm)) { *res = 0; *err = 1; DESTROY_ESTACK(stack); return NIL; } /* OK a list, needs to be processed in order, handling each flat list-level as they occur, just like io_list_to_binary would */ *res = 0; ESTACK_PUSH(stack,ioterm); while (!ESTACK_ISEMPTY(stack) && left) { ioterm = ESTACK_POP(stack); if (is_nil(ioterm)) { /* ignore empty lists */ continue; } if(is_list(ioterm)) { L_Again: /* Restart with sublist, old listend was pushed on stack */ objp = list_val(ioterm); obj = CAR(objp); for(;;) { /* loop over one flat list of bytes and binaries until sublist or list end is encountered */ if (is_byte(obj)) { int bsize = 0; for(;;) { if (bsize >= numbytes) { if (!bytes) { bytes = erts_alloc(ERTS_ALC_T_TMP, numbytes = 500); } else { if (numbytes > left) { numbytes += left; } else { numbytes *= 2; } bytes = erts_realloc(ERTS_ALC_T_TMP, bytes, numbytes); } } bytes[bsize++] = (unsigned char) unsigned_val(obj); --left; ioterm = CDR(objp); if (!is_list(ioterm)) { break; } objp = list_val(ioterm); obj = CAR(objp); if (!is_byte(obj)) break; if (!left) { break; } } (*sumfun)(sum, bytes, bsize); *res += bsize; } else if (is_nil(obj)) { ioterm = CDR(objp); if (!is_list(ioterm)) { break; } objp = list_val(ioterm); obj = CAR(objp); } else if (is_list(obj)) { /* push rest of list for later processing, start again with sublist */ ESTACK_PUSH(stack,CDR(objp)); ioterm = obj; goto L_Again; } else if (is_binary(obj)) { int sres, serr; Eterm rest_term; rest_term = do_chksum(sumfun, p, obj, left, sum, &sres, &serr); *res += sres; if (serr != 0) { *err = 1; DESTROY_ESTACK(stack); if (bytes != NULL) erts_free(ERTS_ALC_T_TMP, bytes); return NIL; } left -= sres; if (rest_term != NIL) { Eterm *hp; hp = HAlloc(p, 2); obj = CDR(objp); ioterm = CONS(hp, rest_term, obj); left = 0; break; } ioterm = CDR(objp); if (is_list(ioterm)) { /* objp and obj need to be updated if loop is to continue */ objp = list_val(ioterm); obj = CAR(objp); } } else { *err = 1; DESTROY_ESTACK(stack); if (bytes != NULL) erts_free(ERTS_ALC_T_TMP, bytes); return NIL; } if (!left || is_nil(ioterm) || !is_list(ioterm)) { break; } } /* for(;;) */ } /* is_list(ioterm) */ if (!left) { #ifdef ALLOW_BYTE_TAIL if (is_byte(ioterm)) { /* inproper list with byte tail*/ Eterm *hp; hp = HAlloc(p, 2); ioterm = CONS(hp, ioterm, NIL); } #else ; #endif } else if (!is_list(ioterm) && !is_nil(ioterm)) { /* inproper list end */ #ifdef ALLOW_BYTE_TAIL if (is_byte(ioterm)) { unsigned char b[1]; b[0] = (unsigned char) unsigned_val(ioterm); (*sumfun)(sum, b, 1); ++(*res); --left; ioterm = NIL; } else #endif if is_binary(ioterm) { int sres, serr; ioterm = do_chksum(sumfun, p, ioterm, left, sum, &sres, &serr); *res +=sres; if (serr != 0) { *err = 1; DESTROY_ESTACK(stack); if (bytes != NULL) erts_free(ERTS_ALC_T_TMP, bytes); return NIL; } left -= sres; } else { *err = 1; DESTROY_ESTACK(stack); if (bytes != NULL) erts_free(ERTS_ALC_T_TMP, bytes); return NIL; } } } /* while left and not estack empty */
/* * Try to load. If the driver is OK, add as LOADED. If the driver is * UNLOAD, possibly change to reload and add as LOADED, * there should be no other * LOADED tagged pid's. If the driver is RELOAD then add/increment as * LOADED (should be some LOADED pid). If the driver is not present, * really load and add as LOADED {ok,loaded} {ok,pending_driver} * {error, permanent} {error,load_error()} */ BIF_RETTYPE erl_ddll_try_load_3(BIF_ALIST_3) { Eterm path_term = BIF_ARG_1; Eterm name_term = BIF_ARG_2; Eterm options = BIF_ARG_3; char *path = NULL; Sint path_len; char *name = NULL; DE_Handle *dh; erts_driver_t *drv; int res; Eterm soft_error_term = NIL; Eterm ok_term = NIL; Eterm *hp; Eterm t; int monitor = 0; int reload = 0; Eterm l; Uint flags = 0; int kill_ports = 0; int do_build_load_error = 0; int build_this_load_error = 0; int encoding; for(l = options; is_list(l); l = CDR(list_val(l))) { Eterm opt = CAR(list_val(l)); Eterm *tp; if (is_not_tuple(opt)) { goto error; } tp = tuple_val(opt); if (*tp != make_arityval(2) || is_not_atom(tp[1])) { goto error; } switch (tp[1]) { case am_driver_options: { Eterm ll; for(ll = tp[2]; is_list(ll); ll = CDR(list_val(ll))) { Eterm dopt = CAR(list_val(ll)); if (dopt == am_kill_ports) { flags |= ERL_DE_FL_KILL_PORTS; } else { goto error; } } if (is_not_nil(ll)) { goto error; } } break; case am_monitor: if (tp[2] == am_pending_driver) { monitor = 1; } else if (tp[2] == am_pending ) { monitor = 2; } else { goto error; } break; case am_reload: if (tp[2] == am_pending_driver) { reload = 1; } else if (tp[2] == am_pending ) { reload = 2; } else { goto error; } break; default: goto error; } } if (is_not_nil(l)) { goto error; } if ((name = pick_list_or_atom(name_term)) == NULL) { goto error; } encoding = erts_get_native_filename_encoding(); if (encoding == ERL_FILENAME_WIN_WCHAR) { /* Do not convert the lib name to utf-16le yet, do that in win32 specific code */ /* since lib_name is used in error messages */ encoding = ERL_FILENAME_UTF8; } path = erts_convert_filename_to_encoding(path_term, NULL, 0, ERTS_ALC_T_DDLL_TMP_BUF, 1, 0, encoding, &path_len, sys_strlen(name) + 2); /* might need path separator */ if (!path) { goto error; } ASSERT(path_len > 0 && path[path_len-1] == 0); while (--path_len > 0 && (path[path_len-1] == '\\' || path[path_len-1] == '/')) ; path[path_len++] = '/'; sys_strcpy(path+path_len,name); erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); lock_drv_list(); if ((drv = lookup_driver(name)) != NULL) { if (drv->handle == NULL) { /* static_driver */ soft_error_term = am_linked_in_driver; goto soft_error; } else { dh = drv->handle; if (dh->status == ERL_DE_OK) { int is_last = is_last_user(dh, BIF_P); if (reload == 1 && !is_last) { /*Want reload if no other users, but there are others...*/ soft_error_term = am_pending_process; goto soft_error; } if (reload != 0) { DE_ProcEntry *old; if ((dh->flags & ERL_FL_CONSISTENT_MASK) != (flags & ERL_FL_CONSISTENT_MASK)) { soft_error_term = am_inconsistent; goto soft_error; } if ((old = find_proc_entry(dh, BIF_P, ERL_DE_PROC_LOADED)) == NULL) { soft_error_term = am_not_loaded_by_this_process; goto soft_error; } else { remove_proc_entry(dh, old); erts_ddll_dereference_driver(dh); erts_free(ERTS_ALC_T_DDLL_PROCESS, old); } /* Reload requested and granted */ dereference_all_processes(dh); set_driver_reloading(dh, BIF_P, path, name, flags); if (dh->flags & ERL_DE_FL_KILL_PORTS) { kill_ports = 1; } ok_term = (reload == 1) ? am_pending_driver : am_pending_process; } else { /* Already loaded and healthy (might be by me) */ if (sys_strcmp(dh->full_path, path) || (dh->flags & ERL_FL_CONSISTENT_MASK) != (flags & ERL_FL_CONSISTENT_MASK)) { soft_error_term = am_inconsistent; goto soft_error; } add_proc_loaded(dh, BIF_P); erts_ddll_reference_driver(dh); monitor = 0; ok_term = mkatom("already_loaded"); } } else if (dh->status == ERL_DE_UNLOAD || dh->status == ERL_DE_FORCE_UNLOAD) { /* pending driver */ if (reload != 0) { soft_error_term = am_not_loaded_by_this_process; goto soft_error; } if (sys_strcmp(dh->full_path, path) || (dh->flags & ERL_FL_CONSISTENT_MASK) != (flags & ERL_FL_CONSISTENT_MASK)) { soft_error_term = am_inconsistent; goto soft_error; } dh->status = ERL_DE_OK; notify_all(dh, drv->name, ERL_DE_PROC_AWAIT_UNLOAD, am_UP, am_unload_cancelled); add_proc_loaded(dh, BIF_P); erts_ddll_reference_driver(dh); monitor = 0; ok_term = mkatom("already_loaded"); } else if (dh->status == ERL_DE_RELOAD || dh->status == ERL_DE_FORCE_RELOAD) { if (reload != 0) { soft_error_term = am_pending_reload; goto soft_error; } if (sys_strcmp(dh->reload_full_path, path) || (dh->reload_flags & ERL_FL_CONSISTENT_MASK) != (flags & ERL_FL_CONSISTENT_MASK)) { soft_error_term = am_inconsistent; goto soft_error; } /* Load of granted unload... */ /* Don't reference, will happen after reload */ add_proc_loaded_deref(dh, BIF_P); ++monitor; ok_term = am_pending_driver; } else { /* ERL_DE_PERMANENT */ soft_error_term = am_permanent; goto soft_error; } } } else { /* driver non-existing */ if (reload != 0) { soft_error_term = am_not_loaded; goto soft_error; } if ((res = load_driver_entry(&dh, path, name)) != ERL_DE_NO_ERROR) { build_this_load_error = res; do_build_load_error = 1; soft_error_term = am_undefined; goto soft_error; } else { dh->flags = flags; add_proc_loaded(dh, BIF_P); first_ddll_reference(dh); monitor = 0; ok_term = mkatom("loaded"); } } assert_drv_list_rwlocked(); if (kill_ports) { /* Avoid closing the driver by referencing it */ erts_ddll_reference_driver(dh); ASSERT(dh->status == ERL_DE_RELOAD); dh->status = ERL_DE_FORCE_RELOAD; unlock_drv_list(); kill_ports_driver_unloaded(dh); /* Dereference, eventually causing driver destruction */ lock_drv_list(); erts_ddll_dereference_driver(dh); } erts_ddll_reference_driver(dh); unlock_drv_list(); erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); lock_drv_list(); erts_ddll_dereference_driver(dh); BIF_P->flags |= F_USING_DDLL; if (monitor) { Eterm mref = add_monitor(BIF_P, dh, ERL_DE_PROC_AWAIT_LOAD); hp = HAlloc(BIF_P, 4); t = TUPLE3(hp, am_ok, ok_term, mref); } else { hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_ok, ok_term); } unlock_drv_list(); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); BIF_RET(t); soft_error: unlock_drv_list(); erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); if (do_build_load_error) { soft_error_term = build_load_error(BIF_P, build_this_load_error); } hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_error, soft_error_term); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); BIF_RET(t); error: assert_drv_list_not_locked(); ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); if (path != NULL) { erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); } if (name != NULL) { erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); } BIF_ERROR(BIF_P, BADARG); }
Uint size_object(Eterm obj) { Uint sum = 0; Eterm* ptr; int arity; DECLARE_ESTACK(s); for (;;) { switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: sum += 2; ptr = list_val(obj); obj = *ptr++; if (!IS_CONST(obj)) { ESTACK_PUSH(s, obj); } obj = *ptr; break; case TAG_PRIMARY_BOXED: { Eterm hdr = *boxed_val(obj); ASSERT(is_header(hdr)); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: ptr = tuple_val(obj); arity = header_arity(hdr); sum += arity + 1; if (arity == 0) { /* Empty tuple -- unusual. */ goto pop_next; } while (arity-- > 1) { obj = *++ptr; if (!IS_CONST(obj)) { ESTACK_PUSH(s, obj); } } obj = *++ptr; break; case FUN_SUBTAG: { Eterm* bptr = fun_val(obj); ErlFunThing* funp = (ErlFunThing *) bptr; unsigned eterms = 1 /* creator */ + funp->num_free; unsigned sz = thing_arityval(hdr); sum += 1 /* header */ + sz + eterms; bptr += 1 /* header */ + sz; while (eterms-- > 1) { obj = *bptr++; if (!IS_CONST(obj)) { ESTACK_PUSH(s, obj); } } obj = *bptr; break; } case SUB_BINARY_SUBTAG: { Eterm real_bin; Uint offset; /* Not used. */ Uint bitsize; Uint bitoffs; Uint extra_bytes; Eterm hdr; ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); if ((bitsize + bitoffs) > 8) { sum += ERL_SUB_BIN_SIZE; extra_bytes = 2; } else if ((bitsize + bitoffs) > 0) { sum += ERL_SUB_BIN_SIZE; extra_bytes = 1; } else { extra_bytes = 0; } hdr = *binary_val(real_bin); if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) { sum += PROC_BIN_SIZE; } else { sum += heap_bin_size(binary_size(obj)+extra_bytes); } goto pop_next; } break; case BIN_MATCHSTATE_SUBTAG: erl_exit(ERTS_ABORT_EXIT, "size_object: matchstate term not allowed"); default: sum += thing_arityval(hdr) + 1; goto pop_next; } } break; case TAG_PRIMARY_IMMED1: pop_next: if (ESTACK_ISEMPTY(s)) { DESTROY_ESTACK(s); return sum; } obj = ESTACK_POP(s); break; default: erl_exit(ERTS_ABORT_EXIT, "size_object: bad tag for %#x\n", obj); } } }
/* You have to have loaded the driver and the pid state is LOADED or AWAIT_LOAD. You will be removed from the list regardless of driver state. If the driver is loaded by someone else to, return is {ok, pending_process} If the driver is loaded but locked by a port, return is {ok, pending_driver} If the driver is loaded and free to unload (you're the last holding it) {ok, unloaded} If it's not loaded or not loaded by you {error, not_loaded} or {error, not_loaded_by_you} Internally, if its in state UNLOADING, just return {ok, pending_driver} and remove/decrement this pid (which should be an LOADED tagged one). If the state is RELOADING, this pid should be in list as LOADED tagged, only AWAIT_LOAD would be possible but not allowed for unloading, remove it and, if the last LOADED tagged, change from RELOAD to UNLOAD and notify any AWAIT_LOAD-waiters with {'DOWN', ref(), driver, name(), load_cancelled} If the driver made itself permanent, {'UP', ref(), driver, name(), permanent} */ Eterm erl_ddll_try_unload_2(BIF_ALIST_2) { Eterm name_term = BIF_ARG_1; Eterm options = BIF_ARG_2; char *name = NULL; Eterm ok_term = NIL; Eterm soft_error_term = NIL; erts_driver_t *drv; DE_Handle *dh; DE_ProcEntry *pe; Eterm *hp; Eterm t; int monitor = 0; Eterm l; int kill_ports = 0; erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); for(l = options; is_list(l); l = CDR(list_val(l))) { Eterm opt = CAR(list_val(l)); Eterm *tp; if (is_not_tuple(opt)) { if (opt == am_kill_ports) { kill_ports = 1; continue; } else { goto error; } } tp = tuple_val(opt); if (*tp != make_arityval(2) || tp[1] != am_monitor) { goto error; } if (tp[2] == am_pending_driver) { monitor = 1; } else if (tp[2] == am_pending) { monitor = 2; } else { goto error; } } if (is_not_nil(l)) { goto error; } if ((name = pick_list_or_atom(name_term)) == NULL) { goto error; } lock_drv_list(); if ((drv = lookup_driver(name)) == NULL) { soft_error_term = am_not_loaded; goto soft_error; } if (drv->handle == NULL) { soft_error_term = am_linked_in_driver; goto soft_error; } else if (drv->handle->status == ERL_DE_PERMANENT) { soft_error_term = am_permanent; goto soft_error; } dh = drv->handle; if (dh->flags & ERL_DE_FL_KILL_PORTS) { kill_ports = 1; } if ((pe = find_proc_entry(dh, BIF_P, ERL_DE_PROC_LOADED)) == NULL) { if (num_procs(dh, ERL_DE_PROC_LOADED) > 0) { soft_error_term = am_not_loaded_by_this_process; goto soft_error; } } else { remove_proc_entry(dh, pe); if (!(pe->flags & ERL_DE_FL_DEREFERENCED)) { erts_ddll_dereference_driver(dh); } erts_free(ERTS_ALC_T_DDLL_PROCESS, pe); } if (num_procs(dh, ERL_DE_PROC_LOADED) > 0) { ok_term = am_pending_process; --monitor; goto done; } if (dh->status == ERL_DE_RELOAD || dh->status == ERL_DE_FORCE_RELOAD) { notify_all(dh, drv->name, ERL_DE_PROC_AWAIT_LOAD, am_DOWN, am_load_cancelled); erts_free(ERTS_ALC_T_DDLL_HANDLE,dh->reload_full_path); erts_free(ERTS_ALC_T_DDLL_HANDLE,dh->reload_driver_name); dh->reload_full_path = dh->reload_driver_name = NULL; dh->reload_flags = 0; } if (erts_atomic32_read_nob(&dh->port_count) > 0) { ++kill_ports; } dh->status = ERL_DE_UNLOAD; ok_term = am_pending_driver; done: assert_drv_list_rwlocked(); if (kill_ports > 1) { /* Avoid closing the driver by referencing it */ erts_ddll_reference_driver(dh); dh->status = ERL_DE_FORCE_UNLOAD; unlock_drv_list(); kill_ports_driver_unloaded(dh); lock_drv_list(); erts_ddll_dereference_driver(dh); } erts_ddll_reference_driver(dh); unlock_drv_list(); erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); lock_drv_list(); erts_ddll_dereference_driver(dh); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); BIF_P->flags |= F_USING_DDLL; if (monitor > 0) { Eterm mref = add_monitor(BIF_P, dh, ERL_DE_PROC_AWAIT_UNLOAD); hp = HAlloc(BIF_P, 4); t = TUPLE3(hp, am_ok, ok_term, mref); } else { hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_ok, ok_term); } if (kill_ports > 1) { ERTS_BIF_CHK_EXITED(BIF_P); /* May be exited by port killing */ } unlock_drv_list(); BIF_RET(t); soft_error: unlock_drv_list(); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_error, soft_error_term); BIF_RET(t); error: /* No lock fiddling before going here */ assert_drv_list_not_locked(); if (name != NULL) { erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); } erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_ERROR(BIF_P, BADARG); }
/* * Copy a structure to a heap. */ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) { char* hstart; Uint hsize; Eterm* htop; Eterm* hbot; Eterm* hp; Eterm* objp; Eterm* tp; Eterm res; Eterm elem; Eterm* tailp; Eterm* argp; Eterm* const_tuple; Eterm hdr; int i; #ifdef DEBUG Eterm org_obj = obj; Uint org_sz = sz; #endif if (IS_CONST(obj)) return obj; hp = htop = *hpp; hbot = htop + sz; hstart = (char *)htop; hsize = (char*) hbot - hstart; const_tuple = 0; /* Copy the object onto the heap */ switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: argp = &res; goto L_copy_list; case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed; default: erl_exit(ERTS_ABORT_EXIT, "%s, line %d: Internal error in copy_struct: 0x%08x\n", __FILE__, __LINE__,obj); } L_copy: while (hp != htop) { obj = *hp; switch (primary_tag(obj)) { case TAG_PRIMARY_IMMED1: hp++; break; case TAG_PRIMARY_LIST: objp = list_val(obj); if (in_area(objp,hstart,hsize)) { hp++; break; } argp = hp++; /* Fall through */ L_copy_list: tailp = argp; while (is_list(obj)) { objp = list_val(obj); tp = tailp; elem = *objp; if (IS_CONST(elem)) { *(hbot-2) = elem; tailp = hbot-1; hbot -= 2; } else { *htop = elem; tailp = htop+1; htop += 2; } *tp = make_list(tailp - 1); obj = *(objp+1); } switch (primary_tag(obj)) { case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy; case TAG_PRIMARY_BOXED: argp = tailp; goto L_copy_boxed; default: erl_exit(ERTS_ABORT_EXIT, "%s, line %d: Internal error in copy_struct: 0x%08x\n", __FILE__, __LINE__,obj); } case TAG_PRIMARY_BOXED: if (in_area(boxed_val(obj),hstart,hsize)) { hp++; break; } argp = hp++; L_copy_boxed: objp = boxed_val(obj); hdr = *objp; switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { int const_flag = 1; /* assume constant tuple */ i = arityval(hdr); *argp = make_tuple(htop); tp = htop; /* tp is pointer to new arity value */ *htop++ = *objp++; /* copy arity value */ while (i--) { elem = *objp++; if (!IS_CONST(elem)) { const_flag = 0; } *htop++ = elem; } if (const_flag) { const_tuple = tp; /* this is the latest const_tuple */ } } break; case REFC_BINARY_SUBTAG: { ProcBin* pb; pb = (ProcBin *) objp; if (pb->flags) { erts_emasculate_writable_binary(pb); } i = thing_arityval(*objp) + 1; hbot -= i; tp = hbot; while (i--) { *tp++ = *objp++; } *argp = make_binary(hbot); pb = (ProcBin*) hbot; erts_refc_inc(&pb->val->refc, 2); pb->next = off_heap->mso; pb->flags = 0; off_heap->mso = pb; off_heap->overhead += pb->size / sizeof(Eterm); } break; case SUB_BINARY_SUBTAG: { ErlSubBin* sb = (ErlSubBin *) objp; Eterm real_bin = sb->orig; Uint bit_offset = sb->bitoffs; Uint bit_size = sb -> bitsize; Uint offset = sb->offs; size_t size = sb->size; Uint extra_bytes; Uint real_size; if ((bit_size + bit_offset) > 8) { extra_bytes = 2; } else if ((bit_size + bit_offset) > 0) { extra_bytes = 1; } else { extra_bytes = 0; } real_size = size+extra_bytes; objp = binary_val(real_bin); if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) { ErlHeapBin* from = (ErlHeapBin *) objp; ErlHeapBin* to; i = heap_bin_size(real_size); hbot -= i; to = (ErlHeapBin *) hbot; to->thing_word = header_heap_bin(real_size); to->size = real_size; sys_memcpy(to->data, ((byte *)from->data)+offset, real_size); } else { ProcBin* from = (ProcBin *) objp; ProcBin* to; ASSERT(thing_subtag(*objp) == REFC_BINARY_SUBTAG); if (from->flags) { erts_emasculate_writable_binary(from); } hbot -= PROC_BIN_SIZE; to = (ProcBin *) hbot; to->thing_word = HEADER_PROC_BIN; to->size = real_size; to->val = from->val; erts_refc_inc(&to->val->refc, 2); to->bytes = from->bytes + offset; to->next = off_heap->mso; to->flags = 0; off_heap->mso = to; off_heap->overhead += to->size / sizeof(Eterm); } *argp = make_binary(hbot); if (extra_bytes != 0) { ErlSubBin* res; hbot -= ERL_SUB_BIN_SIZE; res = (ErlSubBin *) hbot; res->thing_word = HEADER_SUB_BIN; res->size = size; res->bitsize = bit_size; res->bitoffs = bit_offset; res->offs = 0; res->is_writable = 0; res->orig = *argp; *argp = make_binary(hbot); } break; } break; case FUN_SUBTAG: { ErlFunThing* funp = (ErlFunThing *) objp; i = thing_arityval(hdr) + 2 + funp->num_free; tp = htop; while (i--) { *htop++ = *objp++; } #ifndef HYBRID /* FIND ME! */ funp = (ErlFunThing *) tp; funp->next = off_heap->funs; off_heap->funs = funp; erts_refc_inc(&funp->fe->refc, 2); #endif *argp = make_fun(tp); } break; case EXTERNAL_PID_SUBTAG: case EXTERNAL_PORT_SUBTAG: case EXTERNAL_REF_SUBTAG: { ExternalThing *etp = (ExternalThing *) htop; i = thing_arityval(hdr) + 1; tp = htop; while (i--) { *htop++ = *objp++; } etp->next = off_heap->externals; off_heap->externals = etp; erts_refc_inc(&etp->node->refc, 2); *argp = make_external(tp); } break; case BIN_MATCHSTATE_SUBTAG: erl_exit(ERTS_ABORT_EXIT, "copy_struct: matchstate term not allowed"); default: i = thing_arityval(hdr)+1; hbot -= i; tp = hbot; *argp = make_boxed(hbot); while (i--) { *tp++ = *objp++; } } break; case TAG_PRIMARY_HEADER: if (header_is_thing(obj) || hp == const_tuple) { hp += header_arity(obj) + 1; } else { hp++; } break; } } #ifdef DEBUG if (htop != hbot) erl_exit(ERTS_ABORT_EXIT, "Internal error in copy_struct() when copying %T:" " htop=%p != hbot=%p (sz=%bpu)\n", org_obj, htop, hbot, org_sz); #else if (htop > hbot) { erl_exit(ERTS_ABORT_EXIT, "Internal error in copy_struct(): htop, hbot overrun\n"); } #endif *hpp = (Eterm *) (hstart+hsize); return res; }
static int pdisplay1(fmtfn_t to, void *to_arg, Process* p, Eterm obj) { int i, k; Eterm* nobj; if (dcount-- <= 0) return(1); if (is_CP(obj)) { erts_print(to, to_arg, "<cp/header:%0*lX",PTR_SIZE,obj); return 0; } switch (tag_val_def(obj)) { case NIL_DEF: erts_print(to, to_arg, "[]"); break; case ATOM_DEF: erts_print(to, to_arg, "%T", obj); break; case SMALL_DEF: erts_print(to, to_arg, "%ld", signed_val(obj)); break; case BIG_DEF: nobj = big_val(obj); if (!IN_HEAP(p, nobj)) { erts_print(to, to_arg, "#<bad big %X>#", obj); return 1; } i = BIG_SIZE(nobj); if (BIG_SIGN(nobj)) erts_print(to, to_arg, "-#integer(%d) = {", i); else erts_print(to, to_arg, "#integer(%d) = {", i); erts_print(to, to_arg, "%d", BIG_DIGIT(nobj, 0)); for (k = 1; k < i; k++) erts_print(to, to_arg, ",%d", BIG_DIGIT(nobj, k)); erts_putc(to, to_arg, '}'); break; case REF_DEF: case EXTERNAL_REF_DEF: { Uint32 *ref_num; erts_print(to, to_arg, "#Ref<%lu", ref_channel_no(obj)); ref_num = ref_numbers(obj); for (i = ref_no_numbers(obj)-1; i >= 0; i--) erts_print(to, to_arg, ",%lu", ref_num[i]); erts_print(to, to_arg, ">"); break; } case PID_DEF: case EXTERNAL_PID_DEF: erts_print(to, to_arg, "<%lu.%lu.%lu>", pid_channel_no(obj), pid_number(obj), pid_serial(obj)); break; case PORT_DEF: case EXTERNAL_PORT_DEF: erts_print(to, to_arg, "#Port<%lu.%lu>", port_channel_no(obj), port_number(obj)); break; case LIST_DEF: erts_putc(to, to_arg, '['); nobj = list_val(obj); while (1) { if (!IN_HEAP(p, nobj)) { erts_print(to, to_arg, "#<bad list %X>", obj); return 1; } if (pdisplay1(to, to_arg, p, *nobj++) != 0) return(1); if (is_not_list(*nobj)) break; erts_putc(to, to_arg, ','); nobj = list_val(*nobj); } if (is_not_nil(*nobj)) { erts_putc(to, to_arg, '|'); if (pdisplay1(to, to_arg, p, *nobj) != 0) return(1); } erts_putc(to, to_arg, ']'); break; case TUPLE_DEF: nobj = tuple_val(obj); /* pointer to arity */ i = arityval(*nobj); /* arity */ erts_putc(to, to_arg, '{'); while (i--) { if (pdisplay1(to, to_arg, p, *++nobj) != 0) return(1); if (i >= 1) erts_putc(to, to_arg, ','); } erts_putc(to, to_arg, '}'); break; case FLOAT_DEF: { FloatDef ff; GET_DOUBLE(obj, ff); erts_print(to, to_arg, "%.20e", ff.fd); } break; case BINARY_DEF: erts_print(to, to_arg, "#Bin"); break; case MATCHSTATE_DEF: erts_print(to, to_arg, "#Matchstate"); break; default: erts_print(to, to_arg, "unknown object %x", obj); } return(0); }
/* Copy a message to the message area. */ Eterm copy_struct_lazy(Process *from, Eterm orig, Uint offs) { Eterm obj; Eterm dest; #ifdef INCREMENTAL int alloc_old = 0; #else int total_need = 0; #endif VERBOSE(DEBUG_MESSAGES, ("COPY START; %T is sending a message @ 0x%016x\n%T\n", from->id, orig, orig)); #ifndef INCREMENTAL copy_start: #endif MA_STACK_PUSH(src,orig); MA_STACK_PUSH(dst,&dest); MA_STACK_PUSH(offset,offs); while (ma_src_top > 0) { obj = MA_STACK_POP(src); /* copy_struct_lazy should never be called with something that * do not need to be copied. Within the loop, nothing that do * not need copying should be placed in the src-stack. */ ASSERT(!NO_COPY(obj)); switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: { Eterm *hp; Eterm *objp; GlobalAlloc(from,2,hp); objp = list_val(obj); MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_list(hp)); MA_STACK_POP(dst); /* TODO: Byt ordningen nedan så att CDR pushas först. */ if (NO_COPY(*objp)) { hp[0] = *objp; #ifdef INCREMENTAL if (ptr_within(ptr_val(*objp),inc_fromspc,inc_fromend)) INC_STORE(gray,hp,2); #endif } else { MA_STACK_PUSH(src,*objp); MA_STACK_PUSH(dst,hp); MA_STACK_PUSH(offset,0); } objp++; if (NO_COPY(*objp)) { hp[1] = *objp; #ifdef INCREMENTAL if (ptr_within(ptr_val(*objp),inc_fromspc,inc_fromend)) INC_STORE(gray,hp,2); #endif } else { MA_STACK_PUSH(src,*objp); MA_STACK_PUSH(dst,hp); MA_STACK_PUSH(offset,1); } continue; } case TAG_PRIMARY_BOXED: { Eterm *objp = boxed_val(obj); switch (*objp & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { Uint ari = arityval(*objp); Uint i; Eterm *hp; GlobalAlloc(from,ari + 1,hp); /* A GC above might invalidate the value of objp */ objp = boxed_val(obj); MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_tuple(hp)); MA_STACK_POP(dst); *hp = *objp++; for (i = 1; i <= ari; i++) { switch (primary_tag(*objp)) { case TAG_PRIMARY_LIST: case TAG_PRIMARY_BOXED: if (NO_COPY(*objp)) { hp[i] = *objp; #ifdef INCREMENTAL if (ptr_within(ptr_val(*objp), inc_fromspc,inc_fromend)) INC_STORE(gray,hp,BOXED_NEED(hp,*hp)); #endif objp++; } else { MA_STACK_PUSH(src,*objp++); MA_STACK_PUSH(dst,hp); MA_STACK_PUSH(offset,i); } break; default: hp[i] = *objp++; } } continue; } case REFC_BINARY_SUBTAG: { ProcBin *pb; Uint i = thing_arityval(*objp) + 1; Eterm *hp; GlobalAlloc(from,i,hp); /* A GC above might invalidate the value of objp */ objp = boxed_val(obj); MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_binary(hp)); MA_STACK_POP(dst); pb = (ProcBin*) hp; while (i--) { *hp++ = *objp++; } erts_refc_inc(&pb->val->refc, 2); pb->next = erts_global_offheap.mso; erts_global_offheap.mso = pb; erts_global_offheap.overhead += pb->size / sizeof(Eterm); continue; } case FUN_SUBTAG: { ErlFunThing *funp = (ErlFunThing*) objp; Uint i = thing_arityval(*objp) + 1; Uint j = i + 1 + funp->num_free; Uint k = i; Eterm *hp, *hp_start; GlobalAlloc(from,j,hp); /* A GC above might invalidate the value of objp */ objp = boxed_val(obj); hp_start = hp; MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_fun(hp)); MA_STACK_POP(dst); funp = (ErlFunThing*) hp; while (i--) { *hp++ = *objp++; } #ifndef HYBRID // FIND ME! funp->next = erts_global_offheap.funs; erts_global_offheap.funs = funp; erts_refc_inc(&funp->fe->refc, 2); #endif for (i = k; i < j; i++) { switch (primary_tag(*objp)) { case TAG_PRIMARY_LIST: case TAG_PRIMARY_BOXED: if (NO_COPY(*objp)) { #ifdef INCREMENTAL if (ptr_within(ptr_val(*objp), inc_fromspc,inc_fromend)) INC_STORE(gray,hp,BOXED_NEED(hp,*hp)); #endif *hp++ = *objp++; } else { MA_STACK_PUSH(src,*objp++); MA_STACK_PUSH(dst,hp_start); MA_STACK_PUSH(offset,i); hp++; } break; default: *hp++ = *objp++; } } continue; } case EXTERNAL_PID_SUBTAG: case EXTERNAL_PORT_SUBTAG: case EXTERNAL_REF_SUBTAG: { ExternalThing *etp; Uint i = thing_arityval(*objp) + 1; Eterm *hp; GlobalAlloc(from,i,hp); /* A GC above might invalidate the value of objp */ objp = boxed_val(obj); MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_external(hp)); MA_STACK_POP(dst); etp = (ExternalThing*) hp; while (i--) { *hp++ = *objp++; } etp->next = erts_global_offheap.externals; erts_global_offheap.externals = etp; erts_refc_inc(&etp->node->refc, 2); continue; } case SUB_BINARY_SUBTAG: { ErlSubBin *sb = (ErlSubBin *) objp; Eterm *hp; Eterm res_binary; Eterm real_bin = sb->orig; Uint bit_offset = sb->bitoffs; Uint bit_size = sb -> bitsize; Uint sub_offset = sb->offs; size_t size = sb->size; Uint extra_bytes; Uint real_size; Uint sub_binary_heapneed; if ((bit_size + bit_offset) > 8) { extra_bytes = 2; sub_binary_heapneed = ERL_SUB_BIN_SIZE; } else if ((bit_size + bit_offset) > 0) { extra_bytes = 1; sub_binary_heapneed = ERL_SUB_BIN_SIZE; } else { extra_bytes = 0; sub_binary_heapneed = 0; } real_size = size+extra_bytes; objp = binary_val(real_bin); if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) { ErlHeapBin *from_bin; ErlHeapBin *to_bin; Uint i = heap_bin_size(real_size); GlobalAlloc(from,i+sub_binary_heapneed,hp); from_bin = (ErlHeapBin *) objp; to_bin = (ErlHeapBin *) hp; to_bin->thing_word = header_heap_bin(real_size); to_bin->size = real_size; sys_memcpy(to_bin->data, ((byte *)from_bin->data) + sub_offset, real_size); res_binary = make_binary(to_bin); hp += i; } else { ProcBin *from_bin; ProcBin *to_bin; ASSERT(thing_subtag(*objp) == REFC_BINARY_SUBTAG); from_bin = (ProcBin *) objp; erts_refc_inc(&from_bin->val->refc, 2); GlobalAlloc(from,PROC_BIN_SIZE+sub_binary_heapneed,hp); to_bin = (ProcBin *) hp; to_bin->thing_word = HEADER_PROC_BIN; to_bin->size = real_size; to_bin->val = from_bin->val; to_bin->bytes = from_bin->bytes + sub_offset; to_bin->next = erts_global_offheap.mso; erts_global_offheap.mso = to_bin; erts_global_offheap.overhead += to_bin->size / sizeof(Eterm); res_binary=make_binary(to_bin); hp += PROC_BIN_SIZE; } if (extra_bytes != 0) { ErlSubBin* res; res = (ErlSubBin *) hp; res->thing_word = HEADER_SUB_BIN; res->size = size; res->bitsize = bit_size; res->bitoffs = bit_offset; res->offs = 0; res->is_writable = 0; res->orig = res_binary; res_binary = make_binary(hp); } MA_STACK_UPDATE(dst,MA_STACK_POP(offset),res_binary); MA_STACK_POP(dst); continue; } case BIN_MATCHSTATE_SUBTAG: erl_exit(ERTS_ABORT_EXIT, "copy_struct_lazy: matchstate term not allowed"); default: { Uint size = thing_arityval(*objp) + 1; Eterm *hp; GlobalAlloc(from,size,hp); /* A GC above might invalidate the value of objp */ objp = boxed_val(obj); MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_boxed(hp)); MA_STACK_POP(dst); while (size--) { *hp++ = *objp++; } continue; } } continue; } case TAG_PRIMARY_HEADER: ASSERT((obj & _TAG_HEADER_MASK) == ARITYVAL_SUBTAG); { Eterm *objp = &obj; Uint ari = arityval(obj); Uint i; Eterm *hp; GlobalAlloc(from,ari + 1,hp); MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_tuple(hp)); MA_STACK_POP(dst); *hp = *objp++; for (i = 1; i <= ari; i++) { switch (primary_tag(*objp)) { case TAG_PRIMARY_LIST: case TAG_PRIMARY_BOXED: if (NO_COPY(*objp)) { #ifdef INCREMENTAL if (ptr_within(ptr_val(*objp),inc_fromspc,inc_fromend)) INC_STORE(gray,hp,ari + 1); #endif hp[i] = *objp++; } else { MA_STACK_PUSH(src,*objp++); MA_STACK_PUSH(dst,hp); MA_STACK_PUSH(offset,i); } break; default: hp[i] = *objp++; } } continue; } default: erl_exit(ERTS_ABORT_EXIT, "%s, line %d: Internal error in copy_struct_lazy: 0x%08x\n", __FILE__, __LINE__,obj); } } VERBOSE(DEBUG_MESSAGES, ("Copy allocated @ 0x%08lx:\n%T\n", (unsigned long)ptr_val(dest),dest)); ma_gc_flags &= ~GC_CYCLE_START; ASSERT(eq(orig, dest)); ASSERT(ma_src_top == 0); ASSERT(ma_dst_top == 0); ASSERT(ma_offset_top == 0); return dest; }