Beispiel #1
0
BIF_RETTYPE bit_size_1(BIF_ALIST_1)
{
    Uint low_bits;
    Uint bytesize;
    Uint high_bits;
    if (is_binary(BIF_ARG_1)) {
	bytesize = binary_size(BIF_ARG_1);
	high_bits = bytesize >>  ((sizeof(Uint) * 8)-3);
	low_bits = (bytesize << 3) + binary_bitsize(BIF_ARG_1);
	if (high_bits == 0) {
	    if (IS_USMALL(0,low_bits)) {
		BIF_RET(make_small(low_bits));
	    } else {
		Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
		BIF_RET(uint_to_big(low_bits, hp));
	    }
	} else {
	    Uint sz = BIG_UINT_HEAP_SIZE+1;
	    Eterm* hp = HAlloc(BIF_P, sz);
	    hp[0] = make_pos_bignum_header(sz-1);
	    BIG_DIGIT(hp,0) = low_bits;
	    BIG_DIGIT(hp,1) = high_bits;
	    BIF_RET(make_big(hp));
	}
    } else {
Beispiel #2
0
BIF_RETTYPE abs_1(BIF_ALIST_1)
{
    Eterm res;
    Sint i0, i;
    Eterm* hp;

    /* integer arguments */
    if (is_small(BIF_ARG_1)) {
	i0 = signed_val(BIF_ARG_1);
	i = ERTS_SMALL_ABS(i0);
	if (i0 == MIN_SMALL) {
	    hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
	    BIF_RET(uint_to_big(i, hp));
	} else {
	    BIF_RET(make_small(i));
	}
    } else if (is_big(BIF_ARG_1)) {
	if (!big_sign(BIF_ARG_1)) {
	    BIF_RET(BIF_ARG_1);
	} else {
	    int sz = big_arity(BIF_ARG_1) + 1;
	    Uint* x;

	    hp = HAlloc(BIF_P, sz);	/* See note at beginning of file */
	    sz--;
	    res = make_big(hp);
	    x = big_val(BIF_ARG_1);
	    *hp++ = make_pos_bignum_header(sz);
	    x++;                          /* skip thing */
	    while(sz--)
		*hp++ = *x++;
	    BIF_RET(res);
	}
    } else if (is_float(BIF_ARG_1)) {
	FloatDef f;

	GET_DOUBLE(BIF_ARG_1, f);
	if (f.fd < 0.0) {
	    hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT);
	    f.fd = fabs(f.fd);
	    res = make_float(hp);
	    PUT_DOUBLE(f, hp);
	    BIF_RET(res);
	}
	else
	    BIF_RET(BIF_ARG_1);
    }
    BIF_ERROR(BIF_P, BADARG);
}
Beispiel #3
0
static BIF_RETTYPE
dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I)
{
    BIF_RETTYPE ret;
    if (am_scheduler == arg1) {
	ErtsSchedulerData *esdp;
	if (arg2 != am_type) 
	    goto badarg;
	esdp = erts_proc_sched_data(c_p);
	if (!esdp)
            goto scheduler_type_error;
      
        switch (esdp->type) {
        case ERTS_SCHED_NORMAL:
	    ERTS_BIF_PREP_RET(ret, am_normal);
            break;
        case ERTS_SCHED_DIRTY_CPU:
	    ERTS_BIF_PREP_RET(ret, am_dirty_cpu);
            break;
        case ERTS_SCHED_DIRTY_IO:
	    ERTS_BIF_PREP_RET(ret, am_dirty_io);
            break;
        default:
        scheduler_type_error:
	    ERTS_BIF_PREP_RET(ret, am_error);
            break;
        }
    }
    else if (am_error == arg1) {
	switch (arg2) {
	case am_notsup:
	    ERTS_BIF_PREP_ERROR(ret, c_p, EXC_NOTSUP);
	    break;
	case am_undef:
	    ERTS_BIF_PREP_ERROR(ret, c_p, EXC_UNDEF);
	    break;
	case am_badarith:
	    ERTS_BIF_PREP_ERROR(ret, c_p, EXC_BADARITH);
	    break;
	case am_noproc:
	    ERTS_BIF_PREP_ERROR(ret, c_p, EXC_NOPROC);
	    break;
	case am_system_limit:
	    ERTS_BIF_PREP_ERROR(ret, c_p, SYSTEM_LIMIT);
	    break;
	case am_badarg:
	default:
	    goto badarg;
	}
    }
    else if (am_copy == arg1) {
	int i;
	Eterm res;

	for (res = NIL, i = 0; i < 1000; i++) {
	    Eterm *hp, sz;
	    Eterm cpy;
	    /* We do not want this to be optimized,
	       but rather the oposite... */
	    sz = size_object(arg2);
	    hp = HAlloc(c_p, sz);
	    cpy = copy_struct(arg2, sz, &hp, &c_p->off_heap);
	    hp = HAlloc(c_p, 2);
	    res = CONS(hp, cpy, res);
	}

	ERTS_BIF_PREP_RET(ret, res);
    }
    else if (am_send == arg1) {
	dirty_send_message(c_p, arg2, am_ok);
	ERTS_BIF_PREP_RET(ret, am_ok);
    }
    else if (ERTS_IS_ATOM_STR("wait", arg1)) {
	if (!ms_wait(c_p, arg2, type == am_dirty_cpu))
	    goto badarg;
	ERTS_BIF_PREP_RET(ret, am_ok);
    }
    else if (ERTS_IS_ATOM_STR("reschedule", arg1)) {
	/*
	 * Reschedule operation after decrement of two until we reach
	 * zero. Switch between dirty scheduler types when 'n' is
	 * evenly divided by 4. If the initial value wasn't evenly
	 * dividable by 2, throw badarg exception.
	 */
	Eterm next_type;
	Sint n;
	if (!term_to_Sint(arg2, &n) || n < 0)
	    goto badarg;
	if (n == 0)
	    ERTS_BIF_PREP_RET(ret, am_ok);
	else {
	    Eterm argv[3];
	    Eterm eint = erts_make_integer((Uint) (n - 2), c_p);
	    if (n % 4 != 0)
		next_type = type;
	    else {
		switch (type) {
		case am_dirty_cpu: next_type = am_dirty_io; break;
		case am_dirty_io: next_type = am_normal; break;
		case am_normal: next_type = am_dirty_cpu; break;
		default: goto badarg;
		}
	    }
	    switch (next_type) {
	    case am_dirty_io:
		argv[0] = arg1;
		argv[1] = eint;
		ret = erts_schedule_bif(c_p,
					argv,
					I,
					erts_debug_dirty_io_2,
					ERTS_SCHED_DIRTY_IO,
					am_erts_debug,
					am_dirty_io,
					2);
		break;
	    case am_dirty_cpu:
		argv[0] = arg1;
		argv[1] = eint;
		ret = erts_schedule_bif(c_p,
					argv,
					I,
					erts_debug_dirty_cpu_2,
					ERTS_SCHED_DIRTY_CPU,
					am_erts_debug,
					am_dirty_cpu,
					2);
		break;
	    case am_normal:
		argv[0] = am_normal;
		argv[1] = arg1;
		argv[2] = eint;
		ret = erts_schedule_bif(c_p,
					argv,
					I,
					erts_debug_dirty_3,
					ERTS_SCHED_NORMAL,
					am_erts_debug,
					am_dirty,
					3);
		break;
	    default:
		goto badarg;
	    }
	}
    }
    else if (ERTS_IS_ATOM_STR("ready_wait6_done", arg1)) {
	ERTS_DECL_AM(ready);
	ERTS_DECL_AM(done);
	dirty_send_message(c_p, arg2, AM_ready);
	ms_wait(c_p, make_small(6000), 0);
	dirty_send_message(c_p, arg2, AM_done);
	ERTS_BIF_PREP_RET(ret, am_ok);
    }
    else if (ERTS_IS_ATOM_STR("alive_waitexiting", arg1)) {
	Process *real_c_p = erts_proc_shadow2real(c_p);
	Eterm *hp, *hp2;
	Uint sz;
	int i;
	ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
        int dirty_io = esdp->type == ERTS_SCHED_DIRTY_IO;

	if (ERTS_PROC_IS_EXITING(real_c_p))
	    goto badarg;
	dirty_send_message(c_p, arg2, am_alive);

	/* Wait until dead */
	while (!ERTS_PROC_IS_EXITING(real_c_p)) {
            if (dirty_io)
                ms_wait(c_p, make_small(100), 0);
            else
                erts_thr_yield();
        }

	ms_wait(c_p, make_small(1000), 0);

	/* Should still be able to allocate memory */
	hp = HAlloc(c_p, 3); /* Likely on heap */
	sz = 10000;
	hp2 = HAlloc(c_p, sz); /* Likely in heap fragment */
	*hp2 = make_pos_bignum_header(sz);
	for (i = 1; i < sz; i++)
	    hp2[i] = (Eterm) 4711;
	ERTS_BIF_PREP_RET(ret, TUPLE2(hp, am_ok, make_big(hp2)));
    }
    else {
    badarg:
	ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
    }
    return ret;
}
Beispiel #4
0
static ERTS_INLINE Eterm
bld_unique_integer_term(Eterm **hpp, Uint *szp,
			Uint64 val0, Uint64 val1,
			int positive)
{
    Uint hsz;
    Uint64 unique_val[2];

    unique_val[0] = ((Uint64) val0);
    unique_val[0] |= ((Uint64) val1) << unique_data.r.o.left_shift;
    unique_val[1] = ((Uint64) val1) >> unique_data.r.o.right_shift;
    unique_val[1] &= unique_data.r.o.mask;

    if (positive) {
	unique_val[0]++;
	if (unique_val[0] == 0)
	    unique_val[1]++;
    }
    else {
	ASSERT(MIN_SMALL < 0);
	if (unique_val[1] == 0
	    && unique_val[0] < ((Uint64) -1*((Sint64) MIN_SMALL))) {
	    Sint64 s_unique_val = (Sint64) unique_val[0];
	    s_unique_val += MIN_SMALL;
	    ASSERT(MIN_SMALL <= s_unique_val && s_unique_val < 0);
	    if (szp)
		*szp = 0;
	    if (!hpp)
		return THE_NON_VALUE;
	    return make_small((Sint) s_unique_val);
	}
	if (unique_val[0] < ((Uint64) -1*((Sint64) MIN_SMALL))) {
	    ASSERT(unique_val[1] != 0);
	    unique_val[1] -= 1;
	}
	unique_val[0] += MIN_SMALL;
    }

    if (!unique_val[1]) {
	if (unique_val[0] <= MAX_SMALL) {
	    if (szp)
		*szp = 0;
	    if (!hpp)
		return THE_NON_VALUE;
	    return make_small((Uint) unique_val[0]);
	}

	if (szp)
	    *szp = ERTS_UINT64_HEAP_SIZE(unique_val[0]);
	if (!hpp)
	    return THE_NON_VALUE;
	return erts_uint64_to_big(unique_val[0], hpp);
    }
    else {
	Eterm tmp, *tmp_hp, res;
	DeclareTmpHeapNoproc(local_heap, 2*ERTS_MAX_UNIQUE_INT_HEAP_SIZE);

	UseTmpHeapNoproc(2*ERTS_MAX_UNIQUE_INT_HEAP_SIZE);

	tmp_hp = local_heap;

	tmp = erts_uint64_array_to_big(&tmp_hp, 0, 2, unique_val);
	ASSERT(is_big(tmp));

	hsz = big_arity(tmp) + 1;

	ASSERT(hsz <= ERTS_MAX_UNIQUE_INT_HEAP_SIZE);

	if (szp)
	    *szp = hsz;

	if (!hpp)
	    res = THE_NON_VALUE;
	else {
	    int hix;
	    Eterm *hp = *hpp;
	    tmp_hp = big_val(tmp);
	    for (hix = 0; hix < hsz; hix++)
		hp[hix] = tmp_hp[hix];

	    *hpp = hp + hsz;
	    res = make_big(hp);
	}

	UnUseTmpHeapNoproc(2*ERTS_MAX_UNIQUE_INT_HEAP_SIZE);

	return res;
    }
}