utils.c

OTP是开放电信平台的简称

/* ``The contents of this file are subject to the Erlang Public License,
 * Version 1.1, (the "License"); you may not use this file except in
 * compliance with the License. You should have received a copy of the
 * Erlang Public License along with this software. If not, it can be
 * retrieved via the world wide web at http://www.erlang.org/.
 * 
 * Software distributed under the License is distributed on an "AS IS"
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 * the License for the specific language governing rights and limitations
 * under the License.
 * 
 * The Initial Developer of the Original Code is Ericsson Utvecklings AB.
 * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 * AB. All Rights Reserved.''
 * 
 *     $Id$
 */

#ifdef HAVE_CONFIG_H
#  include "config.h"
#endif

#define ERTS_DO_INCL_GLB_INLINE_FUNC_DEF

#include "sys.h"
#include "erl_vm.h"
#include "global.h"
#include "erl_process.h"
#include "big.h"
#include "bif.h"
#include "erl_binary.h"
#include "erl_bits.h"
#define ERTS_WANT_DB_INTERNAL__
#include "erl_db.h"
#include "erl_threads.h"
#include "register.h"
#include "dist.h"
#include "erl_printf.h"
#include "erl_threads.h"
#include "erl_smp.h"
#include "erl_time.h"

#undef M_TRIM_THRESHOLD
#undef M_TOP_PAD
#undef M_MMAP_THRESHOLD
#undef M_MMAP_MAX

#if !defined(ELIB_ALLOC_IS_CLIB) && defined(__GLIBC__) && defined(HAVE_MALLOC_H)
#include <malloc.h>
#endif

#if defined(ELIB_ALLOC_IS_CLIB) || !defined(HAVE_MALLOPT)
#undef  HAVE_MALLOPT
#define HAVE_MALLOPT 0
#endif

Eterm*
erts_heap_alloc(Process* p, Uint need)
{
    ErlHeapFragment* bp;
    Uint n;
#if defined(DEBUG) || defined(CHECK_FOR_HOLES)
    Uint i;
#endif

#if defined(HEAP_FRAG_ELIM_TEST)
    n = need;
#else
    /*
     * Check if there is any space left in the previous heap fragment.
     */

    if (need <= ARITH_AVAIL(p)) {
	Eterm* hp = ARITH_HEAP(p);

	ARITH_HEAP(p) += need;
	ARITH_AVAIL(p) -= need;
	return hp;
    }

    /*
     * Allocate a new arith heap; first find a suitable size.
     */

    n = need;

    if (ARITH_AVAIL(p) < 16 || n < 64) {
#if defined(HYBRID) || defined(CHECK_FOR_HOLES)
        /*
         * Fill the rest of the current arith heap.
         */
        while(ARITH_AVAIL(p) != 0) {
            *ARITH_HEAP(p)++ = NIL;
            ARITH_AVAIL(p)--;
        }
#endif
	ARITH_AVAIL(p) = 0;
	n = p->min_heap_size/2 + need;
	if (n > 16*1024 && n > 2*need) {
	    n = 2*need;
	}
    }
#endif

#ifdef DEBUG
    n++;
#endif

    bp = (ErlHeapFragment*)
	ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG,
			sizeof(ErlHeapFragment) + ((n-1)*sizeof(Eterm)));

#ifdef DEBUG
    n--;
#endif


#ifndef HEAP_FRAG_ELIM_TEST
    if (ARITH_AVAIL(p) == 0) {
	ARITH_AVAIL(p) = n - need;
	ARITH_HEAP(p) = bp->mem + need;
    }
#endif

#if defined(DEBUG)
    for (i = 0; i <= n; i++) {
	bp->mem[i] = ERTS_HOLE_MARKER;
    }
#ifndef HEAP_FRAG_ELIM_TEST
    ARITH_CHECK_ME(p) = ARITH_HEAP(p);
#endif
#elif defined(CHECK_FOR_HOLES)
    for (i = 0; i < n; i++) {
	bp->mem[i] = ERTS_HOLE_MARKER;
    }
#endif

#ifdef HEAP_FRAG_ELIM_TEST
    {
	/*
	 * When we have create a heap fragment, we are no longer allowed
	 * to store anything more on the heap. 
	 */
	Eterm* htop = HEAP_TOP(p);
	if (htop < HEAP_LIMIT(p)) {
	    *htop = make_pos_bignum_header(HEAP_LIMIT(p)-htop-1);
	    HEAP_TOP(p) = HEAP_LIMIT(p);
	}
    }
#endif

    bp->next = MBUF(p);
    MBUF(p) = bp;
    bp->size = n;
    MBUF_SIZE(p) += n;
    bp->off_heap.mso = NULL;
#ifndef HYBRID /* FIND ME! */
    bp->off_heap.funs = NULL;
#endif
    bp->off_heap.externals = NULL;
    bp->off_heap.overhead = 0;

    /*
     * Test if time to do GC; if so bump the reduction count to force
     * a context switch.
     */
#if !defined HEAP_FRAG_ELIM_TEST
    MSO(p).overhead += (sizeof(ErlHeapFragment)/sizeof(Eterm) - 1); 
    if (((MBUF_SIZE(p) + MSO(p).overhead)*MBUF_GC_FACTOR) >= HEAP_SIZE(p)) {
	BUMP_ALL_REDS(p);
    }
#endif
    return bp->mem;
}

#if defined(HEAP_FRAG_ELIM_TEST)
void erts_arith_shrink(Process* p, Eterm* hp)
{
#if defined(CHECK_FOR_HOLES)
    ErlHeapFragment* hf;

    /*
     * We must find the heap fragment that hp points into.
     * If we are unlucky, we might have to search through
     * a large part of the list. We'll hope that will not
     * happen to often.
     */
    for (hf = MBUF(p); hf != 0; hf = hf->next) {
	if (hp - hf->mem < (unsigned long)hf->size) {
	    /*
	     * We are not allowed to changed hf->size (because the
	     * size must be correct when deallocating). Therefore,
	     * clear out the uninitialized part of the heap fragment.
	     */
	    Eterm* to = hf->mem + hf->size;
	    while (hp < to) {
		*hp++ = NIL;
	    }
	    break;
	}
    }
#endif
}
#else
void erts_arith_shrink(Process* p, Eterm* hp)
{
    ErlHeapFragment* hf;

#if !defined(HYBRID) && !defined(DEBUG) && !defined(CHECK_FOR_HOLES)
    if (ARITH_AVAIL(p) == 0) {
	/*
	 * For a non-hybrid system, there is nothing to gain by
	 * do any work here.
	 */
	return;
    }
#endif

    /*
     * We must find the heap fragment that hp points into.
     * If we are unlucky, we might have to search through
     * a large part of the list. We'll hope that will not
     * happen to often.
     */
    for (hf = MBUF(p); hf != 0; hf = hf->next) {
	if (hp - hf->mem < (unsigned long)hf->size) {
	    if (ARITH_HEAP(p) - hf->mem < (unsigned long)hf->size) {
		/*
		 * Regain lost space from the current arith heap
		 * and make sure that there are no garbage in a heap
		 * fragment (important for the hybrid heap).
		 */
		Uint diff = ARITH_HEAP(p) - hp;
		ARITH_HEAP(p) = hp;
		ARITH_AVAIL(p) += diff;
#ifdef DEBUG
		while (diff != 0) {
		    hp[--diff] = ERTS_HOLE_MARKER;
		}
		ARITH_CHECK_ME(p) = hp;
#endif
#if defined(HYBRID) || defined(DEBUG) || defined(CHECK_FOR_HOLES)
	    } else {
		/*
		 * We are not allowed to changed hf->size (because the
		 * size must be correct when deallocating). Therefore,
		 * clear out the uninitialized part of the heap fragment.
		 */
		Eterm* to = hf->mem + hf->size;
		while (hp < to) {
		    *hp++ = NIL;
		}
#endif
	    }
	    return;
	}
    }
}
#endif

#ifdef CHECK_FOR_HOLES
Eterm*
erts_set_hole_marker(Eterm* ptr, Uint sz)
{
    Eterm* p = ptr;
    int i;

    for (i = 0; i < sz; i++) {
	*p++ = ERTS_HOLE_MARKER;
    }
    return ptr;
}
#endif

/*
 * Helper function for the ESTACK macros defined in global.h.
 */

Eterm*
erl_grow_stack(Eterm* ptr, size_t new_size)
{
    if (new_size > 2 * DEF_ESTACK_SIZE) {
	return erts_realloc(ERTS_ALC_T_ESTACK, (void *) ptr, new_size);
    } else {
	Eterm* new_ptr = erts_alloc(ERTS_ALC_T_ESTACK, new_size);
	sys_memcpy(new_ptr, ptr, new_size/2);
	return new_ptr;
    }
}

/* CTYPE macros */

#define LATIN1

#define IS_DIGIT(c)  ((c) >= '0' && (c) <= '9')
#ifdef LATIN1
#define IS_LOWER(c)  (((c) >= 'a' && (c) <= 'z') \
		      || ((c) >= 128+95 && (c) <= 255 && (c) != 247))
#define IS_UPPER(c)  (((c) >= 'A' && (c) <= 'Z') \
		      || ((c) >= 128+64 && (c) <= 128+94 && (c) != 247-32))
#else
#define IS_LOWER(c)  ((c) >= 'a' && (c) <= 'z')
#define IS_UPPER(c)  ((c) >= 'A' && (c) <= 'Z')
#endif

#define IS_ALNUM(c)  (IS_DIGIT(c) || IS_LOWER(c) || IS_UPPER(c))

/* We don't include 160 (non-breaking space). */
#define IS_SPACE(c)  (c == ' ' || c == '\n' || c == '\t' || c == '\r')

#ifdef LATIN1
#define IS_CNTRL(c)  ((c) < ' ' || (c) == 127 \
		      || ((c) >= 128 && (c) < 128+32))
#else
/* Treat all non-ASCII as control characters */
#define IS_CNTRL(c)  ((c) < ' ' || (c) >= 127)
#endif

#define IS_PRINT(c)  (!IS_CNTRL(c))

/*
 * Calculate length of a list.
 * Returns -1 if not a proper list (i.e. not terminated with NIL)
 */
int
list_length(Eterm list)
{
    int i = 0;

    while(is_list(list)) {
	i++;
	list = CDR(list_val(list));
    }
    if (is_not_nil(list)) {
	return -1;
    }
    return i;
}

Uint erts_fit_in_bits(Uint n)
{
   Uint i;

   i = 0;
   while (n > 0) {
      i++;
      n >>= 1;
   }
   return i;
}

int
erts_print(int to, void *arg, char *format, ...)
{
    int res;
    va_list arg_list;
    va_start(arg_list, format);

    if (to < ERTS_PRINT_MIN)
	res = -EINVAL;
    else {
	switch (to) {
	case ERTS_PRINT_STDOUT:
	    res = erts_vprintf(format, arg_list);
	    break;
	case ERTS_PRINT_STDERR:
	    res = erts_vfprintf(stderr, format, arg_list);
	    break;
	case ERTS_PRINT_FILE:
	    res = erts_vfprintf((FILE *) arg, format, arg_list);
	    break;
	case ERTS_PRINT_SBUF:
	    res = erts_vsprintf((char *) arg, format, arg_list);
	    break;
	case ERTS_PRINT_SNBUF:
	    res = erts_vsnprintf(((erts_print_sn_buf *) arg)->buf,
				 ((erts_print_sn_buf *) arg)->size,
				 format,
				 arg_list);
	    break;
	case ERTS_PRINT_DSBUF:
	    res = erts_vdsprintf((erts_dsprintf_buf_t *) arg, format, arg_list);
	    break;
	case ERTS_PRINT_INVALID:
	    res = -EINVAL;
	    break;
	default:
	    res = erts_vfdprintf((int) to, format, arg_list);
	    break;
	}
    }

    va_end(arg_list);
    return res;
}

int
erts_putc(int to, void *arg, char c)
{
    return erts_print(to, arg, "%c", c);
}

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
 * Some Erlang term building utility functions (to be used when performance  *
 * isn't critical).                                                          *
 *                                                                           *
 * Add more functions like these here (and function prototypes in global.h)  *
 * when needed.                                                              *
 *                                                                           *
\*                                                                           */

Eterm
erts_bld_atom(Uint **hpp, Uint *szp, char *str)
{
    if (hpp)
	return am_atom_put(str, sys_strlen(str));
    else
	return THE_NON_VALUE;
}

Eterm
erts_bld_uint(Uint **hpp, Uint *szp, Uint ui)
{
    Eterm res = THE_NON_VALUE;
    if (IS_USMALL(0, ui)) {
	if (hpp)
	    res = make_small(ui);
    }
    else {
	if (szp)
	    *szp += BIG_UINT_HEAP_SIZE;
	if (hpp) {
	    res = uint_to_big(ui, *hpp);
	    *hpp += BIG_UINT_HEAP_SIZE;
	}
    }
    return res;
}

Eterm
erts_bld_cons(Uint **hpp, Uint *szp, Eterm car, Eterm cdr)
{
    Eterm res = THE_NON_VALUE;
    if (szp)
	*szp += 2;
    if (hpp) {
	res = CONS(*hpp, car, cdr);
	*hpp += 2;
    }
    return res;
}

Eterm
erts_bld_tuple(Uint **hpp, Uint *szp, Uint arity, ...)
{
    Eterm res = THE_NON_VALUE;

    ASSERT(arity < (((Uint)1) << (sizeof(Uint)*8 - _HEADER_ARITY_OFFS)));

    if (szp)
	*szp += arity + 1;
    if (hpp) {

	res = make_tuple(*hpp);
	*((*hpp)++) = make_arityval(arity);

	if (arity > 0) {
	    Uint i;
	    va_list argp;

	    va_start(argp, arity);
	    for (i = 0; i < arity; i++)
		*((*hpp)++) = va_arg(argp, Eterm);
	    va_end(argp);
	}
    }
    return res;
}


Eterm erts_bld_tuplev(Uint **hpp, Uint *szp, Uint arity, Eterm terms[])
{
    Eterm res = THE_NON_VALUE;

    ASSERT(arity < (((Uint)1) << (sizeof(Uint)*8 - _HEADER_ARITY_OFFS)));

    if (szp)
	*szp += arity + 1;
    if (hpp) {

	res = make_tuple(*hpp);
	*((*hpp)++) = make_arityval(arity);

	if (arity > 0) {
	    Uint i;
	    for (i = 0; i < arity; i++)
		*((*hpp)++) = terms[i];
	}
    }
    return res;
}

Eterm
erts_bld_string(Uint **hpp, Uint *szp, char *str)
{
    Eterm res = THE_NON_VALUE;
    Sint i = strlen(str);
    if (szp)
	*szp += i*2;
    if (hpp) {
	res = NIL;
	while (--i >= 0) {
	    res = CONS(*hpp, make_small(str[i]), res);
	    *hpp += 2;
	}
    }
    return res;
}

Eterm
erts_bld_list(Uint **hpp, Uint *szp, Sint length, Eterm terms[])
{
    Eterm list = THE_NON_VALUE;
    if (szp)
	*szp += 2*length;
    if (hpp) {
	Sint i = length;
	list = NIL;

	while (--i >= 0) {
	    list = CONS(*hpp, terms[i], list);
	    *hpp += 2;
	}
    }
    return list;
}

Eterm
erts_bld_2tup_list(Uint **hpp, Uint *szp,
		   Sint length, Eterm terms1[], Uint terms2[])
{
    Eterm res = THE_NON_VALUE;
    if (szp)
	*szp += 5*length;
    if (hpp) {
	Sint i = length;
	res = NIL;

	while (--i >= 0) {
	    res = CONS(*hpp+3, TUPLE2(*hpp, terms1[i], terms2[i]), res);
	    *hpp += 5;
	}
    }
    return res;
}