From 6d366f0ae53669a17de96db0094ef62217b60f1b Mon Sep 17 00:00:00 2001 From: happi Date: Fri, 3 May 2013 16:25:37 +0200 Subject: Make term_to_binary yield (trap). --- erts/emulator/beam/atom.names | 2 + erts/emulator/beam/dist.c | 4 +- erts/emulator/beam/erl_gc.c | 9 + erts/emulator/beam/erl_init.c | 1 + erts/emulator/beam/erl_process.c | 4 + erts/emulator/beam/erl_process.h | 5 + erts/emulator/beam/external.c | 517 +++++++++++++++++++++++++++++---------- erts/emulator/beam/external.h | 2 +- erts/emulator/beam/global.h | 3 + 9 files changed, 414 insertions(+), 133 deletions(-) diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 7d86e486f1..bf1480ea06 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -197,6 +197,7 @@ atom elib_malloc atom emulator atom enable_trace atom enabled +atom enc_term_cont atom endian atom env atom eof @@ -530,6 +531,7 @@ atom system_version atom system_architecture atom SYSTEM='SYSTEM' atom table +atom term_to_binary_of_size atom this atom thread_pool_size atom threads diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 44f4eb9d43..a7b3d4cb2f 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1740,10 +1740,10 @@ dsig_send(ErtsDSigData *dsdp, Eterm ctl, Eterm msg, int force_busy) /* Encode internal version of dist header */ obuf->extp = erts_encode_ext_dist_header_setup(obuf->ext_endp, acmp); /* Encode control message */ - erts_encode_dist_ext(ctl, &obuf->ext_endp, flags, acmp); + erts_encode_dist_ext(c_p, ctl, &obuf->ext_endp, flags, acmp); if (is_value(msg)) { /* Encode message */ - erts_encode_dist_ext(msg, &obuf->ext_endp, flags, acmp); + erts_encode_dist_ext(c_p, msg, &obuf->ext_endp, flags, acmp); } ASSERT(obuf->extp < obuf->ext_endp); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 0d12e658d9..2c219ee87c 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1964,6 +1964,15 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) ++n; } + // Check if a suspended bif has live working data. + // How do we know n is small enough to fit in roots[32?]? + if (p->extra_root != NULL) { + printf("GC with extra_root 0x%xl\n", p->extra_root); + roots[n].v = p->extra_root; + roots[n].sz = p->extra_root_sz; + ++n; + } + ASSERT((is_nil(p->seq_trace_token) || is_tuple(follow_moved(p->seq_trace_token)) || is_atom(p->seq_trace_token))); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index b3a3c3d403..2fb73aed96 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -340,6 +340,7 @@ erl_init(int ncpu, erts_init_bif_binary(); erts_init_bif_re(); erts_init_unicode(); /* after RE to get access to PCRE unicode */ + erts_init_external(); erts_delay_trap = erts_export_put(am_erlang, am_delay_trap, 2); erts_late_init_process(); #if HAVE_ERTS_MSEG diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 88eb224f84..7724033245 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -7513,6 +7513,10 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->heap_sz = sz; p->catches = 0; + p->extra_root = NULL; + p->extra_root_sz = 0; + p->extra_root_allocator = 0; + p->bin_vheap_sz = p->min_vheap_size; p->bin_old_vheap_sz = p->min_vheap_size; p->bin_old_vheap = 0; diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 865ac6c43f..fca83dba8f 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -792,6 +792,11 @@ struct process { ErlMessageQueue msg; /* Message queue */ + Eterm *extra_root; /* Extra root set, used e.g. by yielding bifs. */ + Uint extra_root_sz; /* Size of extra root set. */ + ErtsAlcType_t extra_root_allocator; /* Type of memory allocator used, + used for freeing extra_root if process dies. */ + union { ErtsBifTimer *bif_timers; /* Bif timers aiming at this process */ void *terminate; diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 8420cfae24..c90074528c 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -81,7 +81,52 @@ * */ + +typedef struct { + UWord *start; + Eterm *sp; + UWord *end; + UWord *wsp; + + ErtsAtomCacheMap *acmp; + Eterm obj; + byte *bytes, *ep; + Uint32 dflags; + struct erl_off_heap_header** off_heap; +} enc_work_area; + +#define PRINT_EWA(ewa) \ +do { \ + Uint *_msp = ewa->start; \ + printf("start: 0x%lx\n\r", (Uint)ewa->start); \ + printf("sp: 0x%lx\n\r", (Uint)ewa->sp); \ + printf("end: 0x%lx\n\r", (Uint)ewa->end); \ + printf("wsp: 0x%lx\n\r", (Uint)ewa->wsp); \ + printf("acmp: 0x%lx\n\r", (Uint)ewa->acmp); \ + printf("obj: 0x%lx\n\r", (Uint)ewa->obj); \ + printf("ep: 0x%lx\n\r", (Uint)ewa->ep); \ + printf("bytes: 0x%lx\n\r", (Uint)ewa->bytes); \ + printf("dflags: %d\n\r", (int)ewa->dflags); \ + printf("off_heap: 0x%lx\n\r", (Uint)ewa->off_heap); \ + printf("Estack:"); \ + while(_msp < ewa->sp) printf("0x%lx ",(long int)*_msp++); \ + _msp = ewa->end-1; \ + printf("\n\rWstack:"); \ + while(_msp > ewa->wsp) printf("%d ",(int)*_msp--); \ + printf("\n\r\n\n"); \ +} while(0) + +static Export term_to_binary_trap_export; +static Export enc_term_trap_export; + +static BIF_RETTYPE term_to_binary_of_size_2(BIF_ALIST_2); +static BIF_RETTYPE enc_term_trap_3(BIF_ALIST_3); +static BIF_RETTYPE term_to_binary_of_size(Process *, Eterm, Eterm); +static BIF_RETTYPE enc_term_cont(Process *, Eterm); +static BIF_RETTYPE enc_term_trap(Process *, Eterm, Eterm, Eterm); static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_heap_header** off_heap); +static Eterm erl_enc_term(Process *, ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_heap_header** off_heap, Eterm args, byte* bytes, Eterm bin); +static byte* enc_small(Eterm, byte*); static Uint is_external_string(Eterm obj, int* p_is_string); static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint32); static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32); @@ -90,6 +135,15 @@ static byte* dec_atom(ErtsDistExternal *, byte*, Eterm*); static byte* dec_pid(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*); static Sint decoded_size(byte *ep, byte* endp, int internal_tags); +void erts_init_external(void) { + erts_init_trap_export(&term_to_binary_trap_export, + am_erlang, am_term_to_binary_of_size, 2, + &term_to_binary_of_size_2); + erts_init_trap_export(&enc_term_trap_export, + am_erlang, am_enc_term_cont, 3, + &enc_term_trap_3); + return; +} static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned); @@ -498,18 +552,15 @@ Uint erts_encode_ext_size_ets(Eterm term) } -void erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp) +void erts_encode_dist_ext(Process *p, Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp) { byte *ep = *ext; #ifndef ERTS_DEBUG_USE_DIST_SEP if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) #endif *ep++ = VERSION_MAGIC; + // TODO: handle process arg and scheduling ep = enc_term(acmp, term, ep, flags, NULL); - if (!ep) - erl_exit(ERTS_ABORT_EXIT, - "%s:%d:erts_encode_dist_ext(): Internal data structure error\n", - __FILE__, __LINE__); *ext = ep; } @@ -517,16 +568,17 @@ void erts_encode_ext(Eterm term, byte **ext) { byte *ep = *ext; *ep++ = VERSION_MAGIC; + // TODO: get process pointer from all uses of erts_encode_ext, + // and make them handle yielding. ep = enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS, NULL); - if (!ep) - erl_exit(ERTS_ABORT_EXIT, - "%s:%d:erts_encode_ext(): Internal data structure error\n", - __FILE__, __LINE__); *ext = ep; } byte* erts_encode_ext_ets(Eterm term, byte *ep, struct erl_off_heap_header** off_heap) { + // TODO: get process pointer from all uses of erts_encode_ext_ets, + // and make them handle yielding. + return enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS|DFLAG_INTERNAL_TAGS, off_heap); } @@ -1335,37 +1387,87 @@ external_size_2(BIF_ALIST_2) } } + Eterm erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { Uint size; - Eterm bin; - size_t real_size; - byte* endp; + Eterm options, *hp; + /* Save C-level options in an Erlang over trap. */ size = encode_size_struct2(NULL, Term, flags) + 1 /* VERSION_MAGIC */; + hp = HAlloc(p, 4); /* Size of a 3-tuple */ + options = TUPLE3(hp, make_small(level), make_small(flags), make_small(size)); + + BUMP_REDS(p, (size >> 8)); + if (p->fcalls < 1) { + BIF_TRAP2(&term_to_binary_trap_export, p, Term, options); + } + + return term_to_binary_of_size(p, Term, options); +} + +BIF_RETTYPE term_to_binary_of_size_2(BIF_ALIST_2) +{ + return term_to_binary_of_size(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + + +static BIF_RETTYPE term_to_binary_of_size(Process *p, Eterm arg1, Eterm arg2) +{ + Uint size; + Uint32 flags; + Eterm bin, *ptr; + byte* bytes; + + ptr = tuple_val(arg2); + flags = unsigned_val(ptr[2]); + size = unsigned_val(ptr[3]); + + bin = new_binary(p, (byte *)NULL, size); + bytes = binary_bytes(bin); + bytes[0] = VERSION_MAGIC; + return erl_enc_term(p, NULL, arg1, bytes+1, flags, NULL, arg2, bytes, bin); +} + +static BIF_RETTYPE term_to_binary_cont(Process *p, Eterm res, Eterm args, Eterm bin) +{ + Eterm *ptr; + size_t real_size; + byte *bytes, *endp, *ep; + int level; + Uint size; + enc_work_area *ewa; + Binary *bin2; + + + bin2 = ((ProcBin *) binary_val(res))->val; + ewa = ((enc_work_area *)ERTS_MAGIC_BIN_DATA(bin2)); + ep = ewa->ep; + bytes = ewa->bytes; + if (!ep) + erl_exit(ERTS_ABORT_EXIT, + "%s:%d:enc_term: Internal data structure error\n", + __FILE__, __LINE__); + + ptr = tuple_val(args); + level = signed_val(ptr[1]); + size = unsigned_val(ptr[3]); + + bin2 = ((ProcBin *) binary_val(res))->val; + ewa = ((enc_work_area *)ERTS_MAGIC_BIN_DATA(bin2)); + endp = ewa->ep; + + real_size = endp - bytes; + if (real_size > size) { + erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", + __FILE__, __LINE__, endp - (bytes + size)); + } if (level != 0) { - byte buf[256]; - byte* bytes = buf; byte* out_bytes; uLongf dest_len; - if (sizeof(buf) < size) { - bytes = erts_alloc(ERTS_ALC_T_TMP, size); - } - - if ((endp = enc_term(NULL, Term, bytes, flags, NULL)) - == NULL) { - erl_exit(1, "%s, line %d: bad term: %x\n", - __FILE__, __LINE__, Term); - } - real_size = endp - bytes; - if (real_size > size) { - erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", - __FILE__, __LINE__, real_size - size); - } - /* * We don't want to compress if compression actually increases the size. * Therefore, don't give zlib more out buffer than the size of the @@ -1379,7 +1481,7 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) } else { dest_len = real_size - 5; } - bin = new_binary(p, NULL, real_size+1); + bin = erts_realloc_binary(bin, real_size+1); out_bytes = binary_bytes(bin); out_bytes[0] = VERSION_MAGIC; if (erl_zlib_compress2(out_bytes+6, &dest_len, bytes, real_size, level) != Z_OK) { @@ -1390,30 +1492,47 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) put_int32(real_size, out_bytes+2); bin = erts_realloc_binary(bin, dest_len+6); } - if (bytes != buf) { - erts_free(ERTS_ALC_T_TMP, bytes); - } - return bin; + } else { - byte* bytes; - - bin = new_binary(p, (byte *)NULL, size); - bytes = binary_bytes(bin); - bytes[0] = VERSION_MAGIC; - if ((endp = enc_term(NULL, Term, bytes+1, flags, NULL)) - == NULL) { - erl_exit(1, "%s, line %d: bad term: %x\n", - __FILE__, __LINE__, Term); - } - real_size = endp - bytes; - if (real_size > size) { - erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", - __FILE__, __LINE__, endp - (bytes + size)); - } - return erts_realloc_binary(bin, real_size); + bin = erts_realloc_binary(bin, real_size); + } + return bin; +} + + +static byte* +enc_small(Eterm obj, byte *ep) +{ + Uint n; + Sint val = signed_val(obj); + + if ((Uint)val < 256) { + *ep++ = SMALL_INTEGER_EXT; + put_int8(val, ep); + ep++; + } else if (sizeof(Sint) == 4 || IS_SSMALL32(val)) { + *ep++ = INTEGER_EXT; + put_int32(val, ep); + ep += 4; + } else { + DeclareTmpHeapNoproc(tmp_big,2); + Eterm big; + UseTmpHeapNoproc(2); + big = small_to_big(val, tmp_big); + *ep++ = SMALL_BIG_EXT; + n = big_bytes(big); + ASSERT(n < 256); + put_int8(n, ep); + ep += 1; + *ep++ = big_sign(big); + ep = big_to_bytes(big, ep); + UnUseTmpHeapNoproc(2); } + + return ep; } + /* * This function fills ext with the external format of atom. * If it's an old atom we just supply an index, otherwise @@ -1676,13 +1795,166 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete #define ENC_TERM ((Eterm) 0) #define ENC_ONE_CONS ((Eterm) 1) #define ENC_PATCH_FUN_SIZE ((Eterm) 2) -#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3) +/* While doing term_to_binary we keep two stacks. + One stack contains erlang terms to handle, this stack is passed to the GC + as a root set through process.extra_rootset. + The other stack contains "work orders" (integers (0, 1, or 2)), this stack + the GC can't handle. + Both stacks are stored in one memory area which can be reallocated and + deallocated if the process dies during a yield. + */ +#define ALLOC_EWASTACK(ewa) \ + ewa->start = (Eterm *)erts_alloc(ERTS_ALC_T_ESTACK, DEF_WSTACK_SIZE*sizeof(UWord)*2); \ + ewa->sp = ewa->start; \ + ewa->end = ewa->start + DEF_WSTACK_SIZE*2; \ + ewa->wsp = ewa->end - 1; + + +#define DESTROY_EWASTACK(ewa) \ +do { \ + if(ewa->start != NULL) { \ + erts_free(ERTS_ALC_T_ESTACK, ewa->start); \ + ewa->start=NULL; \ + } \ +} while(0) + +#define GROW_IF_NEEDED(ewa) \ + if (ewa->sp == ewa->wsp) { \ + int size = (ewa->end - ewa->wsp) -1; \ + erl_grow_wstack(&ewa->start, &ewa->sp, &ewa->end); \ + ewa->wsp = ewa->end-1; \ + while(size) *ewa->wsp-- = ewa->sp[size--]; \ + } + +#define EWASTACK_PUSH(ewa, x) \ +do { \ + GROW_IF_NEEDED(ewa) \ + *ewa->sp++ = (x); \ +} while(0) + +#define EWASTACK_WPUSH(ewa, x) \ +do { \ + GROW_IF_NEEDED(ewa) \ + *ewa->wsp-- = (x); \ +} while(0) + +#define EWASTACK_COUNT(ewa) (ewa->sp - ewa->start) +#define EWASTACK_WCOUNT(ewa) (ewa->end - ewa->wsp) +#define EWASTACK_WISEMPTY(ewa) (ewa->wsp == (ewa->end-1)) +#define EWASTACK_POP(ewa) (*(--ewa->sp)) +#define EWASTACK_WPOP(ewa) (*(++ewa->wsp)) + +#define SAVE_TO_EWA \ +do { \ + ewa->acmp = acmp; \ + ewa->obj = obj; \ + ewa->ep = ep; \ + ewa->dflags = dflags; \ + ewa->off_heap = off_heap; \ +} while(0) + +#define GET_FROM_EWA \ +do { \ + acmp = ewa->acmp; \ + obj = ewa->obj; \ + ep = ewa->ep; \ + dflags = ewa->dflags; \ + off_heap = ewa->off_heap; \ +} while(0) + + +static void cleanup_my_data_ttb(Binary *bp) +{ + enc_work_area *ewa; + ewa = (enc_work_area *)ERTS_MAGIC_BIN_DATA(bp); + DESTROY_EWASTACK(ewa); + return; +} + + + +#define SET_UP_EWA \ + bin = erts_create_magic_binary(sizeof(enc_work_area), cleanup_my_data_ttb); \ + ewa = (enc_work_area *)ERTS_MAGIC_BIN_DATA(bin); \ + ALLOC_EWASTACK(ewa);\ + SAVE_TO_EWA; + +#define CHECK_ENC_TERM() \ + if (!ep) \ + erl_exit(ERTS_ABORT_EXIT, \ + "%s:%d:enc_term: Internal data structure error\n", \ + __FILE__, __LINE__); + + +/* Yielding entry point to enc_term. */ +Eterm +erl_enc_term(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, + struct erl_off_heap_header** off_heap, Eterm args, byte* bytes, Eterm resbin) +{ + Eterm *hp, mbin, res; + enc_work_area *ewa; + Binary *bin; + SET_UP_EWA; + ewa->bytes = bytes; + + hp = HAlloc(p, PROC_BIN_SIZE); + mbin = erts_mk_magic_binary_term(&hp, &MSO(p), bin); + + res = enc_term_cont(p, mbin); + if(res == THE_NON_VALUE) { + // Yield + p->extra_root = ewa->start; + p->extra_root_sz = (Uint) EWASTACK_COUNT(ewa); + p->extra_root_allocator = ERTS_ALC_T_ESTACK; + BIF_TRAP3(&enc_term_trap_export, p, mbin, args, resbin); + } + + return term_to_binary_cont(p, res, args, resbin); +} + +BIF_RETTYPE enc_term_trap_3(BIF_ALIST_3) +{ + return enc_term_trap(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +BIF_RETTYPE enc_term_trap(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) +{ + Eterm res; + res = enc_term_cont(p, arg1); + if(res == THE_NON_VALUE) { + // Yield + BIF_TRAP3(&enc_term_trap_export, p, arg1, arg2, arg3); + } + + return term_to_binary_cont(p, res, arg2, arg3); +} + +/* Non-yielding entry point to enc_term */ static byte* enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, struct erl_off_heap_header** off_heap) { - DECLARE_WSTACK(s); + Eterm *buf, *start_buf, mbin, res; + ErlOffHeap fake_off_heap; + enc_work_area *ewa; + Binary *bin; + SET_UP_EWA; + start_buf = buf = (Eterm *) erts_alloc(ERTS_ALC_T_BINARY_BUFFER, PROC_BIN_SIZE); + fake_off_heap.first=NULL; + mbin = erts_mk_magic_binary_term(&buf, &fake_off_heap, bin); + res = enc_term_cont(NULL, mbin); + bin = ((ProcBin *) binary_val(res))->val; + ewa = ((enc_work_area *)ERTS_MAGIC_BIN_DATA(bin)); + ep = ewa->ep; + CHECK_ENC_TERM(); + erts_free(ERTS_ALC_T_BINARY_BUFFER, start_buf); + return ep; +} + + +BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1) +{ Uint n; Uint i; Uint j; @@ -1692,66 +1964,74 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, #if HALFWORD_HEAP UWord wobj; #endif - - - goto L_jump_start; + enc_work_area *ewa; + ErtsAtomCacheMap *acmp; + Eterm obj; + byte* ep; + Uint32 dflags; + struct erl_off_heap_header** off_heap; + + int reds; + Binary *bin = ((ProcBin *) binary_val(arg1))->val; + ewa = (enc_work_area *) ERTS_MAGIC_BIN_DATA(bin); + GET_FROM_EWA; + + /* TODO: We could store the old values in ewa and restore them here... */ + if(p != NULL) { + p->extra_root = NULL; + p->extra_root_sz = 0; + } + reds = (p == NULL) ? 0 : p->fcalls; + if (EWASTACK_WISEMPTY(ewa)) goto L_jump_start; + else goto outer_loop; outer_loop: - while (!WSTACK_ISEMPTY(s)) { + while (!EWASTACK_WISEMPTY(ewa)) { + if ((p != NULL) && (--reds < 1)) { + p->fcalls = reds; + SAVE_TO_EWA; + p->extra_root = ewa->start; + p->extra_root_sz = (Uint) EWASTACK_COUNT(ewa); + p->extra_root_allocator = ERTS_ALC_T_ESTACK; + return THE_NON_VALUE; + } + + switch (val = EWASTACK_WPOP(ewa)) { + case ENC_TERM: #if HALFWORD_HEAP - obj = (Eterm) (wobj = WSTACK_POP(s)); + obj = (Eterm) (wobj = EWASTACK_POP(ewa)); #else - obj = WSTACK_POP(s); + obj = EWASTACK_POP(ewa); #endif - switch (val = WSTACK_POP(s)) { - case ENC_TERM: + break; case ENC_ONE_CONS: encode_one_cons: { - Eterm* cons = list_val(obj); + Eterm* cons; Eterm tl; +#if HALFWORD_HEAP + obj = (Eterm) (wobj = EWASTACK_POP(ewa)); +#else + obj = EWASTACK_POP(ewa); +#endif + cons = list_val(obj); obj = CAR(cons); tl = CDR(cons); - WSTACK_PUSH(s, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); - WSTACK_PUSH(s, tl); + EWASTACK_WPUSH(ewa, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); + EWASTACK_PUSH(ewa, tl); } break; case ENC_PATCH_FUN_SIZE: { -#if HALFWORD_HEAP - byte* size_p = (byte *) wobj; -#else - byte* size_p = (byte *) obj; -#endif + byte* size_p = (byte *) EWASTACK_WPOP(ewa); put_int32(ep - size_p, size_p); } goto outer_loop; - case ENC_LAST_ARRAY_ELEMENT: - { -#if HALFWORD_HEAP - Eterm* ptr = (Eterm *) wobj; -#else - Eterm* ptr = (Eterm *) obj; -#endif - obj = *ptr; - } - break; - default: /* ENC_LAST_ARRAY_ELEMENT+1 and upwards */ - { -#if HALFWORD_HEAP - Eterm* ptr = (Eterm *) wobj; -#else - Eterm* ptr = (Eterm *) obj; -#endif - obj = *ptr++; - WSTACK_PUSH(s, val-1); - WSTACK_PUSH(s, (UWord) ptr); - } - break; } + L_jump_start: switch(tag_val_def(obj)) { case NIL_DEF: @@ -1763,34 +2043,7 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, break; case SMALL_DEF: - { - /* From R14B we no longer restrict INTEGER_EXT to 28 bits, - * as done earlier for backward compatibility reasons. */ - Sint val = signed_val(obj); - - if ((Uint)val < 256) { - *ep++ = SMALL_INTEGER_EXT; - put_int8(val, ep); - ep++; - } else if (sizeof(Sint) == 4 || IS_SSMALL32(val)) { - *ep++ = INTEGER_EXT; - put_int32(val, ep); - ep += 4; - } else { - DeclareTmpHeapNoproc(tmp_big,2); - Eterm big; - UseTmpHeapNoproc(2); - big = small_to_big(val, tmp_big); - *ep++ = SMALL_BIG_EXT; - n = big_bytes(big); - ASSERT(n < 256); - put_int8(n, ep); - ep += 1; - *ep++ = big_sign(big); - ep = big_to_bytes(big, ep); - UnUseTmpHeapNoproc(2); - } - } + ep = enc_small(obj, ep); break; case BIG_DEF: @@ -1877,6 +2130,7 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, *ep++ = LIST_EXT; put_int32(i, ep); ep += 4; + EWASTACK_PUSH(ewa, obj); goto encode_one_cons; } } @@ -1895,9 +2149,10 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, put_int32(i, ep); ep += 4; } - if (i > 0) { - WSTACK_PUSH(s, ENC_LAST_ARRAY_ELEMENT+i-1); - WSTACK_PUSH(s, (UWord) ptr); + while (i > 0) { + EWASTACK_WPUSH(ewa, ENC_TERM); + EWASTACK_PUSH(ewa, (UWord) ptr[i-1]); + i--; } break; @@ -2013,11 +2268,12 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, case EXPORT_DEF: { Export* exp = *((Export **) (export_val(obj) + 1)); + if ((dflags & DFLAG_EXPORT_PTR_TAG) != 0) { *ep++ = EXPORT_EXT; ep = enc_atom(acmp, exp->code[0], ep, dflags); ep = enc_atom(acmp, exp->code[1], ep, dflags); - ep = enc_term(acmp, make_small(exp->code[2]), ep, dflags, off_heap); + ep = enc_small(make_small(exp->code[2]), ep); } else { /* Tag, arity */ *ep++ = SMALL_TUPLE_EXT; @@ -2041,8 +2297,8 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, int ei; *ep++ = NEW_FUN_EXT; - WSTACK_PUSH(s, ENC_PATCH_FUN_SIZE); - WSTACK_PUSH(s, (UWord) ep); /* Position for patching in size */ + EWASTACK_WPUSH(ewa, ENC_PATCH_FUN_SIZE); + EWASTACK_WPUSH(ewa, (UWord) ep); /* Position for patching in size */ ep += 4; *ep = funp->arity; ep += 1; @@ -2053,14 +2309,14 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, put_int32(funp->num_free, ep); ep += 4; ep = enc_atom(acmp, funp->fe->module, ep, dflags); - ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap); - ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap); + ep = enc_small(make_small(funp->fe->old_index), ep); + ep = enc_small(make_small(funp->fe->old_uniq), ep); ep = enc_pid(acmp, funp->creator, ep, dflags); fun_env: for (ei = funp->num_free-1; ei > 0; ei--) { - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) funp->env[ei]); + EWASTACK_WPUSH(ewa, ENC_TERM); + EWASTACK_PUSH(ewa, (UWord) funp->env[ei]); } if (funp->num_free != 0) { obj = funp->env[0]; @@ -2103,8 +2359,9 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, break; } } - DESTROY_WSTACK(s); - return ep; + SAVE_TO_EWA; + // DESTROY_EWASTACK(ewa); + return arg1; } static diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index e37d47919e..cef773374e 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -160,7 +160,7 @@ Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *); byte *erts_encode_ext_dist_header_finalize(byte *, ErtsAtomCache *, Uint32); Uint erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap *); -void erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *); +void erts_encode_dist_ext(Process *, Eterm, byte **, Uint32, ErtsAtomCacheMap *); Uint erts_encode_ext_size(Eterm); Uint erts_encode_ext_size_2(Eterm, unsigned); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index d5e727bcba..af245790d9 100755 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -771,6 +771,9 @@ Sint erts_re_set_loop_limit(Sint limit); void erts_init_bif_binary(void); Sint erts_binary_set_loop_limit(Sint limit); +/* external.c */ +void erts_init_external(void); + /* erl_unicode.c */ void erts_init_unicode(void); Sint erts_unicode_set_loop_limit(Sint limit); -- cgit v1.2.3 From 47d6fd3ccf35a4d921591dd0a9b5e69b9804b5b0 Mon Sep 17 00:00:00 2001 From: Patrik Nyblom Date: Wed, 5 Jun 2013 12:02:11 +0200 Subject: Make all steps ofterm_to_binary work in chunks and yield Rewrite and extend of Happi's initial work Extra_root to process structure to enable GC of state - Changed the process structure to point to a separate struct, the struct also contains a destructor function to allow for proper cleanup. Rewrote encode_size_struct and enc_term to have internal versions with reduction counters which will result in interrupt for later restart when the counter reaches zero - removed the EWA_STACK from Happis version and directly save the ESTACK's and WSTACK's in the above mentioned struct (or array thereof) that are pointed out from the process structure. The destructor will take care of the deallocation in case of process death. Added ESTACK and WSTACK macros to save and restore stack and to change allocator, which makes the previously mentioned stack-save work. Rewrote enc_term to not store pointers on the stack, and use one WSTACK for commands etc and another ESTACK for Eterms - Slightly different than Happis version to make halfword code simpler. Rewrote encode_size_struct2 so that it does not store pointers on the stack, also switched to ESTACK instead of WSTACK, this also handles halfword correctly. Added interfaces for chunkwise compression, that are used from term_to_binary/2 when the compressed option is given. --- erts/emulator/beam/atom.names | 3 +- erts/emulator/beam/dist.c | 4 +- erts/emulator/beam/erl_alloc.types | 1 + erts/emulator/beam/erl_gc.c | 17 +- erts/emulator/beam/erl_process.c | 9 +- erts/emulator/beam/erl_process.h | 14 +- erts/emulator/beam/erl_zlib.c | 42 ++ erts/emulator/beam/erl_zlib.h | 8 + erts/emulator/beam/external.c | 1020 +++++++++++++++++++++--------------- erts/emulator/beam/external.h | 2 +- erts/emulator/beam/global.h | 150 +++++- erts/emulator/beam/utils.c | 12 +- 12 files changed, 824 insertions(+), 458 deletions(-) diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index bf1480ea06..267bcf5209 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -197,7 +197,6 @@ atom elib_malloc atom emulator atom enable_trace atom enabled -atom enc_term_cont atom endian atom env atom eof @@ -531,7 +530,7 @@ atom system_version atom system_architecture atom SYSTEM='SYSTEM' atom table -atom term_to_binary_of_size +atom term_to_binary_trap atom this atom thread_pool_size atom threads diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index a7b3d4cb2f..44f4eb9d43 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1740,10 +1740,10 @@ dsig_send(ErtsDSigData *dsdp, Eterm ctl, Eterm msg, int force_busy) /* Encode internal version of dist header */ obuf->extp = erts_encode_ext_dist_header_setup(obuf->ext_endp, acmp); /* Encode control message */ - erts_encode_dist_ext(c_p, ctl, &obuf->ext_endp, flags, acmp); + erts_encode_dist_ext(ctl, &obuf->ext_endp, flags, acmp); if (is_value(msg)) { /* Encode message */ - erts_encode_dist_ext(c_p, msg, &obuf->ext_endp, flags, acmp); + erts_encode_dist_ext(msg, &obuf->ext_endp, flags, acmp); } ASSERT(obuf->extp < obuf->ext_endp); diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 095ad24387..99ba31e8e5 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -150,6 +150,7 @@ type LINK_LH STANDARD PROCESSES link_lh type SUSPEND_MON STANDARD PROCESSES suspend_monitor type PEND_SUSPEND SHORT_LIVED PROCESSES pending_suspend type PROC_LIST SHORT_LIVED PROCESSES proc_list +type EXTRA_ROOT SHORT_LIVED PROCESSES extra_root type FUN_ENTRY LONG_LIVED CODE fun_entry type ATOM_TXT LONG_LIVED ATOM atom_text type BEAM_REGISTER EHEAP PROCESSES beam_register diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 2c219ee87c..da0f46e556 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1964,15 +1964,20 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) ++n; } - // Check if a suspended bif has live working data. - // How do we know n is small enough to fit in roots[32?]? + /* + * A trapping BIF can add to rootset by setting the extra_root + * in the process_structure. + */ if (p->extra_root != NULL) { - printf("GC with extra_root 0x%xl\n", p->extra_root); - roots[n].v = p->extra_root; - roots[n].sz = p->extra_root_sz; - ++n; +#ifdef HARDDEBUG + erts_fprintf(stderr,"GC with extra root 0x%xl\n", p->extra_root->objv); +#endif + roots[n].v = p->extra_root->objv; + roots[n].sz = p->extra_root->sz; + ++n; } + ASSERT((is_nil(p->seq_trace_token) || is_tuple(follow_moved(p->seq_trace_token)) || is_atom(p->seq_trace_token))); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 7724033245..783a529747 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -7512,10 +7512,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->htop = p->heap; p->heap_sz = sz; p->catches = 0; - p->extra_root = NULL; - p->extra_root_sz = 0; - p->extra_root_allocator = 0; p->bin_vheap_sz = p->min_vheap_size; p->bin_old_vheap_sz = p->min_vheap_size; @@ -8948,6 +8945,12 @@ erts_continue_exit_process(Process *p) if (pbt) erts_free(ERTS_ALC_T_BPD, (void *) pbt); + if (p->extra_root != NULL) { + (p->extra_root->cleanup)(p->extra_root); /* Should deallocate + whole structure */ + p->extra_root = NULL; + } + delete_process(p); #ifdef ERTS_SMP diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index fca83dba8f..56cefc9e7d 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -699,6 +699,14 @@ struct ErtsPendingSuspend_ { #endif + +typedef struct ErlExtraRootSet_ ErlExtraRootSet; +struct ErlExtraRootSet_ { + Eterm *objv; + Uint sz; + void (*cleanup)(ErlExtraRootSet *); +}; + /* Defines to ease the change of memory architecture */ # define HEAP_START(p) (p)->heap # define HEAP_TOP(p) (p)->htop @@ -792,10 +800,7 @@ struct process { ErlMessageQueue msg; /* Message queue */ - Eterm *extra_root; /* Extra root set, used e.g. by yielding bifs. */ - Uint extra_root_sz; /* Size of extra root set. */ - ErtsAlcType_t extra_root_allocator; /* Type of memory allocator used, - used for freeing extra_root if process dies. */ + ErlExtraRootSet *extra_root; /* Used by trapping BIF's */ union { ErtsBifTimer *bif_timers; /* Bif timers aiming at this process */ @@ -1980,6 +1985,7 @@ erts_sched_poke(ErtsSchedulerSleepInfo *ssi) } } + #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ #endif /* #ifdef ERTS_SMP */ diff --git a/erts/emulator/beam/erl_zlib.c b/erts/emulator/beam/erl_zlib.c index f73d48b6c2..c8f29a7ce4 100644 --- a/erts/emulator/beam/erl_zlib.c +++ b/erts/emulator/beam/erl_zlib.c @@ -44,6 +44,48 @@ void erl_zlib_zfree_callback (voidpf opaque, voidpf ptr) erts_free(ERTS_ALC_T_ZLIB, ptr); } +/* + * Initialize a z_stream with a source, to later *chunk* data into a destination + * Returns Z_OK or Error. + */ +int ZEXPORT erl_zlib_deflate_start(z_stream *streamp, const Bytef* source, + uLong sourceLen, int level) +{ + streamp->next_in = (Bytef*)source; + streamp->avail_in = (uInt)sourceLen; + streamp->total_out = streamp->avail_out = 0; + streamp->next_out = NULL; + erl_zlib_alloc_init(streamp); + return deflateInit(streamp, level); +} +/* + * Deflate a chunk, The destination length is the limit. + * Returns Z_OK if more to process, Z_STREAM_END if we are done. + */ +int ZEXPORT erl_zlib_deflate_chunk(z_stream *streamp, Bytef* dest, uLongf* destLen) +{ + int err; + uLongf last_tot = streamp->total_out; + + streamp->next_out = dest; + streamp->avail_out = (uInt)*destLen; + + if ((uLong)streamp->avail_out != *destLen) return Z_BUF_ERROR; + + err = deflate(streamp, Z_FINISH); + *destLen = streamp->total_out - last_tot; + return err; +} + + +/* + * When we are done, free up the deflate structure + * Retyurns Z_OK or Error + */ +int ZEXPORT erl_zlib_deflate_finish(z_stream *streamp) +{ + return deflateEnd(streamp); +} int ZEXPORT erl_zlib_compress2 (Bytef* dest, uLongf* destLen, const Bytef* source, uLong sourceLen, diff --git a/erts/emulator/beam/erl_zlib.h b/erts/emulator/beam/erl_zlib.h index 9054a5e428..eb2e14f585 100644 --- a/erts/emulator/beam/erl_zlib.h +++ b/erts/emulator/beam/erl_zlib.h @@ -31,6 +31,14 @@ (s)->zfree = erl_zlib_zfree_callback; \ } while (0) +/* + * Chunked interface, used by term_to_binary among others. + */ +int ZEXPORT erl_zlib_deflate_start(z_stream *streamp, const Bytef* source, + uLong sourceLen, int level); +int ZEXPORT erl_zlib_deflate_chunk(z_stream *streamp, Bytef* dest, uLongf* destLen); +int ZEXPORT erl_zlib_deflate_finish(z_stream *streamp); + /* Use instead of compress */ #define erl_zlib_compress(dest,destLen,source,sourceLen) \ diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index c90074528c..9e86442f32 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -81,52 +81,11 @@ * */ - -typedef struct { - UWord *start; - Eterm *sp; - UWord *end; - UWord *wsp; - - ErtsAtomCacheMap *acmp; - Eterm obj; - byte *bytes, *ep; - Uint32 dflags; - struct erl_off_heap_header** off_heap; -} enc_work_area; - -#define PRINT_EWA(ewa) \ -do { \ - Uint *_msp = ewa->start; \ - printf("start: 0x%lx\n\r", (Uint)ewa->start); \ - printf("sp: 0x%lx\n\r", (Uint)ewa->sp); \ - printf("end: 0x%lx\n\r", (Uint)ewa->end); \ - printf("wsp: 0x%lx\n\r", (Uint)ewa->wsp); \ - printf("acmp: 0x%lx\n\r", (Uint)ewa->acmp); \ - printf("obj: 0x%lx\n\r", (Uint)ewa->obj); \ - printf("ep: 0x%lx\n\r", (Uint)ewa->ep); \ - printf("bytes: 0x%lx\n\r", (Uint)ewa->bytes); \ - printf("dflags: %d\n\r", (int)ewa->dflags); \ - printf("off_heap: 0x%lx\n\r", (Uint)ewa->off_heap); \ - printf("Estack:"); \ - while(_msp < ewa->sp) printf("0x%lx ",(long int)*_msp++); \ - _msp = ewa->end-1; \ - printf("\n\rWstack:"); \ - while(_msp > ewa->wsp) printf("%d ",(int)*_msp--); \ - printf("\n\r\n\n"); \ -} while(0) - static Export term_to_binary_trap_export; -static Export enc_term_trap_export; -static BIF_RETTYPE term_to_binary_of_size_2(BIF_ALIST_2); -static BIF_RETTYPE enc_term_trap_3(BIF_ALIST_3); -static BIF_RETTYPE term_to_binary_of_size(Process *, Eterm, Eterm); -static BIF_RETTYPE enc_term_cont(Process *, Eterm); -static BIF_RETTYPE enc_term_trap(Process *, Eterm, Eterm, Eterm); static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_heap_header** off_heap); -static Eterm erl_enc_term(Process *, ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_heap_header** off_heap, Eterm args, byte* bytes, Eterm bin); -static byte* enc_small(Eterm, byte*); +static int enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, + struct erl_off_heap_header** off_heap, Sint *reds, byte **res); static Uint is_external_string(Eterm obj, int* p_is_string); static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint32); static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32); @@ -134,19 +93,32 @@ static byte* dec_term(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*); static byte* dec_atom(ErtsDistExternal *, byte*, Eterm*); static byte* dec_pid(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*); static Sint decoded_size(byte *ep, byte* endp, int internal_tags); +static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1); + +static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint flags, + Binary *context_b); + +static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned); +static int encode_size_struct_int(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, + unsigned dflags, Sint *reds, Uint *res); void erts_init_external(void) { - erts_init_trap_export(&term_to_binary_trap_export, - am_erlang, am_term_to_binary_of_size, 2, - &term_to_binary_of_size_2); - erts_init_trap_export(&enc_term_trap_export, - am_erlang, am_enc_term_cont, 3, - &enc_term_trap_3); +#if 1 /* In R16 */ + erts_init_trap_export(&term_to_binary_trap_export, + am_erlang, am_term_to_binary_trap, 1, + &term_to_binary_trap_1); +#else + sys_memset((void *) &term_to_binary_trap_export, 0, sizeof(Export)); + term_to_binary_trap_export.address = &term_to_binary_trap_export.code[3]; + term_to_binary_trap_export.code[0] = am_erlang; + term_to_binary_trap_export.code[1] = am_term_to_binary_trap; + term_to_binary_trap_export.code[2] = 1; + term_to_binary_trap_export.code[3] = (BeamInstr) em_apply_bif; + term_to_binary_trap_export.code[4] = (BeamInstr) &term_to_binary_trap_1; +#endif return; } -static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned); - #define ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES 255 #define ERTS_DIST_HDR_ATOM_CACHE_FLAG_BYTE_IX(IIX) \ @@ -552,15 +524,18 @@ Uint erts_encode_ext_size_ets(Eterm term) } -void erts_encode_dist_ext(Process *p, Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp) +void erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp) { byte *ep = *ext; #ifndef ERTS_DEBUG_USE_DIST_SEP if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) #endif *ep++ = VERSION_MAGIC; - // TODO: handle process arg and scheduling ep = enc_term(acmp, term, ep, flags, NULL); + if (!ep) + erl_exit(ERTS_ABORT_EXIT, + "%s:%d:erts_encode_dist_ext(): Internal data structure error\n", + __FILE__, __LINE__); *ext = ep; } @@ -568,17 +543,16 @@ void erts_encode_ext(Eterm term, byte **ext) { byte *ep = *ext; *ep++ = VERSION_MAGIC; - // TODO: get process pointer from all uses of erts_encode_ext, - // and make them handle yielding. ep = enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS, NULL); + if (!ep) + erl_exit(ERTS_ABORT_EXIT, + "%s:%d:erts_encode_ext(): Internal data structure error\n", + __FILE__, __LINE__); *ext = ep; } byte* erts_encode_ext_ets(Eterm term, byte *ep, struct erl_off_heap_header** off_heap) { - // TODO: get process pointer from all uses of erts_encode_ext_ets, - // and make them handle yielding. - return enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS|DFLAG_INTERNAL_TAGS, off_heap); } @@ -1061,10 +1035,28 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2) BIF_ERROR(BIF_P, BADARG); } - +static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1) +{ + Eterm *tp = tuple_val(BIF_ARG_1); + Eterm Term = tp[1]; + Eterm bt = tp[2]; + Binary *bin = ((ProcBin *) binary_val(bt))->val; + Eterm res = erts_term_to_binary_int(BIF_P, Term, 0, 0,bin); + if (is_tuple(res)) { + BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res); + } else { + BIF_RET(res); + } +} + BIF_RETTYPE term_to_binary_1(BIF_ALIST_1) { - return erts_term_to_binary(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS); + Eterm res = erts_term_to_binary_int(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS, NULL); + if (is_tuple(res)) { + BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res); + } else { + BIF_RET(res); + } } BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) @@ -1074,6 +1066,8 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) Eterm Flags = BIF_ARG_2; int level = 0; Uint flags = TERM_TO_BINARY_DFLAGS; + Eterm res; + Binary *bin = NULL; while (is_list(Flags)) { Eterm arg = CAR(list_val(Flags)); @@ -1110,7 +1104,12 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) goto error; } - return erts_term_to_binary(p, Term, level, flags); + res = erts_term_to_binary_int(p, Term, level, flags, bin); + if (is_tuple(res)) { + BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res); + } else { + BIF_RET(res); + } } static uLongf binary2term_uncomp_size(byte* data, Sint size) @@ -1387,87 +1386,34 @@ external_size_2(BIF_ALIST_2) } } - -Eterm -erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) +static Eterm +erts_term_to_binary_simple(Process* p, Eterm Term, Uint size, int level, Uint flags) { - Uint size; - Eterm options, *hp; - - /* Save C-level options in an Erlang over trap. */ - size = encode_size_struct2(NULL, Term, flags) + 1 /* VERSION_MAGIC */; - hp = HAlloc(p, 4); /* Size of a 3-tuple */ - options = TUPLE3(hp, make_small(level), make_small(flags), make_small(size)); - - BUMP_REDS(p, (size >> 8)); - if (p->fcalls < 1) { - BIF_TRAP2(&term_to_binary_trap_export, p, Term, options); - } - - return term_to_binary_of_size(p, Term, options); -} - -BIF_RETTYPE term_to_binary_of_size_2(BIF_ALIST_2) -{ - return term_to_binary_of_size(BIF_P, BIF_ARG_1, BIF_ARG_2); -} - - -static BIF_RETTYPE term_to_binary_of_size(Process *p, Eterm arg1, Eterm arg2) -{ - Uint size; - Uint32 flags; - Eterm bin, *ptr; - byte* bytes; - - ptr = tuple_val(arg2); - flags = unsigned_val(ptr[2]); - size = unsigned_val(ptr[3]); - - bin = new_binary(p, (byte *)NULL, size); - bytes = binary_bytes(bin); - bytes[0] = VERSION_MAGIC; - return erl_enc_term(p, NULL, arg1, bytes+1, flags, NULL, arg2, bytes, bin); -} - -static BIF_RETTYPE term_to_binary_cont(Process *p, Eterm res, Eterm args, Eterm bin) -{ - Eterm *ptr; + Eterm bin; size_t real_size; - byte *bytes, *endp, *ep; - int level; - Uint size; - enc_work_area *ewa; - Binary *bin2; - - - bin2 = ((ProcBin *) binary_val(res))->val; - ewa = ((enc_work_area *)ERTS_MAGIC_BIN_DATA(bin2)); - ep = ewa->ep; - bytes = ewa->bytes; - if (!ep) - erl_exit(ERTS_ABORT_EXIT, - "%s:%d:enc_term: Internal data structure error\n", - __FILE__, __LINE__); - - ptr = tuple_val(args); - level = signed_val(ptr[1]); - size = unsigned_val(ptr[3]); - - bin2 = ((ProcBin *) binary_val(res))->val; - ewa = ((enc_work_area *)ERTS_MAGIC_BIN_DATA(bin2)); - endp = ewa->ep; - - real_size = endp - bytes; - if (real_size > size) { - erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", - __FILE__, __LINE__, endp - (bytes + size)); - } + byte* endp; if (level != 0) { + byte buf[256]; + byte* bytes = buf; byte* out_bytes; uLongf dest_len; + if (sizeof(buf) < size) { + bytes = erts_alloc(ERTS_ALC_T_TMP, size); + } + + if ((endp = enc_term(NULL, Term, bytes, flags, NULL)) + == NULL) { + erl_exit(1, "%s, line %d: bad term: %x\n", + __FILE__, __LINE__, Term); + } + real_size = endp - bytes; + if (real_size > size) { + erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", + __FILE__, __LINE__, real_size - size); + } + /* * We don't want to compress if compression actually increases the size. * Therefore, don't give zlib more out buffer than the size of the @@ -1481,7 +1427,7 @@ static BIF_RETTYPE term_to_binary_cont(Process *p, Eterm res, Eterm args, Eterm } else { dest_len = real_size - 5; } - bin = erts_realloc_binary(bin, real_size+1); + bin = new_binary(p, NULL, real_size+1); out_bytes = binary_bytes(bin); out_bytes[0] = VERSION_MAGIC; if (erl_zlib_compress2(out_bytes+6, &dest_len, bytes, real_size, level) != Z_OK) { @@ -1492,45 +1438,338 @@ static BIF_RETTYPE term_to_binary_cont(Process *p, Eterm res, Eterm args, Eterm put_int32(real_size, out_bytes+2); bin = erts_realloc_binary(bin, dest_len+6); } - + if (bytes != buf) { + erts_free(ERTS_ALC_T_TMP, bytes); + } + return bin; } else { - bin = erts_realloc_binary(bin, real_size); + byte* bytes; + + bin = new_binary(p, (byte *)NULL, size); + bytes = binary_bytes(bin); + bytes[0] = VERSION_MAGIC; + if ((endp = enc_term(NULL, Term, bytes+1, flags, NULL)) + == NULL) { + erl_exit(1, "%s, line %d: bad term: %x\n", + __FILE__, __LINE__, Term); + } + real_size = endp - bytes; + if (real_size > size) { + erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", + __FILE__, __LINE__, endp - (bytes + size)); + } + return erts_realloc_binary(bin, real_size); } - return bin; } +Eterm +erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { + Uint size; + size = encode_size_struct2(NULL, Term, flags) + 1 /* VERSION_MAGIC */; + return erts_term_to_binary_simple(p, Term, size, level, flags); +} -static byte* -enc_small(Eterm obj, byte *ep) +#define EXTREME_TTB_TRAPPING 1 + +#ifndef EXTREME_TTB_TRAPPING +#define TERM_TO_BINARY_LOOP_FACTOR 10 +#define TERM_TO_BINARY_SIZE_FACTOR 10000 +#define TERM_TO_BINARY_COMPRESS_CHUNK 10000 +#else +#define TERM_TO_BINARY_LOOP_FACTOR 1 +#define TERM_TO_BINARY_SIZE_FACTOR 10 +#define TERM_TO_BINARY_COMPRESS_CHUNK 10 +#endif + + +typedef enum { TTBSize, TTBEncode, TTBCompress } TTBState; +typedef struct { + Uint flags; + int level; +} TTBSizeContext; + +typedef struct { + Uint flags; + int level; + Binary *result_bin; +} TTBEncodeContext; + +typedef struct { + Uint real_size; + Uint dest_len; + byte *dbytes; + Binary *result_bin; + Binary *destination_bin; + z_stream stream; +} TTBCompressContext; + +typedef struct { + int alive; + TTBState state; + union { + TTBSizeContext sc; + TTBEncodeContext ec; + TTBCompressContext cc; + } s; +} TTBContext; + +static void context_destructor(Binary *context_bin) { - Uint n; - Sint val = signed_val(obj); - - if ((Uint)val < 256) { - *ep++ = SMALL_INTEGER_EXT; - put_int8(val, ep); - ep++; - } else if (sizeof(Sint) == 4 || IS_SSMALL32(val)) { - *ep++ = INTEGER_EXT; - put_int32(val, ep); - ep += 4; + TTBContext *context = ERTS_MAGIC_BIN_DATA(context_bin); + if (context->alive) { + context->alive = 0; + switch (context->state) { + case TTBSize: + break; + case TTBEncode: + if (context->s.ec.result_bin != NULL) { /* Set to NULL if ever made alive! */ + ASSERT(erts_refc_read(&(context->s.ec.result_bin->refc),0) == 0); + erts_bin_free(context->s.ec.result_bin); + context->s.ec.result_bin = NULL; + } + break; + case TTBCompress: + erl_zlib_deflate_finish(&(context->s.cc.stream)); + + if (context->s.cc.destination_bin != NULL) { /* Set to NULL if ever made alive! */ + ASSERT(erts_refc_read(&(context->s.cc.destination_bin->refc),0) == 0); + erts_bin_free(context->s.cc.destination_bin); + context->s.cc.destination_bin = NULL; + } + + if (context->s.cc.result_bin != NULL) { /* Set to NULL if ever made alive! */ + ASSERT(erts_refc_read(&(context->s.cc.result_bin->refc),0) == 0); + erts_bin_free(context->s.cc.result_bin); + context->s.cc.result_bin = NULL; + } + break; + } + } +} + +static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint flags, + Binary *context_b) +{ + Eterm *hp; + Eterm res; + Eterm c_term; +#ifndef EXTREME_TTB_TRAPPING + Sint reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); +#else + Sint reds = 20; /* XXX */ +#endif + Sint initial_reds = reds; + TTBContext c_buff; + TTBContext *context = &c_buff; + +#define EXPORT_CONTEXT() \ + do { \ + if (context_b == NULL) { \ + context_b = erts_create_magic_binary(sizeof(TTBContext), \ + context_destructor); \ + context = ERTS_MAGIC_BIN_DATA(context_b); \ + memcpy(context,&c_buff,sizeof(TTBContext)); \ + } \ + } while (0) + +#define RETURN_STATE() \ + do { \ + hp = HAlloc(p, PROC_BIN_SIZE+3); \ + c_term = erts_mk_magic_binary_term(&hp, &MSO(p), context_b); \ + res = TUPLE2(hp, Term, c_term); \ + BUMP_ALL_REDS(p); \ + return res; \ + } while (0); + + + if (context_b == NULL) { + /* Setup enough to get started */ + context->state = TTBSize; + context->alive = 1; + context->s.sc.flags = flags; + context->s.sc.level = level; } else { - DeclareTmpHeapNoproc(tmp_big,2); - Eterm big; - UseTmpHeapNoproc(2); - big = small_to_big(val, tmp_big); - *ep++ = SMALL_BIG_EXT; - n = big_bytes(big); - ASSERT(n < 256); - put_int8(n, ep); - ep += 1; - *ep++ = big_sign(big); - ep = big_to_bytes(big, ep); - UnUseTmpHeapNoproc(2); + context = ERTS_MAGIC_BIN_DATA(context_b); + } + /* Initialization done, now we will go through the states */ + for (;;) { + switch (context->state) { + case TTBSize: + { + Uint size; + Binary *result_bin; + int level; + Uint flags; + /* Try for fast path */ + if (encode_size_struct_int(p, NULL, Term, context->s.sc.flags, &reds, &size) < 0) { + EXPORT_CONTEXT(); + /* Same state */ + RETURN_STATE(); + } + ++size; /* VERSION_MAGIC */ + /* Move these to next state */ + flags = context->s.sc.flags; + level = context->s.sc.level; + if (size <= ERL_ONHEAP_BIN_LIMIT) { + /* Finish in one go */ + res = erts_term_to_binary_simple(p, Term, size, + level, flags); + BUMP_REDS(p, size / TERM_TO_BINARY_SIZE_FACTOR); + return res; + } + + result_bin = erts_bin_nrml_alloc(size); + result_bin->flags = 0; + result_bin->orig_size = size; + erts_refc_init(&result_bin->refc, 0); + result_bin->orig_bytes[0] = VERSION_MAGIC; + /* Next state immediately, no need to export context */ + context->state = TTBEncode; + context->s.ec.flags = flags; + context->s.ec.level = level; + context->s.ec.result_bin = result_bin; + break; + } + case TTBEncode: + { + byte *endp; + byte *bytes = (byte *) context->s.ec.result_bin->orig_bytes; + size_t real_size; + Binary *result_bin; + + flags = context->s.ec.flags; + if (enc_term_int(p,NULL,Term, bytes+1, flags, NULL, &reds, &endp) < 0) { + EXPORT_CONTEXT(); + RETURN_STATE(); + } + real_size = endp - bytes; + result_bin = erts_bin_realloc(context->s.ec.result_bin,real_size); + level = context->s.ec.level; + BUMP_REDS(p, (initial_reds - reds) / TERM_TO_BINARY_LOOP_FACTOR); + if (level == 0 || real_size < 6) { /* We are done */ + ProcBin* pb; + return_normal: + context->s.ec.result_bin = NULL; + context->alive = 0; + pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = real_size; + pb->next = MSO(p).first; + MSO(p).first = (struct erl_off_heap_header*)pb; + pb->val = result_bin; + pb->bytes = (byte*) result_bin->orig_bytes; + pb->flags = 0; + OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); + erts_refc_inc(&result_bin->refc, 1); + return make_binary(pb); + } + /* Continue with compression... */ + /* To make absolutely sure that zlib does not barf on a reallocated context, + we make sure it's "exported" before doing anything compession-like */ + EXPORT_CONTEXT(); + if (erl_zlib_deflate_start(&(context->s.cc.stream),bytes+1,real_size-1,level) + != Z_OK) { + goto return_normal; + } + context->state = TTBCompress; + context->s.cc.real_size = real_size; + context->s.cc.result_bin = result_bin; + + result_bin = erts_bin_nrml_alloc(real_size); + result_bin->flags = 0; + result_bin->orig_size = real_size; + erts_refc_init(&result_bin->refc, 0); + result_bin->orig_bytes[0] = VERSION_MAGIC; + + context->s.cc.destination_bin = result_bin; + context->s.cc.dest_len = 0; + context->s.cc.dbytes = (byte *) result_bin->orig_bytes+6; + break; + } + case TTBCompress: + { + uLongf tot_dest_len = context->s.cc.real_size - 6; + uLongf left = (tot_dest_len - context->s.cc.dest_len); + uLongf this_time = (left > TERM_TO_BINARY_COMPRESS_CHUNK) ? + TERM_TO_BINARY_COMPRESS_CHUNK : + left; + Binary *result_bin; + ProcBin *pb; + Uint max = (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_COMPRESS_CHUNK) / CONTEXT_REDS; + + if (max < this_time) { + this_time = max + 1; /* do not set this_time to 0 */ + } + + res = erl_zlib_deflate_chunk(&(context->s.cc.stream), context->s.cc.dbytes, &this_time); + context->s.cc.dbytes += this_time; + context->s.cc.dest_len += this_time; + switch (res) { + case Z_OK: + if (context->s.cc.dest_len >= tot_dest_len) { + goto no_use_compressing; + } + RETURN_STATE(); + case Z_STREAM_END: + { + byte *dbytes = (byte *) context->s.cc.destination_bin->orig_bytes + 1; + + dbytes[0] = COMPRESSED; + put_int32(context->s.cc.real_size-1,dbytes+1); + erl_zlib_deflate_finish(&(context->s.cc.stream)); + result_bin = erts_bin_realloc(context->s.cc.destination_bin, + context->s.cc.dest_len+6); + context->s.cc.destination_bin = NULL; + pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = context->s.cc.dest_len+6; + pb->next = MSO(p).first; + MSO(p).first = (struct erl_off_heap_header*)pb; + pb->val = result_bin; + pb->bytes = (byte*) result_bin->orig_bytes; + pb->flags = 0; + OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); + erts_refc_inc(&result_bin->refc, 1); + erts_bin_free(context->s.cc.result_bin); + context->s.cc.result_bin = NULL; + context->alive = 0; + BUMP_REDS(p, (this_time * CONTEXT_REDS) / TERM_TO_BINARY_COMPRESS_CHUNK); + return make_binary(pb); + } + default: /* Compression error, revert to uncompressed binary (still in + context) */ + no_use_compressing: + result_bin = context->s.cc.result_bin; + context->s.cc.result_bin = NULL; + pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = context->s.cc.real_size; + pb->next = MSO(p).first; + MSO(p).first = (struct erl_off_heap_header*)pb; + pb->val = result_bin; + pb->bytes = (byte*) result_bin->orig_bytes; + pb->flags = 0; + OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); + erts_refc_inc(&result_bin->refc, 1); + erl_zlib_deflate_finish(&(context->s.cc.stream)); + erts_bin_free(context->s.cc.destination_bin); + context->s.cc.destination_bin = NULL; + context->alive = 0; + BUMP_REDS(p, (this_time * CONTEXT_REDS) / TERM_TO_BINARY_COMPRESS_CHUNK); + return make_binary(pb); + } + } + } } +#undef EXPORT_CONTEXT +#undef RETURN_STATE +} + + + + + - return ep; -} /* @@ -1795,244 +2034,134 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete #define ENC_TERM ((Eterm) 0) #define ENC_ONE_CONS ((Eterm) 1) #define ENC_PATCH_FUN_SIZE ((Eterm) 2) +#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3) -/* While doing term_to_binary we keep two stacks. - One stack contains erlang terms to handle, this stack is passed to the GC - as a root set through process.extra_rootset. - The other stack contains "work orders" (integers (0, 1, or 2)), this stack - the GC can't handle. - Both stacks are stored in one memory area which can be reallocated and - deallocated if the process dies during a yield. - */ -#define ALLOC_EWASTACK(ewa) \ - ewa->start = (Eterm *)erts_alloc(ERTS_ALC_T_ESTACK, DEF_WSTACK_SIZE*sizeof(UWord)*2); \ - ewa->sp = ewa->start; \ - ewa->end = ewa->start + DEF_WSTACK_SIZE*2; \ - ewa->wsp = ewa->end - 1; - - -#define DESTROY_EWASTACK(ewa) \ -do { \ - if(ewa->start != NULL) { \ - erts_free(ERTS_ALC_T_ESTACK, ewa->start); \ - ewa->start=NULL; \ - } \ -} while(0) - -#define GROW_IF_NEEDED(ewa) \ - if (ewa->sp == ewa->wsp) { \ - int size = (ewa->end - ewa->wsp) -1; \ - erl_grow_wstack(&ewa->start, &ewa->sp, &ewa->end); \ - ewa->wsp = ewa->end-1; \ - while(size) *ewa->wsp-- = ewa->sp[size--]; \ - } - -#define EWASTACK_PUSH(ewa, x) \ -do { \ - GROW_IF_NEEDED(ewa) \ - *ewa->sp++ = (x); \ -} while(0) - -#define EWASTACK_WPUSH(ewa, x) \ -do { \ - GROW_IF_NEEDED(ewa) \ - *ewa->wsp-- = (x); \ -} while(0) - -#define EWASTACK_COUNT(ewa) (ewa->sp - ewa->start) -#define EWASTACK_WCOUNT(ewa) (ewa->end - ewa->wsp) -#define EWASTACK_WISEMPTY(ewa) (ewa->wsp == (ewa->end-1)) -#define EWASTACK_POP(ewa) (*(--ewa->sp)) -#define EWASTACK_WPOP(ewa) (*(++ewa->wsp)) - -#define SAVE_TO_EWA \ -do { \ - ewa->acmp = acmp; \ - ewa->obj = obj; \ - ewa->ep = ep; \ - ewa->dflags = dflags; \ - ewa->off_heap = off_heap; \ -} while(0) - -#define GET_FROM_EWA \ -do { \ - acmp = ewa->acmp; \ - obj = ewa->obj; \ - ep = ewa->ep; \ - dflags = ewa->dflags; \ - off_heap = ewa->off_heap; \ -} while(0) - - -static void cleanup_my_data_ttb(Binary *bp) -{ - enc_work_area *ewa; - ewa = (enc_work_area *)ERTS_MAGIC_BIN_DATA(bp); - DESTROY_EWASTACK(ewa); - return; -} - - - -#define SET_UP_EWA \ - bin = erts_create_magic_binary(sizeof(enc_work_area), cleanup_my_data_ttb); \ - ewa = (enc_work_area *)ERTS_MAGIC_BIN_DATA(bin); \ - ALLOC_EWASTACK(ewa);\ - SAVE_TO_EWA; - -#define CHECK_ENC_TERM() \ - if (!ep) \ - erl_exit(ERTS_ABORT_EXIT, \ - "%s:%d:enc_term: Internal data structure error\n", \ - __FILE__, __LINE__); - - -/* Yielding entry point to enc_term. */ -Eterm -erl_enc_term(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, - struct erl_off_heap_header** off_heap, Eterm args, byte* bytes, Eterm resbin) +/* Free extra rootset (used when trapping) */ +static void cleanup_ttb_extra_root(ErlExtraRootSet *rs) { - Eterm *hp, mbin, res; - enc_work_area *ewa; - Binary *bin; - SET_UP_EWA; - ewa->bytes = bytes; - - hp = HAlloc(p, PROC_BIN_SIZE); - mbin = erts_mk_magic_binary_term(&hp, &MSO(p), bin); - - res = enc_term_cont(p, mbin); - if(res == THE_NON_VALUE) { - // Yield - p->extra_root = ewa->start; - p->extra_root_sz = (Uint) EWASTACK_COUNT(ewa); - p->extra_root_allocator = ERTS_ALC_T_ESTACK; - BIF_TRAP3(&enc_term_trap_export, p, mbin, args, resbin); + if (rs->objv != NULL) { + erts_free(ERTS_ALC_T_EXTRA_ROOT, rs->objv); } - - return term_to_binary_cont(p, res, args, resbin); -} - -BIF_RETTYPE enc_term_trap_3(BIF_ALIST_3) -{ - return enc_term_trap(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + erts_free(ERTS_ALC_T_EXTRA_ROOT, rs); } -BIF_RETTYPE enc_term_trap(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) +/* Same as above, but we have an extra "stack" beyond GC reach, i.e. an array of two extra roots */ +static void cleanup_ttb_extra_root_2(ErlExtraRootSet *rs) { - Eterm res; - res = enc_term_cont(p, arg1); - if(res == THE_NON_VALUE) { - // Yield - BIF_TRAP3(&enc_term_trap_export, p, arg1, arg2, arg3); + if (rs->objv != NULL) { + erts_free(ERTS_ALC_T_EXTRA_ROOT, rs->objv); } - - return term_to_binary_cont(p, res, arg2, arg3); + if (rs[1].objv != NULL) { + erts_free(ERTS_ALC_T_EXTRA_ROOT, rs[1].objv); + } + + erts_free(ERTS_ALC_T_EXTRA_ROOT, rs); } -/* Non-yielding entry point to enc_term */ static byte* enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, struct erl_off_heap_header** off_heap) { - Eterm *buf, *start_buf, mbin, res; - ErlOffHeap fake_off_heap; - enc_work_area *ewa; - Binary *bin; - SET_UP_EWA; - start_buf = buf = (Eterm *) erts_alloc(ERTS_ALC_T_BINARY_BUFFER, PROC_BIN_SIZE); - fake_off_heap.first=NULL; - mbin = erts_mk_magic_binary_term(&buf, &fake_off_heap, bin); - res = enc_term_cont(NULL, mbin); - bin = ((ProcBin *) binary_val(res))->val; - ewa = ((enc_work_area *)ERTS_MAGIC_BIN_DATA(bin)); - ep = ewa->ep; - CHECK_ENC_TERM(); - erts_free(ERTS_ALC_T_BINARY_BUFFER, start_buf); - return ep; + byte *res; + (void) enc_term_int(NULL, acmp, obj, ep, dflags, off_heap, NULL, &res); + return res; } - -BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1) +static int +enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, + struct erl_off_heap_header** off_heap, Sint *reds, byte **res) { + DECLARE_ESTACK(s); + DECLARE_WSTACK(com); Uint n; Uint i; Uint j; Uint* ptr; Eterm val; FloatDef f; -#if HALFWORD_HEAP - UWord wobj; -#endif - enc_work_area *ewa; - ErtsAtomCacheMap *acmp; - Eterm obj; - byte* ep; - Uint32 dflags; - struct erl_off_heap_header** off_heap; + int count_reds = (p != NULL && reds != NULL); + Sint r = 0; - int reds; - Binary *bin = ((ProcBin *) binary_val(arg1))->val; - ewa = (enc_work_area *) ERTS_MAGIC_BIN_DATA(bin); - GET_FROM_EWA; + if (count_reds) { + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_EXTRA_ROOT); + WSTACK_CHANGE_ALLOCATOR(com, ERTS_ALC_T_EXTRA_ROOT); + r = *reds; + } - /* TODO: We could store the old values in ewa and restore them here... */ - if(p != NULL) { - p->extra_root = NULL; - p->extra_root_sz = 0; + if (p && p->extra_root) { /* restore saved stacks and byte pointer */ + ESTACK_RESTORE(s,p->extra_root[0].objv, p->extra_root[0].sz); + obj = ESTACK_POP(s); + WSTACK_RESTORE(com, p->extra_root[1].objv, p->extra_root[1].sz); + ep = (byte *) WSTACK_POP(com); } - reds = (p == NULL) ? 0 : p->fcalls; - if (EWASTACK_WISEMPTY(ewa)) goto L_jump_start; - else goto outer_loop; - outer_loop: - while (!EWASTACK_WISEMPTY(ewa)) { - if ((p != NULL) && (--reds < 1)) { - p->fcalls = reds; - SAVE_TO_EWA; - p->extra_root = ewa->start; - p->extra_root_sz = (Uint) EWASTACK_COUNT(ewa); - p->extra_root_allocator = ERTS_ALC_T_ESTACK; - return THE_NON_VALUE; - } + goto L_jump_start; - switch (val = EWASTACK_WPOP(ewa)) { + outer_loop: + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + switch (val = WSTACK_POP(com)) { case ENC_TERM: -#if HALFWORD_HEAP - obj = (Eterm) (wobj = EWASTACK_POP(ewa)); -#else - obj = EWASTACK_POP(ewa); -#endif - break; case ENC_ONE_CONS: encode_one_cons: { - Eterm* cons; + Eterm* cons = list_val(obj); Eterm tl; -#if HALFWORD_HEAP - obj = (Eterm) (wobj = EWASTACK_POP(ewa)); -#else - obj = EWASTACK_POP(ewa); -#endif - cons = list_val(obj); obj = CAR(cons); tl = CDR(cons); - EWASTACK_WPUSH(ewa, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); - EWASTACK_PUSH(ewa, tl); + WSTACK_PUSH(com, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); + ESTACK_PUSH(s, tl); } break; case ENC_PATCH_FUN_SIZE: + /* obj will be discarded, it was NIL */ { - byte* size_p = (byte *) EWASTACK_WPOP(ewa); + byte* size_p = (byte *) WSTACK_POP(com); put_int32(ep - size_p, size_p); } goto outer_loop; + case ENC_LAST_ARRAY_ELEMENT: + /* obj is the tuple */ + { + Eterm* ptr = tuple_val(obj); + i = arityval(*ptr); + obj = ptr[i]; + } + break; + default: /* ENC_LAST_ARRAY_ELEMENT+1 and upwards */ + { + Eterm* ptr = tuple_val(obj); + i = arityval(*ptr); + ESTACK_PUSH(s, obj); /* put back tuple and next element index */ + WSTACK_PUSH(com, val-1); + obj = ptr[i - (val - ENC_LAST_ARRAY_ELEMENT)]; /* the index is counting down */ + } + break; } - L_jump_start: + + if (count_reds && --r == 0) { + *reds = r; + ESTACK_PUSH(s,obj); /* push back current object, to be popped on restore */ + WSTACK_PUSH(com,((UWord) ep)); + if (p->extra_root == NULL) { + /* NB. Allocate an arroy of two "extra-roots", of which only the first element + is seen and handled by the GC. Index 1 holds the Wstack. */ + p->extra_root = erts_alloc(ERTS_ALC_T_EXTRA_ROOT, sizeof(ErlExtraRootSet)*2); + p->extra_root->objv = NULL; + p->extra_root->sz = 0; + p->extra_root->cleanup = cleanup_ttb_extra_root_2; + p->extra_root[1].objv = NULL; + p->extra_root[1].sz = 0; + p->extra_root[1].cleanup = NULL; /* Never used */ + } + ESTACK_SAVE(s, p->extra_root[0].objv, p->extra_root[0].sz); + WSTACK_SAVE(com, p->extra_root[1].objv, (p->extra_root[1].sz)); + return -1; + } switch(tag_val_def(obj)) { case NIL_DEF: *ep++ = NIL_EXT; @@ -2043,7 +2172,34 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1) break; case SMALL_DEF: - ep = enc_small(obj, ep); + { + /* From R14B we no longer restrict INTEGER_EXT to 28 bits, + * as done earlier for backward compatibility reasons. */ + Sint val = signed_val(obj); + + if ((Uint)val < 256) { + *ep++ = SMALL_INTEGER_EXT; + put_int8(val, ep); + ep++; + } else if (sizeof(Sint) == 4 || IS_SSMALL32(val)) { + *ep++ = INTEGER_EXT; + put_int32(val, ep); + ep += 4; + } else { + DeclareTmpHeapNoproc(tmp_big,2); + Eterm big; + UseTmpHeapNoproc(2); + big = small_to_big(val, tmp_big); + *ep++ = SMALL_BIG_EXT; + n = big_bytes(big); + ASSERT(n < 256); + put_int8(n, ep); + ep += 1; + *ep++ = big_sign(big); + ep = big_to_bytes(big, ep); + UnUseTmpHeapNoproc(2); + } + } break; case BIG_DEF: @@ -2130,7 +2286,6 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1) *ep++ = LIST_EXT; put_int32(i, ep); ep += 4; - EWASTACK_PUSH(ewa, obj); goto encode_one_cons; } } @@ -2149,10 +2304,9 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1) put_int32(i, ep); ep += 4; } - while (i > 0) { - EWASTACK_WPUSH(ewa, ENC_TERM); - EWASTACK_PUSH(ewa, (UWord) ptr[i-1]); - i--; + if (i > 0) { + WSTACK_PUSH(com, ENC_LAST_ARRAY_ELEMENT+i-1); + ESTACK_PUSH(s, obj); } break; @@ -2268,12 +2422,11 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1) case EXPORT_DEF: { Export* exp = *((Export **) (export_val(obj) + 1)); - if ((dflags & DFLAG_EXPORT_PTR_TAG) != 0) { *ep++ = EXPORT_EXT; ep = enc_atom(acmp, exp->code[0], ep, dflags); ep = enc_atom(acmp, exp->code[1], ep, dflags); - ep = enc_small(make_small(exp->code[2]), ep); + ep = enc_term(acmp, make_small(exp->code[2]), ep, dflags, off_heap); } else { /* Tag, arity */ *ep++ = SMALL_TUPLE_EXT; @@ -2297,8 +2450,9 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1) int ei; *ep++ = NEW_FUN_EXT; - EWASTACK_WPUSH(ewa, ENC_PATCH_FUN_SIZE); - EWASTACK_WPUSH(ewa, (UWord) ep); /* Position for patching in size */ + WSTACK_PUSH(com, (UWord) ep); /* Position for patching in size */ + WSTACK_PUSH(com, ENC_PATCH_FUN_SIZE); + ESTACK_PUSH(s,NIL); /* Will be thrown away */ ep += 4; *ep = funp->arity; ep += 1; @@ -2309,14 +2463,14 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1) put_int32(funp->num_free, ep); ep += 4; ep = enc_atom(acmp, funp->fe->module, ep, dflags); - ep = enc_small(make_small(funp->fe->old_index), ep); - ep = enc_small(make_small(funp->fe->old_uniq), ep); + ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap); + ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap); ep = enc_pid(acmp, funp->creator, ep, dflags); fun_env: for (ei = funp->num_free-1; ei > 0; ei--) { - EWASTACK_WPUSH(ewa, ENC_TERM); - EWASTACK_PUSH(ewa, (UWord) funp->env[ei]); + WSTACK_PUSH(com, ENC_TERM); + ESTACK_PUSH(s, (UWord) funp->env[ei]); } if (funp->num_free != 0) { obj = funp->env[0]; @@ -2359,9 +2513,17 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1) break; } } - SAVE_TO_EWA; - // DESTROY_EWASTACK(ewa); - return arg1; + DESTROY_ESTACK(s); + DESTROY_WSTACK(com); + if (p && p->extra_root) { + cleanup_ttb_extra_root_2(p->extra_root); + p->extra_root = NULL; + } + if (count_reds) { + *reds = r; + } + *res = ep; + return 0; } static @@ -3149,51 +3311,47 @@ dec_term_atom_common: to a sequence of bytes N.B. That this must agree with to_external2() above!!! (except for cached atoms) */ +static Uint encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) { + Uint res; + (void) encode_size_struct_int(NULL, acmp, obj, dflags, NULL, &res); + return res; +} -static Uint -encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) +static int +encode_size_struct_int(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, + unsigned dflags, Sint *reds, Uint *res) { - DECLARE_WSTACK(s); + DECLARE_ESTACK(s); Uint m, i, arity; Uint result = 0; -#if HALFWORD_HEAP - UWord wobj = 0; -#endif + int count_reds = (p != NULL && reds != 0); + Sint r = 0; + + if (count_reds) { + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_EXTRA_ROOT); + r = *reds; + } + + if (p && p->extra_root) { /* restore saved stack */ + ESTACK_RESTORE(s,p->extra_root->objv, p->extra_root->sz + 1); + result = ESTACK_POP(s); /*Untagged, beyond p->extra_root->sz */ + obj = ESTACK_POP(s); + + } goto L_jump_start; outer_loop: - while (!WSTACK_ISEMPTY(s)) { -#if HALFWORD_HEAP - obj = (Eterm) (wobj = WSTACK_POP(s)); -#else - obj = WSTACK_POP(s); -#endif + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); handle_popped_obj: - if (is_CP(obj)) { /* Does not look for CP, looks for "no tag" */ -#if HALFWORD_HEAP - Eterm* ptr = (Eterm *) wobj; -#else - Eterm* ptr = (Eterm *) obj; -#endif - /* - * Pointer into a tuple. - */ - obj = *ptr--; - if (!is_header(obj)) { - WSTACK_PUSH(s, (UWord)ptr); - } else { - /* Reached tuple header */ - ASSERT(header_is_arityval(obj)); - goto outer_loop; - } - } else if (is_list(obj)) { + if (is_list(obj)) { Eterm* cons = list_val(obj); Eterm tl; tl = CDR(cons); obj = CAR(cons); - WSTACK_PUSH(s, tl); + ESTACK_PUSH(s, tl); } else if (is_nil(obj)) { result++; goto outer_loop; @@ -3205,6 +3363,20 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) } L_jump_start: + if (count_reds && --r == 0) { + *reds = r; + ESTACK_PUSH(s,obj); /* push back current object */ + ESTACK_PUSH(s,result); /* Untagged, will be out of GC reach */ + if (p->extra_root == NULL) { + p->extra_root = erts_alloc(ERTS_ALC_T_EXTRA_ROOT, sizeof(ErlExtraRootSet)); + p->extra_root->objv = NULL; + p->extra_root->sz = 0; + p->extra_root->cleanup = cleanup_ttb_extra_root; + } + ESTACK_SAVE(s, p->extra_root->objv, p->extra_root->sz); + --p->extra_root->sz; /* Hide result from GC */ + return -1; + } switch (tag_val_def(obj)) { case NIL_DEF: result++; @@ -3291,20 +3463,24 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) case TUPLE_DEF: { Eterm* ptr = tuple_val(obj); - + Uint i; arity = arityval(*ptr); if (arity <= 0xff) { result += 1 + 1; } else { result += 1 + 4; } - ptr += arity; -#if HALFWORD_HEAP - obj = (Eterm) (wobj = (UWord) ptr); -#else - obj = (Eterm) ptr; -#endif - goto handle_popped_obj; + for (i = 1; i <= arity; ++i) { + if (is_list(ptr[i])) { + if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) { + result += m + 2 + 1; + } else { + result += 5; + } + } + ESTACK_PUSH(s,ptr[i]); + } + goto outer_loop; } break; case FLOAT_DEF: @@ -3362,14 +3538,14 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) if (is_not_list(obj)) { /* Push any non-list terms on the stack */ - WSTACK_PUSH(s, obj); + ESTACK_PUSH(s, obj); } else { /* Lists must be handled specially. */ if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) { result += m + 2 + 1; } else { result += 5; - WSTACK_PUSH(s, obj); + ESTACK_PUSH(s, obj); } } } @@ -3400,8 +3576,16 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) } } - DESTROY_WSTACK(s); - return result; + DESTROY_ESTACK(s); + if (p && p->extra_root) { + cleanup_ttb_extra_root(p->extra_root); + p->extra_root = NULL; + } + if (count_reds) { + *reds = r; + } + *res = result; + return 0; } static Sint diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index cef773374e..e37d47919e 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -160,7 +160,7 @@ Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *); byte *erts_encode_ext_dist_header_finalize(byte *, ErtsAtomCache *, Uint32); Uint erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap *); -void erts_encode_dist_ext(Process *, Eterm, byte **, Uint32, ErtsAtomCacheMap *); +void erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *); Uint erts_encode_ext_size(Eterm); Uint erts_encode_ext_size_2(Eterm, unsigned); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index af245790d9..02087b4218 100755 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -376,7 +376,7 @@ extern int stackdump_on_exit; */ -void erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end); +void erl_grow_stack(ErtsAlcType_t a_type, Eterm** start, Eterm** sp, Eterm** end); #define ESTK_CONCAT(a,b) a##b #define ESTK_SUBSCRIPT(s,i) *((Eterm *)((byte *)ESTK_CONCAT(s,_start) + (i))) #define DEF_ESTACK_SIZE (16) @@ -385,20 +385,79 @@ void erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end); Eterm ESTK_CONCAT(s,_default_stack)[DEF_ESTACK_SIZE]; \ Eterm* ESTK_CONCAT(s,_start) = ESTK_CONCAT(s,_default_stack); \ Eterm* ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start); \ - Eterm* ESTK_CONCAT(s,_end) = ESTK_CONCAT(s,_start) + DEF_ESTACK_SIZE + Eterm* ESTK_CONCAT(s,_end) = ESTK_CONCAT(s,_start) + DEF_ESTACK_SIZE;\ + ErtsAlcType_t ESTK_CONCAT(s,_alloc_type) = ERTS_ALC_T_ESTACK + +#define ESTACK_CHANGE_ALLOCATOR(s,t) \ +do { \ + if (ESTK_CONCAT(s,_start) != ESTK_CONCAT(s,_default_stack)) { \ + erl_exit(1, "Internal error - trying to change allocator " \ + "type of active estack\n"); \ + } \ + ESTK_CONCAT(s,_alloc_type) = (t); \ + } while (0) + +/* + * Do not free the stack after this, it may have pointers into what + * was saved in 'v'. 'v' and 'vsize' are changed by this macro. If + * 'v' points to anything, it should have been allocated by a previous + * call to this macro. Be careful to set a correct allocator prior to + * saving. + * 'v' can be any lvalue pointer, it will point to an array of UWord + * after calling this macro. + */ +#define ESTACK_SAVE(s,v,vsize) /* v and vsize are "name parameters" */ \ +do { \ + Uint _esz = ESTACK_COUNT(s); \ + if (ESTK_CONCAT(s,_start) == ESTK_CONCAT(s,_default_stack)) { \ + if ((v) == NULL) { \ + (v) = erts_alloc(ESTK_CONCAT(s,_alloc_type), \ + DEF_ESTACK_SIZE * sizeof(Eterm)); \ + } \ + memcpy((v),ESTK_CONCAT(s,_start),_esz*sizeof(Eterm)); \ + } else { \ + (v) = (void *) ESTK_CONCAT(s,_start); \ + } \ + (vsize) = _esz; \ + } while (0) + +/* + * Use on empty stack, only the allocator can be changed before this + * The vector parameter is reset to NULL if the vector is moved to stack, + * otherwise it's kept for reuse, so a saved and restored vector might + * need freeing using the correct allocator parameter. + * 'v' can be any lvalue pointer, it's cast to an (Eterm *). + */ +#define ESTACK_RESTORE(s, v, vsize) /*v is a "name parameter"*/ \ +do { \ + if ((vsize) > DEF_ESTACK_SIZE) { \ + Uint _ca = DEF_ESTACK_SIZE; \ + while (_ca < (vsize)) \ + _ca = _ca * 2; \ + ESTK_CONCAT(s,_start) = (Eterm *) (v); \ + ESTK_CONCAT(s,_end) = ((Eterm *)(v)) + _ca; \ + ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start) + (vsize); \ + (v) = NULL; \ + } else { \ + memcpy(ESTK_CONCAT(s,_start),(v),(vsize)*sizeof(Eterm));\ + ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start) + (vsize); \ + } \ + } while (0) + +#define ESTACK_IS_STATIC(s) (ESTK_CONCAT(s,_start) == ESTK_CONCAT(s,_default_stack)) #define DESTROY_ESTACK(s) \ do { \ if (ESTK_CONCAT(s,_start) != ESTK_CONCAT(s,_default_stack)) { \ - erts_free(ERTS_ALC_T_ESTACK, ESTK_CONCAT(s,_start)); \ + erts_free(ESTK_CONCAT(s,_alloc_type), ESTK_CONCAT(s,_start)); \ } \ } while(0) #define ESTACK_PUSH(s, x) \ do { \ if (ESTK_CONCAT(s,_sp) == ESTK_CONCAT(s,_end)) { \ - erl_grow_stack(&ESTK_CONCAT(s,_start), &ESTK_CONCAT(s,_sp), \ - &ESTK_CONCAT(s,_end)); \ + erl_grow_stack(ESTK_CONCAT(s,_alloc_type),&ESTK_CONCAT(s,_start), \ + &ESTK_CONCAT(s,_sp), &ESTK_CONCAT(s,_end)); \ } \ *ESTK_CONCAT(s,_sp)++ = (x); \ } while(0) @@ -406,8 +465,8 @@ do { \ #define ESTACK_PUSH2(s, x, y) \ do { \ if (ESTK_CONCAT(s,_sp) > ESTK_CONCAT(s,_end) - 2) { \ - erl_grow_stack(&ESTK_CONCAT(s,_start), &ESTK_CONCAT(s,_sp), \ - &ESTK_CONCAT(s,_end)); \ + erl_grow_stack(ESTK_CONCAT(s,_alloc_type),&ESTK_CONCAT(s,_start), \ + &ESTK_CONCAT(s,_sp), &ESTK_CONCAT(s,_end)); \ } \ *ESTK_CONCAT(s,_sp)++ = (x); \ *ESTK_CONCAT(s,_sp)++ = (y); \ @@ -430,7 +489,7 @@ do { \ #define ESTACK_POP(s) (*(--ESTK_CONCAT(s,_sp))) -void erl_grow_wstack(UWord** start, UWord** sp, UWord** end); +void erl_grow_wstack(ErtsAlcType_t a_type, UWord** start, UWord** sp, UWord** end); #define WSTK_CONCAT(a,b) a##b #define WSTK_SUBSCRIPT(s,i) *((UWord *)((byte *)WSTK_CONCAT(s,_start) + (i))) #define DEF_WSTACK_SIZE (16) @@ -439,20 +498,79 @@ void erl_grow_wstack(UWord** start, UWord** sp, UWord** end); UWord WSTK_CONCAT(s,_default_stack)[DEF_WSTACK_SIZE]; \ UWord* WSTK_CONCAT(s,_start) = WSTK_CONCAT(s,_default_stack); \ UWord* WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start); \ - UWord* WSTK_CONCAT(s,_end) = WSTK_CONCAT(s,_start) + DEF_WSTACK_SIZE + UWord* WSTK_CONCAT(s,_end) = WSTK_CONCAT(s,_start) + DEF_WSTACK_SIZE; \ + ErtsAlcType_t WSTK_CONCAT(s,_alloc_type) = ERTS_ALC_T_ESTACK + +#define WSTACK_CHANGE_ALLOCATOR(s,t) \ +do { \ + if (WSTK_CONCAT(s,_start) != WSTK_CONCAT(s,_default_stack)) { \ + erl_exit(1, "Internal error - trying to change allocator " \ + "type of active wstack\n"); \ + } \ + WSTK_CONCAT(s,_alloc_type) = (t); \ + } while (0) #define DESTROY_WSTACK(s) \ do { \ if (WSTK_CONCAT(s,_start) != WSTK_CONCAT(s,_default_stack)) { \ - erts_free(ERTS_ALC_T_ESTACK, WSTK_CONCAT(s,_start)); \ + erts_free(WSTK_CONCAT(s,_alloc_type), WSTK_CONCAT(s,_start)); \ } \ } while(0) +/* + * Do not free the stack after this, it may have pointers into what + * was saved in 'v'. 'v' and 'vsize' are changed by this macro. If + * 'v' points to anything, it should have been allocated by a previous + * call to this macro. Be careful to set a correct allocator prior to + * saving. + * 'v' can be any lvalue pointer, it will point to an array of UWord + * after calling this macro. + */ +#define WSTACK_SAVE(s,v,vsize) /* v and vsize are "name parameters" */ \ +do { \ + Uint _wsz = WSTACK_COUNT(s); \ + if (WSTK_CONCAT(s,_start) == WSTK_CONCAT(s,_default_stack)) { \ + if ((v) == NULL) { \ + (v) = erts_alloc(WSTK_CONCAT(s,_alloc_type), \ + DEF_WSTACK_SIZE * sizeof(UWord)); \ + } \ + memcpy((v),WSTK_CONCAT(s,_start),_wsz*sizeof(UWord)); \ + } else { \ + (v) = (void *) WSTK_CONCAT(s,_start); \ + } \ + (vsize) = _wsz; \ + } while (0) + +/* + * Use on empty stack, only the allocator can be changed before this + * The vector parameter is reset to NULL if the vector is moved to stack, + * otherwise it's kept for reuse, so a saved and restored vector might + * need freeing using the correct allocator parameter. + * 'v' can be any lvalue pointer, it's cast to an (UWord *). + */ +#define WSTACK_RESTORE(s, v, vsize) /*v is a "name parameter"*/ \ +do { \ + if ((vsize) > DEF_WSTACK_SIZE) { \ + Uint _ca = DEF_WSTACK_SIZE; \ + while (_ca < (vsize)) \ + _ca = _ca * 2; \ + WSTK_CONCAT(s,_start) = (UWord *) (v); \ + WSTK_CONCAT(s,_end) = ((UWord *)(v)) + _ca; \ + WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start) + (vsize); \ + (v) = NULL; \ + } else { \ + memcpy(WSTK_CONCAT(s,_start),(v),(vsize)*sizeof(UWord));\ + WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start) + (vsize); \ + } \ + } while (0) + +#define WSTACK_IS_STATIC(s) (WSTK_CONCAT(s,_start) == WSTK_CONCAT(s,_default_stack)) + #define WSTACK_PUSH(s, x) \ do { \ if (WSTK_CONCAT(s,_sp) == WSTK_CONCAT(s,_end)) { \ - erl_grow_wstack(&WSTK_CONCAT(s,_start), &WSTK_CONCAT(s,_sp), \ - &WSTK_CONCAT(s,_end)); \ + erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \ + &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \ } \ *WSTK_CONCAT(s,_sp)++ = (x); \ } while(0) @@ -460,8 +578,8 @@ do { \ #define WSTACK_PUSH2(s, x, y) \ do { \ if (WSTK_CONCAT(s,_sp) > WSTK_CONCAT(s,_end) - 2) { \ - erl_grow_wstack(&WSTK_CONCAT(s,_start), &WSTK_CONCAT(s,_sp), \ - &WSTK_CONCAT(s,_end)); \ + erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \ + &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \ } \ *WSTK_CONCAT(s,_sp)++ = (x); \ *WSTK_CONCAT(s,_sp)++ = (y); \ @@ -470,8 +588,8 @@ do { \ #define WSTACK_PUSH3(s, x, y, z) \ do { \ if (WSTK_CONCAT(s,_sp) > WSTK_CONCAT(s,_end) - 3) { \ - erl_grow_wstack(&WSTK_CONCAT(s,_start), &WSTK_CONCAT(s,_sp), \ - &WSTK_CONCAT(s,_end)); \ + erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \ + &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \ } \ *WSTK_CONCAT(s,_sp)++ = (x); \ *WSTK_CONCAT(s,_sp)++ = (y); \ diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index d5d97d748a..d91ddb7eae 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -185,15 +185,15 @@ erts_set_hole_marker(Eterm* ptr, Uint sz) * Helper function for the ESTACK macros defined in global.h. */ void -erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end) +erl_grow_stack(ErtsAlcType_t a_type, Eterm** start, Eterm** sp, Eterm** end) { Uint old_size = (*end - *start); Uint new_size = old_size * 2; Uint sp_offs = *sp - *start; if (new_size > 2 * DEF_ESTACK_SIZE) { - *start = erts_realloc(ERTS_ALC_T_ESTACK, (void *) *start, new_size*sizeof(Eterm)); + *start = erts_realloc(a_type, (void *) *start, new_size*sizeof(Eterm)); } else { - Eterm* new_ptr = erts_alloc(ERTS_ALC_T_ESTACK, new_size*sizeof(Eterm)); + Eterm* new_ptr = erts_alloc(a_type, new_size*sizeof(Eterm)); sys_memcpy(new_ptr, *start, old_size*sizeof(Eterm)); *start = new_ptr; } @@ -204,15 +204,15 @@ erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end) * Helper function for the ESTACK macros defined in global.h. */ void -erl_grow_wstack(UWord** start, UWord** sp, UWord** end) +erl_grow_wstack(ErtsAlcType_t a_type, UWord** start, UWord** sp, UWord** end) { Uint old_size = (*end - *start); Uint new_size = old_size * 2; Uint sp_offs = *sp - *start; if (new_size > 2 * DEF_ESTACK_SIZE) { - *start = erts_realloc(ERTS_ALC_T_ESTACK, (void *) *start, new_size*sizeof(UWord)); + *start = erts_realloc(a_type, (void *) *start, new_size*sizeof(UWord)); } else { - UWord* new_ptr = erts_alloc(ERTS_ALC_T_ESTACK, new_size*sizeof(UWord)); + UWord* new_ptr = erts_alloc(a_type, new_size*sizeof(UWord)); sys_memcpy(new_ptr, *start, old_size*sizeof(UWord)); *start = new_ptr; } -- cgit v1.2.3 From e967d253c637f599b9f9237b605bc9c066032b41 Mon Sep 17 00:00:00 2001 From: Patrik Nyblom Date: Wed, 5 Jun 2013 18:23:02 +0200 Subject: Teach external.c to handle reallocs before compression --- erts/emulator/beam/external.c | 1 + 1 file changed, 1 insertion(+) diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 9e86442f32..8a1e89afb4 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -1667,6 +1667,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla /* To make absolutely sure that zlib does not barf on a reallocated context, we make sure it's "exported" before doing anything compession-like */ EXPORT_CONTEXT(); + bytes = (byte *) result_bin->orig_bytes; /* result_bin is reallocated */ if (erl_zlib_deflate_start(&(context->s.cc.stream),bytes+1,real_size-1,level) != Z_OK) { goto return_normal; -- cgit v1.2.3 From 2b4707d10b6ea5656242f5ae8506969c921ac841 Mon Sep 17 00:00:00 2001 From: Patrik Nyblom Date: Thu, 6 Jun 2013 08:20:20 +0200 Subject: Teach erl_gc:offset_rootset about extra_root --- erts/emulator/beam/erl_gc.c | 6 ++++++ erts/emulator/beam/external.c | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index da0f46e556..7b463958d2 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -2555,6 +2555,12 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size, p->dictionary->used, offs, area, area_size); } + if (p->extra_root != NULL) { + offset_heap_ptr(p->extra_root->objv, + p->extra_root->sz, + offs, area, area_size); + } + offset_heap_ptr(&p->fvalue, 1, offs, area, area_size); offset_heap_ptr(&p->ftrace, 1, offs, area, area_size); offset_heap_ptr(&p->seq_trace_token, 1, offs, area, area_size); diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 8a1e89afb4..de2aacfa7b 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -2149,7 +2149,7 @@ enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dfla ESTACK_PUSH(s,obj); /* push back current object, to be popped on restore */ WSTACK_PUSH(com,((UWord) ep)); if (p->extra_root == NULL) { - /* NB. Allocate an arroy of two "extra-roots", of which only the first element + /* NB. Allocate an array of two "extra-roots", of which only the first element is seen and handled by the GC. Index 1 holds the Wstack. */ p->extra_root = erts_alloc(ERTS_ALC_T_EXTRA_ROOT, sizeof(ErlExtraRootSet)*2); p->extra_root->objv = NULL; -- cgit v1.2.3 From 6318211b480cec0b74170d4db962e7e9b374f895 Mon Sep 17 00:00:00 2001 From: Patrik Nyblom Date: Mon, 10 Jun 2013 14:48:37 +0200 Subject: term_to_binary: Remove debug code and set production trap levels --- erts/emulator/beam/erl_gc.c | 3 --- erts/emulator/beam/external.c | 11 ++++++----- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 7b463958d2..8ba94d89e9 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1969,9 +1969,6 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) * in the process_structure. */ if (p->extra_root != NULL) { -#ifdef HARDDEBUG - erts_fprintf(stderr,"GC with extra root 0x%xl\n", p->extra_root->objv); -#endif roots[n].v = p->extra_root->objv; roots[n].sz = p->extra_root->sz; ++n; diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index de2aacfa7b..45025ad631 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -1469,12 +1469,13 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { return erts_term_to_binary_simple(p, Term, size, level, flags); } -#define EXTREME_TTB_TRAPPING 1 +/* Define for testing */ +/* #define EXTREME_TTB_TRAPPING 1 */ #ifndef EXTREME_TTB_TRAPPING -#define TERM_TO_BINARY_LOOP_FACTOR 10 -#define TERM_TO_BINARY_SIZE_FACTOR 10000 -#define TERM_TO_BINARY_COMPRESS_CHUNK 10000 +#define TERM_TO_BINARY_LOOP_FACTOR 500 +#define TERM_TO_BINARY_SIZE_FACTOR 500000 +#define TERM_TO_BINARY_COMPRESS_CHUNK 500000 #else #define TERM_TO_BINARY_LOOP_FACTOR 1 #define TERM_TO_BINARY_SIZE_FACTOR 10 @@ -1556,7 +1557,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla #ifndef EXTREME_TTB_TRAPPING Sint reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); #else - Sint reds = 20; /* XXX */ + Sint reds = 20; /* For testing */ #endif Sint initial_reds = reds; TTBContext c_buff; -- cgit v1.2.3 From c013f8b647c29a41f351a91825906861f01d13ca Mon Sep 17 00:00:00 2001 From: Patrik Nyblom Date: Tue, 11 Jun 2013 12:26:28 +0200 Subject: Add testcase to stress extra_root --- erts/emulator/test/binary_SUITE.erl | 38 ++++++++++++++++++++++++++++++++++--- 1 file changed, 35 insertions(+), 3 deletions(-) diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index babdb3363f..1e924a0fee 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -57,10 +57,10 @@ ordering/1,unaligned_order/1,gc_test/1, bit_sized_binary_sizes/1, otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1, - otp_8180/1]). + otp_8180/1, ttb_trap/1]). %% Internal exports. --export([sleeper/0]). +-export([sleeper/0,ttb_loop/2]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,2}}]. @@ -75,7 +75,7 @@ all() -> bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep, - obsolete_funs, robustness, otp_8180]. + obsolete_funs, robustness, otp_8180, ttb_trap]. groups() -> []. @@ -1322,6 +1322,38 @@ run_otp_8180(Name) -> end || Bin <- Bins], ok. +%% Test that exit and GC during term_to_binary trap does not crash. +ttb_trap(Config) when is_list(Config)-> + case erlang:system_info(wordsize) of + N when N < 8 -> + {skipped, "Only on 64bit machines"}; + _ -> + do_ttb_trap(5) + end. + +do_ttb_trap(0) -> + ok; +do_ttb_trap(N) -> + Pid = spawn(?MODULE,ttb_loop,[1000,self()]), + receive ok -> ok end, + receive after 100 -> ok end, + erlang:garbage_collect(Pid), + receive after 100 -> ok end, + exit(Pid,kill), + receive after 1 -> ok end, + do_ttb_trap(N-1). + +ttb_loop(N,Pid) -> + Term = lists:duplicate(2000000,2000000), + Pid ! ok, + ttb_loop2(N,Term). +ttb_loop2(0,_T) -> + ok; +ttb_loop2(N,T) -> + apply(erlang,term_to_binary,[T]), + ttb_loop2(N-1,T). + + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> -- cgit v1.2.3