diff options
29 files changed, 2055 insertions, 1224 deletions
diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index ff15d834ab..f47f5a9c0c 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * 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 @@ -1558,7 +1558,7 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp) ** Convert a bignum to a double float */ int -big_to_double(Eterm x, double* resp) +big_to_double(Wterm x, double* resp) { double d = 0.0; Eterm* xp = big_val(x); @@ -1725,7 +1725,7 @@ static Eterm big_norm(Eterm *x, dsize_t xl, short sign) /* ** Compare bignums */ -int big_comp(Eterm x, Eterm y) +int big_comp(Wterm x, Wterm y) { Eterm* xp = big_val(x); Eterm* yp = big_val(y); @@ -2060,7 +2060,7 @@ static Eterm B_plus_minus(ErtsDigit *x, dsize_t xl, short xsgn, /* ** Add bignums */ -Eterm big_plus(Eterm x, Eterm y, Eterm *r) +Eterm big_plus(Wterm x, Wterm y, Eterm *r) { Eterm* xp = big_val(x); Eterm* yp = big_val(y); diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 25466cd3c2..f28a390aea 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * 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 @@ -120,7 +120,7 @@ char *erts_big_to_string(Eterm x, char *buf, Uint buf_sz); Eterm small_times(Sint, Sint, Eterm*); -Eterm big_plus(Eterm, Eterm, Eterm*); +Eterm big_plus(Wterm, Wterm, Eterm*); Eterm big_minus(Eterm, Eterm, Eterm*); Eterm big_times(Eterm, Eterm, Eterm*); Eterm big_div(Eterm, Eterm, Eterm*); @@ -137,9 +137,9 @@ Eterm big_bxor(Eterm, Eterm, Eterm*); Eterm big_bnot(Eterm, Eterm*); Eterm big_lshift(Eterm, Sint, Eterm*); -int big_comp (Eterm, Eterm); +int big_comp (Wterm, Wterm); int big_ucomp (Eterm, Eterm); -int big_to_double(Eterm x, double* resp); +int big_to_double(Wterm x, double* resp); Eterm small_to_big(Sint, Eterm*); Eterm uint_to_big(Uint, Eterm*); Eterm uword_to_big(UWord, Eterm*); diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 8bee47232e..243e8973cf 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * 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 @@ -72,8 +72,11 @@ copy_object(Eterm obj, Process* to) * Return the "flat" size of the object. */ -Uint -size_object(Eterm obj) +#if HALFWORD_HEAP +Uint size_object_rel(Eterm obj, Eterm* base) +#else +Uint size_object(Eterm obj) +#endif { Uint sum = 0; Eterm* ptr; @@ -84,7 +87,7 @@ size_object(Eterm obj) switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: sum += 2; - ptr = list_val(obj); + ptr = list_val_rel(obj,base); obj = *ptr++; if (!IS_CONST(obj)) { ESTACK_PUSH(s, obj); @@ -93,11 +96,11 @@ size_object(Eterm obj) break; case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val(obj); + Eterm hdr = *boxed_val_rel(obj,base); ASSERT(is_header(hdr)); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: - ptr = tuple_val(obj); + ptr = tuple_val_rel(obj,base); arity = header_arity(hdr); sum += arity + 1; if (arity == 0) { /* Empty tuple -- unusual. */ @@ -113,7 +116,7 @@ size_object(Eterm obj) break; case FUN_SUBTAG: { - Eterm* bptr = fun_val(obj); + Eterm* bptr = fun_val_rel(obj,base); ErlFunThing* funp = (ErlFunThing *) bptr; unsigned eterms = 1 /* creator */ + funp->num_free; unsigned sz = thing_arityval(hdr); @@ -136,7 +139,7 @@ size_object(Eterm obj) Uint bitoffs; Uint extra_bytes; Eterm hdr; - ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); + ERTS_GET_REAL_BIN_REL(obj, real_bin, offset, bitoffs, bitsize, base); if ((bitsize + bitoffs) > 8) { sum += ERL_SUB_BIN_SIZE; extra_bytes = 2; @@ -146,11 +149,11 @@ size_object(Eterm obj) } else { extra_bytes = 0; } - hdr = *binary_val(real_bin); + hdr = *binary_val_rel(real_bin,base); if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) { sum += PROC_BIN_SIZE; } else { - sum += heap_bin_size(binary_size(obj)+extra_bytes); + sum += heap_bin_size(binary_size_rel(obj,base)+extra_bytes); } goto pop_next; } @@ -181,8 +184,12 @@ size_object(Eterm obj) /* * Copy a structure to a heap. */ -Eterm -copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +#if HALFWORD_HEAP +Eterm copy_struct_rel(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, + Eterm* src_base, Eterm* dst_base) +#else +Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +#endif { char* hstart; Uint hsize; @@ -214,7 +221,10 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) /* Copy the object onto the heap */ switch (primary_tag(obj)) { - case TAG_PRIMARY_LIST: argp = &res; goto L_copy_list; + case TAG_PRIMARY_LIST: + argp = &res; + objp = list_val_rel(obj,src_base); + goto L_copy_list; case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed; default: erl_exit(ERTS_ABORT_EXIT, @@ -231,32 +241,46 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) hp++; break; case TAG_PRIMARY_LIST: - objp = list_val(obj); + objp = list_val_rel(obj,src_base); + #if !HALFWORD_HEAP || defined(DEBUG) if (in_area(objp,hstart,hsize)) { + ASSERT(!HALFWORD_HEAP); hp++; break; } + #endif argp = hp++; /* Fall through */ L_copy_list: tailp = argp; - while (is_list(obj)) { - objp = list_val(obj); + for (;;) { tp = tailp; - elem = *objp; + elem = CAR(objp); if (IS_CONST(elem)) { - *(hbot-2) = elem; - tailp = hbot-1; hbot -= 2; + CAR(hbot) = elem; + tailp = &CDR(hbot); } else { - *htop = elem; - tailp = htop+1; + CAR(htop) = elem; + #if HALFWORD_HEAP + CDR(htop) = CDR(objp); + *tailp = make_list_rel(htop,dst_base); + htop += 2; + goto L_copy; + #else + tailp = &CDR(htop); htop += 2; + #endif + } + ASSERT(!HALFWORD_HEAP || tp < hp || tp >= hbot); + *tp = make_list_rel(tailp - 1, dst_base); + obj = CDR(objp); + if (!is_list(obj)) { + break; } - *tp = make_list(tailp - 1); - obj = *(objp+1); + objp = list_val_rel(obj,src_base); } switch (primary_tag(obj)) { case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy; @@ -268,21 +292,24 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } case TAG_PRIMARY_BOXED: - if (in_area(boxed_val(obj),hstart,hsize)) { + #if !HALFWORD_HEAP || defined(DEBUG) + if (in_area(boxed_val_rel(obj,src_base),hstart,hsize)) { + ASSERT(!HALFWORD_HEAP); hp++; break; } + #endif argp = hp++; L_copy_boxed: - objp = boxed_val(obj); + objp = boxed_val_rel(obj, src_base); hdr = *objp; switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { int const_flag = 1; /* assume constant tuple */ i = arityval(hdr); - *argp = make_tuple(htop); + *argp = make_tuple_rel(htop, dst_base); tp = htop; /* tp is pointer to new arity value */ *htop++ = *objp++; /* copy arity value */ while (i--) { @@ -311,7 +338,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) while (i--) { *tp++ = *objp++; } - *argp = make_binary(hbot); + *argp = make_binary_rel(hbot, dst_base); pb = (ProcBin*) hbot; erts_refc_inc(&pb->val->refc, 2); pb->next = off_heap->first; @@ -338,7 +365,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) extra_bytes = 0; } real_size = size+extra_bytes; - objp = binary_val(real_bin); + objp = binary_val_rel(real_bin,src_base); if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) { ErlHeapBin* from = (ErlHeapBin *) objp; ErlHeapBin* to; @@ -368,7 +395,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = (struct erl_off_heap_header*) to; OH_OVERHEAD(off_heap, to->size / sizeof(Eterm)); } - *argp = make_binary(hbot); + *argp = make_binary_rel(hbot, dst_base); if (extra_bytes != 0) { ErlSubBin* res; hbot -= ERL_SUB_BIN_SIZE; @@ -380,7 +407,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) res->offs = 0; res->is_writable = 0; res->orig = *argp; - *argp = make_binary(hbot); + *argp = make_binary_rel(hbot, dst_base); } break; } @@ -400,7 +427,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = (struct erl_off_heap_header*) funp; erts_refc_inc(&funp->fe->refc, 2); #endif - *argp = make_fun(tp); + *argp = make_fun_rel(tp, dst_base); } break; case EXTERNAL_PID_SUBTAG: @@ -420,7 +447,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = (struct erl_off_heap_header*)etp; erts_refc_inc(&etp->node->refc, 2); - *argp = make_external(tp); + *argp = make_external_rel(tp, dst_base); } break; case BIN_MATCHSTATE_SUBTAG: @@ -430,7 +457,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) i = thing_arityval(hdr)+1; hbot -= i; tp = hbot; - *argp = make_boxed(hbot); + *argp = make_boxed_rel(hbot, dst_base); while (i--) { *tp++ = *objp++; } @@ -885,12 +912,21 @@ Eterm copy_struct_lazy(Process *from, Eterm orig, Uint offs) * * NOTE: Assumes that term is a tuple (ptr is an untagged tuple ptr). */ -Eterm -copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +#if HALFWORD_HEAP +Eterm copy_shallow_rel(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, + Eterm* src_base) +#else +Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +#endif { Eterm* tp = ptr; Eterm* hp = *hpp; - Sint offs = hp - tp; + const Eterm res = make_tuple(hp); +#if HALFWORD_HEAP + const Sint offs = COMPRESS_POINTER(hp - (tp - src_base)); +#else + const Sint offs = (hp - tp) * sizeof(Eterm); +#endif while (sz--) { Eterm val = *tp++; @@ -901,7 +937,7 @@ copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) break; case TAG_PRIMARY_LIST: case TAG_PRIMARY_BOXED: - *hp++ = offset_ptr(val, offs); + *hp++ = byte_offset_ptr(val, offs); break; case TAG_PRIMARY_HEADER: *hp++ = val; @@ -958,7 +994,8 @@ copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } } *hpp = hp; - return make_tuple(ptr + offs); + + return res; } /* Move all terms in heap fragments into heap. The terms must be guaranteed to diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index b7b9c6a133..ca71798917 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2010. All Rights Reserved. +# Copyright Ericsson AB 2003-2011. All Rights Reserved. # # 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 @@ -193,6 +193,7 @@ type DB_FIXATION SHORT_LIVED ETS db_fixation type DB_FIX_DEL SHORT_LIVED ETS fixed_del type DB_TABLES LONG_LIVED ETS db_tabs type DB_NTAB_ENT STANDARD ETS db_named_table_entry +type DB_HEIR_DATA STANDARD ETS db_heir_data type DB_TMP TEMPORARY ETS db_tmp type DB_MC_STK TEMPORARY ETS db_mc_stack type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index ce13469801..47c48e74d6 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2010. All Rights Reserved. + * Copyright Ericsson AB 1999-2011. All Rights Reserved. * * 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 @@ -378,7 +378,7 @@ keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List) Eterm *tuple_ptr = tuple_val(term); if (pos <= arityval(*tuple_ptr)) { Eterm element = tuple_ptr[pos]; - if (cmp(Key, element) == 0) { + if (CMP(Key, element) == 0) { return term; } } diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index bdf0fe23fc..506c4813fa 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2010. All Rights Reserved. + * Copyright Ericsson AB 2000-2011. All Rights Reserved. * * 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 @@ -71,6 +71,7 @@ typedef struct erl_heap_bin { */ #define binary_size(Bin) (binary_val(Bin)[1]) +#define binary_size_rel(Bin,BasePtr) (binary_val_rel(Bin,BasePtr)[1]) #define binary_bitsize(Bin) \ ((*binary_val(Bin) == HEADER_SUB_BIN) ? \ @@ -93,9 +94,12 @@ typedef struct erl_heap_bin { * Bitsize: output variable (Uint) */ -#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \ +#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \ + ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,NULL) + +#define ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,BasePtr) \ do { \ - Eterm* _real_bin = binary_val(Bin); \ + Eterm* _real_bin = binary_val_rel(Bin,BasePtr); \ Uint _offs = 0; \ Bitoffs = Bitsize = 0; \ if (*_real_bin == HEADER_SUB_BIN) { \ @@ -103,7 +107,7 @@ do { \ _offs = _sb->offs; \ Bitoffs = _sb->bitoffs; \ Bitsize = _sb->bitsize; \ - _real_bin = binary_val(_sb->orig); \ + _real_bin = binary_val_rel(_sb->orig,BasePtr); \ } \ if (*_real_bin == HEADER_PROC_BIN) { \ Bytep = ((ProcBin *) _real_bin)->bytes + _offs; \ @@ -125,9 +129,12 @@ do { \ * BitSize: Extra bit size (Uint) */ -#define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \ +#define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \ + ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, NULL) + +#define ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, BasePtr) \ do { \ - ErlSubBin* _sb = (ErlSubBin *) binary_val(Bin); \ + ErlSubBin* _sb = (ErlSubBin *) binary_val_rel(Bin,BasePtr); \ if (_sb->thing_word == HEADER_SUB_BIN) { \ RealBin = _sb->orig; \ ByteOffset = _sb->offs; \ diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 3173d3510e..5b74240cc3 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * 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 @@ -910,7 +910,8 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) Eterm upop; Eterm* tpl; Sint position; - Eterm incr, warp, oldcnt; + Eterm incr, warp; + Wterm oldcnt; if (is_not_list(iter)) { goto finalize; @@ -985,7 +986,7 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) Eterm* tpl = tuple_val(CAR(list_val(iter))); Sint position = signed_val(tpl[1]); Eterm incr = tpl[2]; - Eterm oldcnt = handle.dbterm->tpl[position]; + Wterm oldcnt = db_do_read_element(&handle,position); Eterm newcnt = db_add_counter(&htop, oldcnt, incr); if (newcnt == NIL) { @@ -998,9 +999,9 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) if (arityval(*tpl) == 4) { /* Maybe warp it */ Eterm threshold = tpl[3]; - if ((cmp(incr,make_small(0)) < 0) ? /* negative increment? */ - (cmp(newcnt,threshold) < 0) : /* if negative, check if below */ - (cmp(newcnt,threshold) > 0)) { /* else check if above threshold */ + if ((CMP(incr,make_small(0)) < 0) ? /* negative increment? */ + (CMP(newcnt,threshold) < 0) : /* if negative, check if below */ + (CMP(newcnt,threshold) > 0)) { /* else check if above threshold */ newcnt = tpl[4]; } @@ -2712,7 +2713,6 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) Binary *mp; Eterm res; Uint32 dummy; - Uint sz; if (!(is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) || !is_binary(BIF_ARG_2)) { error: @@ -2737,11 +2737,10 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) BIF_TRAP3(bif_export[BIF_ets_match_spec_run_r_3], BIF_P,lst,BIF_ARG_2,ret); } - res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, 0, &dummy); + res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, NULL, 0, + ERTS_PAM_COPY_RESULT, &dummy); if (is_value(res)) { - sz = size_object(res); - hp = HAlloc(BIF_P, sz + 2); - res = copy_struct(res, sz, &hp, &MSO(BIF_P)); + hp = HAlloc(BIF_P, 2); ret = CONS(hp,res,ret); /*hp += 2;*/ } @@ -3490,11 +3489,24 @@ static void set_heir(Process* me, DbTable* tb, Eterm heir, UWord heir_data) if (!is_immed(heir_data)) { DeclareTmpHeap(tmp,2,me); + Eterm wrap_tpl; + int size; + DbTerm* dbterm; + Eterm* top; + ErlOffHeap tmp_offheap; UseTmpHeap(2,me); - /* Make a dummy 1-tuple around data to use db_get_term() */ - heir_data = (UWord) db_store_term(&tb->common, NULL, 0, - TUPLE1(tmp,heir_data)); + /* Make a dummy 1-tuple around data to use DbTerm */ + wrap_tpl = TUPLE1(tmp,heir_data); + size = size_object(wrap_tpl); + dbterm = erts_db_alloc(ERTS_ALC_T_DB_HEIR_DATA, (DbTable *)tb, + (sizeof(DbTerm) + sizeof(Eterm)*(size-1))); + dbterm->size = size; + top = dbterm->tpl; + tmp_offheap.first = NULL; + copy_struct(wrap_tpl, size, &top, &tmp_offheap); + dbterm->first_oh = tmp_offheap.first; + heir_data = (UWord)dbterm; UnUseTmpHeap(2,me); ASSERT(!is_immed(heir_data)); } @@ -3506,7 +3518,7 @@ static void free_heir_data(DbTable* tb) if (tb->common.heir != am_none && !is_immed(tb->common.heir_data)) { DbTerm* p = (DbTerm*) tb->common.heir_data; db_cleanup_offheap_comp(p); - erts_db_free(ERTS_ALC_T_DB_TERM, tb, (void *)p, + erts_db_free(ERTS_ALC_T_DB_HEIR_DATA, tb, (void *)p, sizeof(DbTerm) + (p->size-1)*sizeof(Eterm)); } #ifdef DEBUG diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 1e50fee554..9ef990cc4f 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2011. All Rights Reserved. * * 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 @@ -258,12 +258,6 @@ static ERTS_INLINE Sint next_slot_w(DbTableHash* tb, Uint ix, } -/* - * tplp is an untagged pointer to a tuple we know is large enough - * and dth is a pointer to a DbTableHash. - */ -#define GETKEY(dth, tplp) (*((tplp) + (dth)->common.keypos)) - /* * Some special binary flags */ @@ -434,6 +428,9 @@ static ERTS_INLINE void try_shrink(DbTableHash* tb) } } +#define EQ_REL(x,y,y_base) \ + (is_same(x,NULL,y,y_base) || (is_not_both_immed((x),(y)) && eq_rel((x),NULL,(y),y_base))) + /* Is this a live object (not pseodo-deleted) with the specified key? */ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, @@ -443,7 +440,7 @@ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); ASSERT(!is_header(itemKey)); - return EQ(key,itemKey); + return EQ_REL(key, itemKey, b->dbterm.tpl); } } @@ -456,7 +453,7 @@ static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b, else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); ASSERT(!is_header(itemKey)); - return EQ(key,itemKey); + return EQ_REL(key, itemKey, b->dbterm.tpl); } } @@ -696,9 +693,7 @@ static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret) } } if (list != NULL) { - Eterm key = GETKEY(tb, list->dbterm.tpl); - - COPY_OBJECT(key, p, ret); + *ret = db_copy_key(p, tbl, &list->dbterm); RUNLOCK_HASH(lck); } else { @@ -746,7 +741,7 @@ static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) *ret = am_EOT; } else { - COPY_OBJECT(GETKEY(tb, b->dbterm.tpl), p, ret); + *ret = db_copy_key(p, tbl, &b->dbterm); RUNLOCK_HASH(lck); } return DB_ERROR_NONE; @@ -1308,8 +1303,8 @@ static int db_select_continue_hash(Process *p, } for(;;) { if (current->hvalue != INVALID_HASH && - (match_res = db_prog_match_and_copy(&tb->common, p, mp, all_objects, - ¤t->dbterm, &hp, 2), + (match_res = db_match_dbterm(&tb->common, p, mp, all_objects, + ¤t->dbterm, &hp, 2), is_value(match_res))) { match_list = CONS(hp, match_res, match_list); @@ -1473,8 +1468,8 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, for(;;) { if (current != NULL) { if (current->hvalue != INVALID_HASH) { - match_res = db_prog_match_and_copy(&tb->common, p, mpi.mp, 0, - ¤t->dbterm, &hp, 2); + match_res = db_match_dbterm(&tb->common, p, mpi.mp, 0, + ¤t->dbterm, &hp, 2); if (is_value(match_res)) { match_list = CONS(hp, match_res, match_list); ++got; @@ -1639,8 +1634,8 @@ static int db_select_count_hash(Process *p, for(;;) { if (current != NULL) { if (current->hvalue != INVALID_HASH) { - if (db_prog_match_and_copy(&tb->common, p, mpi.mp, 0, - ¤t->dbterm, NULL,0) == am_true) { + if (db_match_dbterm(&tb->common, p, mpi.mp, 0, + ¤t->dbterm, NULL,0) == am_true) { ++got; } --num_left; @@ -1788,8 +1783,8 @@ static int db_select_delete_hash(Process *p, } else { int did_erase = 0; - if (db_prog_match_and_copy(&tb->common, p, mpi.mp, 0, - &(*current)->dbterm, NULL, 0) == am_true) { + if (db_match_dbterm(&tb->common, p, mpi.mp, 0, + &(*current)->dbterm, NULL, 0) == am_true) { if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */ if (slot_ix != last_pseudo_delete) { add_fixed_deletion(tb, slot_ix); @@ -1899,8 +1894,8 @@ static int db_select_delete_continue_hash(Process *p, } else { int did_erase = 0; - if (db_prog_match_and_copy(&tb->common, p, mp, 0, - &(*current)->dbterm, NULL, 0) == am_true) { + if (db_match_dbterm(&tb->common, p, mp, 0, + &(*current)->dbterm, NULL, 0) == am_true) { if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */ if (slot_ix != last_pseudo_delete) { add_fixed_deletion(tb, slot_ix); @@ -1999,8 +1994,8 @@ static int db_select_count_continue_hash(Process *p, current = current->next; continue; } - if (db_prog_match_and_copy(&tb->common, p, mp, 0, ¤t->dbterm, - NULL, 0) == am_true) { + if (db_match_dbterm(&tb->common, p, mp, 0, ¤t->dbterm, + NULL, 0) == am_true) { ++got; } --num_left; @@ -2179,7 +2174,7 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern, HashValue hval = NIL; int num_heads = 0; int i; - + mpi->lists = mpi->dlists; mpi->num_lists = 0; mpi->key_given = 1; @@ -2695,6 +2690,9 @@ static int db_lookup_dbterm_hash(DbTable *tbl, Eterm key, DbUpdateHandle* handle handle->dbterm = &b->dbterm; handle->mustResize = 0; handle->new_size = b->dbterm.size; + #if HALFWORD_HEAP + handle->abs_vec = NULL; + #endif handle->lck = lck; /* KEEP hval WLOCKED, db_finalize_dbterm_hash will WUNLOCK */ return 1; diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 8108494fc5..484a096249 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2011. All Rights Reserved. * * 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 @@ -48,9 +48,6 @@ #include "erl_db_tree.h" - - -#define GETKEY(dtt, tplp) (*((tplp) + (dtt)->common.keypos)) #define GETKEY_WITH_POS(Keypos, Tplp) (*((Tplp) + Keypos)) #define NITEMS(tb) ((int)erts_smp_atomic_read(&(tb)->common.nitems)) @@ -282,7 +279,7 @@ struct select_delete_context { /* ** Forward declarations */ -static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key); +static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key, Eterm* key_base); static TreeDbTerm *linkout_object_tree(DbTableTree *tb, Eterm object); static int do_free_tree_cont(DbTableTree *tb, int num_left); @@ -293,15 +290,15 @@ static int delsub(TreeDbTerm **this); static TreeDbTerm *slot_search(Process *p, DbTableTree *tb, Sint slot); static TreeDbTerm *find_node(DbTableTree *tb, Eterm key); static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key); -static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key); -static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key); +static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase); +static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase); static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack*, Eterm key); static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack*, Eterm key); static void traverse_backwards(DbTableTree *tb, DbTreeStack*, - Eterm lastkey, + Eterm lastkey, Eterm* lk_base, int (*doit)(DbTableTree *tb, TreeDbTerm *, void *, @@ -309,7 +306,7 @@ static void traverse_backwards(DbTableTree *tb, void *context); static void traverse_forward(DbTableTree *tb, DbTreeStack*, - Eterm lastkey, + Eterm lastkey, Eterm* lk_base, int (*doit)(DbTableTree *tb, TreeDbTerm *, void *, @@ -317,8 +314,8 @@ static void traverse_forward(DbTableTree *tb, void *context); static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, Eterm *partly_bound_key); -static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key); -static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done); +static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base); +static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done); static int analyze_pattern(DbTableTree *tb, Eterm pattern, struct mp_info *mpi); @@ -492,9 +489,6 @@ static int db_first_tree(Process *p, DbTable *tbl, Eterm *ret) DbTableTree *tb = &tbl->tree; DbTreeStack* stack; TreeDbTerm *this; - Eterm e; - Eterm *hp; - Uint sz; if (( this = tb->root ) == NULL) { *ret = am_EOT; @@ -513,13 +507,7 @@ static int db_first_tree(Process *p, DbTable *tbl, Eterm *ret) stack->slot = 1; release_stack(tb,stack); } - e = GETKEY(tb, this->dbterm.tpl); - sz = size_object(e); - - hp = HAlloc(p, sz); - - *ret = copy_struct(e,sz,&hp,&MSO(p)); - + *ret = db_copy_key(p, tbl, &this->dbterm); return DB_ERROR_NONE; } @@ -528,26 +516,17 @@ static int db_next_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) DbTableTree *tb = &tbl->tree; DbTreeStack* stack; TreeDbTerm *this; - Eterm e; - Eterm *hp; - Uint sz; if (is_atom(key) && key == am_EOT) return DB_ERROR_BADKEY; stack = get_any_stack(tb); - this = find_next(tb, stack, key); + this = find_next(tb, stack, key, NULL); release_stack(tb,stack); if (this == NULL) { *ret = am_EOT; return DB_ERROR_NONE; } - e = GETKEY(tb, this->dbterm.tpl); - sz = size_object(e); - - hp = HAlloc(p, sz); - - *ret = copy_struct(e,sz,&hp,&MSO(p)); - + *ret = db_copy_key(p, tbl, &this->dbterm); return DB_ERROR_NONE; } @@ -556,9 +535,6 @@ static int db_last_tree(Process *p, DbTable *tbl, Eterm *ret) DbTableTree *tb = &tbl->tree; TreeDbTerm *this; DbTreeStack* stack; - Eterm e; - Eterm *hp; - Uint sz; if (( this = tb->root ) == NULL) { *ret = am_EOT; @@ -577,13 +553,7 @@ static int db_last_tree(Process *p, DbTable *tbl, Eterm *ret) stack->slot = NITEMS(tb); release_stack(tb,stack); } - e = GETKEY(tb, this->dbterm.tpl); - sz = size_object(e); - - hp = HAlloc(p, sz); - - *ret = copy_struct(e,sz,&hp,&MSO(p)); - + *ret = db_copy_key(p, tbl, &this->dbterm); return DB_ERROR_NONE; } @@ -592,27 +562,33 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) DbTableTree *tb = &tbl->tree; TreeDbTerm *this; DbTreeStack* stack; - Eterm e; - Eterm *hp; - Uint sz; if (is_atom(key) && key == am_EOT) return DB_ERROR_BADKEY; stack = get_any_stack(tb); - this = find_prev(tb, stack, key); + this = find_prev(tb, stack, key, NULL); release_stack(tb,stack); if (this == NULL) { *ret = am_EOT; return DB_ERROR_NONE; } - e = GETKEY(tb, this->dbterm.tpl); - sz = size_object(e); + *ret = db_copy_key(p, tbl, &this->dbterm); + return DB_ERROR_NONE; +} - hp = HAlloc(p, sz); +static ERTS_INLINE int cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base, + TreeDbTerm* obj) +{ + return cmp_rel(key, key_base, + GETKEY(tb,obj->dbterm.tpl), obj->dbterm.tpl); +} - *ret = copy_struct(e,sz,&hp,&MSO(p)); - - return DB_ERROR_NONE; +static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, Eterm* key_base, + TreeDbTerm* obj) +{ + Eterm obj_key = GETKEY(tb,obj->dbterm.tpl); + return is_same(key, key_base, obj_key, obj->dbterm.tpl) + || cmp_rel(key, key_base, obj_key, obj->dbterm.tpl) == 0; } static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) @@ -646,8 +622,8 @@ static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) (*this)->balance = 0; (*this)->left = (*this)->right = NULL; break; - } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) { - /* go left */ + } else if ((c = cmp_key(tb, key, NULL, *this)) < 0) { + /* go lefts */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -801,7 +777,7 @@ static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret) *ret = am_true; - if ((res = linkout_tree(tb, key)) != NULL) { + if ((res = linkout_tree(tb, key, NULL)) != NULL) { free_term(tb, res); } return DB_ERROR_NONE; @@ -993,15 +969,15 @@ static int db_select_continue_tree(Process *p, stack = get_any_stack(tb); if (chunk_size) { if (reverse) { - traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc); + traverse_backwards(tb, stack, lastkey, NULL, &doit_select_chunk, &sc); } else { - traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc); + traverse_forward(tb, stack, lastkey, NULL, &doit_select_chunk, &sc); } } else { if (reverse) { - traverse_forward(tb, stack, lastkey, &doit_select, &sc); + traverse_forward(tb, stack, lastkey, NULL, &doit_select, &sc); } else { - traverse_backwards(tb, stack, lastkey, &doit_select, &sc); + traverse_backwards(tb, stack, lastkey, NULL, &doit_select, &sc); } } release_stack(tb,stack); @@ -1026,10 +1002,9 @@ static int db_select_continue_tree(Process *p, } key = GETKEY(tb, sc.lastobj); - - sz = size_object(key); + sz = size_object_rel(key,sc.lastobj); hp = HAlloc(p, 9 + sz); - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); continuation = TUPLE8 (hp, tptr[1], @@ -1050,8 +1025,8 @@ static int db_select_continue_tree(Process *p, key = GETKEY(tb, sc.lastobj); if (chunk_size) { if (end_condition != NIL && - ((!reverse && cmp_partly_bound(end_condition,key) < 0) || - (reverse && cmp_partly_bound(end_condition,key) > 0))) { + ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0) || + (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0))) { /* done anyway */ if (!sc.got) { RET_TO_BIF(am_EOT, DB_ERROR_NONE); @@ -1063,16 +1038,16 @@ static int db_select_continue_tree(Process *p, } } else { if (end_condition != NIL && - ((!reverse && cmp_partly_bound(end_condition,key) > 0) || - (reverse && cmp_partly_bound(end_condition,key) < 0))) { + ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0) || + (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0))) { /* done anyway */ RET_TO_BIF(sc.accum,DB_ERROR_NONE); } } /* Not done yet, let's trap. */ - sz = size_object(key); + sz = size_object_rel(key,sc.lastobj); hp = HAlloc(p, 9 + sz); - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); continuation = TUPLE8 (hp, tptr[1], @@ -1099,6 +1074,7 @@ static int db_select_tree(Process *p, DbTable *tbl, struct select_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; + Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1140,7 +1116,7 @@ static int db_select_tree(Process *p, DbTable *tbl, sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && - cmp(mpi.least,mpi.most) == 0) { + CMP(mpi.least,mpi.most) == 0) { doit_select(tb,mpi.save_term,&sc,0 /* direction doesn't matter */); RET_TO_BIF(sc.accum,DB_ERROR_NONE); } @@ -1150,20 +1126,20 @@ static int db_select_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.most; } - - traverse_forward(tb, stack, lastkey, &doit_select, &sc); + traverse_forward(tb, stack, lastkey, lk_base, &doit_select, &sc); } else { if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - - traverse_backwards(tb, stack, lastkey, &doit_select, &sc); + traverse_backwards(tb, stack, lastkey, lk_base, &doit_select, &sc); } release_stack(tb,stack); #ifdef HARDDEBUG @@ -1176,9 +1152,9 @@ static int db_select_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object(key); + sz = size_object_rel(key, sc.lastobj); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb=db_make_mp_binary(p,mpi.mp,&hp); @@ -1259,7 +1235,7 @@ static int db_select_count_continue_tree(Process *p, } stack = get_any_stack(tb); - traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc); + traverse_backwards(tb, stack, lastkey, NULL, &doit_select_count, &sc); release_stack(tb,stack); BUMP_REDS(p, 1000 - sc.max); @@ -1269,12 +1245,12 @@ static int db_select_count_continue_tree(Process *p, } key = GETKEY(tb, sc.lastobj); if (end_condition != NIL && - (cmp_partly_bound(end_condition,key) > 0)) { + (cmp_partly_bound(end_condition,key,sc.lastobj) > 0)) { /* done anyway */ RET_TO_BIF(make_small(sc.got),DB_ERROR_NONE); } /* Not done yet, let's trap. */ - sz = size_object(key); + sz = size_object_rel(key, sc.lastobj); if (IS_USMALL(0, sc.got)) { hp = HAlloc(p, sz + 6); egot = make_small(sc.got); @@ -1284,7 +1260,7 @@ static int db_select_count_continue_tree(Process *p, egot = uint_to_big(sc.got, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); continuation = TUPLE5 (hp, tptr[1], @@ -1307,6 +1283,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, struct select_count_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; + Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1347,7 +1324,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && - cmp(mpi.least,mpi.most) == 0) { + CMP(mpi.least,mpi.most) == 0) { doit_select_count(tb,mpi.save_term,&sc,0 /* dummy */); RET_TO_BIF(erts_make_integer(sc.got,p),DB_ERROR_NONE); } @@ -1356,11 +1333,12 @@ static int db_select_count_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc); + traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_count, &sc); release_stack(tb,stack); BUMP_REDS(p, 1000 - sc.max); if (sc.max > 0) { @@ -1368,7 +1346,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object(key); + sz = size_object_rel(key, sc.lastobj); if (IS_USMALL(0, sc.got)) { hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); egot = make_small(sc.got); @@ -1378,7 +1356,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, egot = uint_to_big(sc.got, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb = db_make_mp_binary(p,mpi.mp,&hp); @@ -1409,6 +1387,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, struct select_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; + Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1450,7 +1429,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && - cmp(mpi.least,mpi.most) == 0) { + CMP(mpi.least,mpi.most) == 0) { doit_select(tb,mpi.save_term,&sc, 0 /* direction doesn't matter */); if (sc.accum != NIL) { hp=HAlloc(p, 3); @@ -1465,20 +1444,20 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - - traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc); + traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc); } else { if (mpi.some_limitation) { if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.most; } - - traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc); + traverse_forward(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc); } release_stack(tb,stack); @@ -1503,9 +1482,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object(key); + sz = size_object_rel(key, sc.lastobj); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb = db_make_mp_binary(p,mpi.mp,&hp); @@ -1528,9 +1507,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object(key); + sz = size_object_rel(key, sc.lastobj); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; @@ -1606,7 +1585,7 @@ static int db_select_delete_continue_tree(Process *p, sc.keypos = tb->common.keypos; ASSERT(!erts_smp_atomic_read(&tb->is_stack_busy)); - traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc); + traverse_backwards(tb, &tb->static_stack, lastkey, NULL, &doit_select_delete, &sc); BUMP_REDS(p, 1000 - sc.max); @@ -1615,11 +1594,11 @@ static int db_select_delete_continue_tree(Process *p, } key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); if (end_condition != NIL && - cmp_partly_bound(end_condition,key) > 0) { /* done anyway */ + cmp_partly_bound(end_condition,key,sc.lastterm->dbterm.tpl) > 0) { /* done anyway */ RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); } /* Not done yet, let's trap. */ - sz = size_object(key); + sz = size_object_rel(key, sc.lastterm->dbterm.tpl); if (IS_USMALL(0, sc.accum)) { hp = HAlloc(p, sz + 6); eaccsum = make_small(sc.accum); @@ -1629,7 +1608,7 @@ static int db_select_delete_continue_tree(Process *p, eaccsum = uint_to_big(sc.accum, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL); continuation = TUPLE5 (hp, tptr[1], @@ -1650,6 +1629,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, struct select_delete_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; + Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1693,7 +1673,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, sc.mp = mpi.mp; if (!mpi.got_partial && mpi.some_limitation && - cmp(mpi.least,mpi.most) == 0) { + CMP(mpi.least,mpi.most) == 0) { doit_select_delete(tb,mpi.save_term,&sc, 0 /* direction doesn't matter */); RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); @@ -1702,11 +1682,12 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, &tb->static_stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc); + traverse_backwards(tb, &tb->static_stack, lastkey, lk_base, &doit_select_delete, &sc); BUMP_REDS(p, 1000 - sc.max); if (sc.max > 0) { @@ -1714,7 +1695,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); - sz = size_object(key); + sz = size_object_rel(key, sc.lastterm->dbterm.tpl); if (IS_USMALL(0, sc.accum)) { hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); eaccsum = make_small(sc.accum); @@ -1724,7 +1705,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, eaccsum = uint_to_big(sc.accum, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL); mpb = db_make_mp_binary(p,mpi.mp,&hp); continuation = TUPLE5 @@ -1842,7 +1823,7 @@ do_db_tree_foreach_offheap(TreeDbTerm *tdbt, } static TreeDbTerm *linkout_tree(DbTableTree *tb, - Eterm key) + Eterm key, Eterm* key_base) { TreeDbTerm **tstack[STACK_NEED]; int tpos = 0; @@ -1865,7 +1846,7 @@ static TreeDbTerm *linkout_tree(DbTableTree *tb, for (;;) { if (!*this) { /* Failure */ return NULL; - } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) { + } else if ((c = cmp_key(tb, key, key_base, *this)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -1929,7 +1910,7 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb, for (;;) { if (!*this) { /* Failure */ return NULL; - } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) { + } else if ((c = cmp_key(tb,key,NULL,*this)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -2324,14 +2305,15 @@ done: * Find next and previous in sort order */ -static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) +static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, + Eterm key, Eterm* key_base) { TreeDbTerm *this; TreeDbTerm *tmp; Sint c; if(( this = TOP_NODE(stack)) != NULL) { - if (!CMP_EQ(GETKEY(tb, this->dbterm.tpl),key)) { + if (!cmp_key_eq(tb,key,key_base,this)) { /* Start from the beginning */ stack->pos = stack->slot = 0; } @@ -2341,14 +2323,14 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp(GETKEY(tb, this->dbterm.tpl),key) ) < 0) { + if (( c = cmp_key(tb,key,key_base,this) ) > 0) { if (this->right == NULL) /* We are at the previos and the element does not exist */ break; else this = this->right; - } else if (c > 0) { + } else if (c < 0) { if (this->left == NULL) /* Done */ return this; else @@ -2381,14 +2363,15 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) return this; } -static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key) +static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, + Eterm key, Eterm* key_base) { TreeDbTerm *this; TreeDbTerm *tmp; Sint c; if(( this = TOP_NODE(stack)) != NULL) { - if (!CMP_EQ(GETKEY(tb, this->dbterm.tpl),key)) { + if (!cmp_key_eq(tb,key,key_base,this)) { /* Start from the beginning */ stack->pos = stack->slot = 0; } @@ -2398,14 +2381,14 @@ static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key) return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp(GETKEY(tb, this->dbterm.tpl),key) ) > 0) { + if (( c = cmp_key(tb,key,key_base,this) ) < 0) { if (this->left == NULL) /* We are at the next and the element does not exist */ break; else this = this->left; - } else if (c < 0) { + } else if (c > 0) { if (this->right == NULL) /* Done */ return this; else @@ -2451,7 +2434,8 @@ static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl)) ) >= 0) { + if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl), + this->dbterm.tpl) ) >= 0) { if (this->right == NULL) { do { tmp = POP_NODE(stack); @@ -2484,7 +2468,8 @@ static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl)) ) <= 0) { + if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl), + this->dbterm.tpl) ) <= 0) { if (this->left == NULL) { do { tmp = POP_NODE(stack); @@ -2514,12 +2499,11 @@ static TreeDbTerm *find_node(DbTableTree *tb, Eterm key) Sint res; DbTreeStack* stack = get_static_stack(tb); - if(!stack || EMPTY_NODE(stack) - || !CMP_EQ(GETKEY(tb, ( this = TOP_NODE(stack) )->dbterm.tpl), key)) { + if(!stack || EMPTY_NODE(stack) + || !cmp_key_eq(tb, key, NULL, (this=TOP_NODE(stack)))) { this = tb->root; - while (this != NULL && - ( res = cmp(key, GETKEY(tb, this->dbterm.tpl)) ) != 0) { + while (this != NULL && (res = cmp_key(tb,key,NULL,this)) != 0) { if (res < 0) this = this->left; else @@ -2541,8 +2525,7 @@ static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key) Sint res; this = &tb->root; - while ((*this) != NULL && - ( res = cmp(key, GETKEY(tb, (*this)->dbterm.tpl)) ) != 0) { + while ((*this) != NULL && (res = cmp_key(tb, key, NULL, *this)) != 0) { if (res < 0) this = &((*this)->left); else @@ -2565,6 +2548,9 @@ static int db_lookup_dbterm_tree(DbTable *tbl, Eterm key, DbUpdateHandle* handle handle->mustResize = 0; handle->bp = (void**) pp; handle->new_size = (*pp)->dbterm.size; +#if HALFWORD_HEAP + handle->abs_vec = NULL; +#endif return 1; } @@ -2589,7 +2575,7 @@ static void db_finalize_dbterm_tree(DbUpdateHandle* handle) */ static void traverse_backwards(DbTableTree *tb, DbTreeStack* stack, - Eterm lastkey, + Eterm lastkey, Eterm* lk_base, int (*doit)(DbTableTree *, TreeDbTerm *, void *, @@ -2608,15 +2594,16 @@ static void traverse_backwards(DbTableTree *tb, this = this->right; } this = TOP_NODE(stack); - next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl)); + next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), + this->dbterm.tpl); if (!((*doit)(tb, this, context, 0))) return; } else { - next = find_prev(tb, stack, lastkey); + next = find_prev(tb, stack, lastkey, lk_base); } while ((this = next) != NULL) { - next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl)); + next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); if (!((*doit)(tb, this, context, 0))) return; } @@ -2627,7 +2614,7 @@ static void traverse_backwards(DbTableTree *tb, */ static void traverse_forward(DbTableTree *tb, DbTreeStack* stack, - Eterm lastkey, + Eterm lastkey, Eterm* lk_base, int (*doit)(DbTableTree *, TreeDbTerm *, void *, @@ -2646,15 +2633,15 @@ static void traverse_forward(DbTableTree *tb, this = this->left; } this = TOP_NODE(stack); - next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl)); + next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); if (!((*doit)(tb, this, context, 1))) return; } else { - next = find_next(tb, stack, lastkey); + next = find_next(tb, stack, lastkey, lk_base); } while ((this = next) != NULL) { - next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl)); + next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); if (!((*doit)(tb, this, context, 1))) return; } @@ -2680,7 +2667,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, if (( this = find_node(tb, key) ) == NULL) { return -1; } - *ret = this; + *ret = this; return 1; } else if (partly_bound != NULL && key != am_Underscore && db_is_variable(key) < 0) @@ -2691,7 +2678,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, -static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done) +static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) { Eterm* aa; Eterm* bb; @@ -2705,44 +2692,44 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done) *done = 1; return 0; } - if (a == b) + if (is_same(a,NULL,b,b_base)) return 0; switch (a & _TAG_PRIMARY_MASK) { case TAG_PRIMARY_LIST: if (!is_list(b)) { - return cmp(a,b); + return cmp_rel(a,NULL,b,b_base); } aa = list_val(a); - bb = list_val(b); + bb = list_val_rel(b,b_base); while (1) { - if ((j = do_cmp_partly_bound(*aa++, *bb++, done)) != 0 || *done) + if ((j = do_cmp_partly_bound(*aa++, *bb++, b_base, done)) != 0 || *done) return j; if (*aa==*bb) return 0; if (is_not_list(*aa) || is_not_list(*bb)) - return do_cmp_partly_bound(*aa, *bb, done); + return do_cmp_partly_bound(*aa, *bb, b_base, done); aa = list_val(*aa); - bb = list_val(*bb); + bb = list_val_rel(*bb,b_base); } case TAG_PRIMARY_BOXED: if ((b & _TAG_PRIMARY_MASK) != TAG_PRIMARY_BOXED) { - return cmp(a,b); + return cmp_rel(a,NULL,b,b_base); } a_hdr = ((*boxed_val(a)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; - b_hdr = ((*boxed_val(b)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; + b_hdr = ((*boxed_val_rel(b,b_base)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; if (a_hdr != b_hdr) { - return cmp(a, b); + return cmp_rel(a, NULL, b, b_base); } if (a_hdr == (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) { aa = tuple_val(a); - bb = tuple_val(b); + bb = tuple_val_rel(b, b_base); /* compare the arities */ i = arityval(*aa); /* get the arity*/ if (i < arityval(*bb)) return(-1); if (i > arityval(*bb)) return(1); while (i--) { - if ((j = do_cmp_partly_bound(*++aa, *++bb, done)) != 0 + if ((j = do_cmp_partly_bound(*++aa, *++bb, b_base, done)) != 0 || *done) return j; } @@ -2750,14 +2737,14 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done) } /* Drop through */ default: - return cmp(a, b); + return cmp_rel(a, NULL, b, b_base); } } -static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key) +static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base) { int done = 0; - Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, &done); + Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, bk_base, &done); #ifdef HARDDEBUG erts_fprintf(stderr,"\ncmp_partly_bound: %T", partly_bound_key); if (ret < 0) @@ -2766,7 +2753,7 @@ static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key) erts_fprintf(stderr," > "); else erts_fprintf(stderr," == "); - erts_fprintf(stderr,"%T\n",bound_key); + erts_fprintf(stderr,"%T\n",bound_key); // HALFWORD BUG: printing rterm #endif return ret; } @@ -2853,7 +2840,7 @@ static int do_partly_bound_can_match_lesser(Eterm a, Eterm b, if (not_eq_tags(a,b)) { *done = 1; - return (cmp(a, b) < 0) ? 1 : 0; + return (CMP(a, b) < 0) ? 1 : 0; } /* we now know that tags are the same */ @@ -2889,7 +2876,7 @@ static int do_partly_bound_can_match_lesser(Eterm a, Eterm b, bb = list_val(*bb); } default: - if((i = cmp(a, b)) != 0) { + if((i = CMP(a, b)) != 0) { *done = 1; } return (i < 0) ? 1 : 0; @@ -2924,7 +2911,7 @@ static int do_partly_bound_can_match_greater(Eterm a, Eterm b, if (not_eq_tags(a,b)) { *done = 1; - return (cmp(a, b) > 0) ? 1 : 0; + return (CMP(a, b) > 0) ? 1 : 0; } /* we now know that tags are the same */ @@ -2960,7 +2947,7 @@ static int do_partly_bound_can_match_greater(Eterm a, Eterm b, bb = list_val(*bb); } default: - if((i = cmp(a, b)) != 0) { + if((i = CMP(a, b)) != 0) { *done = 1; } return (i > 0) ? 1 : 0; @@ -2983,16 +2970,16 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && ((forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) < 0) || + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) < 0) || (!forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) > 0))) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) > 0))) { return 0; } - ret = db_prog_match_and_copy(&tb->common,sc->p,sc->mp,sc->all_objects, - &this->dbterm, &hp, 2); + ret = db_match_dbterm(&tb->common,sc->p,sc->mp,sc->all_objects, + &this->dbterm, &hp, 2); if (is_value(ret)) { sc->accum = CONS(hp, ret, sc->accum); } @@ -3020,12 +3007,12 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr, /* Always backwards traversing */ if (sc->end_condition != NIL && (cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) > 0)) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) > 0)) { return 0; } - ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, 0, - &this->dbterm, NULL, 0); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0, + &this->dbterm, NULL, 0); if (ret == am_true) { ++(sc->got); } @@ -3047,17 +3034,17 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && ((forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) < 0) || + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) < 0) || (!forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) > 0))) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) > 0))) { return 0; } - ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, sc->all_objects, - &this->dbterm, &hp, 2); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, sc->all_objects, + &this->dbterm, &hp, 2); if (is_value(ret)) { ++(sc->got); sc->accum = CONS(hp, ret, sc->accum); @@ -3090,14 +3077,14 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) > 0) + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) > 0) return 0; - ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, 0, - &this->dbterm, NULL, 0); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0, + &this->dbterm, NULL, 0); if (ret == am_true) { key = GETKEY(sc->tb, this->dbterm.tpl); - linkout_tree(sc->tb, key); + linkout_tree(sc->tb, key, this->dbterm.tpl); sc->erase_lastterm = 1; ++sc->accum; } diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 2852fb93fe..d3e31da413 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2011. All Rights Reserved. * * 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 @@ -57,6 +57,7 @@ DBIF_TABLE_GUARD | DBIF_TABLE_BODY | DBIF_TRACE_GUARD | DBIF_TRACE_BODY +#define HEAP_XTRA 100 /* ** Some convenience macros for stacks (DMC == db_match_compile) @@ -229,6 +230,11 @@ typedef enum { matchCall2, matchCall3, matchPushV, +#if HALFWORD_HEAP + matchPushVGuard, /* First guard-only variable reference */ +#endif + matchPushVResult, /* First variable reference in result, or (if HALFWORD) + in guard if also referenced in result */ matchPushExpr, /* Push the whole expression we're matching ('$_') */ matchPushArrayAsList, /* Only when parameter is an Array and not an erlang term (DCOMP_TRACE) */ @@ -292,11 +298,19 @@ DMC_DECLARE_STACK_TYPE(unsigned); ** Data about the heap during compilation */ +typedef struct DMCVariable { + int is_bound; + int is_in_body; +#if HALFWORD_HEAP + int first_guard_label; /* to maybe change from PushVGuard to PushVResult */ +#endif +} DMCVariable; + typedef struct DMCHeap { int size; - unsigned def[DMC_DEFAULT_SIZE]; - unsigned *data; - int used; + DMCVariable vars_def[DMC_DEFAULT_SIZE]; + DMCVariable* vars; + int vars_used; } DMCHeap; /* @@ -323,7 +337,6 @@ typedef struct dmc_context { Eterm *bodyexpr; int num_match; int current_match; - int eheap_need; Uint cflags; int is_guard; /* 1 if in guard, 0 if in body */ int special; /* 1 if the head in the match was a single expression */ @@ -346,9 +359,22 @@ typedef struct dmc_context { #define ERTS_DEFAULT_MS_HEAP_SIZE 128 +/* Runtime info about a $-variable +*/ +typedef struct MatchVariable { + Eterm term; +#ifdef DEBUG + Process* proc; + Eterm* base; +#endif +} MatchVariable; + typedef struct { Process process; - Eterm *heap; + union { + Eterm* heap; + MatchVariable* variables; /* first on "heap" */ + }u; Eterm default_heap[ERTS_DEFAULT_MS_HEAP_SIZE]; } ErtsMatchPseudoProcess; @@ -371,10 +397,10 @@ cleanup_match_pseudo_process(ErtsMatchPseudoProcess *mpsp, int keep_heap) } #endif if (!keep_heap) { - if (mpsp->heap != &mpsp->default_heap[0]) { + if (mpsp->u.heap != mpsp->default_heap) { /* Have to be done *after* call to erts_cleanup_empty_process() */ - erts_free(ERTS_ALC_T_DB_MS_RUN_HEAP, (void *) mpsp->heap); - mpsp->heap = &mpsp->default_heap[0]; + erts_free(ERTS_ALC_T_DB_MS_RUN_HEAP, (void *) mpsp->u.heap); + mpsp->u.heap = mpsp->default_heap; } #ifdef DEBUG else { @@ -398,7 +424,7 @@ create_match_pseudo_process(void) mpsp = (ErtsMatchPseudoProcess *)erts_alloc(ERTS_ALC_T_DB_MS_PSDO_PROC, sizeof(ErtsMatchPseudoProcess)); erts_init_empty_process(&mpsp->process); - mpsp->heap = &mpsp->default_heap[0]; + mpsp->u.heap = mpsp->default_heap; return mpsp; } @@ -422,11 +448,11 @@ get_match_pseudo_process(Process *c_p, Uint heap_size) mpsp = match_pseudo_process; cleanup_match_pseudo_process(mpsp, 0); #endif - if (heap_size > ERTS_DEFAULT_MS_HEAP_SIZE) - mpsp->heap = (Eterm *) erts_alloc(ERTS_ALC_T_DB_MS_RUN_HEAP, - heap_size*sizeof(Uint)); + if (heap_size > ERTS_DEFAULT_MS_HEAP_SIZE*sizeof(Eterm)) { + mpsp->u.heap = (Eterm*) erts_alloc(ERTS_ALC_T_DB_MS_RUN_HEAP, heap_size); + } else { - ASSERT(mpsp->heap == &mpsp->default_heap[0]); + ASSERT(mpsp->u.heap == mpsp->default_heap); } return mpsp; } @@ -467,23 +493,6 @@ erts_match_set_release_result(Process* c_p) static erts_smp_atomic_t trace_control_word; - -Eterm -erts_ets_copy_object(Eterm obj, Process* to) -{ - Uint size = size_object(obj); - Eterm* hp = HAlloc(to, size); - Eterm res; - - res = copy_struct(obj, size, &hp, &MSO(to)); -#ifdef DEBUG - if (eq(obj, res) == 0) { - erl_exit(1, "copy not equal to source\n"); - } -#endif - return res; -} - /* This needs to be here, before the bif table... */ static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm val); @@ -869,9 +878,9 @@ static DMCRet dmc_one_term(DMCContext *context, #ifdef DMC_DEBUG static int test_disassemble_next = 0; -static void db_match_dis(Binary *prog); +void db_match_dis(Binary *prog); #define TRACE erts_fprintf(stderr,"Trace: %s:%d\n",__FILE__,__LINE__) -#define FENCE_PATTERN_SIZE 1 +#define FENCE_PATTERN_SIZE (1*sizeof(Uint)) #define FENCE_PATTERN 0xDEADBEEFUL #else #define TRACE /* Nothing */ @@ -1179,14 +1188,14 @@ done: } Eterm erts_match_set_run(Process *p, Binary *mpsp, - Eterm *args, int num_args, + Eterm *args, int num_args, + enum erts_pam_run_flags in_flags, Uint32 *return_flags) { Eterm ret; - ret = db_prog_match(p, mpsp, - NIL, args, - num_args, return_flags); + ret = db_prog_match(p, mpsp, NIL, NULL, args, num_args, + in_flags, return_flags); #if defined(HARDDEBUG) if (is_non_value(ret)) { erts_fprintf(stderr, "Failed\n"); @@ -1210,9 +1219,9 @@ static Eterm erts_match_set_run_ets(Process *p, Binary *mpsp, { Eterm ret; - ret = db_prog_match(p, mpsp, - args, NULL, - num_args, return_flags); + ret = db_prog_match(p, mpsp, args, NULL, NULL, num_args, + ERTS_PAM_CONTIGUOUS_TUPLE | ERTS_PAM_COPY_RESULT, + return_flags); #if defined(HARDDEBUG) if (is_non_value(ret)) { erts_fprintf(stderr, "Failed\n"); @@ -1280,7 +1289,6 @@ Binary *db_match_compile(Eterm *matchexpr, int structure_checked; DMCRet res; int current_try_label; - Uint max_eheap_need; Binary *bp = NULL; unsigned clause_start; @@ -1293,27 +1301,24 @@ Binary *db_match_compile(Eterm *matchexpr, context.matchexpr = matchexpr; context.guardexpr = guards; context.bodyexpr = body; - context.eheap_need = 0; context.err_info = err_info; context.cflags = flags; heap.size = DMC_DEFAULT_SIZE; - heap.data = heap.def; + heap.vars = heap.vars_def; /* ** Compile the match expression */ restart: - heap.used = 0; - max_eheap_need = 0; + heap.vars_used = 0; for (context.current_match = 0; context.current_match < num_progs; ++context.current_match) { /* This loop is long, too long */ - memset(heap.data, 0, heap.size * sizeof(*heap.data)); + memset(heap.vars, 0, heap.size * sizeof(*heap.vars)); t = context.matchexpr[context.current_match]; context.stack_used = 0; - context.eheap_need = 0; structure_checked = 0; if (context.current_match < num_progs - 1) { DMC_PUSH(text,matchTryMeElse); @@ -1485,10 +1490,6 @@ restart: if (current_try_label >= 0) { DMC_POKE(text, current_try_label, DMC_STACK_NUM(text)); } - /* So, how much eheap did this part of the match program need? */ - if (context.eheap_need > max_eheap_need) { - max_eheap_need = context.eheap_need; - } } /* for (context.current_match = 0 ...) */ @@ -1524,16 +1525,13 @@ restart: ret->saved_program_buf = NULL; ret->saved_program = NIL; ret->term_save = context.save; - ret->num_bindings = heap.used; + ret->num_bindings = heap.vars_used; ret->single_variable = context.special; sys_memcpy(ret->text, DMC_STACK_DATA(text), DMC_STACK_NUM(text) * sizeof(UWord)); - ret->heap_size = ((heap.used * sizeof(Eterm)) + - (max_eheap_need * sizeof(Eterm)) + - (context.stack_need * sizeof(Eterm *)) + - (3 * (FENCE_PATTERN_SIZE * sizeof(Eterm *)))); - ret->eheap_offset = heap.used + FENCE_PATTERN_SIZE; - ret->stack_offset = ret->eheap_offset + max_eheap_need + FENCE_PATTERN_SIZE; + ret->stack_offset = heap.vars_used*sizeof(MatchVariable) + FENCE_PATTERN_SIZE; + ret->heap_size = ret->stack_offset + context.stack_need * sizeof(Eterm*) + FENCE_PATTERN_SIZE; + #ifdef DMC_DEBUG ret->prog_end = ret->text + DMC_STACK_NUM(text); #endif @@ -1551,8 +1549,8 @@ error: /* Here is were we land when compilation failed. */ DMC_FREE(text); if (context.copy != NULL) free_message_buffer(context.copy); - if (heap.data != heap.def) - erts_free(ERTS_ALC_T_DB_MS_CMPL_HEAP, (void *) heap.data); + if (heap.vars != heap.vars_def) + erts_free(ERTS_ALC_T_DB_MS_CMPL_HEAP, (void *) heap.vars); return bp; } @@ -1597,7 +1595,7 @@ erts_match_prog_foreach_offheap(Binary *bprog, */ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) { - Eterm *hp = HAlloc(psp, arity * 2); + Eterm *hp = HAllocX(psp, arity * 2, HEAP_XTRA); Eterm ret = NIL; while (--arity >= 0) { ret = CONS(hp, arr[arity], ret); @@ -1606,15 +1604,82 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) return ret; } + +#if HALFWORD_HEAP +struct heap_checkpoint_t +{ + Process *p; + Eterm* htop; + ErlHeapFragment* mbuf; + unsigned used_size; + ErlOffHeap off_heap; +}; + +static void heap_checkpoint_init(Process* p, struct heap_checkpoint_t* hcp) +{ + hcp->p = p; + hcp->htop = HEAP_TOP(p); + hcp->mbuf = MBUF(p); + hcp->used_size = hcp->mbuf ? hcp->mbuf->used_size : 0; + hcp->off_heap = MSO(p); +} + +static void heap_checkpoint_revert(struct heap_checkpoint_t* hcp) +{ + struct erl_off_heap_header* oh = MSO(hcp->p).first; + + if (oh != hcp->off_heap.first) { + ASSERT(oh != NULL); + if (hcp->off_heap.first) { + while (oh->next != hcp->off_heap.first) { + oh = oh->next; + } + oh->next = NULL; + } + erts_cleanup_offheap(&MSO(hcp->p)); + MSO(hcp->p) = hcp->off_heap; + } + if (MBUF(hcp->p) != hcp->mbuf) { + ErlHeapFragment* hf = MBUF(hcp->p); + ASSERT(hf != NULL); + if (hcp->mbuf) { + while (hf->next != hcp->mbuf) { + hf = hf->next; + } + hf->next = NULL; + } + free_message_buffer(MBUF(hcp->p)); + MBUF(hcp->p) = hcp->mbuf; + } + if (hcp->mbuf != NULL && hcp->mbuf->used_size != hcp->used_size) { + hcp->mbuf->used_size = hcp->used_size; + } + HEAP_TOP(hcp->p) = hcp->htop; +} +#endif /* HALFWORD_HEAP */ + +static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base) +{ + if (!is_immed(term)) { + Uint sz = size_object_rel(term, base); + Eterm* top = HAllocX(p, sz, HEAP_XTRA); + return copy_struct_rel(term, sz, &top, &MSO(p), base, NULL); + } + return term; +} + + /* ** Execution of the match program, this is Pam. ** May return THE_NON_VALUE, which is a bailout. -** the para meter 'arity' is only used if 'term' is actually an array, +** the parameter 'arity' is only used if 'term' is actually an array, ** i.e. 'DCOMP_TRACE' was specified */ -Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, +Eterm db_prog_match(Process *c_p, Binary *bprog, + Eterm term, Eterm* base, Eterm *termp, int arity, + enum erts_pam_run_flags in_flags, Uint32 *return_flags) { MatchProg *prog = Binary2MatchProg(bprog); @@ -1623,7 +1688,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, Eterm t; Eterm **sp; Eterm *esp; - Eterm *hp; + MatchVariable* variables; BeamInstr *cp; UWord *pc = prog->text; Eterm *ehp; @@ -1633,19 +1698,24 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, unsigned do_catch; ErtsMatchPseudoProcess *mpsp; Process *psp; + Process* build_proc; Process *tmpp; Process *current_scheduled; ErtsSchedulerData *esdp; Eterm (*bif)(Process*, ...); int fail_label; int atomic_trace; +#if HALFWORD_HEAP + struct heap_checkpoint_t c_p_checkpoint = {}; +#endif #ifdef DMC_DEBUG Uint *heap_fence; - Uint *eheap_fence; Uint *stack_fence; Uint save_op; #endif /* DMC_DEBUG */ + ASSERT(base==NULL || HALFWORD_HEAP); + mpsp = get_match_pseudo_process(c_p, prog->heap_size); psp = &mpsp->process; @@ -1655,7 +1725,6 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, esdp = ERTS_GET_SCHEDULER_DATA_FROM_PROC(c_p); ASSERT(esdp != NULL); current_scheduled = esdp->current_process; - esdp->current_process = psp; /* SMP: psp->scheduler_data is set by get_match_pseudo_process */ atomic_trace = 0; @@ -1678,11 +1747,9 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, #ifdef DMC_DEBUG save_op = 0; - heap_fence = (Uint *) mpsp->heap + prog->eheap_offset - 1; - eheap_fence = (Uint *) mpsp->heap + prog->stack_offset - 1; - stack_fence = (Uint *) mpsp->heap + prog->heap_size - 1; + heap_fence = (Eterm*)((char*) mpsp->u.heap + prog->stack_offset) - 1; + stack_fence = (Eterm*)((char*) mpsp->u.heap + prog->heap_size) - 1; *heap_fence = FENCE_PATTERN; - *eheap_fence = FENCE_PATTERN; *stack_fence = FENCE_PATTERN; #endif /* DMC_DEBUG */ @@ -1696,36 +1763,48 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, *return_flags = 0U; + variables = mpsp->u.variables; +#if HALFWORD_HEAP + c_p_checkpoint.p = NULL; +#endif + restart: ep = &term; - esp = mpsp->heap + prog->stack_offset; + esp = (Eterm*)((char*)mpsp->u.heap + prog->stack_offset); sp = (Eterm **) esp; - hp = mpsp->heap; - ehp = mpsp->heap + prog->eheap_offset; ret = am_true; do_catch = 0; fail_label = -1; + build_proc = psp; + esdp->current_process = psp; + ASSERT_HALFWORD(!c_p_checkpoint.p); + +#ifdef DEBUG + ASSERT(variables == mpsp->u.variables); + for (i=0; i<prog->num_bindings; i++) { + variables[i].term = THE_NON_VALUE; + variables[i].proc = NULL; + variables[i].base = base; + } +#endif for (;;) { -#ifdef DMC_DEBUG + + #ifdef DMC_DEBUG if (*heap_fence != FENCE_PATTERN) { erl_exit(1, "Heap fence overwritten in db_prog_match after op " "0x%08x, overwritten with 0x%08x.", save_op, *heap_fence); } - if (*eheap_fence != FENCE_PATTERN) { - erl_exit(1, "Eheap fence overwritten in db_prog_match after op " - "0x%08x, overwritten with 0x%08x.", save_op, - *eheap_fence); - } if (*stack_fence != FENCE_PATTERN) { erl_exit(1, "Stack fence overwritten in db_prog_match after op " "0x%08x, overwritten with 0x%08x.", save_op, *stack_fence); } save_op = *pc; -#endif + #endif switch (*pc++) { case matchTryMeElse: + ASSERT(fail_label == -1); fail_label = *pc++; break; case matchArray: /* only when DCOMP_TRACE, is always first @@ -1736,13 +1815,14 @@ restart: ep = termp; break; case matchArrayBind: /* When the array size is unknown. */ + ASSERT(termp); n = *pc++; - hp[n] = dpm_array_to_list(psp, termp, arity); + variables[n].term = dpm_array_to_list(psp, termp, arity); break; case matchTuple: /* *ep is a tuple of arity n */ - if (!is_tuple(*ep)) + if (!is_tuple_rel(*ep,base)) FAIL(); - ep = tuple_val(*ep); + ep = tuple_val_rel(*ep,base); n = *pc++; if (arityval(*ep) != n) FAIL(); @@ -1750,9 +1830,9 @@ restart: break; case matchPushT: /* *ep is a tuple of arity n, push ptr to first element */ - if (!is_tuple(*ep)) + if (!is_tuple_rel(*ep,base)) FAIL(); - tp = tuple_val(*ep); + tp = tuple_val_rel(*ep,base); n = *pc++; if (arityval(*tp) != n) FAIL(); @@ -1762,12 +1842,12 @@ restart: case matchList: if (!is_list(*ep)) FAIL(); - ep = list_val(*ep); + ep = list_val_rel(*ep,base); break; case matchPushL: if (!is_list(*ep)) FAIL(); - *sp++ = list_val(*ep); + *sp++ = list_val_rel(*ep,base); ++ep; break; case matchPop: @@ -1775,41 +1855,44 @@ restart: break; case matchBind: n = *pc++; - hp[n] = *ep++; + variables[n].term = *ep++; break; case matchCmp: n = *pc++; - if (!eq(hp[n],*ep)) + if (!eq_rel(variables[n].term, base, *ep, base)) FAIL(); ++ep; break; case matchEqBin: t = (Eterm) *pc++; - if (!eq(*ep,t)) + if (!eq_rel(t,NULL,*ep,base)) FAIL(); ++ep; break; case matchEqFloat: - if (!is_float(*ep)) + if (!is_float_rel(*ep,base)) FAIL(); - if (memcmp(float_val(*ep) + 1, pc, sizeof(double))) + if (memcmp(float_val_rel(*ep,base) + 1, pc, sizeof(double))) FAIL(); pc += TermWords(2); ++ep; break; - case matchEqRef: - if (!is_ref(*ep)) + case matchEqRef: { + Eterm* epc = (Eterm*)pc; + if (!is_ref_rel(*ep,base)) FAIL(); - if (!eq(*ep, make_internal_ref((Uint *) pc))) + if (!eq_rel(make_internal_ref_rel(epc, epc), epc, *ep, base)) { FAIL(); - i = thing_arityval(*((Uint *) pc)); + } + i = thing_arityval(*epc); pc += TermWords(i+1); ++ep; break; + } case matchEqBig: - if (!is_big(*ep)) + if (!is_big_rel(*ep,base)) FAIL(); - tp = big_val(*ep); + tp = big_val_rel(*ep,base); { Eterm *epc = (Eterm *) pc; if (*tp != *epc) @@ -1825,7 +1908,8 @@ restart: ++ep; break; case matchEq: - t = (Eterm) *pc++; + t = (Eterm) *pc++; + ASSERT(is_immed(t)); if (t != *ep++) FAIL(); break; @@ -1833,25 +1917,32 @@ restart: ++ep; break; /* - * Here comes guard instructions + * Here comes guard & body instructions */ case matchPushC: /* Push constant */ - *esp++ = *pc++; + if ((in_flags & ERTS_PAM_COPY_RESULT) + && do_catch && !is_immed(*pc)) { + *esp++ = copy_object(*pc++, c_p); + } + else { + *esp++ = *pc++; + } break; case matchConsA: - ehp[1] = *--esp; - ehp[0] = esp[-1]; + ehp = HAllocX(build_proc, 2, HEAP_XTRA); + CDR(ehp) = *--esp; + CAR(ehp) = esp[-1]; esp[-1] = make_list(ehp); - ehp += 2; break; case matchConsB: - ehp[0] = *--esp; - ehp[1] = esp[-1]; + ehp = HAllocX(build_proc, 2, HEAP_XTRA); + CAR(ehp) = *--esp; + CDR(ehp) = esp[-1]; esp[-1] = make_list(ehp); - ehp += 2; break; case matchMkTuple: n = *pc++; + ehp = HAllocX(build_proc, n+1, HEAP_XTRA); t = make_tuple(ehp); *ehp++ = make_arityval(n); while (n--) { @@ -1861,7 +1952,7 @@ restart: break; case matchCall0: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(psp); + t = (*bif)(build_proc); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1872,7 +1963,7 @@ restart: break; case matchCall1: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(psp, esp[-1]); + t = (*bif)(build_proc, esp[-1]); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1883,7 +1974,7 @@ restart: break; case matchCall2: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(psp, esp[-1], esp[-2]); + t = (*bif)(build_proc, esp[-1], esp[-2]); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1895,7 +1986,7 @@ restart: break; case matchCall3: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(psp, esp[-1], esp[-2], esp[-3]); + t = (*bif)(build_proc, esp[-1], esp[-2], esp[-3]); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1905,15 +1996,73 @@ restart: esp -= 2; esp[-1] = t; break; + + #if HALFWORD_HEAP + case matchPushVGuard: + if (!base) goto case_matchPushV; + /* Build NULL-based copy on pseudo heap for easy disposal */ + n = *pc++; + ASSERT(is_value(variables[n].term)); + ASSERT(!variables[n].proc); + variables[n].term = copy_object_rel(psp, variables[n].term, base); + *esp++ = variables[n].term; + #ifdef DEBUG + variables[n].proc = psp; + variables[n].base = NULL; + #endif + break; + #endif + case matchPushVResult: + if (!(in_flags & ERTS_PAM_COPY_RESULT)) goto case_matchPushV; + + /* Build (NULL-based) copy on callers heap */ + #if HALFWORD_HEAP + if (!do_catch && !c_p_checkpoint.p) { + heap_checkpoint_init(c_p, &c_p_checkpoint); + } + #endif + n = *pc++; + ASSERT(is_value(variables[n].term)); + ASSERT(!variables[n].proc); + variables[n].term = copy_object_rel(c_p, variables[n].term, base); + *esp++ = variables[n].term; + #ifdef DEBUG + variables[n].proc = c_p; + variables[n].base = NULL; + #endif + break; case matchPushV: - *esp++ = hp[*pc++]; + case_matchPushV: + n = *pc++; + ASSERT(is_value(variables[n].term)); + ASSERT(!variables[n].base); + *esp++ = variables[n].term; break; case matchPushExpr: - *esp++ = term; + if (in_flags & ERTS_PAM_COPY_RESULT) { + Uint sz; + Eterm* top; + sz = size_object_rel(term, base); + top = HAllocX(build_proc, sz, HEAP_XTRA); + if (in_flags & ERTS_PAM_CONTIGUOUS_TUPLE) { + ASSERT(is_tuple_rel(term,base)); + *esp++ = copy_shallow_rel(tuple_val_rel(term,base), sz, + &top, &MSO(build_proc), base); + } + else { + *esp++ = copy_struct_rel(term, sz, &top, &MSO(build_proc), + base, NULL); + } + } + else { + *esp = term; + } break; case matchPushArrayAsList: + ASSERT_HALFWORD(base == NULL); n = arity; /* Only happens when 'term' is an array */ tp = termp; + ehp = HAllocX(build_proc, n*2, HEAP_XTRA); *esp++ = make_list(ehp); while (n--) { *ehp++ = *tp++; @@ -1926,7 +2075,8 @@ restart: break; case matchPushArrayAsListU: /* This instruction is NOT efficient. */ - *esp++ = dpm_array_to_list(psp, termp, arity); + ASSERT_HALFWORD(base == NULL); + *esp++ = dpm_array_to_list(build_proc, termp, arity); break; case matchTrue: if (*--esp != am_true) @@ -2012,7 +2162,7 @@ restart: case matchProcessDump: { erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0); print_process_info(ERTS_PRINT_DSBUF, (void *) dsbufp, c_p); - *esp++ = new_binary(psp, (byte *)dsbufp->str, (int)dsbufp->str_len); + *esp++ = new_binary(build_proc, (byte *)dsbufp->str, (int)dsbufp->str_len); erts_destroy_tmp_dsbuf(dsbufp); break; } @@ -2056,29 +2206,24 @@ restart: if (SEQ_TRACE_TOKEN(c_p) == NIL) *esp++ = NIL; else { + Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p); + Uint sender_sz = is_immed(sender) ? 0 : size_object(sender); + ehp = HAllocX(build_proc, 6 + sender_sz, HEAP_XTRA); + if (sender_sz) { + sender = copy_struct(sender, sender_sz, &ehp, &MSO(build_proc)); + } *esp++ = make_tuple(ehp); ehp[0] = make_arityval(5); ehp[1] = SEQ_TRACE_TOKEN_FLAGS(c_p); ehp[2] = SEQ_TRACE_TOKEN_LABEL(c_p); ehp[3] = SEQ_TRACE_TOKEN_SERIAL(c_p); - ehp[4] = SEQ_TRACE_TOKEN_SENDER(c_p); + ehp[4] = sender; ehp[5] = SEQ_TRACE_TOKEN_LASTCNT(c_p); ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5); ASSERT(is_immed(ehp[1])); ASSERT(is_immed(ehp[2])); ASSERT(is_immed(ehp[3])); ASSERT(is_immed(ehp[5])); - if(!is_immed(ehp[4])) { - Eterm *sender = &ehp[4]; - ehp += 6; - *sender = copy_struct(*sender, - size_object(*sender), - &ehp, - &MSO(psp)); - } - else - ehp += 6; - } break; case matchEnableTrace: @@ -2127,12 +2272,12 @@ restart: if (!(c_p->cp) || !(cp = find_function_from_pc(c_p->cp))) { *esp++ = am_undefined; } else { + ehp = HAllocX(build_proc, 4, HEAP_XTRA); *esp++ = make_tuple(ehp); ehp[0] = make_arityval(3); ehp[1] = cp[0]; ehp[2] = cp[1]; ehp[3] = make_small((Uint) cp[2]); - ehp += 4; } break; case matchSilent: @@ -2209,8 +2354,12 @@ restart: } } break; - case matchCatch: + case matchCatch: /* Match success, now build result */ do_catch = 1; + if (in_flags & ERTS_PAM_COPY_RESULT) { + build_proc = c_p; + esdp->current_process = c_p; + } break; case matchHalt: goto success; @@ -2219,9 +2368,16 @@ restart: } } fail: +#if HALFWORD_HEAP + if (c_p_checkpoint.p) { + /* Dispose garbage built by guards on caller heap */ + heap_checkpoint_revert(&c_p_checkpoint); + c_p_checkpoint.p = NULL; + } +#endif *return_flags = 0U; - if (fail_label >= 0) { /* We failed during a "TryMeElse", - lets restart, with the next match + if (fail_label >= 0) { /* We failed during a "TryMeElse", + lets restart, with the next match program */ pc = (prog->text) + fail_label; cleanup_match_pseudo_process(mpsp, 1); @@ -2235,11 +2391,6 @@ success: erl_exit(1, "Heap fence overwritten in db_prog_match after op " "0x%08x, overwritten with 0x%08x.", save_op, *heap_fence); } - if (*eheap_fence != FENCE_PATTERN) { - erl_exit(1, "Eheap fence overwritten in db_prog_match after op " - "0x%08x, overwritten with 0x%08x.", save_op, - *eheap_fence); - } if (*stack_fence != FENCE_PATTERN) { erl_exit(1, "Stack fence overwritten in db_prog_match after op " "0x%08x, overwritten with 0x%08x.", save_op, @@ -2250,6 +2401,7 @@ success: esdp->current_process = current_scheduled; END_ATOMIC_TRACE(c_p); + return ret; #undef FAIL #undef FAIL_TERM @@ -2261,7 +2413,8 @@ success: /* * Convert a match program to a "magic" binary to return up to erlang */ -Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp) { +Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp) +{ return erts_mk_magic_binary_term(hpp, &MSO(p), mp); } @@ -2327,13 +2480,13 @@ void db_free_dmc_err_info(DMCErrInfo *ei){ ** Store bignum in *hpp and increase *hpp accordingly. ** *hpp is assumed to be large enough to hold the result. */ -Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr) +Eterm db_add_counter(Eterm** hpp, Wterm counter, Eterm incr) { DeclareTmpHeapNoproc(big_tmp,2); Eterm res; Sint ires; - Eterm arg1; - Eterm arg2; + Wterm arg1; + Wterm arg2; if (is_both_small(counter,incr)) { ires = signed_val(counter) + signed_val(incr); @@ -2374,6 +2527,34 @@ Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr) } } +/* Must be called to read elements after db_lookup_dbterm. +** Will decompress if needed. +** HEALFWORD_HEAP: +** Will convert from relative to Wterm format if needed. +** (but only on top level, tuples and lists will still contain rterms) +*/ +Wterm db_do_read_element(DbUpdateHandle* handle, Sint position) +{ + Eterm elem = handle->dbterm->tpl[position]; + if (!is_header(elem)) { +#if HALFWORD_HEAP + if (!is_immed(elem) + && !handle->tb->common.compress + && !(handle->abs_vec && handle->abs_vec[position])) { + return rterm2wterm(elem, handle->dbterm->tpl); + } +#endif + return elem; + } + + ASSERT(((DbTableCommon*)handle->tb)->compress); + ASSERT(!handle->mustResize); + handle->dbterm = db_alloc_tmp_uncompressed(&handle->tb->common, + handle->dbterm); + handle->mustResize = 1; + return handle->dbterm->tpl[position]; +} + /* ** Update one element: ** handle: Initialized by db_lookup_dbterm() @@ -2390,14 +2571,17 @@ void db_do_update_element(DbUpdateHandle* handle, Eterm* oldp; Uint newval_sz; Uint oldval_sz; +#if HALFWORD_HEAP + Eterm* old_base; +#endif if (is_both_immed(newval,oldval)) { handle->dbterm->tpl[position] = newval; -#ifdef DEBUG_CLONE + #ifdef DEBUG_CLONE if (handle->dbterm->debug_clone) { handle->dbterm->debug_clone[position] = newval; } -#endif + #endif return; } if (!handle->mustResize) { @@ -2406,49 +2590,78 @@ void db_do_update_element(DbUpdateHandle* handle, handle->dbterm); handle->mustResize = 1; oldval = handle->dbterm->tpl[position]; + #if HALFWORD_HEAP + old_base = NULL; + #endif } - else if (is_boxed(newval)) { - newp = boxed_val(newval); - switch (*newp & _TAG_HEADER_MASK) { - case _TAG_HEADER_POS_BIG: - case _TAG_HEADER_NEG_BIG: - case _TAG_HEADER_FLOAT: - case _TAG_HEADER_HEAP_BIN: - newval_sz = header_arity(*newp) + 1; - if (is_boxed(oldval)) { - oldp = boxed_val(oldval); - switch (*oldp & _TAG_HEADER_MASK) { - case _TAG_HEADER_POS_BIG: - case _TAG_HEADER_NEG_BIG: - case _TAG_HEADER_FLOAT: - case _TAG_HEADER_HEAP_BIN: - oldval_sz = header_arity(*oldp) + 1; - if (oldval_sz == newval_sz) { - /* "self contained" terms of same size, do memcpy */ - sys_memcpy(oldp, newp, newval_sz*sizeof(Eterm)); - return; + else { + #if HALFWORD_HEAP + ASSERT(!handle->abs_vec); + old_base = handle->dbterm->tpl; + #endif + if (is_boxed(newval)) { + newp = boxed_val(newval); + switch (*newp & _TAG_HEADER_MASK) { + case _TAG_HEADER_POS_BIG: + case _TAG_HEADER_NEG_BIG: + case _TAG_HEADER_FLOAT: + case _TAG_HEADER_HEAP_BIN: + newval_sz = header_arity(*newp) + 1; + if (is_boxed(oldval)) { + oldp = boxed_val_rel(oldval,old_base); + switch (*oldp & _TAG_HEADER_MASK) { + case _TAG_HEADER_POS_BIG: + case _TAG_HEADER_NEG_BIG: + case _TAG_HEADER_FLOAT: + case _TAG_HEADER_HEAP_BIN: + oldval_sz = header_arity(*oldp) + 1; + if (oldval_sz == newval_sz) { + /* "self contained" terms of same size, do memcpy */ + sys_memcpy(oldp, newp, newval_sz*sizeof(Eterm)); + return; + } + goto both_size_set; } - goto both_size_set; } + goto new_size_set; } - goto new_size_set; } } } +#if HALFWORD_HEAP + else { + old_base = (handle->tb->common.compress + || (handle->abs_vec && handle->abs_vec[position])) ? + NULL : handle->dbterm->tpl; + } +#endif /* Not possible for simple memcpy or dbterm is already non-contiguous, */ /* need to realloc... */ newval_sz = is_immed(newval) ? 0 : size_object(newval); new_size_set: - - oldval_sz = is_immed(oldval) ? 0 : size_object(oldval); + + oldval_sz = is_immed(oldval) ? 0 : size_object_rel(oldval,old_base); both_size_set: handle->new_size = handle->new_size - oldval_sz + newval_sz; - /* write new value in old dbterm, finalize will make a flat copy */ + /* write new value in old dbterm, finalize will make a flat copy */ handle->dbterm->tpl[position] = newval; handle->mustResize = 1; + +#if HALFWORD_HEAP + if (old_base && newval_sz > 0) { + ASSERT(!handle->tb->common.compress); + if (!handle->abs_vec) { + int i = header_arity(handle->dbterm->tpl[0]); + handle->abs_vec = erts_alloc(ERTS_ALC_T_TMP, (i+1)*sizeof(char)); + sys_memset(handle->abs_vec, 0, i+1); + /* abs_vec[0] not used */ + } + handle->abs_vec[position] = 1; + } +#endif } static ERTS_INLINE byte* db_realloc_term(DbTableCommon* tb, void* old, @@ -2547,7 +2760,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest, tpl[arity + 1] = alloc_size; tmp_offheap.first = NULL; - tpl[tb->keypos] = copy_struct(key, size_object(key), &top.ep, &tmp_offheap); + tpl[tb->keypos] = copy_struct_rel(key, size_object(key), &top.ep, &tmp_offheap, NULL, tpl); dest->first_oh = tmp_offheap.first; for (i=1; i<=arity; i++) { if (i != tb->keypos) { @@ -2566,7 +2779,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest, Eterm* dbg_top = erts_alloc(ERTS_ALC_T_DB_TERM, dest->size * sizeof(Eterm)); dest->debug_clone = dbg_top; tmp_offheap.first = dest->first_oh; - copy_struct(obj, dest->size, &dbg_top, &tmp_offheap); + copy_struct_rel(obj, dest->size, &dbg_top, &tmp_offheap, NULL, dbg_top); dest->first_oh = tmp_offheap.first; ASSERT(dbg_top == dest->debug_clone + dest->size); } @@ -2613,7 +2826,7 @@ void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) newp->size = size; top = newp->tpl; tmp_offheap.first = NULL; - copy_struct(obj, size, &top, &tmp_offheap); + copy_struct_rel(obj, size, &top, &tmp_offheap, NULL, top); newp->first_oh = tmp_offheap.first; #ifdef DEBUG_CLONE newp->debug_clone = NULL; @@ -2652,7 +2865,7 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) top = copy_to_comp(tb, obj, newp, new_sz); ASSERT(top <= basep + new_sz); - // SVERK: realloc? + /* ToDo: Maybe realloc if ((basep+new_sz) - top) > WASTED_SPACE_LIMIT */ return basep; } @@ -2673,6 +2886,9 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset) *(handle->bp) = newp; newDbTerm = (DbTerm*) (newp + offset); newDbTerm->size = handle->new_size; +#ifdef DEBUG_CLONE + newDbTerm->debug_clone = NULL; +#endif /* make a flat copy */ @@ -2682,17 +2898,38 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset) db_free_tmp_uncompressed(handle->dbterm); } else { - Eterm* top; ErlOffHeap tmp_offheap; + Eterm* tpl = handle->dbterm->tpl; + Eterm* top = newDbTerm->tpl; + tmp_offheap.first = NULL; - top = newDbTerm->tpl; - copy_struct(make_tuple(handle->dbterm->tpl), handle->new_size, - &top, &tmp_offheap); - newDbTerm->first_oh = tmp_offheap.first; -#ifdef DEBUG_CLONE - newDbTerm->debug_clone = NULL; -#endif - ASSERT((byte*)top <= (newp + alloc_sz)); + + #if HALFWORD_HEAP + if (handle->abs_vec) { + int i, arity = header_arity(handle->dbterm->tpl[0]); + + top[0] = tpl[0]; + top += arity + 1; + for (i=1; i<=arity; i++) { + Eterm* src_base = handle->abs_vec[i] ? NULL : tpl; + + newDbTerm->tpl[i] = copy_struct_rel(tpl[i], + size_object_rel(tpl[i],src_base), + &top, &tmp_offheap, src_base, + newDbTerm->tpl); + } + newDbTerm->first_oh = tmp_offheap.first; + ASSERT((byte*)top <= (newp + alloc_sz)); + erts_free(ERTS_ALC_T_TMP, handle->abs_vec); + } + else + #endif /* HALFWORD_HEAP */ + { + copy_struct_rel(make_tuple_rel(tpl,tpl), handle->new_size, &top, + &tmp_offheap, tpl, top); + newDbTerm->first_oh = tmp_offheap.first; + ASSERT((byte*)top == (newp + alloc_sz)); + } } } @@ -2705,9 +2942,9 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, hp[0] = bp->tpl[0]; *hpp += arity + 1; - hp[tb->keypos] = copy_struct(bp->tpl[tb->keypos], - size_object(bp->tpl[tb->keypos]), - hpp, off_heap); + hp[tb->keypos] = copy_struct_rel(bp->tpl[tb->keypos], + size_object_rel(bp->tpl[tb->keypos], bp->tpl), + hpp, off_heap, bp->tpl, NULL); for (i=arity; i>0; i--) { if (i != tb->keypos) { if (is_immed(bp->tpl[i])) { @@ -2721,7 +2958,7 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, } ASSERT((*hpp - hp) <= bp->size); #ifdef DEBUG_CLONE - ASSERT(eq(make_tuple(hp),make_tuple(bp->debug_clone))); + ASSERT(eq_rel(make_tuple(hp),make_tuple(bp->debug_clone),bp->debug_clone)); #endif return make_tuple(hp); } @@ -2744,14 +2981,14 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, hp += extra; HRelease(p, endp, hp); #ifdef DEBUG_CLONE - ASSERT(eq(copy,obj->debug_clone[pos])); + ASSERT(eq_rel(copy, obj->debug_clone[pos], obj->debug_clone)); #endif return copy; } else { - Uint sz = size_object(obj->tpl[pos]); + Uint sz = size_object_rel(obj->tpl[pos], obj->tpl); *hpp = HAlloc(p, sz + extra); - return copy_struct(obj->tpl[pos], sz, hpp, &MSO(p)); + return copy_struct_rel(obj->tpl[pos], sz, hpp, &MSO(p), obj->tpl, NULL); } } @@ -2765,7 +3002,7 @@ void db_cleanup_offheap_comp(DbTerm* obj) ProcBin tmp; for (u.hdr = obj->first_oh; u.hdr; u.hdr = u.hdr->next) { - if ((UWord)u.voidp % sizeof(UWord) != 0) { /* unaligned ptr */ + if ((UWord)u.voidp % sizeof(Uint) != 0) { /* unaligned ptr */ sys_memcpy(&tmp, u.voidp, sizeof(tmp)); /* Warning, must pass (void*)-variable to memcpy. Otherwise it will cause Bus error on Sparc due to false compile time assumptions @@ -2961,7 +3198,7 @@ static DMCRet dmc_one_term(DMCContext *context, ** Ouch, big integer in match variable. */ Eterm *save_hp; - ASSERT(heap->data == heap->def); + ASSERT(heap->vars == heap->vars_def); sz = sz2 = sz3 = 0; for (j = 0; j < context->num_match; ++j) { sz += size_object(context->matchexpr[j]); @@ -2999,24 +3236,23 @@ static DMCRet dmc_one_term(DMCContext *context, may be atoms that changed */ context->matchexpr[j] = context->copy->mem[j]; } - heap->data = erts_alloc(ERTS_ALC_T_DB_MS_CMPL_HEAP, - heap->size*sizeof(unsigned)); - sys_memset(heap->data, 0, - heap->size * sizeof(unsigned)); + heap->vars = erts_alloc(ERTS_ALC_T_DB_MS_CMPL_HEAP, + heap->size*sizeof(DMCVariable)); + sys_memset(heap->vars, 0, heap->size * sizeof(DMCVariable)); DMC_CLEAR(*stack); /*DMC_PUSH(*stack,NIL);*/ DMC_CLEAR(*text); return retRestart; } - if (heap->data[n]) { /* already bound ? */ + if (heap->vars[n].is_bound) { DMC_PUSH(*text,matchCmp); DMC_PUSH(*text,n); } else { /* Not bound, bind! */ - if (n >= heap->used) - heap->used = n + 1; + if (n >= heap->vars_used) + heap->vars_used = n + 1; DMC_PUSH(*text,matchBind); DMC_PUSH(*text,n); - heap->data[n] = 1; + heap->vars[n].is_bound = 1; } } else if (c == am_Underscore) { DMC_PUSH(*text, matchSkip); @@ -3041,6 +3277,8 @@ static DMCRet dmc_one_term(DMCContext *context, DMC_PUSH(*stack, c); break; case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): + { + Eterm* ref_val = internal_ref_val(c); DMC_PUSH(*text, matchEqRef); #if HALFWORD_HEAP { @@ -3048,25 +3286,27 @@ static DMCRet dmc_one_term(DMCContext *context, UWord u; Uint t[2]; } fiddle; - ASSERT(thing_arityval(*internal_ref_val(c)) == 3); - fiddle.t[0] = *internal_ref_val(c); - fiddle.t[1] = (Uint) internal_ref_val(c)[1]; + ASSERT(thing_arityval(ref_val[0]) == 3); + fiddle.t[0] = ref_val[0]; + fiddle.t[1] = ref_val[1]; DMC_PUSH(*text, fiddle.u); - fiddle.t[0] = (Uint) internal_ref_val(c)[2]; - fiddle.t[1] = (Uint) internal_ref_val(c)[3]; + fiddle.t[0] = ref_val[2]; + fiddle.t[1] = ref_val[3]; DMC_PUSH(*text, fiddle.u); } #else - n = thing_arityval(*internal_ref_val(c)); - DMC_PUSH(*text, *internal_ref_val(c)); - for (i = 1; i <= n; ++i) { - DMC_PUSH(*text, (Uint) internal_ref_val(c)[i]); + n = thing_arityval(ref_val[0]); + for (i = 0; i <= n; ++i) { + DMC_PUSH(*text, ref_val[i]); } #endif break; + } case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): - n = thing_arityval(*big_val(c)); + { + Eterm* bval = big_val(c); + n = thing_arityval(bval[0]); DMC_PUSH(*text, matchEqBig); #if HALFWORD_HEAP { @@ -3075,13 +3315,13 @@ static DMCRet dmc_one_term(DMCContext *context, Uint t[2]; } fiddle; ASSERT(n >= 1); - fiddle.t[0] = *big_val(c); - fiddle.t[1] = big_val(c)[1]; + fiddle.t[0] = bval[0]; + fiddle.t[1] = bval[1]; DMC_PUSH(*text, fiddle.u); for (i = 2; i <= n; ++i) { - fiddle.t[0] = big_val(c)[i]; + fiddle.t[0] = bval[i]; if (++i <= n) { - fiddle.t[1] = big_val(c)[i]; + fiddle.t[1] = bval[i]; } else { fiddle.t[1] = (Uint) 0; } @@ -3089,12 +3329,12 @@ static DMCRet dmc_one_term(DMCContext *context, } } #else - DMC_PUSH(*text, *big_val(c)); - for (i = 1; i <= n; ++i) { - DMC_PUSH(*text, (Uint) big_val(c)[i]); + for (i = 0; i <= n; ++i) { + DMC_PUSH(*text, (Uint) bval[i]); } #endif break; + } case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): DMC_PUSH(*text,matchEqFloat); #if HALFWORD_HEAP @@ -3227,7 +3467,6 @@ static DMCRet dmc_list(DMCContext *context, DMC_PUSH(*text, matchConsB); } --context->stack_used; /* Two objects on stack becomes one */ - context->eheap_need += 2; return retOk; } @@ -3286,7 +3525,6 @@ static DMCRet dmc_tuple(DMCContext *context, DMC_PUSH(*text, matchMkTuple); DMC_PUSH(*text, nelems); context->stack_used -= (nelems - 1); - context->eheap_need += (nelems + 1); *constant = 0; return retOk; } @@ -3304,9 +3542,6 @@ static DMCRet dmc_whole_expression(DMCContext *context, } else { ASSERT(is_tuple(context->matchexpr [context->current_match])); - context->eheap_need += - arityval(*(tuple_val(context->matchexpr - [context->current_match]))) * 2; DMC_PUSH(*text, matchPushArrayAsList); } } else { @@ -3319,6 +3554,41 @@ static DMCRet dmc_whole_expression(DMCContext *context, return retOk; } +/* Figure out which PushV instruction to use. +*/ +static void dmc_add_pushv_variant(DMCContext *context, DMCHeap *heap, + DMC_STACK_TYPE(UWord) *text, Uint n) +{ + DMCVariable* v = &heap->vars[n]; + MatchOps instr = matchPushV; + + ASSERT(n < heap->vars_used && v->is_bound); + if (context->is_guard) { + #if HALFWORD_HEAP + if (!v->first_guard_label) { + v->first_guard_label = DMC_STACK_NUM(*text); + ASSERT(v->first_guard_label); + instr = matchPushVGuard; /* may be changed to PushVResult below */ + } + #endif + } + else { /* body */ + #if HALFWORD_HEAP + if (v->first_guard_label) { + /* Avoid double-copy, copy to result heap at first encounter in guard */ + DMC_POKE(*text, v->first_guard_label, matchPushVResult); + v->is_in_body = 1; + } + #endif + if (!v->is_in_body) { + instr = matchPushVResult; + v->is_in_body = 1; + } + } + DMC_PUSH(*text, instr); + DMC_PUSH(*text, n); +} + static DMCRet dmc_variable(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, @@ -3326,13 +3596,13 @@ static DMCRet dmc_variable(DMCContext *context, int *constant) { Uint n = db_is_variable(t); - ASSERT(n >= 0); - if (n >= heap->used) - RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant); - if (heap->data[n] == 0U) + + if (n >= heap->vars_used || !heap->vars[n].is_bound) { RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant); - DMC_PUSH(*text, matchPushV); - DMC_PUSH(*text, n); + } + + dmc_add_pushv_variant(context, heap, text, n); + ++context->stack_used; if (context->stack_used > context->stack_need) context->stack_need = context->stack_used; @@ -3351,10 +3621,9 @@ static DMCRet dmc_all_bindings(DMCContext *context, DMC_PUSH(*text, matchPushC); DMC_PUSH(*text, NIL); - for (i = heap->used - 1; i >= 0; --i) { - if (heap->data[i]) { - DMC_PUSH(*text, matchPushV); - DMC_PUSH(*text, i); + for (i = heap->vars_used - 1; i >= 0; --i) { + if (heap->vars[i].is_bound) { + dmc_add_pushv_variant(context, heap, text, i); DMC_PUSH(*text, matchConsB); heap_used += 2; } @@ -3362,7 +3631,6 @@ static DMCRet dmc_all_bindings(DMCContext *context, ++context->stack_used; if ((context->stack_used + 1) > context->stack_need) context->stack_need = (context->stack_used + 1); - context->eheap_need += heap_used; *constant = 0; return retOk; } @@ -3765,10 +4033,6 @@ static DMCRet dmc_get_seq_token(DMCContext *context, *constant = 0; DMC_PUSH(*text, matchGetSeqToken); - context->eheap_need += (6 /* A 5-tuple is built */ - + EXTERNAL_THING_HEAD_SIZE + 2 /* Sender can - be an external - pid */); if (++context->stack_used > context->stack_need) context->stack_need = context->stack_used; return retOk; @@ -4065,7 +4329,6 @@ static DMCRet dmc_caller(DMCContext *context, } *constant = 0; DMC_PUSH(*text, matchCaller); /* Creates binary */ - context->eheap_need += 4; /* A 3-tuple is built */ if (++context->stack_used > context->stack_need) context->stack_need = context->stack_used; return retOk; @@ -4663,7 +4926,8 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) } save_cp = p->cp; p->cp = NULL; - res = erts_match_set_run(p, mps, arr, n, &ret_flags); + res = erts_match_set_run(p, mps, arr, n, + ERTS_PAM_COPY_RESULT, &ret_flags); p->cp = save_cp; } else { n = 0; @@ -4676,11 +4940,10 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) if (is_non_value(res)) { res = am_false; } - sz = size_object(res); + sz = 0; if (ret_flags & MATCH_SET_EXCEPTION_TRACE) sz += 2; if (ret_flags & MATCH_SET_RETURN_TRACE) sz += 2; hp = HAlloc(p, 5 + sz); - res = copy_struct(res, sz, &hp, &MSO(p)); flg = NIL; if (ret_flags & MATCH_SET_EXCEPTION_TRACE) { flg = CONS(hp, am_exception_trace, flg); @@ -4735,28 +4998,24 @@ void db_free_tmp_uncompressed(DbTerm* obj) erts_free(ERTS_ALC_T_TMP, obj); } -Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog, +Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, int all, DbTerm* obj, Eterm** hpp, Uint extra) { Uint32 dummy; + Eterm* base; Eterm res; if (tb->compress) { obj = db_alloc_tmp_uncompressed(tb, obj); + base = NULL; } + else base = HALFWORD_HEAP ? obj->tpl : NULL; - res = db_prog_match(c_p, bprog, make_tuple(obj->tpl), NULL, 0, &dummy); + res = db_prog_match(c_p, bprog, make_tuple_rel(obj->tpl,base), base, NULL, 0, + ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy); if (is_value(res) && hpp!=NULL) { - if (all) { - *hpp = HAlloc(c_p, obj->size + extra); - res = copy_shallow(obj->tpl, obj->size, hpp, &MSO(c_p)); - } - else { - Uint sz = size_object(res); - *hpp = HAlloc(c_p, sz + extra); - res = copy_struct(res, sz, hpp, &MSO(c_p)); - } + *hpp = HAlloc(c_p, extra); } if (tb->compress) { @@ -4767,10 +5026,11 @@ Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog, #ifdef DMC_DEBUG + /* ** Disassemble match program */ -static void db_match_dis(Binary *bp) +void db_match_dis(Binary *bp) { MatchProg *prog = Binary2MatchProg(bp); UWord *t = prog->text; @@ -4985,6 +5245,18 @@ static void db_match_dis(Binary *bp) ++t; erts_printf("PushV\t%bpu\n", n); break; + #if HALFWORD_HEAP + case matchPushVGuard: + n = (Uint) *++t; + ++t; + erts_printf("PushVGuard\t%bpu\n", n); + break; + #endif + case matchPushVResult: + n = (Uint) *++t; + ++t; + erts_printf("PushVResult\t%bpu\n", n); + break; case matchTrue: ++t; erts_printf("True\n"); @@ -5095,7 +5367,6 @@ static void db_match_dis(Binary *bp) erts_printf("}\n"); erts_printf("num_bindings: %d\n", prog->num_bindings); erts_printf("heap_size: %bpu\n", prog->heap_size); - erts_printf("eheap_offset: %bpu\n", prog->eheap_offset); erts_printf("stack_offset: %bpu\n", prog->stack_offset); erts_printf("text: 0x%08x\n", (unsigned long) prog->text); erts_printf("stack_size: %d (words)\n", prog->heap_size-prog->stack_offset); diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 58ad39d772..bb1751d309 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2011. All Rights Reserved. * * 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 @@ -86,6 +86,9 @@ typedef struct { Uint new_size; int mustResize; void* lck; +#if HALFWORD_HEAP + unsigned char* abs_vec; /* [i] true if dbterm->tpl[i] is absolute Eterm */ +#endif } DbUpdateHandle; @@ -255,7 +258,14 @@ typedef struct db_table_common { #define NFIXED(T) (erts_refc_read(&(T)->common.ref,0)) #define IS_FIXED(T) (NFIXED(T) != 0) -Eterm erts_ets_copy_object(Eterm, Process*); +/* + * tplp is an untagged pointer to a tuple we know is large enough + * and dth is a pointer to a DbTableHash. + */ +#define GETKEY(dth, tplp) (*((tplp) + ((DbTableCommon*)(dth))->keypos)) + + +ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj); Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, ErlOffHeap* off_heap); int db_eq_comp(DbTableCommon* tb, Eterm a, DbTerm* b); @@ -264,9 +274,23 @@ DbTerm* db_alloc_tmp_uncompressed(DbTableCommon* tb, DbTerm* org); ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, ErlOffHeap* off_heap); ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b); -ERTS_GLB_INLINE Eterm db_do_read_element(DbUpdateHandle* handle, Sint position); +Wterm db_do_read_element(DbUpdateHandle* handle, Sint position); #if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj) +{ + Eterm key = GETKEY(tb, obj->tpl); + if IS_CONST(key) return key; + else { + Uint size = size_object_rel(key, obj->tpl); + Eterm* hp = HAlloc(p, size); + Eterm res = copy_struct_rel(key, size, &hp, &MSO(p), obj->tpl, NULL); + ASSERT(eq_rel(res,NULL,key,obj->tpl)); + return res; + } +} + ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, ErlOffHeap* off_heap) { @@ -274,49 +298,27 @@ ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, return db_copy_from_comp(tb, bp, hpp, off_heap); } else { - return copy_shallow(bp->tpl, bp->size, hpp, off_heap); + return copy_shallow_rel(bp->tpl, bp->size, hpp, off_heap, bp->tpl); } } ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b) { if (!tb->compress) { - return eq(a, make_tuple(b->tpl)); + return eq_rel(a, NULL, make_tuple_rel(b->tpl,b->tpl), b->tpl); } else { return db_eq_comp(tb, a, b); } } -/* Must be called to read elements after db_lookup_dbterm. -** Will decompress if needed. */ -ERTS_GLB_INLINE Eterm db_do_read_element(DbUpdateHandle* handle, Sint position) -{ - Eterm elem = handle->dbterm->tpl[position]; - if (!is_header(elem)) { - return elem; - } - ASSERT(((DbTableCommon*)handle->tb)->compress); - ASSERT(!handle->mustResize); - handle->dbterm = db_alloc_tmp_uncompressed((DbTableCommon*)handle->tb, handle->dbterm); - handle->mustResize = 1; - return handle->dbterm->tpl[position]; -} - #endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ -/* optimised version of copy_object (normal case? atomic object) */ -#define COPY_OBJECT(obj, p, objp) \ - if (IS_CONST(obj)) { *(objp) = (obj); } \ - else { *objp = erts_ets_copy_object(obj, p); } #define DB_READ (DB_PROTECTED|DB_PUBLIC) #define DB_WRITE DB_PUBLIC #define DB_INFO (DB_PROTECTED|DB_PUBLIC|DB_PRIVATE) -/* tb is an DbTableCommon and obj is an Eterm (tagged) */ -#define TERM_GETKEY(tb, obj) db_getkey((tb)->common.keypos, (obj)) - #define ONLY_WRITER(P,T) (((T)->common.status & (DB_PRIVATE|DB_PROTECTED)) \ && (T)->common.owner == (P)->id) @@ -337,12 +339,11 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, DbTerm* obj, Uint pos, Eterm** hpp, Uint extra); int db_has_variable(Eterm obj); int db_is_variable(Eterm obj); -Eterm db_do_read_element(DbUpdateHandle* handle, Sint position); void db_do_update_element(DbUpdateHandle* handle, Sint position, Eterm newval); void db_finalize_resize(DbUpdateHandle* handle, Uint offset); -Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr); +Eterm db_add_counter(Eterm** hpp, Wterm counter, Eterm incr); Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags); Binary *db_match_set_compile(Process *p, Eterm matchexpr, Uint flags); @@ -359,7 +360,6 @@ typedef struct match_prog { struct erl_heap_fragment *saved_program_buf; Eterm saved_program; Uint heap_size; /* size of: heap + eheap + stack */ - Uint eheap_offset; Uint stack_offset; #ifdef DMC_DEBUG UWord* prog_end; /* End of program */ @@ -423,11 +423,16 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards, Eterm *body, int num_matches, Uint flags, DMCErrInfo *err_info); -Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog, - int all, DbTerm* obj, Eterm** hpp, Uint extra); /* Returns newly allocated MatchProg binary with refc == 0*/ -Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm *termp, int arity, + +Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, + int all, DbTerm* obj, Eterm** hpp, Uint extra); + +Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm* base, + Eterm *termp, int arity, + enum erts_pam_run_flags in_flags, Uint32 *return_flags /* Zeroed on enter */); + /* returns DB_ERROR_NONE if matches, 1 if not matches and some db error on error. */ DMCErrInfo *db_new_dmc_err_info(void); diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 0185baee6b..9e18997890 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2010. All Rights Reserved. + * Copyright Ericsson AB 2005-2011. All Rights Reserved. * * 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 @@ -155,7 +155,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "alcu_allocator", "index" }, { "alcu_delayed_free", "index" }, { "mseg", NULL }, -#ifdef HALFWORD_HEAP +#if HALFWORD_HEAP { "pmmap", NULL }, #endif #ifdef ERTS_SMP diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c index d873c7a701..9751b5d77c 100644 --- a/erts/emulator/beam/erl_monitors.c +++ b/erts/emulator/beam/erl_monitors.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * Copyright Ericsson AB 2004-2011. All Rights Reserved. * * 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 @@ -85,7 +85,7 @@ static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2) if (is_ref_thing_header(*b2)) { return 1; } - return cmp(ref1,ref2); + return CMP(ref1,ref2); } #define CP_LINK_VAL(To, Hp, From) \ @@ -380,7 +380,7 @@ int erts_add_link(ErtsLink **root, Uint type, Eterm pid) state = 1; *this = create_link(type,pid); break; - } else if ((c = cmp(pid,(*this)->pid)) < 0) { + } else if ((c = CMP(pid,(*this)->pid)) < 0) { /* go left */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; @@ -415,7 +415,7 @@ erts_add_or_lookup_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid) state = 1; res = *this = create_suspend_monitor(pid); break; - } else if ((c = cmp(pid,(*this)->pid)) < 0) { + } else if ((c = CMP(pid,(*this)->pid)) < 0) { /* go left */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; @@ -453,7 +453,7 @@ ErtsLink *erts_add_or_lookup_link(ErtsLink **root, Uint type, Eterm pid) *this = create_link(type,pid); ret = *this; break; - } else if ((c = cmp(pid,(*this)->pid)) < 0) { + } else if ((c = CMP(pid,(*this)->pid)) < 0) { /* go left */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; @@ -663,7 +663,7 @@ ErtsLink *erts_remove_link(ErtsLink **root, Eterm pid) for (;;) { if (!*this) { /* Failure */ return NULL; - } else if ((c = cmp(pid,(*this)->pid)) < 0) { + } else if ((c = CMP(pid,(*this)->pid)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -715,7 +715,7 @@ erts_delete_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid) for (;;) { if (!*this) { /* Nothing found */ return; - } else if ((c = cmp(pid,(*this)->pid)) < 0) { + } else if ((c = CMP(pid,(*this)->pid)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -771,7 +771,7 @@ ErtsLink *erts_lookup_link(ErtsLink *root, Eterm pid) Sint c; for (;;) { - if (root == NULL || (c = cmp(pid,root->pid)) == 0) { + if (root == NULL || (c = CMP(pid,root->pid)) == 0) { return root; } else if (c < 0) { root = root->left; @@ -787,7 +787,7 @@ erts_lookup_suspend_monitor(ErtsSuspendMonitor *root, Eterm pid) Sint c; for (;;) { - if (root == NULL || (c = cmp(pid,root->pid)) == 0) { + if (root == NULL || (c = CMP(pid,root->pid)) == 0) { return root; } else if (c < 0) { root = root->left; diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index a680097c2d..135c6b0ccc 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2010. All Rights Reserved. + * Copyright Ericsson AB 2009-2011. All Rights Reserved. * * 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 @@ -81,7 +81,6 @@ static ERTS_INLINE Eterm* alloc_heap(ErlNifEnv* env, unsigned need) static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp) { - unsigned frag_sz; env->hp = hp; if (env->heap_frag == NULL) { ASSERT(HEAP_LIMIT(env->proc) == env->hp_end); @@ -91,11 +90,11 @@ static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp) env->heap_frag->used_size = hp - env->heap_frag->mem; ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size); } - frag_sz = need + MIN_HEAP_FRAG_SZ; - hp = erts_heap_alloc(env->proc, frag_sz); - env->hp = hp + need; - env->hp_end = hp + frag_sz; + hp = erts_heap_alloc(env->proc, need, MIN_HEAP_FRAG_SZ); env->heap_frag = MBUF(env->proc); + env->hp = hp + need; + env->hp_end = env->heap_frag->mem + env->heap_frag->alloc_size; + return hp; } @@ -574,7 +573,7 @@ int enif_is_identical(Eterm lhs, Eterm rhs) int enif_compare(Eterm lhs, Eterm rhs) { - return cmp(lhs,rhs); + return CMP(lhs,rhs); } int enif_get_tuple(ErlNifEnv* env, Eterm tpl, int* arity, const Eterm** array) @@ -939,21 +938,26 @@ ERL_NIF_TERM enif_make_list_cell(ErlNifEnv* env, Eterm car, Eterm cdr) ERL_NIF_TERM enif_make_list(ErlNifEnv* env, unsigned cnt, ...) { - Eterm* hp = alloc_heap(env,cnt*2); - Eterm ret = make_list(hp); - Eterm* last = &ret; - va_list ap; - - va_start(ap,cnt); - while (cnt--) { - *last = make_list(hp); - *hp = va_arg(ap,Eterm); - last = ++hp; - ++hp; + if (cnt == 0) { + return NIL; + } + else { + Eterm* hp = alloc_heap(env,cnt*2); + Eterm ret = make_list(hp); + Eterm* last = &ret; + va_list ap; + + va_start(ap,cnt); + while (cnt--) { + *last = make_list(hp); + *hp = va_arg(ap,Eterm); + last = ++hp; + ++hp; + } + va_end(ap); + *last = NIL; + return ret; } - va_end(ap); - *last = NIL; - return ret; } ERL_NIF_TERM enif_make_list_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt) @@ -1474,7 +1478,13 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) ret = load_nif_error(BIF_P, bad_lib, "Library version (%d.%d) not compatible (with %d.%d).", entry->major, entry->minor, ERL_NIF_MAJOR_VERSION, ERL_NIF_MINOR_VERSION); - } + } + else if (entry->minor >= 1 + && sys_strcmp(entry->vm_variant, ERL_NIF_VM_VARIANT) != 0) { + ret = load_nif_error(BIF_P, bad_lib, "Library (%s) not compiled for " + "this vm variant (%s).", + entry->vm_variant, ERL_NIF_VM_VARIANT); + } else if (!erts_is_atom_str((char*)entry->name, mod_atom)) { ret = load_nif_error(BIF_P, bad_lib, "Library module name '%s' does not" " match calling module '%T'", entry->name, mod_atom); diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index ee3a7cd5f4..8050b3640a 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2010. All Rights Reserved. + * Copyright Ericsson AB 2009-2011. All Rights Reserved. * * 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 @@ -30,9 +30,10 @@ ** 0.1: R13B03 ** 1.0: R13B04 ** 2.0: R14A +** 2.1: R14B02 "vm_variant" */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 0 +#define ERL_NIF_MINOR_VERSION 1 #include <stdlib.h> @@ -80,8 +81,10 @@ typedef long long ErlNifSInt64; #endif #ifdef HALFWORD_HEAP_EMULATOR +# define ERL_NIF_VM_VARIANT "beam.halfword" typedef unsigned int ERL_NIF_TERM; #else +# define ERL_NIF_VM_VARIANT "beam.vanilla" typedef unsigned long ERL_NIF_TERM; #endif @@ -105,7 +108,8 @@ typedef struct enif_entry_t int (*load) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info); int (*reload) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info); int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); - void (*unload) (ErlNifEnv*, void* priv_data); + void (*unload) (ErlNifEnv*, void* priv_data); + const char* vm_variant; }ErlNifEntry; @@ -198,6 +202,7 @@ extern TWinDynNifCallbacks WinDynNifCallbacks; #define ERL_NIF_INIT(NAME, FUNCS, LOAD, RELOAD, UPGRADE, UNLOAD) \ ERL_NIF_INIT_PROLOGUE \ ERL_NIF_INIT_GLOB \ +ERL_NIF_INIT_DECL(NAME); \ ERL_NIF_INIT_DECL(NAME) \ { \ static ErlNifEntry entry = \ @@ -207,7 +212,8 @@ ERL_NIF_INIT_DECL(NAME) \ #NAME, \ sizeof(FUNCS) / sizeof(*FUNCS), \ FUNCS, \ - LOAD, RELOAD, UPGRADE, UNLOAD \ + LOAD, RELOAD, UPGRADE, UNLOAD, \ + ERL_NIF_VM_VARIANT \ }; \ ERL_NIF_INIT_BODY; \ return &entry; \ diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h index ae1316eba2..2c67e781e0 100644 --- a/erts/emulator/beam/erl_node_container_utils.h +++ b/erts/emulator/beam/erl_node_container_utils.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2010. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. All Rights Reserved. * * 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 @@ -255,19 +255,32 @@ extern int erts_use_r9_pids_ports; #define internal_ref_no_of_numbers(x) \ (internal_ref_data((x))[0]) +#define internal_thing_ref_no_of_numbers(thing) \ + (internal_thing_ref_data(thing)[0]) #define internal_ref_numbers(x) \ (&internal_ref_data((x))[1]) +#define internal_thing_ref_numbers(thing) \ + (&internal_thing_ref_data(thing)[1]) #define external_ref_no_of_numbers(x) \ (external_ref_data((x))[0]) +#define external_thing_ref_no_of_numbers(thing) \ + (external_thing_ref_data(thing)[0]) #define external_ref_numbers(x) \ (&external_ref_data((x))[1]) +#define external_thing_ref_numbers(thing) \ + (&external_thing_ref_data(thing)[1]) + #else #define internal_ref_no_of_numbers(x) (internal_ref_data_words((x))) +#define internal_thing_ref_no_of_numbers(t) (internal_thing_ref_data_words(t)) #define internal_ref_numbers(x) (internal_ref_data((x))) +#define internal_thing_ref_numbers(t) (internal_thing_ref_data(t)) #define external_ref_no_of_numbers(x) (external_ref_data_words((x))) +#define external_thing_ref_no_of_numbers(t) (external_thing_ref_data_words((t))) #define external_ref_numbers(x) (external_ref_data((x))) +#define external_thing_ref_numbers(t) (external_thing_ref_data((t))) #endif @@ -311,6 +324,8 @@ extern int erts_use_r9_pids_ports; : external_ref_channel_no((x))) #define is_ref(x) (is_internal_ref((x)) \ || is_external_ref((x))) +#define is_ref_rel(x,Base) (is_internal_ref_rel((x),Base) \ + || is_external_ref_rel((x),Base)) #define is_not_ref(x) (!is_ref(x)) #endif diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index d927415f37..8479e56710 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * 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 @@ -824,7 +824,7 @@ ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp) } #endif /* inline */ -Eterm* erts_heap_alloc(Process* p, Uint need); +Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra); #ifdef CHECK_FOR_HOLES Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz); #endif diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 7a7042abe4..68fda01597 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2010. All Rights Reserved. + * Copyright Ericsson AB 2003-2011. All Rights Reserved. * * 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 @@ -261,139 +261,139 @@ print_function_from_pc(int to, void *to_arg, BeamInstr* x) static void heap_dump(int to, void *to_arg, Eterm x) { + DeclareTmpHeapNoproc(last,1); + Eterm* next = last; Eterm* ptr; - Eterm last = OUR_NIL; - Eterm* next = &last; if (is_immed(x) || is_CP(x)) { return; } - - again: - if (x == OUR_NIL) { /* We are done. */ - return; - } if (is_CP(x)) { - next = (Eterm *) EXPAND_POINTER(x); - } else if (is_list(x)) { - ptr = list_val(x); - if (ptr[0] != OUR_NIL) { - erts_print(to, to_arg, ADDR_FMT ":l", ptr); - dump_element(to, to_arg, ptr[0]); - erts_putc(to, to_arg, '|'); - dump_element(to, to_arg, ptr[1]); - erts_putc(to, to_arg, '\n'); - if (is_immed(ptr[1])) { - ptr[1] = make_small(0); - } - x = ptr[0]; - ptr[0] = (Eterm) COMPRESS_POINTER(next); - next = ptr + 1; - goto again; - } - } else if (is_boxed(x)) { - Eterm hdr; - - ptr = boxed_val(x); - hdr = *ptr; - if (hdr != OUR_NIL) { /* If not visited */ - erts_print(to, to_arg, ADDR_FMT ":", ptr); - if (is_arity_value(hdr)) { - Uint i; - Uint arity = arityval(hdr); - - erts_print(to, to_arg, "t" WORD_FMT ":", arity); - for (i = 1; i <= arity; i++) { - dump_element(to, to_arg, ptr[i]); - if (is_immed(ptr[i])) { - ptr[i] = make_small(0); - } - if (i < arity) { - erts_putc(to, to_arg, ','); - } - } + UseTmpHeapNoproc(1); + *last = OUR_NIL; + + while (x != OUR_NIL) { + if (is_CP(x)) { + next = (Eterm *) EXPAND_POINTER(x); + } else if (is_list(x)) { + ptr = list_val(x); + if (ptr[0] != OUR_NIL) { + erts_print(to, to_arg, ADDR_FMT ":l", ptr); + dump_element(to, to_arg, ptr[0]); + erts_putc(to, to_arg, '|'); + dump_element(to, to_arg, ptr[1]); erts_putc(to, to_arg, '\n'); - if (arity == 0) { - ptr[0] = OUR_NIL; - } else { - x = ptr[arity]; - ptr[0] = (Eterm) COMPRESS_POINTER(next); - next = ptr + arity - 1; - goto again; + if (is_immed(ptr[1])) { + ptr[1] = make_small(0); } - } else if (hdr == HEADER_FLONUM) { - FloatDef f; - char sbuf[31]; - int i; - - GET_DOUBLE_DATA((ptr+1), f); - i = sys_double_to_chars(f.fd, (char*) sbuf); - sys_memset(sbuf+i, 0, 31-i); - erts_print(to, to_arg, "F%X:%s\n", i, sbuf); - *ptr = OUR_NIL; - } else if (_is_bignum_header(hdr)) { - erts_print(to, to_arg, "B%T\n", x); - *ptr = OUR_NIL; - } else if (is_binary_header(hdr)) { - Uint tag = thing_subtag(hdr); - Uint size = binary_size(x); - Uint i; - - if (tag == HEAP_BINARY_SUBTAG) { - byte* p; - - erts_print(to, to_arg, "Yh%X:", size); - p = binary_bytes(x); - for (i = 0; i < size; i++) { - erts_print(to, to_arg, "%02X", p[i]); + x = ptr[0]; + ptr[0] = (Eterm) COMPRESS_POINTER(next); + next = ptr + 1; + continue; + } + } else if (is_boxed(x)) { + Eterm hdr; + + ptr = boxed_val(x); + hdr = *ptr; + if (hdr != OUR_NIL) { /* If not visited */ + erts_print(to, to_arg, ADDR_FMT ":", ptr); + if (is_arity_value(hdr)) { + Uint i; + Uint arity = arityval(hdr); + + erts_print(to, to_arg, "t" WORD_FMT ":", arity); + for (i = 1; i <= arity; i++) { + dump_element(to, to_arg, ptr[i]); + if (is_immed(ptr[i])) { + ptr[i] = make_small(0); + } + if (i < arity) { + erts_putc(to, to_arg, ','); + } } - } else if (tag == REFC_BINARY_SUBTAG) { - ProcBin* pb = (ProcBin *) binary_val(x); - Binary* val = pb->val; - - if (erts_smp_atomic_xchg(&val->refc, 0) != 0) { - val->flags = (UWord) all_binaries; - all_binaries = val; + erts_putc(to, to_arg, '\n'); + if (arity == 0) { + ptr[0] = OUR_NIL; + } else { + x = ptr[arity]; + ptr[0] = (Eterm) COMPRESS_POINTER(next); + next = ptr + arity - 1; + continue; } - erts_print(to, to_arg, "Yc%X:%X:%X", val, - pb->bytes - (byte *)val->orig_bytes, - size); - } else if (tag == SUB_BINARY_SUBTAG) { - ErlSubBin* Sb = (ErlSubBin *) binary_val(x); - Eterm* real_bin = binary_val(Sb->orig); - void* val; - - if (thing_subtag(*real_bin) == REFC_BINARY_SUBTAG) { - ProcBin* pb = (ProcBin *) real_bin; - val = pb->val; - } else { /* Heap binary */ - val = real_bin; + } else if (hdr == HEADER_FLONUM) { + FloatDef f; + char sbuf[31]; + int i; + + GET_DOUBLE_DATA((ptr+1), f); + i = sys_double_to_chars(f.fd, (char*) sbuf); + sys_memset(sbuf+i, 0, 31-i); + erts_print(to, to_arg, "F%X:%s\n", i, sbuf); + *ptr = OUR_NIL; + } else if (_is_bignum_header(hdr)) { + erts_print(to, to_arg, "B%T\n", x); + *ptr = OUR_NIL; + } else if (is_binary_header(hdr)) { + Uint tag = thing_subtag(hdr); + Uint size = binary_size(x); + Uint i; + + if (tag == HEAP_BINARY_SUBTAG) { + byte* p; + + erts_print(to, to_arg, "Yh%X:", size); + p = binary_bytes(x); + for (i = 0; i < size; i++) { + erts_print(to, to_arg, "%02X", p[i]); + } + } else if (tag == REFC_BINARY_SUBTAG) { + ProcBin* pb = (ProcBin *) binary_val(x); + Binary* val = pb->val; + + if (erts_smp_atomic_xchg(&val->refc, 0) != 0) { + val->flags = (UWord) all_binaries; + all_binaries = val; + } + erts_print(to, to_arg, "Yc%X:%X:%X", val, + pb->bytes - (byte *)val->orig_bytes, + size); + } else if (tag == SUB_BINARY_SUBTAG) { + ErlSubBin* Sb = (ErlSubBin *) binary_val(x); + Eterm* real_bin = binary_val(Sb->orig); + void* val; + + if (thing_subtag(*real_bin) == REFC_BINARY_SUBTAG) { + ProcBin* pb = (ProcBin *) real_bin; + val = pb->val; + } else { /* Heap binary */ + val = real_bin; + } + erts_print(to, to_arg, "Ys%X:%X:%X", val, Sb->offs, size); } - erts_print(to, to_arg, "Ys%X:%X:%X", val, Sb->offs, size); + erts_putc(to, to_arg, '\n'); + *ptr = OUR_NIL; + } else if (is_external_pid_header(hdr)) { + erts_print(to, to_arg, "P%T\n", x); + *ptr = OUR_NIL; + } else if (is_external_port_header(hdr)) { + erts_print(to, to_arg, "p<%bpu.%bpu>\n", + port_channel_no(x), port_number(x)); + *ptr = OUR_NIL; + } else { + /* + * All other we dump in the external term format. + */ + dump_externally(to, to_arg, x); + erts_putc(to, to_arg, '\n'); + *ptr = OUR_NIL; } - erts_putc(to, to_arg, '\n'); - *ptr = OUR_NIL; - } else if (is_external_pid_header(hdr)) { - erts_print(to, to_arg, "P%T\n", x); - *ptr = OUR_NIL; - } else if (is_external_port_header(hdr)) { - erts_print(to, to_arg, "p<%bpu.%bpu>\n", - port_channel_no(x), port_number(x)); - *ptr = OUR_NIL; - } else { - /* - * All other we dump in the external term format. - */ - dump_externally(to, to_arg, x); - erts_putc(to, to_arg, '\n'); - *ptr = OUR_NIL; } } + x = *next; + *next = OUR_NIL; + next--; } - - x = *next; - *next = OUR_NIL; - next--; - goto again; + UnUseTmpHeapNoproc(1); } static void diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index c6458a0e45..f77e8b798f 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2010. All Rights Reserved. + * Copyright Ericsson AB 2000-2011. All Rights Reserved. * * 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 @@ -58,9 +58,9 @@ do { \ #endif #if ET_DEBUG -unsigned tag_val_def_debug(Eterm x, const char *file, unsigned line) +unsigned tag_val_def_debug(Wterm x, const char *file, unsigned line) #else -unsigned tag_val_def(Eterm x) +unsigned tag_val_def(Wterm x) #define file __FILE__ #define line __LINE__ #endif @@ -125,10 +125,10 @@ FUNTY checked_##FUN(ARGTY x, const char *file, unsigned line) \ ET_DEFINE_CHECKED(Eterm,make_boxed,Eterm*,_is_taggable_pointer); ET_DEFINE_CHECKED(int,is_boxed,Eterm,!is_header); -ET_DEFINE_CHECKED(Eterm*,boxed_val,Eterm,_boxed_precond); +ET_DEFINE_CHECKED(Eterm*,boxed_val,Wterm,_boxed_precond); ET_DEFINE_CHECKED(Eterm,make_list,Eterm*,_is_taggable_pointer); ET_DEFINE_CHECKED(int,is_not_list,Eterm,!is_header); -ET_DEFINE_CHECKED(Eterm*,list_val,Eterm,_list_precond); +ET_DEFINE_CHECKED(Eterm*,list_val,Wterm,_list_precond); ET_DEFINE_CHECKED(Uint,unsigned_val,Eterm,is_small); ET_DEFINE_CHECKED(Sint,signed_val,Eterm,is_small); ET_DEFINE_CHECKED(Uint,atom_val,Eterm,is_atom); @@ -136,34 +136,35 @@ ET_DEFINE_CHECKED(Uint,header_arity,Eterm,is_header); ET_DEFINE_CHECKED(Uint,arityval,Eterm,is_arity_value); ET_DEFINE_CHECKED(Uint,thing_arityval,Eterm,is_thing); ET_DEFINE_CHECKED(Uint,thing_subtag,Eterm,is_thing); -ET_DEFINE_CHECKED(Eterm*,binary_val,Eterm,is_binary); -ET_DEFINE_CHECKED(Eterm*,fun_val,Eterm,is_fun); +ET_DEFINE_CHECKED(Eterm*,binary_val,Wterm,is_binary); +ET_DEFINE_CHECKED(Eterm*,fun_val,Wterm,is_fun); ET_DEFINE_CHECKED(int,bignum_header_is_neg,Eterm,_is_bignum_header); ET_DEFINE_CHECKED(Eterm,bignum_header_neg,Eterm,_is_bignum_header); ET_DEFINE_CHECKED(Uint,bignum_header_arity,Eterm,_is_bignum_header); -ET_DEFINE_CHECKED(Eterm*,big_val,Eterm,is_big); -ET_DEFINE_CHECKED(Eterm*,float_val,Eterm,is_float); -ET_DEFINE_CHECKED(Eterm*,tuple_val,Eterm,is_tuple); +ET_DEFINE_CHECKED(Eterm*,big_val,Wterm,is_big); +ET_DEFINE_CHECKED(Eterm*,float_val,Wterm,is_float); +ET_DEFINE_CHECKED(Eterm*,tuple_val,Wterm,is_tuple); ET_DEFINE_CHECKED(Uint,internal_pid_data,Eterm,is_internal_pid); ET_DEFINE_CHECKED(struct erl_node_*,internal_pid_node,Eterm,is_internal_pid); ET_DEFINE_CHECKED(Uint,internal_port_data,Eterm,is_internal_port); ET_DEFINE_CHECKED(struct erl_node_*,internal_port_node,Eterm,is_internal_port); -ET_DEFINE_CHECKED(Eterm*,internal_ref_val,Eterm,is_internal_ref); -ET_DEFINE_CHECKED(Uint,internal_ref_data_words,Eterm,is_internal_ref); -ET_DEFINE_CHECKED(Uint32*,internal_ref_data,Eterm,is_internal_ref); +ET_DEFINE_CHECKED(Eterm*,internal_ref_val,Wterm,is_internal_ref); +ET_DEFINE_CHECKED(Uint,internal_ref_data_words,Wterm,is_internal_ref); +ET_DEFINE_CHECKED(Uint32*,internal_ref_data,Wterm,is_internal_ref); ET_DEFINE_CHECKED(struct erl_node_*,internal_ref_node,Eterm,is_internal_ref); -ET_DEFINE_CHECKED(Eterm*,external_val,Eterm,is_external); -ET_DEFINE_CHECKED(Uint,external_data_words,Eterm,is_external); -ET_DEFINE_CHECKED(Uint,external_pid_data_words,Eterm,is_external_pid); -ET_DEFINE_CHECKED(Uint,external_pid_data,Eterm,is_external_pid); -ET_DEFINE_CHECKED(struct erl_node_*,external_pid_node,Eterm,is_external_pid); -ET_DEFINE_CHECKED(Uint,external_port_data_words,Eterm,is_external_port); -ET_DEFINE_CHECKED(Uint,external_port_data,Eterm,is_external_port); -ET_DEFINE_CHECKED(struct erl_node_*,external_port_node,Eterm,is_external_port); -ET_DEFINE_CHECKED(Uint,external_ref_data_words,Eterm,is_external_ref); -ET_DEFINE_CHECKED(Uint32*,external_ref_data,Eterm,is_external_ref); +ET_DEFINE_CHECKED(Eterm*,external_val,Wterm,is_external); +ET_DEFINE_CHECKED(Uint,external_data_words,Wterm,is_external); +ET_DEFINE_CHECKED(Uint,external_pid_data_words,Wterm,is_external_pid); +ET_DEFINE_CHECKED(Uint,external_pid_data,Wterm,is_external_pid); +ET_DEFINE_CHECKED(struct erl_node_*,external_pid_node,Wterm,is_external_pid); +ET_DEFINE_CHECKED(Uint,external_port_data_words,Wterm,is_external_port); +ET_DEFINE_CHECKED(Uint,external_port_data,Wterm,is_external_port); +ET_DEFINE_CHECKED(struct erl_node_*,external_port_node,Wterm,is_external_port); +ET_DEFINE_CHECKED(Uint,external_ref_data_words,Wterm,is_external_ref); +ET_DEFINE_CHECKED(Uint32*,external_ref_data,Wterm,is_external_ref); ET_DEFINE_CHECKED(struct erl_node_*,external_ref_node,Eterm,is_external_ref); -ET_DEFINE_CHECKED(Eterm*,export_val,Eterm,is_export); +ET_DEFINE_CHECKED(Eterm*,export_val,Wterm,is_export); +ET_DEFINE_CHECKED(Uint,external_thing_data_words,ExternalThing*,is_thing_ptr); ET_DEFINE_CHECKED(Eterm,make_cp,UWord *,_is_taggable_pointer); ET_DEFINE_CHECKED(UWord *,cp_val,Eterm,is_CP); diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 815cc1beae..1d75fa313c 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2010. All Rights Reserved. + * Copyright Ericsson AB 2000-2011. All Rights Reserved. * * 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 @@ -22,6 +22,8 @@ #include "sys.h" /* defines HALFWORD_HEAP */ +typedef UWord Wterm; /* Full word terms */ + #if HALFWORD_HEAP # define HEAP_ON_C_STACK 0 # if HALFWORD_ASSERT @@ -204,7 +206,7 @@ _ET_DECLARE_CHECKED(int,is_boxed,Eterm) #define is_boxed(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_BOXED) #endif #define _unchecked_boxed_val(x) ((Eterm*) EXPAND_POINTER(((x) - TAG_PRIMARY_BOXED))) -_ET_DECLARE_CHECKED(Eterm*,boxed_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,boxed_val,Wterm) #define boxed_val(x) _ET_APPLY(boxed_val,(x)) /* cons cell ("list") access methods */ @@ -226,7 +228,7 @@ _ET_DECLARE_CHECKED(int,is_not_list,Eterm) #define _list_precond(x) (is_list(x)) #endif #define _unchecked_list_val(x) ((Eterm*) EXPAND_POINTER((x) - TAG_PRIMARY_LIST)) -_ET_DECLARE_CHECKED(Eterm*,list_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,list_val,Wterm) #define list_val(x) _ET_APPLY(list_val,(x)) #define CONS(hp, car, cdr) \ @@ -240,6 +242,8 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Eterm) #define ptr_val(x) _unchecked_ptr_val((x)) /*XXX*/ #define _unchecked_offset_ptr(x,offs) ((x)+((offs)*sizeof(Eterm))) #define offset_ptr(x,offs) _unchecked_offset_ptr(x,offs) /*XXX*/ +#define _unchecked_byte_offset_ptr(x,byte_offs) ((x)+(offs)) +#define byte_offset_ptr(x,offs) _unchecked_byte_offset_ptr(x,offs) /*XXX*/ /* fixnum ("small") access methods */ #if defined(ARCH_64) && !HALFWORD_HEAP @@ -305,6 +309,7 @@ _ET_DECLARE_CHECKED(Uint,arityval,Eterm) /* thing access methods */ #define is_thing(x) (is_header((x)) && header_is_thing((x))) +#define is_thing_ptr(t) (is_thing((t)->header)) #define _unchecked_thing_arityval(x) _unchecked_header_arity((x)) _ET_DECLARE_CHECKED(Uint,thing_arityval,Eterm) #define thing_arityval(x) _ET_APPLY(thing_arityval,(x)) @@ -339,7 +344,7 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm) #define is_binary(x) (is_boxed((x)) && is_binary_header(*boxed_val((x)))) #define is_not_binary(x) (!is_binary((x))) #define _unchecked_binary_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,binary_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,binary_val,Wterm) #define binary_val(x) _ET_APPLY(binary_val,(x)) /* process binaries stuff (special case of binaries) */ @@ -356,7 +361,7 @@ _ET_DECLARE_CHECKED(Eterm*,binary_val,Eterm) #define is_fun(x) (is_boxed((x)) && is_fun_header(*boxed_val((x)))) #define is_not_fun(x) (!is_fun((x))) #define _unchecked_fun_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,fun_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,fun_val,Wterm) #define fun_val(x) _ET_APPLY(fun_val,(x)) /* export access methods */ @@ -364,7 +369,7 @@ _ET_DECLARE_CHECKED(Eterm*,fun_val,Eterm) #define is_export(x) (is_boxed((x)) && is_export_header(*boxed_val((x)))) #define is_not_export(x) (!is_export((x))) #define _unchecked_export_val(x) _unchecked_boxed_val(x) -_ET_DECLARE_CHECKED(Eterm*,export_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,export_val,Wterm) #define export_val(x) _ET_APPLY(export_val,(x)) #define is_export_header(x) ((x) == HEADER_EXPORT) #if HALFWORD_HEAP @@ -391,7 +396,7 @@ _ET_DECLARE_CHECKED(Uint,bignum_header_arity,Eterm) #define is_big(x) (is_boxed((x)) && _is_bignum_header(*boxed_val((x)))) #define is_not_big(x) (!is_big((x))) #define _unchecked_big_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,big_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,big_val,Wterm) #define big_val(x) _ET_APPLY(big_val,(x)) /* flonum ("float") access methods */ @@ -404,7 +409,7 @@ _ET_DECLARE_CHECKED(Eterm*,big_val,Eterm) #define is_float(x) (is_boxed((x)) && *boxed_val((x)) == HEADER_FLONUM) #define is_not_float(x) (!is_float(x)) #define _unchecked_float_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,float_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,float_val,Wterm) #define float_val(x) _ET_APPLY(float_val,(x)) /* Float definition for byte and word access */ @@ -422,15 +427,16 @@ typedef union float_def } FloatDef; #if defined(ARCH_64) && !HALFWORD_HEAP -#define GET_DOUBLE(x, f) (f).fdw = *(float_val(x)+1) + +#define FLOAT_VAL_GET_DOUBLE(fval, f) (f).fdw = *((fval)+1) #define PUT_DOUBLE(f, x) *(x) = HEADER_FLONUM, \ *((x)+1) = (f).fdw #define GET_DOUBLE_DATA(p, f) (f).fdw = *((Uint *) (p)) #define PUT_DOUBLE_DATA(f,p) *((Uint *) (p)) = (f).fdw #else -#define GET_DOUBLE(x, f) (f).fw[0] = *(float_val(x)+1), \ - (f).fw[1] = *(float_val(x)+2) +#define FLOAT_VAL_GET_DOUBLE(fval, f) (f).fw[0] = *((fval)+1), \ + (f).fw[1] = *((fval)+2) #define PUT_DOUBLE(f, x) *(x) = HEADER_FLONUM, \ *((x)+1) = (f).fw[0], \ @@ -440,6 +446,9 @@ typedef union float_def #define PUT_DOUBLE_DATA(f,p) *((Uint *) (p)) = (f).fw[0],\ *(((Uint *) (p))+1) = (f).fw[1] #endif + +#define GET_DOUBLE(x, f) FLOAT_VAL_GET_DOUBLE(float_val(x), f) + #define DOUBLE_DATA_WORDS (sizeof(ieee754_8)/sizeof(Eterm)) #define FLOAT_SIZE_OBJECT (DOUBLE_DATA_WORDS+1) @@ -451,7 +460,7 @@ typedef union float_def (is_boxed((x)) && *boxed_val((x)) == make_arityval((a))) #define is_not_tuple_arity(x, a) (!is_tuple_arity((x),(a))) #define _unchecked_tuple_val(x) _unchecked_boxed_val(x) -_ET_DECLARE_CHECKED(Eterm*,tuple_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,tuple_val,Wterm) #define tuple_val(x) _ET_APPLY(tuple_val,(x)) #define TUPLE0(t) \ @@ -790,21 +799,24 @@ do { \ ((RefThing*) internal_ref_val(x)) #define is_internal_ref(x) \ - (_unchecked_is_boxed((x)) && is_ref_thing_header(*boxed_val((x)))) + (_unchecked_is_boxed((x)) && is_ref_thing_header(*boxed_val((x)))) + #define is_not_internal_ref(x) \ (!is_internal_ref((x))) #define _unchecked_internal_ref_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,internal_ref_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,internal_ref_val,Wterm) #define internal_ref_val(x) _ET_APPLY(internal_ref_val,(x)) +#define internal_thing_ref_data_words(t) (thing_arityval(*(Eterm*)(t))) #define _unchecked_internal_ref_data_words(x) \ (_unchecked_thing_arityval(*_unchecked_internal_ref_val(x))) -_ET_DECLARE_CHECKED(Uint,internal_ref_data_words,Eterm) +_ET_DECLARE_CHECKED(Uint,internal_ref_data_words,Wterm) #define internal_ref_data_words(x) _ET_APPLY(internal_ref_data_words,(x)) -#define _unchecked_internal_ref_data(x) (_unchecked_ref_thing_ptr(x)->data.ui32) -_ET_DECLARE_CHECKED(Uint32*,internal_ref_data,Eterm) +#define internal_thing_ref_data(thing) ((thing)->data.ui32) +#define _unchecked_internal_ref_data(x) (internal_thing_ref_data(_unchecked_ref_thing_ptr(x))) +_ET_DECLARE_CHECKED(Uint32*,internal_ref_data,Wterm) #define internal_ref_data(x) _ET_APPLY(internal_ref_data,(x)) #define _unchecked_internal_ref_node(x) erts_this_node @@ -889,14 +901,14 @@ typedef struct external_thing_ { #define is_external_header(x) \ (((x) & (_TAG_HEADER_MASK-_BINARY_XXX_MASK)) == _TAG_HEADER_EXTERNAL_PID) -#define is_external(x) \ - (is_boxed((x)) && is_external_header(*boxed_val((x)))) +#define is_external(x) (is_boxed((x)) && is_external_header(*boxed_val((x)))) + #define is_external_pid(x) \ (is_boxed((x)) && is_external_pid_header(*boxed_val((x)))) #define is_external_port(x) \ - (is_boxed((x)) && is_external_port_header(*boxed_val((x)))) -#define is_external_ref(x) \ - (_unchecked_is_boxed((x)) && is_external_ref_header(*boxed_val((x)))) + (is_boxed((x)) && is_external_port_header(*boxed_val((x)))) + +#define is_external_ref(x) (_unchecked_is_boxed((x)) && is_external_ref_header(*boxed_val((x)))) #define _unchecked_is_external(x) \ (_unchecked_is_boxed((x)) && is_external_header(*_unchecked_boxed_val((x)))) @@ -914,17 +926,21 @@ typedef struct external_thing_ { #define make_external_ref make_external #define _unchecked_external_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,external_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,external_val,Wterm) #define external_val(x) _ET_APPLY(external_val,(x)) #define external_thing_ptr(x) ((ExternalThing *) external_val((x))) #define _unchecked_external_thing_ptr(x) \ ((ExternalThing *) _unchecked_external_val((x))) +#define _unchecked_external_thing_data_words(thing) \ + (_unchecked_thing_arityval((thing)->header) + (1 - EXTERNAL_THING_HEAD_SIZE)) +_ET_DECLARE_CHECKED(Uint,external_thing_data_words,ExternalThing*) +#define external_thing_data_words(thing) _ET_APPLY(external_thing_data_words,(thing)) + #define _unchecked_external_data_words(x) \ - (_unchecked_thing_arityval(_unchecked_external_thing_ptr((x))->header) \ - + (1 - EXTERNAL_THING_HEAD_SIZE)) -_ET_DECLARE_CHECKED(Uint,external_data_words,Eterm) + _unchecked_external_thing_data_words(_unchecked_external_thing_ptr((x))) +_ET_DECLARE_CHECKED(Uint,external_data_words,Wterm) #define external_data_words(x) _ET_APPLY(external_data_words,(x)) #define _unchecked_external_data(x) (_unchecked_external_thing_ptr((x))->data.ui) @@ -935,15 +951,15 @@ _ET_DECLARE_CHECKED(Uint,external_data_words,Eterm) #define _unchecked_external_pid_data_words(x) \ _unchecked_external_data_words((x)) -_ET_DECLARE_CHECKED(Uint,external_pid_data_words,Eterm) +_ET_DECLARE_CHECKED(Uint,external_pid_data_words,Wterm) #define external_pid_data_words(x) _ET_APPLY(external_pid_data_words,(x)) #define _unchecked_external_pid_data(x) _unchecked_external_data((x))[0] -_ET_DECLARE_CHECKED(Uint,external_pid_data,Eterm) +_ET_DECLARE_CHECKED(Uint,external_pid_data,Wterm) #define external_pid_data(x) _ET_APPLY(external_pid_data,(x)) #define _unchecked_external_pid_node(x) _unchecked_external_node((x)) -_ET_DECLARE_CHECKED(struct erl_node_*,external_pid_node,Eterm) +_ET_DECLARE_CHECKED(struct erl_node_*,external_pid_node,Wterm) #define external_pid_node(x) _ET_APPLY(external_pid_node,(x)) #define external_pid_number(x) _GET_PID_NUM(external_pid_data((x))) @@ -951,27 +967,29 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_pid_node,Eterm) #define _unchecked_external_port_data_words(x) \ _unchecked_external_data_words((x)) -_ET_DECLARE_CHECKED(Uint,external_port_data_words,Eterm) +_ET_DECLARE_CHECKED(Uint,external_port_data_words,Wterm) #define external_port_data_words(x) _ET_APPLY(external_port_data_words,(x)) #define _unchecked_external_port_data(x) _unchecked_external_data((x))[0] -_ET_DECLARE_CHECKED(Uint,external_port_data,Eterm) +_ET_DECLARE_CHECKED(Uint,external_port_data,Wterm) #define external_port_data(x) _ET_APPLY(external_port_data,(x)) #define _unchecked_external_port_node(x) _unchecked_external_node((x)) -_ET_DECLARE_CHECKED(struct erl_node_*,external_port_node,Eterm) +_ET_DECLARE_CHECKED(struct erl_node_*,external_port_node,Wterm) #define external_port_node(x) _ET_APPLY(external_port_node,(x)) #define external_port_number(x) _GET_PORT_NUM(external_port_data((x))) #define _unchecked_external_ref_data_words(x) \ _unchecked_external_data_words((x)) -_ET_DECLARE_CHECKED(Uint,external_ref_data_words,Eterm) +_ET_DECLARE_CHECKED(Uint,external_ref_data_words,Wterm) #define external_ref_data_words(x) _ET_APPLY(external_ref_data_words,(x)) +#define external_thing_ref_data_words(thing) external_thing_data_words(thing) #define _unchecked_external_ref_data(x) (_unchecked_external_thing_ptr((x))->data.ui32) -_ET_DECLARE_CHECKED(Uint32*,external_ref_data,Eterm) +_ET_DECLARE_CHECKED(Uint32*,external_ref_data,Wterm) #define external_ref_data(x) _ET_APPLY(external_ref_data,(x)) +#define external_thing_ref_data(thing) ((thing)->data.ui32) #define _unchecked_external_ref_node(x) _unchecked_external_node((x)) _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm) @@ -1083,10 +1101,10 @@ _ET_DECLARE_CHECKED(Uint,y_reg_index,Uint) #define SMALL_DEF 0xf #if ET_DEBUG -extern unsigned tag_val_def_debug(Eterm, const char*, unsigned); +extern unsigned tag_val_def_debug(Wterm, const char*, unsigned); #define tag_val_def(x) tag_val_def_debug((x),__FILE__,__LINE__) #else -extern unsigned tag_val_def(Eterm); +extern unsigned tag_val_def(Wterm); #endif #define not_eq_tags(X,Y) (tag_val_def((X)) ^ tag_val_def((Y))) @@ -1102,5 +1120,81 @@ extern unsigned tag_val_def(Eterm); #define FLOAT_BIG _NUMBER_CODE(FLOAT_DEF,BIG_DEF) #define FLOAT_FLOAT _NUMBER_CODE(FLOAT_DEF,FLOAT_DEF) +#if HALFWORD_HEAP +#define ptr2rel(PTR,BASE) ((Eterm*)((char*)(PTR) - (char*)(BASE))) +#define rterm2wterm(REL,BASE) ((Wterm)(REL) + (Wterm)(BASE)) + +#else /* HALFWORD_HEAP */ + +#define ptr2rel(PTR,BASE) (PTR) +#define rterm2wterm(REL,BASE) (REL) + +#endif /* !HALFWORD_HEAP */ + +#define make_list_rel(PTR, BASE) make_list(ptr2rel(PTR,BASE)) +#define make_boxed_rel(PTR, BASE) make_boxed(ptr2rel(PTR,BASE)) +#define make_fun_rel make_boxed_rel +#define make_binary_rel make_boxed_rel +#define make_tuple_rel make_boxed_rel +#define make_external_rel make_boxed_rel +#define make_internal_ref_rel make_boxed_rel + +#define binary_val_rel(RTERM, BASE) binary_val(rterm2wterm(RTERM, BASE)) +#define list_val_rel(RTERM, BASE) list_val(rterm2wterm(RTERM, BASE)) +#define boxed_val_rel(RTERM, BASE) boxed_val(rterm2wterm(RTERM, BASE)) +#define tuple_val_rel(RTERM, BASE) tuple_val(rterm2wterm(RTERM, BASE)) +#define export_val_rel(RTERM, BASE) export_val(rterm2wterm(RTERM, BASE)) +#define fun_val_rel(RTERM, BASE) fun_val(rterm2wterm(RTERM, BASE)) +#define big_val_rel(RTERM,BASE) big_val(rterm2wterm(RTERM,BASE)) +#define float_val_rel(RTERM,BASE) float_val(rterm2wterm(RTERM,BASE)) +#define internal_ref_val_rel(RTERM,BASE) internal_ref_val(rterm2wterm(RTERM,BASE)) + +#define external_thing_ptr_rel(RTERM, BASE) external_thing_ptr(rterm2wterm(RTERM, BASE)) +#define external_data_words_rel(RTERM,BASE) external_data_words(rterm2wterm(RTERM,BASE)) + +#define external_port_node_rel(RTERM,BASE) external_port_node(rterm2wterm(RTERM,BASE)) +#define external_port_data_rel(RTERM,BASE) external_port_data(rterm2wterm(RTERM,BASE)) + +#define is_external_pid_rel(RTERM,BASE) is_external_pid(rterm2wterm(RTERM,BASE)) +#define external_pid_node_rel(RTERM,BASE) external_pid_node(rterm2wterm(RTERM,BASE)) +#define external_pid_data_rel(RTERM,BASE) external_pid_data(rterm2wterm(RTERM,BASE)) + +#define is_binary_rel(RTERM,BASE) is_binary(rterm2wterm(RTERM,BASE)) +#define is_float_rel(RTERM,BASE) is_float(rterm2wterm(RTERM,BASE)) +#define is_fun_rel(RTERM,BASE) is_fun(rterm2wterm(RTERM,BASE)) +#define is_big_rel(RTERM,BASE) is_big(rterm2wterm(RTERM,BASE)) +#define is_export_rel(RTERM,BASE) is_export(rterm2wterm(RTERM,BASE)) +#define is_tuple_rel(RTERM,BASE) is_tuple(rterm2wterm(RTERM,BASE)) + +#define GET_DOUBLE_REL(RTERM, f, BASE) GET_DOUBLE(rterm2wterm(RTERM,BASE), f) + +#define ref_thing_ptr_rel(RTERM,BASE) ref_thing_ptr(rterm2wterm(RTERM,BASE)) +#define is_internal_ref_rel(RTERM,BASE) is_internal_ref(rterm2wterm(RTERM,BASE)) +#define is_external_rel(RTERM,BASE) is_external(rterm2wterm(RTERM,BASE)) +#define is_external_port_rel(RTERM,BASE) is_external_port(rterm2wterm(RTERM,BASE)) +#define is_external_ref_rel(RTERM,BASE) is_external_ref(rterm2wterm(RTERM,BASE)) + +#define external_node_rel(RTERM,BASE) external_node(rterm2wterm(RTERM,BASE)) + + +#if HALFWORD_HEAP +ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) +{ + /* If bases differ, assume a and b are on different "heaps", + ie can only be same if immed */ + ASSERT(a_base == b_base || is_immed(a) || is_immed(b) + || rterm2wterm(a,a_base) != rterm2wterm(b,b_base)); + + return a == b && (a_base == b_base || is_immed(a)); +} +#endif + +#else /* !HALFWORD_HEAP */ +#define is_same(A,A_BASE,B,B_BASE) ((A)==(B)) +#endif + #endif /* __ERL_TERM_H */ diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 3043bb1e8c..c0397ca6c3 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2010. All Rights Reserved. + * Copyright Ericsson AB 1999-2011. All Rights Reserved. * * 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 @@ -1668,7 +1668,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, return_flags = 0; if (match_spec) { pam_result = erts_match_set_run(p, match_spec, args, arity, - &return_flags); + ERTS_PAM_TMP_RESULT, &return_flags); if (is_non_value(pam_result)) { erts_match_set_release_result(p); #if !HEAP_ON_C_STACK @@ -1815,7 +1815,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, return_flags = 0; if (match_spec) { pam_result = erts_match_set_run(p, match_spec, args, arity, - &return_flags); + ERTS_PAM_TMP_RESULT, &return_flags); if (is_non_value(pam_result)) { erts_match_set_release_result(p); UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 5b42a2ce11..e7fd144ec3 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -120,14 +120,15 @@ * Allocate heap memory, first on the ordinary heap; * failing that, in a heap fragment. */ -#define HAlloc(p, sz) \ +#define HAllocX(p, sz, xtra) \ (ASSERT_EXPR((sz) >= 0), \ ErtsHAllocLockCheck(p), \ (IS_FORCE_HEAP_FRAGS || (((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \ - ? erts_heap_alloc((p),(sz)) \ + ? erts_heap_alloc((p),(sz),(xtra)) \ : (INIT_HEAP_MEM(p,sz), \ HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz)))) +#define HAlloc(P, SZ) HAllocX(P,SZ,0) #define HRelease(p, endp, ptr) \ if ((ptr) == (endp)) { \ diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index e8a9d5f32f..bd540eaaa6 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * 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 @@ -890,9 +890,31 @@ void erl_error(char*, va_list); /* copy.c */ void init_copy(void); Eterm copy_object(Eterm, Process*); + +#if HALFWORD_HEAP +Uint size_object_rel(Eterm, Eterm*); +# define size_object(A) size_object_rel(A,NULL) + +Eterm copy_struct_rel(Eterm, Uint, Eterm**, ErlOffHeap*, Eterm* src_base, Eterm* dst_base); +# define copy_struct(OBJ,SZ,HPP,OH) copy_struct_rel(OBJ,SZ,HPP,OH, NULL,NULL) + +Eterm copy_shallow_rel(Eterm*, Uint, Eterm**, ErlOffHeap*, Eterm* src_base); +# define copy_shallow(A,B,C,D) copy_shallow_rel(A,B,C,D,NULL) + +#else /* !HALFWORD_HEAP */ + Uint size_object(Eterm); +# define size_object_rel(A,B) size_object(A) + Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*); +# define copy_struct_rel(OBJ,SZ,HPP,OH, SB,DB) copy_struct(OBJ,SZ,HPP,OH) + Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); +# define copy_shallow_rel(A,B,C,D, BASE) copy_shallow(A,B,C,D) + +#endif + + void move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first, Eterm* refs, unsigned nrefs); @@ -1483,16 +1505,30 @@ void erts_init_utils_mem(void); erts_dsprintf_buf_t *erts_create_tmp_dsbuf(Uint); void erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *); +#if HALFWORD_HEAP +int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base); +# define eq(A,B) eq_rel(A,NULL,B,NULL) +#else int eq(Eterm, Eterm); +# define eq_rel(A,A_BASE,B,B_BASE) eq(A,B) +#endif + #define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y)))) +#if HALFWORD_HEAP +Sint cmp_rel(Eterm, Eterm*, Eterm, Eterm*); +#define CMP(A,B) cmp_rel(A,NULL,B,NULL) +#else Sint cmp(Eterm, Eterm); -#define cmp_lt(a,b) (cmp((a),(b)) < 0) -#define cmp_le(a,b) (cmp((a),(b)) <= 0) -#define cmp_eq(a,b) (cmp((a),(b)) == 0) -#define cmp_ne(a,b) (cmp((a),(b)) != 0) -#define cmp_ge(a,b) (cmp((a),(b)) >= 0) -#define cmp_gt(a,b) (cmp((a),(b)) > 0) +#define cmp_rel(A,A_BASE,B,B_BASE) cmp(A,B) +#define CMP(A,B) cmp(A,B) +#endif +#define cmp_lt(a,b) (CMP((a),(b)) < 0) +#define cmp_le(a,b) (CMP((a),(b)) <= 0) +#define cmp_eq(a,b) (CMP((a),(b)) == 0) +#define cmp_ne(a,b) (CMP((a),(b)) != 0) +#define cmp_ge(a,b) (CMP((a),(b)) >= 0) +#define cmp_gt(a,b) (CMP((a),(b)) > 0) #define CMP_LT(a,b) ((a) != (b) && cmp_lt((a),(b))) #define CMP_GE(a,b) ((a) == (b) || cmp_ge((a),(b))) @@ -1721,8 +1757,15 @@ do { \ extern Binary *erts_match_set_compile(Process *p, Eterm matchexpr); Eterm erts_match_set_lint(Process *p, Eterm matchexpr); extern void erts_match_set_release_result(Process* p); + +enum erts_pam_run_flags { + ERTS_PAM_TMP_RESULT=0, + ERTS_PAM_COPY_RESULT=1, + ERTS_PAM_CONTIGUOUS_TUPLE=2 +}; extern Eterm erts_match_set_run(Process *p, Binary *mpsp, Eterm *args, int num_args, + enum erts_pam_run_flags in_flags, Uint32 *return_flags); extern Eterm erts_match_set_get_source(Binary *mpsp); extern void erts_match_prog_foreach_offheap(Binary *b, diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index dff2dc37a2..b1cd683b3b 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * 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 @@ -225,14 +225,14 @@ int real_printf(const char *fmt, ...); #else #error Neither 32 nor 64 bit architecture #endif -#ifdef ARCH_64 -# ifdef HALFWORD_HEAP_EMULATOR +#if defined(ARCH_64) && defined(HALFWORD_HEAP_EMULATOR) # define HALFWORD_HEAP 1 # define HALFWORD_ASSERT 0 -# else +# define ASSERT_HALFWORD(COND) ASSERT(COND) +#else # define HALFWORD_HEAP 0 # define HALFWORD_ASSERT 0 -# endif +# define ASSERT_HALFWORD(COND) #endif #if SIZEOF_VOID_P != SIZEOF_SIZE_T diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 1d60b54d21..f531d1430b 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * 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 @@ -91,7 +91,7 @@ dispatch_profile_msg_q(profile_sched_msg_q *psmq) Eterm* -erts_heap_alloc(Process* p, Uint need) +erts_heap_alloc(Process* p, Uint need, Uint xtra) { ErlHeapFragment* bp; Eterm* htop; @@ -117,7 +117,7 @@ erts_heap_alloc(Process* p, Uint need) p->space_verified_from = NULL; #endif /* FORCE_HEAP_FRAGS */ - n = need; + n = need + xtra; bp = MBUF(p); if (bp != NULL && need <= (bp->alloc_size - bp->used_size)) { Eterm* ret = bp->mem + bp->used_size; @@ -153,7 +153,7 @@ erts_heap_alloc(Process* p, Uint need) bp->next = MBUF(p); MBUF(p) = bp; bp->alloc_size = n; - bp->used_size = n; + bp->used_size = need; MBUF_SIZE(p) += n; bp->off_heap.first = NULL; bp->off_heap.overhead = 0; @@ -1894,34 +1894,36 @@ erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp) erts_free(ERTS_ALC_T_TMP_DSBUF, (void *) dsbufp); } - /* eq and cmp are written as separate functions a eq is a little faster */ /* * Test for equality of two terms. * Returns 0 if not equal, or a non-zero value otherwise. */ - +#if HALFWORD_HEAP +int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) +#else int eq(Eterm a, Eterm b) +#endif { DECLARE_WSTACK(stack); Sint sz; Eterm* aa; - Eterm* bb; + Eterm* bb; tailrecur: - if (a == b) goto pop_next; + if (is_same(a, a_base, b, b_base)) goto pop_next; tailrecur_ne: switch (primary_tag(a)) { case TAG_PRIMARY_LIST: if (is_list(b)) { - Eterm* aval = list_val(a); - Eterm* bval = list_val(b); + Eterm* aval = list_val_rel(a, a_base); + Eterm* bval = list_val_rel(b, b_base); while (1) { Eterm atmp = CAR(aval); Eterm btmp = CAR(bval); - if (atmp != btmp) { + if (!is_same(atmp,a_base,btmp,b_base)) { WSTACK_PUSH2(stack,(UWord) CDR(bval),(UWord) CDR(aval)); a = atmp; b = btmp; @@ -1929,7 +1931,7 @@ tailrecur_ne: } atmp = CDR(aval); btmp = CDR(bval); - if (atmp == btmp) { + if (is_same(atmp,a_base,btmp,b_base)) { goto pop_next; } if (is_not_list(atmp) || is_not_list(btmp)) { @@ -1937,22 +1939,22 @@ tailrecur_ne: b = btmp; goto tailrecur_ne; } - aval = list_val(atmp); - bval = list_val(btmp); + aval = list_val_rel(atmp, a_base); + bval = list_val_rel(btmp, b_base); } } break; /* not equal */ case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val(a); + Eterm hdr = *boxed_val_rel(a,a_base); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { - aa = tuple_val(a); - if (!is_boxed(b) || *boxed_val(b) != *aa) + aa = tuple_val_rel(a, a_base); + if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa) goto not_equal; - bb = tuple_val(b); + bb = tuple_val_rel(b,b_base); if ((sz = arityval(*aa)) == 0) goto pop_next; ++aa; ++bb; @@ -1971,16 +1973,16 @@ tailrecur_ne: Uint a_bitoffs; Uint b_bitoffs; - if (is_not_binary(b)) { + if (!is_binary_rel(b,b_base)) { goto not_equal; } - a_size = binary_size(a); - b_size = binary_size(b); + a_size = binary_size_rel(a,a_base); + b_size = binary_size_rel(b,b_base); if (a_size != b_size) { goto not_equal; } - ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize); - ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize); + ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base); + ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base); if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) { if (sys_memcmp(a_ptr, b_ptr, a_size) == 0) goto pop_next; } else if (a_bitsize == b_bitsize) { @@ -1991,9 +1993,9 @@ tailrecur_ne: } case EXPORT_SUBTAG: { - if (is_export(b)) { - Export* a_exp = *((Export **) (export_val(a) + 1)); - Export* b_exp = *((Export **) (export_val(b) + 1)); + if (is_export_rel(b,b_base)) { + Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1)); + Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1)); if (a_exp == b_exp) goto pop_next; } break; /* not equal */ @@ -2003,10 +2005,10 @@ tailrecur_ne: ErlFunThing* f1; ErlFunThing* f2; - if (is_not_fun(b)) + if (!is_fun_rel(b,b_base)) goto not_equal; - f1 = (ErlFunThing *) fun_val(a); - f2 = (ErlFunThing *) fun_val(b); + f1 = (ErlFunThing *) fun_val_rel(a,a_base); + f2 = (ErlFunThing *) fun_val_rel(b,b_base); if (f1->fe->module != f2->fe->module || f1->fe->old_index != f2->fe->old_index || f1->fe->old_uniq != f2->fe->old_uniq || @@ -2024,15 +2026,15 @@ tailrecur_ne: ExternalThing *ap; ExternalThing *bp; - if(is_not_external(b)) + if(!is_external_rel(b,b_base)) goto not_equal; - ap = external_thing_ptr(a); - bp = external_thing_ptr(b); + ap = external_thing_ptr_rel(a,a_base); + bp = external_thing_ptr_rel(b,b_base); if(ap->header == bp->header && ap->node == bp->node) { - ASSERT(1 == external_data_words(a)); - ASSERT(1 == external_data_words(b)); + ASSERT(1 == external_data_words_rel(a,a_base)); + ASSERT(1 == external_data_words_rel(b,b_base)); if (ap->data.ui[0] == bp->data.ui[0]) goto pop_next; } @@ -2050,27 +2052,36 @@ tailrecur_ne: Uint alen; Uint blen; Uint i; + ExternalThing* athing; + ExternalThing* bthing; - if(is_not_external_ref(b)) + if(!is_external_ref_rel(b,b_base)) goto not_equal; - if(external_node(a) != external_node(b)) + athing = external_thing_ptr_rel(a,a_base); + bthing = external_thing_ptr_rel(b,b_base); + + if(athing->node != bthing->node) goto not_equal; - anum = external_ref_numbers(a); - bnum = external_ref_numbers(b); - alen = external_ref_no_of_numbers(a); - blen = external_ref_no_of_numbers(b); + anum = external_thing_ref_numbers(athing); + bnum = external_thing_ref_numbers(bthing); + alen = external_thing_ref_no_of_numbers(athing); + blen = external_thing_ref_no_of_numbers(bthing); goto ref_common; case REF_SUBTAG: - - if (is_not_internal_ref(b)) + if (!is_internal_ref_rel(b,b_base)) goto not_equal; - alen = internal_ref_no_of_numbers(a); - blen = internal_ref_no_of_numbers(b); - anum = internal_ref_numbers(a); - bnum = internal_ref_numbers(b); + + { + RefThing* athing = ref_thing_ptr_rel(a,a_base); + RefThing* bthing = ref_thing_ptr_rel(b,b_base); + alen = internal_thing_ref_no_of_numbers(athing); + blen = internal_thing_ref_no_of_numbers(bthing); + anum = internal_thing_ref_numbers(athing); + bnum = internal_thing_ref_numbers(bthing); + } ref_common: ASSERT(alen > 0 && blen > 0); @@ -2115,10 +2126,10 @@ tailrecur_ne: { int i; - if (is_not_big(b)) + if (!is_big_rel(b,b_base)) goto not_equal; - aa = big_val(a); /* get pointer to thing */ - bb = big_val(b); + aa = big_val_rel(a,a_base); + bb = big_val_rel(b,b_base); if (*aa != *bb) goto not_equal; i = BIG_ARITY(aa); @@ -2133,9 +2144,9 @@ tailrecur_ne: FloatDef af; FloatDef bf; - if (is_float(b)) { - GET_DOUBLE(a, af); - GET_DOUBLE(b, bf); + if (is_float_rel(b,b_base)) { + GET_DOUBLE_REL(a, af, a_base); + GET_DOUBLE_REL(b, bf, b_base); if (af.fd == bf.fd) goto pop_next; } break; /* not equal */ @@ -2154,7 +2165,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'sz' */ Eterm* bp = bb; Sint i = sz; for (;;) { - if (*ap != *bp) break; + if (!is_same(*ap,a_base,*bp,b_base)) break; if (--i == 0) goto pop_next; ++ap; ++bp; @@ -2243,7 +2254,11 @@ static int cmp_atoms(Eterm a, Eterm b) bb->name+3, bb->len-3); } +#if HALFWORD_HEAP +Sint cmp_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) +#else Sint cmp(Eterm a, Eterm b) +#endif { DECLARE_WSTACK(stack); Eterm* aa; @@ -2277,7 +2292,7 @@ Sint cmp(Eterm a, Eterm b) tailrecur: - if (a == b) { /* Equal values or pointers. */ + if (is_same(a,a_base,b,b_base)) { /* Equal values or pointers. */ goto pop_next; } tailrecur_ne: @@ -2303,9 +2318,9 @@ tailrecur_ne: if (is_internal_port(b)) { bnode = erts_this_node; bdata = internal_port_data(b); - } else if (is_external_port(b)) { - bnode = external_port_node(b); - bdata = external_port_data(b); + } else if (is_external_port_rel(b,b_base)) { + bnode = external_port_node_rel(b,b_base); + bdata = external_port_data_rel(b,b_base); } else { a_tag = PORT_DEF; goto mixed_types; @@ -2321,9 +2336,9 @@ tailrecur_ne: if (is_internal_pid(b)) { bnode = erts_this_node; bdata = internal_pid_data(b); - } else if (is_external_pid(b)) { - bnode = external_pid_node(b); - bdata = external_pid_data(b); + } else if (is_external_pid_rel(b,b_base)) { + bnode = external_pid_node_rel(b,b_base); + bdata = external_pid_data_rel(b,b_base); } else { a_tag = PID_DEF; goto mixed_types; @@ -2356,12 +2371,12 @@ tailrecur_ne: a_tag = LIST_DEF; goto mixed_types; } - aa = list_val(a); - bb = list_val(b); + aa = list_val_rel(a,a_base); + bb = list_val_rel(b,b_base); while (1) { Eterm atmp = CAR(aa); Eterm btmp = CAR(bb); - if (atmp != btmp) { + if (!is_same(atmp,a_base,btmp,b_base)) { WSTACK_PUSH2(stack,(UWord) CDR(bb),(UWord) CDR(aa)); a = atmp; b = btmp; @@ -2369,7 +2384,7 @@ tailrecur_ne: } atmp = CDR(aa); btmp = CDR(bb); - if (atmp == btmp) { + if (is_same(atmp,a_base,btmp,b_base)) { goto pop_next; } if (is_not_list(atmp) || is_not_list(btmp)) { @@ -2377,20 +2392,20 @@ tailrecur_ne: b = btmp; goto tailrecur_ne; } - aa = list_val(atmp); - bb = list_val(btmp); + aa = list_val_rel(atmp,a_base); + bb = list_val_rel(btmp,b_base); } case TAG_PRIMARY_BOXED: { - Eterm ahdr = *boxed_val(a); + Eterm ahdr = *boxed_val_rel(a,a_base); switch ((ahdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): - if (is_not_tuple(b)) { + if (!is_tuple_rel(b,b_base)) { a_tag = TUPLE_DEF; goto mixed_types; } - aa = tuple_val(a); - bb = tuple_val(b); + aa = tuple_val_rel(a,a_base); + bb = tuple_val_rel(b,b_base); /* compare the arities */ i = arityval(ahdr); /* get the arity*/ if (i != arityval(*bb)) { @@ -2404,31 +2419,31 @@ tailrecur_ne: goto term_array; case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): - if (is_not_float(b)) { + if (!is_float_rel(b,b_base)) { a_tag = FLOAT_DEF; goto mixed_types; } else { FloatDef af; FloatDef bf; - GET_DOUBLE(a, af); - GET_DOUBLE(b, bf); + GET_DOUBLE_REL(a, af, a_base); + GET_DOUBLE_REL(b, bf, b_base); ON_CMP_GOTO(float_comp(af.fd, bf.fd)); } case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): - if (is_not_big(b)) { + if (!is_big_rel(b,b_base)) { a_tag = BIG_DEF; goto mixed_types; } - ON_CMP_GOTO(big_comp(a, b)); + ON_CMP_GOTO(big_comp(rterm2wterm(a,a_base), rterm2wterm(b,b_base))); case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): - if (is_not_export(b)) { + if (!is_export_rel(b,b_base)) { a_tag = EXPORT_DEF; goto mixed_types; } else { - Export* a_exp = *((Export **) (export_val(a) + 1)); - Export* b_exp = *((Export **) (export_val(b) + 1)); + Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1)); + Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1)); if ((j = cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) { RETURN_NEQ(j); @@ -2440,12 +2455,12 @@ tailrecur_ne: } break; case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): - if (is_not_fun(b)) { + if (!is_fun_rel(b,b_base)) { a_tag = FUN_DEF; goto mixed_types; } else { - ErlFunThing* f1 = (ErlFunThing *) fun_val(a); - ErlFunThing* f2 = (ErlFunThing *) fun_val(b); + ErlFunThing* f1 = (ErlFunThing *) fun_val_rel(a,a_base); + ErlFunThing* f2 = (ErlFunThing *) fun_val_rel(b,b_base); Sint diff; diff = cmpbytes(atom_tab(atom_val(f1->fe->module))->name, @@ -2477,51 +2492,57 @@ tailrecur_ne: if (is_internal_pid(b)) { bnode = erts_this_node; bdata = internal_pid_data(b); - } else if (is_external_pid(b)) { - bnode = external_pid_node(b); - bdata = external_pid_data(b); + } else if (is_external_pid_rel(b,b_base)) { + bnode = external_pid_node_rel(b,b_base); + bdata = external_pid_data_rel(b,b_base); } else { a_tag = EXTERNAL_PID_DEF; goto mixed_types; } - anode = external_pid_node(a); - adata = external_pid_data(a); + anode = external_pid_node_rel(a,a_base); + adata = external_pid_data_rel(a,a_base); goto pid_common; case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): if (is_internal_port(b)) { bnode = erts_this_node; bdata = internal_port_data(b); - } else if (is_external_port(b)) { - bnode = external_port_node(b); - bdata = external_port_data(b); + } else if (is_external_port_rel(b,b_base)) { + bnode = external_port_node_rel(b,b_base); + bdata = external_port_data_rel(b,b_base); } else { a_tag = EXTERNAL_PORT_DEF; goto mixed_types; } - anode = external_port_node(a); - adata = external_port_data(a); + anode = external_port_node_rel(a,a_base); + adata = external_port_data_rel(a,a_base); goto port_common; case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): /* * Note! When comparing refs we need to compare ref numbers * (32-bit words), *not* ref data words. */ + - if (is_internal_ref(b)) { + if (is_internal_ref_rel(b,b_base)) { + RefThing* bthing = ref_thing_ptr_rel(b,b_base); bnode = erts_this_node; - bnum = internal_ref_numbers(b); - blen = internal_ref_no_of_numbers(b); - } else if(is_external_ref(b)) { - bnode = external_ref_node(b); - bnum = external_ref_numbers(b); - blen = external_ref_no_of_numbers(b); + bnum = internal_thing_ref_numbers(bthing); + blen = internal_thing_ref_no_of_numbers(bthing); + } else if(is_external_ref_rel(b,b_base)) { + ExternalThing* bthing = external_thing_ptr_rel(b,b_base); + bnode = bthing->node; + bnum = external_thing_ref_numbers(bthing); + blen = external_thing_ref_no_of_numbers(bthing); } else { a_tag = REF_DEF; goto mixed_types; } - anode = erts_this_node; - anum = internal_ref_numbers(a); - alen = internal_ref_no_of_numbers(a); + { + RefThing* athing = ref_thing_ptr_rel(a,a_base); + anode = erts_this_node; + anum = internal_thing_ref_numbers(athing); + alen = internal_thing_ref_no_of_numbers(athing); + } ref_common: CMP_NODES(anode, bnode); @@ -2550,31 +2571,36 @@ tailrecur_ne: RETURN_NEQ((Sint32) (anum[i] - bnum[i])); goto pop_next; case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): - if (is_internal_ref(b)) { + if (is_internal_ref_rel(b,b_base)) { + RefThing* bthing = ref_thing_ptr_rel(b,b_base); bnode = erts_this_node; - bnum = internal_ref_numbers(b); - blen = internal_ref_no_of_numbers(b); - } else if (is_external_ref(b)) { - bnode = external_ref_node(b); - bnum = external_ref_numbers(b); - blen = external_ref_no_of_numbers(b); + bnum = internal_thing_ref_numbers(bthing); + blen = internal_thing_ref_no_of_numbers(bthing); + } else if (is_external_ref_rel(b,b_base)) { + ExternalThing* bthing = external_thing_ptr_rel(b,b_base); + bnode = bthing->node; + bnum = external_thing_ref_numbers(bthing); + blen = external_thing_ref_no_of_numbers(bthing); } else { a_tag = EXTERNAL_REF_DEF; goto mixed_types; } - anode = external_ref_node(a); - anum = external_ref_numbers(a); - alen = external_ref_no_of_numbers(a); + { + ExternalThing* athing = external_thing_ptr_rel(a,a_base); + anode = athing->node; + anum = external_thing_ref_numbers(athing); + alen = external_thing_ref_no_of_numbers(athing); + } goto ref_common; default: /* Must be a binary */ - ASSERT(is_binary(a)); - if (is_not_binary(b)) { + ASSERT(is_binary_rel(a,a_base)); + if (!is_binary_rel(b,b_base)) { a_tag = BINARY_DEF; goto mixed_types; } else { - Uint a_size = binary_size(a); - Uint b_size = binary_size(b); + Uint a_size = binary_size_rel(a,a_base); + Uint b_size = binary_size_rel(b,b_base); Uint a_bitsize; Uint b_bitsize; Uint a_bitoffs; @@ -2583,8 +2609,8 @@ tailrecur_ne: int cmp; byte* a_ptr; byte* b_ptr; - ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize); - ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize); + ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base); + ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base); if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) { min_size = (a_size < b_size) ? a_size : b_size; if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) { @@ -2611,7 +2637,6 @@ tailrecur_ne: */ mixed_types: - b_tag = tag_val_def(b); { FloatDef f1, f2; @@ -2621,39 +2646,47 @@ tailrecur_ne: #else Eterm *big_buf = erts_get_scheduler_data()->cmp_tmp_heap; #endif +#if HALFWORD_HEAP + Wterm aw = is_immed(a) ? a : rterm2wterm(a,a_base); + Wterm bw = is_immed(b) ? b : rterm2wterm(b,b_base); +#else + Eterm aw = a; + Eterm bw = b; +#endif + b_tag = tag_val_def(bw); switch(_NUMBER_CODE(a_tag, b_tag)) { case SMALL_BIG: big = small_to_big(signed_val(a), big_buf); - j = big_comp(big, b); + j = big_comp(big, bw); break; case SMALL_FLOAT: f1.fd = signed_val(a); - GET_DOUBLE(b, f2); + GET_DOUBLE(bw, f2); j = float_comp(f1.fd, f2.fd); break; case BIG_SMALL: big = small_to_big(signed_val(b), big_buf); - j = big_comp(a, big); + j = big_comp(aw, big); break; case BIG_FLOAT: - if (big_to_double(a, &f1.fd) < 0) { + if (big_to_double(aw, &f1.fd) < 0) { j = big_sign(a) ? -1 : 1; } else { - GET_DOUBLE(b, f2); + GET_DOUBLE(bw, f2); j = float_comp(f1.fd, f2.fd); } break; case FLOAT_SMALL: - GET_DOUBLE(a, f1); + GET_DOUBLE(aw, f1); f2.fd = signed_val(b); j = float_comp(f1.fd, f2.fd); break; case FLOAT_BIG: - if (big_to_double(b, &f2.fd) < 0) { + if (big_to_double(bw, &f2.fd) < 0) { j = big_sign(b) ? 1 : -1; } else { - GET_DOUBLE(a, f1); + GET_DOUBLE(aw, f1); j = float_comp(f1.fd, f2.fd); } break; diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 010d60eb63..8421eb415c 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2010. All Rights Reserved. + * Copyright Ericsson AB 2002-2011. All Rights Reserved. * * 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 @@ -77,8 +77,10 @@ static int atoms_initialized; static Uint cache_check_interval; +typedef struct mem_kind_t MemKind; + static void check_cache(void *unused); -static void mseg_clear_cache(void); +static void mseg_clear_cache(MemKind*); static int is_cache_check_scheduled; #ifdef ERTS_THREADS_NO_SMP static int is_cache_check_requested; @@ -160,14 +162,43 @@ static struct { CallCounter check_cache; } calls; -static cache_desc_t cache_descs[MAX_CACHE_SIZE]; -static cache_desc_t *free_cache_descs; -static cache_desc_t *cache; -static cache_desc_t *cache_end; -static Uint cache_hits; -static Uint cache_size; -static Uint min_cached_seg_size; -static Uint max_cached_seg_size; +struct mem_kind_t { + cache_desc_t cache_descs[MAX_CACHE_SIZE]; + cache_desc_t *free_cache_descs; + cache_desc_t *cache; + cache_desc_t *cache_end; + + Uint cache_size; + Uint min_cached_seg_size; + Uint max_cached_seg_size; + Uint cache_hits; + + struct { + struct { + Uint watermark; + Uint no; + Uint sz; + } current; + struct { + Uint no; + Uint sz; + } max; + struct { + Uint no; + Uint sz; + } max_ever; + } segments; + + const char* name; + MemKind* next; +};/*MemKind*/ + +#if HALFWORD_HEAP +static MemKind low_mem, hi_mem; +#else +static MemKind the_mem; +#endif +static MemKind* mk_list = NULL; static Uint max_cache_size; static Uint abs_max_cache_bad_fit; @@ -177,47 +208,32 @@ static Uint rel_max_cache_bad_fit; static Uint min_seg_size; #endif -struct { - struct { - Uint watermark; - Uint no; - Uint sz; - } current; - struct { - Uint no; - Uint sz; - } max; - struct { - Uint no; - Uint sz; - } max_ever; -} segments; -#define ERTS_MSEG_ALLOC_STAT(SZ) \ +#define ERTS_MSEG_ALLOC_STAT(C,SZ) \ do { \ - segments.current.no++; \ - if (segments.max.no < segments.current.no) \ - segments.max.no = segments.current.no; \ - if (segments.current.watermark < segments.current.no) \ - segments.current.watermark = segments.current.no; \ - segments.current.sz += (SZ); \ - if (segments.max.sz < segments.current.sz) \ - segments.max.sz = segments.current.sz; \ + C->segments.current.no++; \ + if (C->segments.max.no < C->segments.current.no) \ + C->segments.max.no = C->segments.current.no; \ + if (C->segments.current.watermark < C->segments.current.no) \ + C->segments.current.watermark = C->segments.current.no; \ + C->segments.current.sz += (SZ); \ + if (C->segments.max.sz < C->segments.current.sz) \ + C->segments.max.sz = C->segments.current.sz; \ } while (0) -#define ERTS_MSEG_DEALLOC_STAT(SZ) \ +#define ERTS_MSEG_DEALLOC_STAT(C,SZ) \ do { \ - ASSERT(segments.current.no > 0); \ - segments.current.no--; \ - ASSERT(segments.current.sz >= (SZ)); \ - segments.current.sz -= (SZ); \ + ASSERT(C->segments.current.no > 0); \ + C->segments.current.no--; \ + ASSERT(C->segments.current.sz >= (SZ)); \ + C->segments.current.sz -= (SZ); \ } while (0) -#define ERTS_MSEG_REALLOC_STAT(OSZ, NSZ) \ +#define ERTS_MSEG_REALLOC_STAT(C,OSZ, NSZ) \ do { \ - ASSERT(segments.current.sz >= (OSZ)); \ - segments.current.sz -= (OSZ); \ - segments.current.sz += (NSZ); \ + ASSERT(C->segments.current.sz >= (OSZ)); \ + C->segments.current.sz -= (OSZ); \ + C->segments.current.sz += (NSZ); \ } while (0) #define ONE_GIGA (1000000000) @@ -303,13 +319,16 @@ check_schedule_cache_check(void) static void mseg_shutdown(void) { + MemKind* mk; erts_mtx_lock(&mseg_mutex); - mseg_clear_cache(); + for (mk=mk_list; mk; mk=mk->next) { + mseg_clear_cache(mk); + } erts_mtx_unlock(&mseg_mutex); } static ERTS_INLINE void * -mseg_create(Uint size) +mseg_create(MemKind* mk, Uint size) { void *seg; @@ -319,19 +338,21 @@ mseg_create(Uint size) seg = erts_sys_alloc(ERTS_ALC_N_INVALID, NULL, size); #elif HAVE_MMAP #if HALFWORD_HEAP - seg = pmmap(size); -#else - seg = (void *) mmap((void *) 0, (size_t) size, - MMAP_PROT, MMAP_FLAGS, MMAP_FD, 0); - if (seg == (void *) MAP_FAILED) - seg = NULL; -#endif -#if HALFWORD_HEAP - if ((unsigned long) seg & CHECK_POINTER_MASK) { - erts_fprintf(stderr,"Pointer mask failure (0x%08lx)\n",(unsigned long) seg); - return NULL; + if (mk == &low_mem) { + seg = pmmap(size); + if ((unsigned long) seg & CHECK_POINTER_MASK) { + erts_fprintf(stderr,"Pointer mask failure (0x%08lx)\n",(unsigned long) seg); + return NULL; + } } + else #endif + { + seg = (void *) mmap((void *) 0, (size_t) size, + MMAP_PROT, MMAP_FLAGS, MMAP_FD, 0); + if (seg == (void *) MAP_FAILED) + seg = NULL; + } #else #error "Missing mseg_create() implementation" #endif @@ -342,20 +363,23 @@ mseg_create(Uint size) } static ERTS_INLINE void -mseg_destroy(void *seg, Uint size) +mseg_destroy(MemKind* mk, void *seg, Uint size) { #if defined(ERTS_MSEG_FAKE_SEGMENTS) erts_sys_free(ERTS_ALC_N_INVALID, NULL, seg); #elif HAVE_MMAP + int res; -#ifdef DEBUG - int res = -#endif #if HALFWORD_HEAP - pmunmap((void *) seg, size); -#else - munmap((void *) seg, size); + if (mk == &low_mem) { + res = pmunmap((void *) seg, size); + } + else #endif + { + res = munmap((void *) seg, size); + } + ASSERT(size % page_size == 0); ASSERT(res == 0); #else @@ -369,7 +393,7 @@ mseg_destroy(void *seg, Uint size) #if HAVE_MSEG_RECREATE static ERTS_INLINE void * -mseg_recreate(void *old_seg, Uint old_size, Uint new_size) +mseg_recreate(MemKind* mk, void *old_seg, Uint old_size, Uint new_size) { void *new_seg; @@ -380,25 +404,29 @@ mseg_recreate(void *old_seg, Uint old_size, Uint new_size) new_seg = erts_sys_realloc(ERTS_ALC_N_INVALID, NULL, old_seg, new_size); #elif HAVE_MREMAP #if HALFWORD_HEAP - new_seg = (void *) pmremap((void *) old_seg, - (size_t) old_size, - (size_t) new_size); -#elif defined(__NetBSD__) - new_seg = (void *) mremap((void *) old_seg, - (size_t) old_size, - NULL, - (size_t) new_size, - 0); - if (new_seg == (void *) MAP_FAILED) - new_seg = NULL; -#else - new_seg = (void *) mremap((void *) old_seg, - (size_t) old_size, - (size_t) new_size, - MREMAP_MAYMOVE); - if (new_seg == (void *) MAP_FAILED) - new_seg = NULL; + if (mk == &low_mem) { + new_seg = (void *) pmremap((void *) old_seg, + (size_t) old_size, + (size_t) new_size); + } + else #endif + { + #if defined(__NetBSD__) + new_seg = (void *) mremap((void *) old_seg, + (size_t) old_size, + NULL, + (size_t) new_size, + 0); + #else + new_seg = (void *) mremap((void *) old_seg, + (size_t) old_size, + (size_t) new_size, + MREMAP_MAYMOVE); + #endif + if (new_seg == (void *) MAP_FAILED) + new_seg = NULL; + } #else #error "Missing mseg_recreate() implementation" #endif @@ -412,134 +440,142 @@ mseg_recreate(void *old_seg, Uint old_size, Uint new_size) static ERTS_INLINE cache_desc_t * -alloc_cd(void) +alloc_cd(MemKind* mk) { - cache_desc_t *cd = free_cache_descs; + cache_desc_t *cd = mk->free_cache_descs; ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); if (cd) - free_cache_descs = cd->next; + mk->free_cache_descs = cd->next; return cd; } static ERTS_INLINE void -free_cd(cache_desc_t *cd) +free_cd(MemKind* mk, cache_desc_t *cd) { ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); - cd->next = free_cache_descs; - free_cache_descs = cd; + cd->next = mk->free_cache_descs; + mk->free_cache_descs = cd; } static ERTS_INLINE void -link_cd(cache_desc_t *cd) +link_cd(MemKind* mk, cache_desc_t *cd) { ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); - if (cache) - cache->prev = cd; - cd->next = cache; + if (mk->cache) + mk->cache->prev = cd; + cd->next = mk->cache; cd->prev = NULL; - cache = cd; + mk->cache = cd; - if (!cache_end) { + if (!mk->cache_end) { ASSERT(!cd->next); - cache_end = cd; + mk->cache_end = cd; } - cache_size++; + mk->cache_size++; } +#if CAN_PARTLY_DESTROY static ERTS_INLINE void -end_link_cd(cache_desc_t *cd) +end_link_cd(MemKind* mk, cache_desc_t *cd) { ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); - if (cache_end) - cache_end->next = cd; + if (mk->cache_end) + mk->cache_end->next = cd; cd->next = NULL; - cd->prev = cache_end; - cache_end = cd; + cd->prev = mk->cache_end; + mk->cache_end = cd; - if (!cache) { + if (!mk->cache) { ASSERT(!cd->prev); - cache = cd; + mk->cache = cd; } - cache_size++; + mk->cache_size++; } +#endif static ERTS_INLINE void -unlink_cd(cache_desc_t *cd) +unlink_cd(MemKind* mk, cache_desc_t *cd) { ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); if (cd->next) cd->next->prev = cd->prev; else - cache_end = cd->prev; + mk->cache_end = cd->prev; if (cd->prev) cd->prev->next = cd->next; else - cache = cd->next; - ASSERT(cache_size > 0); - cache_size--; + mk->cache = cd->next; + ASSERT(mk->cache_size > 0); + mk->cache_size--; } static ERTS_INLINE void -check_cache_limits(void) +check_cache_limits(MemKind* mk) { cache_desc_t *cd; ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); - max_cached_seg_size = 0; - min_cached_seg_size = ~((Uint) 0); - for (cd = cache; cd; cd = cd->next) { - if (cd->size < min_cached_seg_size) - min_cached_seg_size = cd->size; - if (cd->size > max_cached_seg_size) - max_cached_seg_size = cd->size; + mk->max_cached_seg_size = 0; + mk->min_cached_seg_size = ~((Uint) 0); + for (cd = mk->cache; cd; cd = cd->next) { + if (cd->size < mk->min_cached_seg_size) + mk->min_cached_seg_size = cd->size; + if (cd->size > mk->max_cached_seg_size) + mk->max_cached_seg_size = cd->size; } - } static ERTS_INLINE void -adjust_cache_size(int force_check_limits) +adjust_cache_size(MemKind* mk, int force_check_limits) { cache_desc_t *cd; int check_limits = force_check_limits; - Sint max_cached = ((Sint) segments.current.watermark - - (Sint) segments.current.no); + Sint max_cached = ((Sint) mk->segments.current.watermark + - (Sint) mk->segments.current.no); ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); - while (((Sint) cache_size) > max_cached && ((Sint) cache_size) > 0) { - ASSERT(cache_end); - cd = cache_end; + while (((Sint) mk->cache_size) > max_cached && ((Sint) mk->cache_size) > 0) { + ASSERT(mk->cache_end); + cd = mk->cache_end; if (!check_limits && - !(min_cached_seg_size < cd->size - && cd->size < max_cached_seg_size)) { + !(mk->min_cached_seg_size < cd->size + && cd->size < mk->max_cached_seg_size)) { check_limits = 1; } if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg); - mseg_destroy(cd->seg, cd->size); - unlink_cd(cd); - free_cd(cd); + mseg_destroy(mk, cd->seg, cd->size); + unlink_cd(mk,cd); + free_cd(mk,cd); } if (check_limits) - check_cache_limits(); - + check_cache_limits(mk); } static void -check_cache(void *unused) +check_one_cache(MemKind* mk) { + if (mk->segments.current.watermark > mk->segments.current.no) + mk->segments.current.watermark--; + adjust_cache_size(mk, 0); + + if (mk->cache_size) + schedule_cache_check(); +} + +static void check_cache(void* unused) +{ + MemKind* mk; erts_mtx_lock(&mseg_mutex); is_cache_check_scheduled = 0; - if (segments.current.watermark > segments.current.no) - segments.current.watermark--; - adjust_cache_size(0); - - if (cache_size) - schedule_cache_check(); + for (mk=mk_list; mk; mk=mk->next) { + check_one_cache(mk); + } INC_CC(check_cache); @@ -547,28 +583,45 @@ check_cache(void *unused) } static void -mseg_clear_cache(void) +mseg_clear_cache(MemKind* mk) { - segments.current.watermark = 0; + mk->segments.current.watermark = 0; - adjust_cache_size(1); + adjust_cache_size(mk, 1); - ASSERT(!cache); - ASSERT(!cache_end); - ASSERT(!cache_size); + ASSERT(!mk->cache); + ASSERT(!mk->cache_end); + ASSERT(!mk->cache_size); - segments.current.watermark = segments.current.no; + mk->segments.current.watermark = mk->segments.current.no; INC_CC(clear_cache); } +static ERTS_INLINE MemKind* type2mk(ErtsAlcType_t atype) +{ +#if HALFWORD_HEAP + switch (atype) { + case ERTS_ALC_A_ETS: + case ERTS_ALC_A_BINARY: + case ERTS_ALC_A_FIXED_SIZE: + case ERTS_ALC_A_DRIVER: + return &hi_mem; + default: + return &low_mem; + } +#else + return &the_mem; +#endif +} + static void * mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) { - Uint max, min, diff_size, size; cache_desc_t *cd, *cand_cd; void *seg; + MemKind* mk = type2mk(atype); INC_CC(alloc); @@ -581,11 +634,11 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) if (!opt->cache) { create_seg: - adjust_cache_size(0); - seg = mseg_create(size); + adjust_cache_size(mk,0); + seg = mseg_create(mk, size); if (!seg) { - mseg_clear_cache(); - seg = mseg_create(size); + mseg_clear_cache(mk); + seg = mseg_create(mk, size); if (!seg) size = 0; } @@ -594,17 +647,17 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) if (seg) { if (erts_mtrace_enabled) erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size); - ERTS_MSEG_ALLOC_STAT(size); + ERTS_MSEG_ALLOC_STAT(mk,size); } return seg; } - if (size > max_cached_seg_size) + if (size > mk->max_cached_seg_size) goto create_seg; - if (size < min_cached_seg_size) { + if (size < mk->min_cached_seg_size) { - diff_size = min_cached_seg_size - size; + diff_size = mk->min_cached_seg_size - size; if (diff_size > abs_max_cache_bad_fit) goto create_seg; @@ -618,7 +671,7 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) min = ~((Uint) 0); cand_cd = NULL; - for (cd = cache; cd; cd = cd->next) { + for (cd = mk->cache; cd; cd = cd->next) { if (cd->size >= size) { if (!cand_cd) { cand_cd = cd; @@ -639,8 +692,8 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) min = cd->size; } - min_cached_seg_size = min; - max_cached_seg_size = max; + mk->min_cached_seg_size = min; + mk->max_cached_seg_size = max; if (!cand_cd) goto create_seg; @@ -649,20 +702,20 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) if (diff_size > abs_max_cache_bad_fit || 100*PAGES(diff_size) > rel_max_cache_bad_fit*PAGES(size)) { - if (max_cached_seg_size < cand_cd->size) - max_cached_seg_size = cand_cd->size; - if (min_cached_seg_size > cand_cd->size) - min_cached_seg_size = cand_cd->size; + if (mk->max_cached_seg_size < cand_cd->size) + mk->max_cached_seg_size = cand_cd->size; + if (mk->min_cached_seg_size > cand_cd->size) + mk->min_cached_seg_size = cand_cd->size; goto create_seg; } - cache_hits++; + mk->cache_hits++; size = cand_cd->size; seg = cand_cd->seg; - unlink_cd(cand_cd); - free_cd(cand_cd); + unlink_cd(mk,cand_cd); + free_cd(mk,cand_cd); *size_p = size; @@ -672,7 +725,7 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) } if (seg) - ERTS_MSEG_ALLOC_STAT(size); + ERTS_MSEG_ALLOC_STAT(mk,size); return seg; } @@ -681,41 +734,42 @@ static void mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, const ErtsMsegOpt_t *opt) { + MemKind* mk = type2mk(atype); cache_desc_t *cd; - ERTS_MSEG_DEALLOC_STAT(size); + ERTS_MSEG_DEALLOC_STAT(mk,size); if (!opt->cache || max_cache_size == 0) { if (erts_mtrace_enabled) erts_mtrace_crr_free(atype, SEGTYPE, seg); - mseg_destroy(seg, size); + mseg_destroy(mk, seg, size); } else { int check_limits = 0; - if (size < min_cached_seg_size) - min_cached_seg_size = size; - if (size > max_cached_seg_size) - max_cached_seg_size = size; - - if (!free_cache_descs) { - cd = cache_end; - if (!(min_cached_seg_size < cd->size - && cd->size < max_cached_seg_size)) { + if (size < mk->min_cached_seg_size) + mk->min_cached_seg_size = size; + if (size > mk->max_cached_seg_size) + mk->max_cached_seg_size = size; + + if (!mk->free_cache_descs) { + cd = mk->cache_end; + if (!(mk->min_cached_seg_size < cd->size + && cd->size < mk->max_cached_seg_size)) { check_limits = 1; } if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg); - mseg_destroy(cd->seg, cd->size); - unlink_cd(cd); - free_cd(cd); + mseg_destroy(mk, cd->seg, cd->size); + unlink_cd(mk,cd); + free_cd(mk,cd); } - cd = alloc_cd(); + cd = alloc_cd(mk); ASSERT(cd); cd->seg = seg; cd->size = size; - link_cd(cd); + link_cd(mk,cd); if (erts_mtrace_enabled) { erts_mtrace_crr_free(atype, SEGTYPE, seg); @@ -725,7 +779,7 @@ mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, /* ASSERT(segments.current.watermark >= segments.current.no + cache_size); */ if (check_limits) - check_cache_limits(); + check_cache_limits(mk); schedule_cache_check(); @@ -738,6 +792,7 @@ static void * mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, const ErtsMsegOpt_t *opt) { + MemKind* mk = type2mk(atype); void *new_seg; Uint new_size; @@ -775,15 +830,15 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, #if CAN_PARTLY_DESTROY if (shrink_sz > min_seg_size - && free_cache_descs + && mk->free_cache_descs && opt->cache) { cache_desc_t *cd; - cd = alloc_cd(); + cd = alloc_cd(mk); ASSERT(cd); cd->seg = ((char *) seg) + new_size; cd->size = shrink_sz; - end_link_cd(cd); + end_link_cd(mk,cd); if (erts_mtrace_enabled) { erts_mtrace_crr_realloc(new_seg, @@ -802,7 +857,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, SEGTYPE, seg, new_size); - mseg_destroy(((char *) seg) + new_size, shrink_sz); + mseg_destroy(mk, ((char *) seg) + new_size, shrink_sz); } #elif HAVE_MSEG_RECREATE @@ -836,7 +891,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, #if !CAN_PARTLY_DESTROY do_recreate: #endif - new_seg = mseg_recreate((void *) seg, old_size, new_size); + new_seg = mseg_recreate(mk, (void *) seg, old_size, new_size); if (erts_mtrace_enabled) erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size); if (!new_seg) @@ -859,7 +914,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, *new_size_p = new_size; - ERTS_MSEG_REALLOC_STAT(old_size, new_size); + ERTS_MSEG_REALLOC_STAT(mk, old_size, new_size); return new_seg; } @@ -875,6 +930,8 @@ static struct { Eterm mcs; Eterm cci; + Eterm memkind; + Eterm name; Eterm status; Eterm cached_segments; Eterm cache_hits; @@ -924,6 +981,8 @@ init_atoms(void) #endif AM_INIT(version); + AM_INIT(memkind); + AM_INIT(name); AM_INIT(options); AM_INIT(amcbf); @@ -1134,65 +1193,88 @@ info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) } static Eterm -info_status(int *print_to_p, - void *print_to_arg, - int begin_new_max_period, - Uint **hpp, - Uint *szp) +info_status(MemKind* mk, int *print_to_p, void *print_to_arg, + int begin_new_max_period, Uint **hpp, Uint *szp) { Eterm res = THE_NON_VALUE; - if (segments.max_ever.no < segments.max.no) - segments.max_ever.no = segments.max.no; - if (segments.max_ever.sz < segments.max.sz) - segments.max_ever.sz = segments.max.sz; + if (mk->segments.max_ever.no < mk->segments.max.no) + mk->segments.max_ever.no = mk->segments.max.no; + if (mk->segments.max_ever.sz < mk->segments.max.sz) + mk->segments.max_ever.sz = mk->segments.max.sz; if (print_to_p) { int to = *print_to_p; void *arg = print_to_arg; - erts_print(to, arg, "cached_segments: %bpu\n", cache_size); - erts_print(to, arg, "cache_hits: %bpu\n", cache_hits); + erts_print(to, arg, "cached_segments: %bpu\n", mk->cache_size); + erts_print(to, arg, "cache_hits: %bpu\n", mk->cache_hits); erts_print(to, arg, "segments: %bpu %bpu %bpu\n", - segments.current.no, segments.max.no, segments.max_ever.no); + mk->segments.current.no, mk->segments.max.no, mk->segments.max_ever.no); erts_print(to, arg, "segments_size: %bpu %bpu %bpu\n", - segments.current.sz, segments.max.sz, segments.max_ever.sz); + mk->segments.current.sz, mk->segments.max.sz, mk->segments.max_ever.sz); erts_print(to, arg, "segments_watermark: %bpu\n", - segments.current.watermark); + mk->segments.current.watermark); } if (hpp || szp) { res = NIL; add_2tup(hpp, szp, &res, am.segments_watermark, - bld_unstable_uint(hpp, szp, segments.current.watermark)); + bld_unstable_uint(hpp, szp, mk->segments.current.watermark)); add_4tup(hpp, szp, &res, am.segments_size, - bld_unstable_uint(hpp, szp, segments.current.sz), - bld_unstable_uint(hpp, szp, segments.max.sz), - bld_unstable_uint(hpp, szp, segments.max_ever.sz)); + bld_unstable_uint(hpp, szp, mk->segments.current.sz), + bld_unstable_uint(hpp, szp, mk->segments.max.sz), + bld_unstable_uint(hpp, szp, mk->segments.max_ever.sz)); add_4tup(hpp, szp, &res, am.segments, - bld_unstable_uint(hpp, szp, segments.current.no), - bld_unstable_uint(hpp, szp, segments.max.no), - bld_unstable_uint(hpp, szp, segments.max_ever.no)); + bld_unstable_uint(hpp, szp, mk->segments.current.no), + bld_unstable_uint(hpp, szp, mk->segments.max.no), + bld_unstable_uint(hpp, szp, mk->segments.max_ever.no)); add_2tup(hpp, szp, &res, am.cache_hits, - bld_unstable_uint(hpp, szp, cache_hits)); + bld_unstable_uint(hpp, szp, mk->cache_hits)); add_2tup(hpp, szp, &res, am.cached_segments, - bld_unstable_uint(hpp, szp, cache_size)); + bld_unstable_uint(hpp, szp, mk->cache_size)); } if (begin_new_max_period) { - segments.max.no = segments.current.no; - segments.max.sz = segments.current.sz; + mk->segments.max.no = mk->segments.current.no; + mk->segments.max.sz = mk->segments.current.sz; } return res; } +static Eterm info_memkind(MemKind* mk, int *print_to_p, void *print_to_arg, + int begin_max_per, Uint **hpp, Uint *szp) +{ + Eterm res = THE_NON_VALUE; + Eterm atoms[3]; + Eterm values[3]; + + if (print_to_p) { + erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", mk->name); + } + if (hpp || szp) { + atoms[0] = am.name; + atoms[1] = am.status; + atoms[2] = am.calls; + values[0] = erts_bld_string(hpp, szp, mk->name); + } + values[1] = info_status(mk, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[2] = info_calls(print_to_p, print_to_arg, hpp, szp); + + if (hpp || szp) + res = bld_2tup_list(hpp, szp, 3, atoms, values); + + return res; +} + + static Eterm info_version(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) { @@ -1239,6 +1321,7 @@ erts_mseg_info(int *print_to_p, Eterm res = THE_NON_VALUE; Eterm atoms[4]; Eterm values[4]; + Uint n = 0; erts_mtx_lock(&mseg_mutex); @@ -1249,17 +1332,19 @@ erts_mseg_info(int *print_to_p, atoms[0] = am.version; atoms[1] = am.options; - atoms[2] = am.status; - atoms[3] = am.calls; + atoms[2] = am.memkind; + atoms[3] = am.memkind; } - - values[0] = info_version(print_to_p, print_to_arg, hpp, szp); - values[1] = info_options("option ", print_to_p, print_to_arg, hpp, szp); - values[2] = info_status(print_to_p, print_to_arg, begin_max_per, hpp, szp); - values[3] = info_calls(print_to_p, print_to_arg, hpp, szp); - + values[n++] = info_version(print_to_p, print_to_arg, hpp, szp); + values[n++] = info_options("option ", print_to_p, print_to_arg, hpp, szp); +#if HALFWORD_HEAP + values[n++] = info_memkind(&low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[n++] = info_memkind(&hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); +#else + values[n++] = info_memkind(&the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); +#endif if (hpp || szp) - res = bld_2tup_list(hpp, szp, 4, atoms, values); + res = bld_2tup_list(hpp, szp, n, atoms, values); erts_mtx_unlock(&mseg_mutex); @@ -1318,17 +1403,23 @@ erts_mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, void erts_mseg_clear_cache(void) { + MemKind* mk; erts_mtx_lock(&mseg_mutex); - mseg_clear_cache(); + for (mk=mk_list; mk; mk=mk->next) { + mseg_clear_cache(mk); + } erts_mtx_unlock(&mseg_mutex); } Uint erts_mseg_no(void) { - Uint n; + MemKind* mk; + Uint n = 0; erts_mtx_lock(&mseg_mutex); - n = segments.current.no; + for (mk=mk_list; mk; mk=mk->next) { + n += mk->segments.current.no; + } erts_mtx_unlock(&mseg_mutex); return n; } @@ -1339,11 +1430,43 @@ erts_mseg_unit_size(void) return page_size; } -void -erts_mseg_init(ErtsMsegInit_t *init) +static void mem_kind_init(MemKind* mk, const char* name) { unsigned i; + mk->cache = NULL; + mk->cache_end = NULL; + mk->max_cached_seg_size = 0; + mk->min_cached_seg_size = ~((Uint) 0); + mk->cache_size = 0; + mk->cache_hits = 0; + + if (max_cache_size > 0) { + for (i = 0; i < max_cache_size - 1; i++) + mk->cache_descs[i].next = &mk->cache_descs[i + 1]; + mk->cache_descs[max_cache_size - 1].next = NULL; + mk->free_cache_descs = &mk->cache_descs[0]; + } + else + mk->free_cache_descs = NULL; + + mk->segments.current.watermark = 0; + mk->segments.current.no = 0; + mk->segments.current.sz = 0; + mk->segments.max.no = 0; + mk->segments.max.sz = 0; + mk->segments.max_ever.no = 0; + mk->segments.max_ever.sz = 0; + + mk->name = name; + mk->next = mk_list; + mk_list = mk; +} + + +void +erts_mseg_init(ErtsMsegInit_t *init) +{ atoms_initialized = 0; is_init_done = 0; @@ -1386,40 +1509,33 @@ erts_mseg_init(ErtsMsegInit_t *init) min_seg_size = ~((Uint) 0); #endif - cache = NULL; - cache_end = NULL; - cache_hits = 0; - max_cached_seg_size = 0; - min_cached_seg_size = ~((Uint) 0); - cache_size = 0; + if (max_cache_size > MAX_CACHE_SIZE) + max_cache_size = MAX_CACHE_SIZE; + +#if HALFWORD_HEAP + mem_kind_init(&low_mem, "low memory"); + mem_kind_init(&hi_mem, "high memory"); +#else + mem_kind_init(&the_mem, "all memory"); +#endif is_cache_check_scheduled = 0; #ifdef ERTS_THREADS_NO_SMP is_cache_check_requested = 0; #endif +} - if (max_cache_size > MAX_CACHE_SIZE) - max_cache_size = MAX_CACHE_SIZE; - if (max_cache_size > 0) { - for (i = 0; i < max_cache_size - 1; i++) - cache_descs[i].next = &cache_descs[i + 1]; - cache_descs[max_cache_size - 1].next = NULL; - free_cache_descs = &cache_descs[0]; +static ERTS_INLINE Uint tot_cache_size(void) +{ + MemKind* mk; + Uint sz = 0; + for (mk=mk_list; mk; mk=mk->next) { + sz += mk->cache_size; } - else - free_cache_descs = NULL; - - segments.current.watermark = 0; - segments.current.no = 0; - segments.current.sz = 0; - segments.max.no = 0; - segments.max.sz = 0; - segments.max_ever.no = 0; - segments.max_ever.sz = 0; + return sz; } - /* * erts_mseg_late_init() have to be called after all allocators, * threads and timers have been initialized. @@ -1437,7 +1553,7 @@ erts_mseg_late_init(void) #ifdef ERTS_THREADS_NO_SMP async_handle = handle; #endif - if (cache_size) + if (tot_cache_size()) schedule_cache_check(); erts_mtx_unlock(&mseg_mutex); } @@ -1478,7 +1594,7 @@ erts_mseg_test(unsigned long op, case 0x406: { unsigned long res; erts_mtx_lock(&mseg_mutex); - res = (unsigned long) cache_size; + res = (unsigned long) tot_cache_size(); erts_mtx_unlock(&mseg_mutex); return res; } @@ -1757,6 +1873,7 @@ static int pmunmap(void *p, size_t size) FreeBlock *last; FreeBlock *nb = (FreeBlock *) p; + ASSERT(((unsigned long)p & CHECK_POINTER_MASK)==0); if (real_size > pagsz) { if (do_unmap(((char *) p) + pagsz,real_size - pagsz)) { return 1; diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 6e9376b0f3..8ec7b31ce0 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2010. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. All Rights Reserved. * * 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 @@ -36,11 +36,6 @@ erts_sys_init_float(void) # endif } -static ERTS_INLINE void set_current_fp_exception(unsigned long pc) -{ - /* nothing to do */ -} - #else /* !NO_FPE_SIGNALS */ #ifdef ERTS_SMP diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index d1893e08dd..6c85c2c3d1 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% 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 @@ -1780,8 +1780,8 @@ mseg_alloc_ccc() -> mseg_alloc_ccc(erlang:system_info({allocator,mseg_alloc})). mseg_alloc_ccc(MsegAllocInfo) -> - ?line {value,{calls, CL}} - = lists:keysearch(calls, 1, MsegAllocInfo), + ?line {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo), + ?line {value,{calls, CL}} = lists:keysearch(calls, 1, MKL), ?line {value,{mseg_check_cache, GigaCCC, CCC}} = lists:keysearch(mseg_check_cache, 1, CL), ?line GigaCCC*1000000000 + CCC. @@ -1790,12 +1790,28 @@ mseg_alloc_cached_segments() -> mseg_alloc_cached_segments(erlang:system_info({allocator,mseg_alloc})). mseg_alloc_cached_segments(MsegAllocInfo) -> + MemName = case is_halfword_vm() of + true -> "high memory"; + false -> "all memory" + end, + ?line [{memkind,DrvMem}] + = lists:filter(fun(E) -> case E of + {memkind, [{name, MemName} | _]} -> true; + _ -> false + end end, MsegAllocInfo), ?line {value,{status, SL}} - = lists:keysearch(status, 1, MsegAllocInfo), + = lists:keysearch(status, 1, DrvMem), ?line {value,{cached_segments, CS}} = lists:keysearch(cached_segments, 1, SL), ?line CS. +is_halfword_vm() -> + case {erlang:system_info({wordsize, internal}), + erlang:system_info({wordsize, external})} of + {4, 8} -> true; + {WS, WS} -> false + end. + driver_alloc_sbct() -> {_, _, _, As} = erlang:system_info(allocator), case lists:keysearch(driver_alloc, 1, As) of diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index dba70d9f3f..60fa429a3e 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% 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 @@ -93,13 +93,16 @@ misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1, heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1, do_heavy_concurrent/1, tab2file2_do/2, exit_large_table_owner_do/2, - types_do/1, sleeper/0, rpc_externals/0, memory_do/1 + types_do/1, sleeper/0, rpc_externals/0, memory_do/1, + ms_tracee_dummy/1, ms_tracee_dummy/2, ms_tracee_dummy/3, ms_tracee_dummy/4 ]). -export([t_select_reverse/1]). -include_lib("test_server/include/test_server.hrl"). +-define(m(A,B), ?line assert_eq(A,B)). + init_per_testcase(Case, Config) -> Seed = {S1,S2,S3} = random:seed0(), %now(), random:seed(S1,S2,S3), @@ -213,29 +216,180 @@ t_match_spec_run(suite) -> t_match_spec_run(doc) -> ["Check ets:match_spec_run/2."]; t_match_spec_run(Config) when is_list(Config) -> + init_externals(), ?line EtsMem = etsmem(), - ?line [2,3] = ets:match_spec_run([{1},{2},{3}], - ets:match_spec_compile( - [{{'$1'},[{'>','$1',1}],['$1']}])), + + t_match_spec_run_test([{1},{2},{3}], + [{{'$1'},[{'>','$1',1}],['$1']}], + [2,3]), + ?line Huge = [{X} || X <- lists:seq(1,2500)], ?line L = lists:seq(2476,2500), - ?line L = ets:match_spec_run(Huge, - ets:match_spec_compile( - [{{'$1'},[{'>','$1',2475}],['$1']}])), + t_match_spec_run_test(Huge, [{{'$1'},[{'>','$1',2475}],['$1']}], L), + ?line L2 = [{X*16#FFFFFFF} || X <- L], - ?line L2 = ets:match_spec_run(Huge, - ets:match_spec_compile( - [{{'$1'}, - [{'>','$1',2475}], - [{{{'*','$1',16#FFFFFFF}}}]}])), - ?line [500,1000,1500,2000,2500] = - ets:match_spec_run(Huge, - ets:match_spec_compile( - [{{'$1'}, - [{'=:=',{'rem','$1',500},0}], - ['$1']}])), + t_match_spec_run_test(Huge, + [{{'$1'}, [{'>','$1',2475}], [{{{'*','$1',16#FFFFFFF}}}]}], + L2), + + t_match_spec_run_test(Huge, [{{'$1'}, [{'=:=',{'rem','$1',500},0}], ['$1']}], + [500,1000,1500,2000,2500]), + + %% More matching fun with several match clauses and guards, + %% applied to a variety of terms. + Fun = fun(Term) -> + CTerm = {const, Term}, + + N_List = [{Term, "0", "v-element"}, + {"=hidden_node", "0", Term}, + {"0", Term, Term}, + {"something", Term, "something else"}, + {"guard and res", Term, 872346}, + {Term, {'and',Term,'again'}, 3.14}, + {Term, {'and',Term,'again'}, "m&g"}, + {Term, {'and',Term,'again'}, "m&g&r"}, + {[{second,Term}, 'and', "tail"], Term, ['and',"tail"]}], + + N_MS = [{{'$1','$2','$3'}, + [{'=:=','$1',CTerm}, {'=:=','$2',{const,"0"}}], + [{{"Guard only for $1",'$3'}}]}, + + {{'$3','$1','$4'}, + [{'=:=','$3',"=hidden_node"}, {'=:=','$1',{const,"0"}}], + [{{"Result only for $4",'$4'}}]}, + + {{'$2','$1','$1'}, + [{'=:=','$2',{const,"0"}}], + [{{"Match only for $1",'$2'}}]}, + + {{'$2',Term,['$3'|'_']}, + [{is_list,'$2'},{'=:=','$3',$s}], + [{{"Matching term",'$2'}}]}, + + {{'$1','$2',872346}, + [{'=:=','$2',CTerm}, {is_list,'$1'}], + [{{"Guard and result",'$2'}}]}, + + {{'$1', {'and','$1','again'}, '$2'}, + [{is_float,'$2'}], + [{{"Match and result",'$1'}}]}, + + {{'$1', {'and','$1','again'}, '$2'}, + [{'=:=','$1',CTerm}, {'=:=', '$2', "m&g"}], + [{{"Match and guard",'$2'}}]}, + + {{'$1', {'and','$1','again'}, "m&g&r"}, + [{'=:=','$1',CTerm}], + [{{"Match, guard and result",'$1'}}]}, + + {{'$1', '$2', '$3'}, + [{'=:=','$1',[{{second,'$2'}} | '$3']}], + [{{"Building guard"}}]} + ], + + N_Result = [{"Guard only for $1", "v-element"}, + {"Result only for $4", Term}, + {"Match only for $1", "0"}, + {"Matching term","something"}, + {"Guard and result",Term}, + {"Match and result",Term}, + {"Match and guard","m&g"}, + {"Match, guard and result",Term}, + {"Building guard"}], + + F = fun(N_MS_Perm) -> + t_match_spec_run_test(N_List, N_MS_Perm, N_Result) + end, + repeat_for_permutations(F, N_MS) + end, + + test_terms(Fun, skip_refc_check), + ?line verify_etsmem(EtsMem). +t_match_spec_run_test(List, MS, Result) -> + + %%io:format("ms = ~p\n",[MS]), + + ?m(Result, ets:match_spec_run(List, ets:match_spec_compile(MS))), + + %% Check that ets:select agree + Tab = ets:new(xxx, [bag]), + ets:insert(Tab, List), + SRes = lists:sort(Result), + ?m(SRes, lists:sort(ets:select(Tab, MS))), + ets:delete(Tab), + + %% Check that tracing agree + Self = self(), + {Tracee, MonRef} = spawn_monitor(fun() -> ms_tracee(Self, List) end), + receive {Tracee, ready} -> ok end, + + MST = lists:map(fun(Clause) -> ms_clause_ets_to_trace(Clause) end, MS), + + %%io:format("MS = ~p\nMST= ~p\n",[MS,MST]), + + erlang:trace_pattern({?MODULE,ms_tracee_dummy,'_'}, MST , [local]), + erlang:trace(Tracee, true, [call]), + Tracee ! start, + TRes = ms_tracer_collect(Tracee, MonRef, []), + %erlang:trace(Tracee, false, [call]), + %Tracee ! stop, + case TRes of + SRes -> ok; + _ -> + io:format("TRACE MATCH FAILED\n"), + io:format("Input = ~p\nMST = ~p\nExpected = ~p\nGot = ~p\n", [List, MST, SRes, TRes]), + ?t:fail("TRACE MATCH FAILED") + end, + ok. + + + +ms_tracer_collect(Tracee, Ref, Acc) -> + receive + {trace, Tracee, call, Args, [Msg]} -> + %io:format("trace Args=~p Msg=~p\n", [Args, Msg]), + ms_tracer_collect(Tracee, Ref, [Msg | Acc]); + + {'DOWN', Ref, process, Tracee, _} -> + %io:format("monitor DOWN for ~p\n", [Tracee]), + TDRef = erlang:trace_delivered(Tracee), + ms_tracer_collect(Tracee, TDRef, Acc); + + {trace_delivered, Tracee, Ref} -> + %%io:format("trace delivered for ~p\n", [Tracee]), + lists:sort(Acc); + + Other -> + io:format("Unexpected message = ~p\n", [Other]), + ?t:fail("Unexpected tracer msg") + end. + + +ms_tracee(Parent, CallArgList) -> + %io:format("ms_tracee ~p started with ArgList = ~p\n", [self(), CallArgList]), + Parent ! {self(), ready}, + receive start -> ok end, + lists:foreach(fun(Args) -> + erlang:apply(?MODULE, ms_tracee_dummy, tuple_to_list(Args)) + end, CallArgList). + %%receive stop -> ok end. + + + +ms_tracee_dummy(_) -> ok. +ms_tracee_dummy(_,_) -> ok. +ms_tracee_dummy(_,_,_) -> ok. +ms_tracee_dummy(_,_,_,_) -> ok. + +ms_clause_ets_to_trace({Head, Guard, Body}) -> + {tuple_to_list(Head), Guard, [{message, Body}]}. + +assert_eq(A,A) -> ok; +assert_eq(A,B) -> + io:format("FAILED MATCH:\n~p\n =/=\n~p\n",[A,B]), + ?t:fail("assert_eq failed"). t_repair_continuation(suite) -> @@ -1427,8 +1581,7 @@ update_element_opts(Tuple,KeyPos,UpdPos,Opts) -> ok. update_element(T,Tuple,KeyPos,UpdPos) -> - KeyList = [Key || Key <- [17,"seventeen",<<"seventeen">>,{17},list_to_binary(lists:seq(1,100)), - make_ref(), self()]], + KeyList = [17,"seventeen",<<"seventeen">>,{17},list_to_binary(lists:seq(1,100)),make_ref(), self()], lists:foreach(fun(Key) -> TupleWithKey = setelement(KeyPos,Tuple,Key), update_element_do(T,TupleWithKey,Key,UpdPos) @@ -1442,6 +1595,8 @@ update_element_do(Tab,Tuple,Key,UpdPos) -> % This will try all combinations of {fromValue,toValue} % % IMPORTANT: size(Values) must be a prime number for this to work!!! + + %io:format("update_element_do for key=~p\n",[Key]), Big32 = 16#12345678, Big64 = 16#123456789abcdef0, Values = { 623, -27, 0, Big32, -Big32, Big64, -Big64, Big32*Big32, @@ -1462,7 +1617,7 @@ update_element_do(Tab,Tuple,Key,UpdPos) -> (ToIx, [], Pos, _Rand, _MeF) -> {Pos, element(ToIx+1,Values)} % single {pos,value} arg end, - + UpdateF = fun(ToIx,Rand) -> PosValArg = PosValArgF(ToIx,[],UpdPos,Rand,PosValArgF), %%io:format("update_element(~p)~n",[PosValArg]), @@ -1589,6 +1744,7 @@ update_counter_for(T) -> (Obj, Times, Arg3, Myself) -> ?line {NewObj, Ret} = uc_mimic(Obj,Arg3), ArgHash = erlang:phash2({T,a,Arg3}), + %%io:format("update_counter(~p, ~p, ~p) expecting ~p\n",[T,a,Arg3,Ret]), ?line Ret = ets:update_counter(T,a,Arg3), ?line ArgHash = erlang:phash2({T,a,Arg3}), %%io:format("NewObj=~p~n ",[NewObj]), @@ -3441,7 +3597,7 @@ firstnext_concurrent(Config) when is_list(Config) -> [dynamic_go() || _ <- lists:seq(1, 2)], receive after 5000 -> ok - end. + end. ets_init(Tab, N) -> ets_new(Tab, [named_table,public,ordered_set]), @@ -4073,7 +4229,7 @@ do_lookup_element(Tab, N, M) -> end. -heavy_concurrent(_Config) -> +heavy_concurrent(Config) when is_list(Config) -> repeat_for_opts(do_heavy_concurrent). do_heavy_concurrent(Opts) -> @@ -5259,7 +5415,7 @@ types_do(Opts) -> ets:delete_all_objects(T), ?line 0 = ets:info(T,size) end, - test_terms(Fun), + test_terms(Fun, strict), ets:delete(T), ?line verify_etsmem(EtsMem). @@ -5503,6 +5659,20 @@ repeat_while(Fun, Arg0) -> {false,Ret} -> Ret end. +%% Some (but not all) permutations of List +repeat_for_permutations(Fun, List) -> + repeat_for_permutations(Fun, List, length(List)-1). +repeat_for_permutations(Fun, List, 0) -> + Fun(List); +repeat_for_permutations(Fun, List, N) -> + {A,B} = lists:split(N, List), + L1 = B++A, + L2 = lists:reverse(L1), + L3 = B++lists:reverse(A), + L4 = lists:reverse(B)++A, + Fun(L1), Fun(L2), Fun(L3), Fun(L4), + repeat_for_permutations(Fun, List, N-1). + receive_any() -> receive M -> io:format("Process ~p got msg ~p\n", [self(),M]), @@ -5560,7 +5730,7 @@ only_if_smp(Schedulers, Func) -> %% Copy-paste from emulator/test/binary_SUITE.erl -define(heap_binary_size, 64). -test_terms(Test_Func) -> +test_terms(Test_Func, Mode) -> garbage_collect(), ?line Pib0 = process_info(self(),binary), @@ -5637,7 +5807,10 @@ test_terms(Test_Func) -> Pib = process_info(self(),binary), ?line Test_Func(Bin3), garbage_collect(), - ?line Pib = process_info(self(),binary), + case Mode of + strict -> ?line Pib = process_info(self(),binary); + skip_refc_check -> ok + end, ?line Test_Func(make_unaligned_sub_binary(Bin0)), ?line Test_Func(make_unaligned_sub_binary(Bin1)), @@ -5681,9 +5854,13 @@ test_terms(Test_Func) -> ?line Test_Func(lists:duplicate(32, FF)), garbage_collect(), - ?line Pib0 = process_info(self(),binary), + case Mode of + strict -> ?line Pib0 = process_info(self(),binary); + skip_refc_check -> ok + end, ok. + id(I) -> I. very_big_num() -> @@ -5715,27 +5892,32 @@ make_ext_ref() -> Ref. init_externals() -> - SysDistSz = ets:info(sys_dist,size), - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {ok, Node} = test_server:start_node(plopp, slave, [{args, " -pa " ++ Pa}]), - ?line Res = case rpc:call(Node, ?MODULE, rpc_externals, []) of - {badrpc, {'EXIT', E}} -> - test_server:fail({rpcresult, E}); - R -> R - end, - ?line test_server:stop_node(Node), - - %% Wait for table 'sys_dist' to stabilize - repeat_while(fun() -> - case ets:info(sys_dist,size) of - SysDistSz -> false; - Sz -> - io:format("Waiting for sys_dist to revert size from ~p to size ~p\n", - [Sz, SysDistSz]), - receive after 1000 -> true end - end - end), - put(externals, Res). + case get(externals) of + undefined -> + SysDistSz = ets:info(sys_dist,size), + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line {ok, Node} = test_server:start_node(plopp, slave, [{args, " -pa " ++ Pa}]), + ?line Res = case rpc:call(Node, ?MODULE, rpc_externals, []) of + {badrpc, {'EXIT', E}} -> + test_server:fail({rpcresult, E}); + R -> R + end, + ?line test_server:stop_node(Node), + + %% Wait for table 'sys_dist' to stabilize + repeat_while(fun() -> + case ets:info(sys_dist,size) of + SysDistSz -> false; + Sz -> + io:format("Waiting for sys_dist to revert size from ~p to size ~p\n", + [Sz, SysDistSz]), + receive after 1000 -> true end + end + end), + put(externals, Res); + + {_,_,_} -> ok + end. rpc_externals() -> {self(), make_port(), make_ref()}. |