diff options
| -rw-r--r-- | erts/emulator/beam/atom.names | 3 | ||||
| -rw-r--r-- | erts/emulator/beam/dist.c | 4 | ||||
| -rw-r--r-- | erts/emulator/beam/erl_alloc.types | 1 | ||||
| -rw-r--r-- | erts/emulator/beam/erl_gc.c | 17 | ||||
| -rw-r--r-- | erts/emulator/beam/erl_process.c | 9 | ||||
| -rw-r--r-- | erts/emulator/beam/erl_process.h | 14 | ||||
| -rw-r--r-- | erts/emulator/beam/erl_zlib.c | 42 | ||||
| -rw-r--r-- | erts/emulator/beam/erl_zlib.h | 8 | ||||
| -rw-r--r-- | erts/emulator/beam/external.c | 1020 | ||||
| -rw-r--r-- | erts/emulator/beam/external.h | 2 | ||||
| -rwxr-xr-x | erts/emulator/beam/global.h | 150 | ||||
| -rw-r--r-- | 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; } |