diff options
45 files changed, 1350 insertions, 854 deletions
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 8142ea8893..11884299e2 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -258,6 +258,7 @@ type MREF_ENT STANDARD SYSTEM magic_ref_entry type MREF_TAB_BKTS STANDARD SYSTEM magic_ref_table_buckets type MREF_TAB LONG_LIVED SYSTEM magic_ref_table type MINDIRECTION FIXED_SIZE SYSTEM magic_indirection +type BINARY_FIND SHORT_LIVED PROCESSES binary_find type THR_Q_EL STANDARD SYSTEM thr_q_element type THR_Q_EL_SL FIXED_SIZE SYSTEM sl_thr_q_element diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index dcffde5777..4cafa499a9 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -171,6 +171,16 @@ static void *my_alloc(MyAllocator *my, Uint size) #define ALPHABET_SIZE 256 +typedef struct _findall_data { + Uint pos; + Uint len; +#ifdef HARDDEBUG + Uint id; +#endif + Eterm epos; + Eterm elen; +} FindallData; + typedef struct _ac_node { #ifdef HARDDEBUG Uint32 id; /* To identify h pointer targets when @@ -208,6 +218,103 @@ typedef struct _bm_data { Sint badshift[ALPHABET_SIZE]; } BMData; +typedef struct _ac_find_all_state { + ACNode *q; + Uint pos; + Uint len; + Uint m; + Uint allocated; + FindallData *out; +} ACFindAllState; + +typedef struct _ac_find_first_state { + ACNode *q; + Uint pos; + Uint len; + ACNode *candidate; + Uint candidate_start; +} ACFindFirstState; + +typedef struct _bm_find_all_state { + Sint pos; + Sint len; + Uint m; + Uint allocated; + FindallData *out; +} BMFindAllState; + +typedef struct _bm_find_first_state { + Sint pos; + Sint len; +} BMFindFirstState; + +typedef enum _bf_return { + BF_RESTART = -3, + BF_NOT_FOUND, + BF_BADARG, + BF_OK +} BFReturn; + +typedef struct _binary_find_all_context { + ErtsHeapFactory factory; + Eterm term; + Sint head; + Sint tail; + Uint end_pos; + Uint size; + FindallData *data; + union { + ACFindAllState ac; + BMFindAllState bm; + } d; +} BinaryFindAllContext; + +typedef struct _binary_find_first_context { + Uint pos; + Uint len; + union { + ACFindFirstState ac; + BMFindFirstState bm; + } d; +} BinaryFindFirstContext; + +typedef struct _binary_find_context BinaryFindContext; + +typedef struct _binary_find_search { + void (*init) (BinaryFindContext *); + BFReturn (*find) (BinaryFindContext *, byte *); + void (*done) (BinaryFindContext *); +} BinaryFindSearch; + +typedef Eterm (*BinaryFindResult)(Process *, Eterm, BinaryFindContext **); + +typedef enum _binary_find_state { + BFSearch, + BFResult, + BFDone +} BinaryFindState; + +struct _binary_find_context { + Eterm pat_type; + Eterm pat_term; + Binary *pat_bin; + Uint flags; + Uint hsstart; + Uint hsend; + int loop_factor; + int exported; + Uint reds; + BinaryFindState state; + Eterm trap_term; + BinaryFindSearch *search; + BinaryFindResult not_found; + BinaryFindResult found; + union { + BinaryFindAllContext fa; + BinaryFindFirstContext ff; + } u; +}; + #ifdef HARDDEBUG static void dump_bm_data(BMData *bm); static void dump_ac_trie(ACTrie *act); @@ -414,32 +521,25 @@ static void ac_compute_failure_functions(ACTrie *act, ACNode **qbuff) * Basic AC finds the first end before the first start... * */ -typedef struct { - ACNode *q; - Uint pos; - Uint len; - ACNode *candidate; - Uint candidate_start; -} ACFindFirstState; - - -static void ac_init_find_first_match(ACFindFirstState *state, ACTrie *act, Sint startpos, Uint len) +static void ac_init_find_first_match(BinaryFindContext *ctx) { + ACFindFirstState *state = &(ctx->u.ff.d.ac); + ACTrie *act = ERTS_MAGIC_BIN_DATA(ctx->pat_bin); state->q = act->root; - state->pos = startpos; - state->len = len; + state->pos = ctx->hsstart; + state->len = ctx->hsend; state->candidate = NULL; state->candidate_start = 0; } -#define AC_OK 0 -#define AC_NOT_FOUND -1 -#define AC_RESTART -2 #define AC_LOOP_FACTOR 10 -static int ac_find_first_match(ACFindFirstState *state, byte *haystack, - Uint *mpos, Uint *mlen, Uint *reductions) +static BFReturn ac_find_first_match(BinaryFindContext *ctx, byte *haystack) { + ACFindFirstState *state = &(ctx->u.ff.d.ac); + Uint *mpos = &(ctx->u.ff.pos); + Uint *mlen = &(ctx->u.ff.len); + Uint *reductions = &(ctx->reds); ACNode *q = state->q; Uint i = state->pos; ACNode *candidate = state->candidate, *r; @@ -455,7 +555,7 @@ static int ac_find_first_match(ACFindFirstState *state, byte *haystack, state->len = len; state->candidate = candidate; state->candidate_start = candidate_start; - return AC_RESTART; + return BF_RESTART; } while (q->g[haystack[i]] == NULL && q->h != q) { @@ -485,68 +585,33 @@ static int ac_find_first_match(ACFindFirstState *state, byte *haystack, } *reductions = reds; if (!candidate) { - return AC_NOT_FOUND; + return BF_NOT_FOUND; } #ifdef HARDDEBUG dump_ac_node(candidate,0,'?'); #endif *mpos = candidate_start; *mlen = candidate->d; - return AC_OK; + return BF_OK; } -typedef struct _findall_data { - Uint pos; - Uint len; -#ifdef HARDDEBUG - Uint id; -#endif - Eterm epos; - Eterm elen; -} FindallData; - -typedef struct { - ACNode *q; - Uint pos; - Uint len; - Uint m; - Uint allocated; - FindallData *out; -} ACFindAllState; - -static void ac_init_find_all(ACFindAllState *state, ACTrie *act, Sint startpos, Uint len) +static void ac_init_find_all(BinaryFindContext *ctx) { + ACFindAllState *state = &(ctx->u.fa.d.ac); + ACTrie *act = ERTS_MAGIC_BIN_DATA(ctx->pat_bin); state->q = act->root; - state->pos = startpos; - state->len = len; + state->pos = ctx->hsstart; + state->len = ctx->hsend; state->m = 0; state->allocated = 0; state->out = NULL; } -static void ac_restore_find_all(ACFindAllState *state, - const ACFindAllState *src) -{ - memcpy(state, src, sizeof(ACFindAllState)); - if (state->allocated > 0) { - state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * (state->allocated)); - memcpy(state->out, src+1, sizeof(FindallData)*state->m); - } else { - state->out = NULL; - } -} - -static void ac_serialize_find_all(const ACFindAllState *state, - ACFindAllState *dst) -{ - memcpy(dst, state, sizeof(ACFindAllState)); - memcpy(dst+1, state->out, sizeof(FindallData)*state->m); -} - -static void ac_clean_find_all(ACFindAllState *state) +static void ac_clean_find_all(BinaryFindContext *ctx) { + ACFindAllState *state = &(ctx->u.fa.d.ac); if (state->out != NULL) { - erts_free(ERTS_ALC_T_TMP, state->out); + erts_free(ERTS_ALC_T_BINARY_FIND, state->out); } #ifdef HARDDEBUG state->out = NULL; @@ -558,9 +623,10 @@ static void ac_clean_find_all(ACFindAllState *state) * Differs to the find_first function in that it stores all matches and the values * arte returned only in the state. */ -static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack, - Uint *reductions) +static BFReturn ac_find_all_non_overlapping(BinaryFindContext *ctx, byte *haystack) { + ACFindAllState *state = &(ctx->u.fa.d.ac); + Uint *reductions = &(ctx->reds); ACNode *q = state->q; Uint i = state->pos; Uint rstart; @@ -571,7 +637,6 @@ static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack, FindallData *out = state->out; register Uint reds = *reductions; - while (i < len) { if (--reds == 0) { state->q = q; @@ -580,7 +645,7 @@ static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack, state->m = m; state->allocated = allocated; state->out = out; - return AC_RESTART; + return BF_RESTART; } while (q->g[haystack[i]] == NULL && q->h != q) { q = q->h; @@ -618,11 +683,11 @@ static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack, if (m >= allocated) { if (!allocated) { allocated = 10; - out = erts_alloc(ERTS_ALC_T_TMP, + out = erts_alloc(ERTS_ALC_T_BINARY_FIND, sizeof(FindallData) * allocated); } else { allocated *= 2; - out = erts_realloc(ERTS_ALC_T_TMP, out, + out = erts_realloc(ERTS_ALC_T_BINARY_FIND, out, sizeof(FindallData) * allocated); } @@ -649,7 +714,7 @@ static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack, *reductions = reds; state->m = m; state->out = out; - return (m == 0) ? AC_NOT_FOUND : AC_OK; + return (m == 0) ? BF_NOT_FOUND : BF_OK; } /* @@ -736,27 +801,22 @@ static void compute_goodshifts(BMData *bmd) erts_free(ERTS_ALC_T_TMP, suffixes); } -typedef struct { - Sint pos; - Sint len; -} BMFindFirstState; - -#define BM_OK 0 /* used only for find_all */ -#define BM_NOT_FOUND -1 -#define BM_RESTART -2 #define BM_LOOP_FACTOR 10 /* Should we have a higher value? */ -static void bm_init_find_first_match(BMFindFirstState *state, Sint startpos, - Uint len) +static void bm_init_find_first_match(BinaryFindContext *ctx) { - state->pos = startpos; - state->len = (Sint) len; + BMFindFirstState *state = &(ctx->u.ff.d.bm); + state->pos = ctx->hsstart; + state->len = ctx->hsend; } - -static Sint bm_find_first_match(BMFindFirstState *state, BMData *bmd, - byte *haystack, Uint *reductions) +static BFReturn bm_find_first_match(BinaryFindContext *ctx, byte *haystack) { + BMFindFirstState *state = &(ctx->u.ff.d.bm); + BMData *bmd = ERTS_MAGIC_BIN_DATA(ctx->pat_bin); + Uint *mpos = &(ctx->u.ff.pos); + Uint *mlen = &(ctx->u.ff.len); + Uint *reductions = &(ctx->reds); Sint blen = bmd->len; Sint len = state->len; Sint *gs = bmd->goodshift; @@ -769,61 +829,37 @@ static Sint bm_find_first_match(BMFindFirstState *state, BMData *bmd, while (j <= len - blen) { if (--reds == 0) { state->pos = j; - return BM_RESTART; + return BF_RESTART; } for (i = blen - 1; i >= 0 && needle[i] == haystack[i + j]; --i) ; if (i < 0) { /* found */ *reductions = reds; - return j; + *mpos = (Uint) j; + *mlen = (Uint) blen; + return BF_OK; } j += MAX(gs[i],bs[haystack[i+j]] - blen + 1 + i); } *reductions = reds; - return BM_NOT_FOUND; + return BF_NOT_FOUND; } -typedef struct { - Sint pos; - Sint len; - Uint m; - Uint allocated; - FindallData *out; -} BMFindAllState; - -static void bm_init_find_all(BMFindAllState *state, Sint startpos, Uint len) +static void bm_init_find_all(BinaryFindContext *ctx) { - state->pos = startpos; - state->len = (Sint) len; + BMFindAllState *state = &(ctx->u.fa.d.bm); + state->pos = ctx->hsstart; + state->len = ctx->hsend; state->m = 0; state->allocated = 0; state->out = NULL; } -static void bm_restore_find_all(BMFindAllState *state, - const BMFindAllState *src) -{ - memcpy(state, src, sizeof(BMFindAllState)); - if (state->allocated > 0) { - state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * - (state->allocated)); - memcpy(state->out, src+1, sizeof(FindallData)*state->m); - } else { - state->out = NULL; - } -} - -static void bm_serialize_find_all(const BMFindAllState *state, - BMFindAllState *dst) -{ - memcpy(dst, state, sizeof(BMFindAllState)); - memcpy(dst+1, state->out, sizeof(FindallData)*state->m); -} - -static void bm_clean_find_all(BMFindAllState *state) +static void bm_clean_find_all(BinaryFindContext *ctx) { + BMFindAllState *state = &(ctx->u.fa.d.bm); if (state->out != NULL) { - erts_free(ERTS_ALC_T_TMP, state->out); + erts_free(ERTS_ALC_T_BINARY_FIND, state->out); } #ifdef HARDDEBUG state->out = NULL; @@ -835,10 +871,11 @@ static void bm_clean_find_all(BMFindAllState *state) * Differs to the find_first function in that it stores all matches and the * values are returned only in the state. */ -static Sint bm_find_all_non_overlapping(BMFindAllState *state, - BMData *bmd, byte *haystack, - Uint *reductions) +static BFReturn bm_find_all_non_overlapping(BinaryFindContext *ctx, byte *haystack) { + BMFindAllState *state = &(ctx->u.fa.d.bm); + BMData *bmd = ERTS_MAGIC_BIN_DATA(ctx->pat_bin); + Uint *reductions = &(ctx->reds); Sint blen = bmd->len; Sint len = state->len; Sint *gs = bmd->goodshift; @@ -857,7 +894,7 @@ static Sint bm_find_all_non_overlapping(BMFindAllState *state, state->m = m; state->allocated = allocated; state->out = out; - return BM_RESTART; + return BF_RESTART; } for (i = blen - 1; i >= 0 && needle[i] == haystack[i + j]; --i) ; @@ -865,10 +902,11 @@ static Sint bm_find_all_non_overlapping(BMFindAllState *state, if (m >= allocated) { if (!allocated) { allocated = 10; - out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * allocated); + out = erts_alloc(ERTS_ALC_T_BINARY_FIND, + sizeof(FindallData) * allocated); } else { allocated *= 2; - out = erts_realloc(ERTS_ALC_T_TMP, out, + out = erts_realloc(ERTS_ALC_T_BINARY_FIND, out, sizeof(FindallData) * allocated); } } @@ -883,7 +921,7 @@ static Sint bm_find_all_non_overlapping(BMFindAllState *state, state->m = m; state->out = out; *reductions = reds; - return (m == 0) ? BM_NOT_FOUND : BM_OK; + return (m == 0) ? BF_NOT_FOUND : BF_OK; } /* @@ -1009,51 +1047,160 @@ BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1) BIF_RET(ret); } -#define DO_BIN_MATCH_OK 0 -#define DO_BIN_MATCH_BADARG -1 -#define DO_BIN_MATCH_RESTART -2 +#define BF_FLAG_GLOBAL 0x01 +#define BF_FLAG_SPLIT_TRIM 0x02 +#define BF_FLAG_SPLIT_TRIM_ALL 0x04 -#define BINARY_FIND_ALL 0x01 -#define BINARY_SPLIT_TRIM 0x02 -#define BINARY_SPLIT_TRIM_ALL 0x04 +static void bf_context_init(BinaryFindContext *ctx, BinaryFindResult not_found, + BinaryFindResult single, BinaryFindResult global, + Binary *pat_bin); +static BinaryFindContext *bf_context_export(Process *p, BinaryFindContext *src); +static int bf_context_destructor(Binary *ctx_bin); +#ifdef HARDDEBUG +static void bf_context_dump(BinaryFindContext *ctx); +#endif -typedef struct BinaryFindState { - Eterm type; - Uint flags; - Uint hsstart; - Uint hsend; - Eterm (*not_found_result) (Process *, Eterm, struct BinaryFindState *); - Eterm (*single_result) (Process *, Eterm, struct BinaryFindState *, Sint, Sint); - Eterm (*global_result) (Process *, Eterm, struct BinaryFindState *, FindallData *, Uint); -} BinaryFindState; +static BinaryFindSearch bf_search_ac_global = { + ac_init_find_all, + ac_find_all_non_overlapping, + ac_clean_find_all +}; + +static BinaryFindSearch bf_search_ac_single = { + ac_init_find_first_match, + ac_find_first_match, + NULL +}; + +static BinaryFindSearch bf_search_bm_global = { + bm_init_find_all, + bm_find_all_non_overlapping, + bm_clean_find_all +}; + +static BinaryFindSearch bf_search_bm_single = { + bm_init_find_first_match, + bm_find_first_match, + NULL +}; + +static void bf_context_init(BinaryFindContext *ctx, BinaryFindResult not_found, + BinaryFindResult single, BinaryFindResult global, + Binary *pat_bin) +{ + ctx->exported = 0; + ctx->state = BFSearch; + ctx->not_found = not_found; + if (ctx->flags & BF_FLAG_GLOBAL) { + ctx->found = global; + if (ctx->pat_type == am_bm) { + ctx->search = &bf_search_bm_global; + ctx->loop_factor = BM_LOOP_FACTOR; + } else if (ctx->pat_type == am_ac) { + ctx->search = &bf_search_ac_global; + ctx->loop_factor = AC_LOOP_FACTOR; + } + } else { + ctx->found = single; + if (ctx->pat_type == am_bm) { + ctx->search = &bf_search_bm_single; + ctx->loop_factor = BM_LOOP_FACTOR; + } else if (ctx->pat_type == am_ac) { + ctx->search = &bf_search_ac_single; + ctx->loop_factor = AC_LOOP_FACTOR; + } + } + ctx->trap_term = THE_NON_VALUE; + ctx->pat_bin = pat_bin; + ctx->search->init(ctx); +} -typedef struct BinaryFindState_bignum { - Eterm bignum_hdr; - BinaryFindState bfs; - union { - BMFindFirstState bmffs; - BMFindAllState bmfas; - ACFindFirstState acffs; - ACFindAllState acfas; - } data; -} BinaryFindState_bignum; - -#define SIZEOF_BINARY_FIND_STATE(S) \ - (sizeof(BinaryFindState)+sizeof(S)) - -#define SIZEOF_BINARY_FIND_ALL_STATE(S) \ - (sizeof(BinaryFindState)+sizeof(S)+(sizeof(FindallData)*(S).m)) - -static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs); -static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs, - Sint pos, Sint len); -static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindState *bfs, - FindallData *fad, Uint fad_sz); -static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs); -static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *bfs, - Sint pos, Sint len); -static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs, - FindallData *fad, Uint fad_sz); +static BinaryFindContext *bf_context_export(Process *p, BinaryFindContext *src) +{ + Binary *ctx_bin; + BinaryFindContext *ctx; + Eterm *hp; + + ASSERT(src->exported == 0); + ctx_bin = erts_create_magic_binary(sizeof(BinaryFindContext), + bf_context_destructor); + ctx = ERTS_MAGIC_BIN_DATA(ctx_bin); + sys_memcpy(ctx, src, sizeof(BinaryFindContext)); + if (ctx->pat_bin != NULL && ctx->pat_term == THE_NON_VALUE) { + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE * 2); + ctx->pat_term = erts_mk_magic_ref(&hp, &MSO(p), ctx->pat_bin); + } else { + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + } + ctx->trap_term = erts_mk_magic_ref(&hp, &MSO(p), ctx_bin); + ctx->exported = 1; + return ctx; +} + +static int bf_context_destructor(Binary *ctx_bin) +{ + BinaryFindContext *ctx; + + ctx = ERTS_MAGIC_BIN_DATA(ctx_bin); + if (ctx->state != BFDone) { + if (ctx->search->done != NULL) { + ctx->search->done(ctx); + } + ctx->state = BFDone; + } + return 1; +} + +#ifdef HARDDEBUG +static void bf_context_dump(BinaryFindContext *ctx) +{ + if (ctx->pat_type == am_bm) { + BMData *bm; + bm = ERTS_MAGIC_BIN_DATA(ctx->pat_bin); + dump_bm_data(bm); + } else { + ACTrie *act; + act = ERTS_MAGIC_BIN_DATA(ctx->pat_bin); + dump_ac_trie(act); + } +} +#endif + +static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindContext **ctxp); +static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindContext **ctxp); +static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindContext **ctxp); +static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindContext **ctxp); +static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindContext **ctxp); +static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindContext **ctxp); + +static BFReturn maybe_binary_match_compile(BinaryFindContext *ctx, Eterm arg, Binary **pat_bin) +{ + Eterm *tp; + ctx->pat_term = THE_NON_VALUE; + if (is_tuple(arg)) { + tp = tuple_val(arg); + if (arityval(*tp) != 2 || is_not_atom(tp[1])) { + return BF_BADARG; + } + if (((tp[1] != am_bm) && (tp[1] != am_ac)) || + !is_internal_magic_ref(tp[2])) { + return BF_BADARG; + } + *pat_bin = erts_magic_ref2bin(tp[2]); + if ((tp[1] == am_bm && + ERTS_MAGIC_BIN_DESTRUCTOR(*pat_bin) != cleanup_my_data_bm) || + (tp[1] == am_ac && + ERTS_MAGIC_BIN_DESTRUCTOR(*pat_bin) != cleanup_my_data_ac)) { + *pat_bin = NULL; + return BF_BADARG; + } + ctx->pat_type = tp[1]; + ctx->pat_term = tp[2]; + } else if (do_binary_match_compile(arg, &(ctx->pat_type), pat_bin) != 0) { + return BF_BADARG; + } + return BF_OK; +} static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp) { @@ -1134,17 +1281,17 @@ static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uin Uint orig_size; if (is_atom(t)) { if (t == am_global) { - *optp |= BINARY_FIND_ALL; + *optp |= BF_FLAG_GLOBAL; l = CDR(list_val(l)); continue; } if (t == am_trim) { - *optp |= BINARY_SPLIT_TRIM; + *optp |= BF_FLAG_SPLIT_TRIM; l = CDR(list_val(l)); continue; } if (t == am_trim_all) { - *optp |= BINARY_SPLIT_TRIM_ALL; + *optp |= BF_FLAG_SPLIT_TRIM_ALL; l = CDR(list_val(l)); continue; } @@ -1197,266 +1344,160 @@ static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uin } } -static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binary *bin, - Eterm state_term, Eterm *res_term) +static BFReturn do_binary_find(Process *p, Eterm subject, BinaryFindContext **ctxp, + Binary *pat_bin, Binary *ctx_bin, Eterm *res_term) { - byte *bytes; - Uint bitoffs, bitsize; - byte *temp_alloc = NULL; - BinaryFindState_bignum *state_ptr = NULL; + BinaryFindContext *ctx; + int is_first_call; + Uint initial_reds; + BFReturn runres; - ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize); - if (bitsize != 0) { - goto badarg; - } - if (bitoffs != 0) { - bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc); - } - if (state_term != NIL) { - state_ptr = (BinaryFindState_bignum *)(big_val(state_term)); - bfs = &(state_ptr->bfs); + if (ctx_bin == NULL) { + is_first_call = 1; + ctx = *ctxp; + } else { + is_first_call = 0; + ctx = ERTS_MAGIC_BIN_DATA(ctx_bin); + ctx->pat_bin = pat_bin; + *ctxp = ctx; } - if (bfs->flags & BINARY_FIND_ALL) { - if (bfs->type == am_bm) { - BMData *bm; - Sint pos; - BMFindAllState state; - Uint reds = get_reds(p, BM_LOOP_FACTOR); - Uint save_reds = reds; + initial_reds = ctx->reds = get_reds(p, ctx->loop_factor); - bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin); -#ifdef HARDDEBUG - dump_bm_data(bm); -#endif - if (state_term == NIL) { - bm_init_find_all(&state, bfs->hsstart, bfs->hsend); - } else { - bm_restore_find_all(&state, &(state_ptr->data.bmfas)); - } + switch (ctx->state) { + case BFSearch: { + byte *bytes; + Uint bitoffs, bitsize; + byte *temp_alloc = NULL; - pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds); - if (pos == BM_NOT_FOUND) { - *res_term = bfs->not_found_result(p, subject, bfs); - } else if (pos == BM_RESTART) { - int x = - (SIZEOF_BINARY_FIND_ALL_STATE(state) / sizeof(Eterm)) + - !!(SIZEOF_BINARY_FIND_ALL_STATE(state) % sizeof(Eterm)); -#ifdef HARDDEBUG - erts_printf("Trap bm!\n"); -#endif - state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1); - state_ptr->bignum_hdr = make_pos_bignum_header(x); - memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState)); - bm_serialize_find_all(&state, &state_ptr->data.bmfas); - *res_term = make_big(&state_ptr->bignum_hdr); - erts_free_aligned_binary_bytes(temp_alloc); - bm_clean_find_all(&state); - return DO_BIN_MATCH_RESTART; - } else { - *res_term = bfs->global_result(p, subject, bfs, state.out, state.m); - } - erts_free_aligned_binary_bytes(temp_alloc); - bm_clean_find_all(&state); - BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR); - return DO_BIN_MATCH_OK; - } else if (bfs->type == am_ac) { - ACTrie *act; - int acr; - ACFindAllState state; - Uint reds = get_reds(p, AC_LOOP_FACTOR); - Uint save_reds = reds; - - act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin); + ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize); + if (bitsize != 0) { + goto badarg; + } + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc); + } #ifdef HARDDEBUG - dump_ac_trie(act); + bf_context_dump(ctx); #endif - if (state_term == NIL) { - ac_init_find_all(&state, act, bfs->hsstart, bfs->hsend); - } else { - ac_restore_find_all(&state, &(state_ptr->data.acfas)); - } - acr = ac_find_all_non_overlapping(&state, bytes, &reds); - if (acr == AC_NOT_FOUND) { - *res_term = bfs->not_found_result(p, subject, bfs); - } else if (acr == AC_RESTART) { - int x = - (SIZEOF_BINARY_FIND_ALL_STATE(state) / sizeof(Eterm)) + - !!(SIZEOF_BINARY_FIND_ALL_STATE(state) % sizeof(Eterm)); + runres = ctx->search->find(ctx, bytes); + if (runres == BF_NOT_FOUND) { + *res_term = ctx->not_found(p, subject, &ctx); + *ctxp = ctx; + } else if (runres == BF_RESTART) { #ifdef HARDDEBUG + if (ctx->pat_type == am_ac) { erts_printf("Trap ac!\n"); -#endif - state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1); - state_ptr->bignum_hdr = make_pos_bignum_header(x); - memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState)); - ac_serialize_find_all(&state, &state_ptr->data.acfas); - *res_term = make_big(&state_ptr->bignum_hdr); - erts_free_aligned_binary_bytes(temp_alloc); - ac_clean_find_all(&state); - return DO_BIN_MATCH_RESTART; - } else { - *res_term = bfs->global_result(p, subject, bfs, state.out, state.m); - } - erts_free_aligned_binary_bytes(temp_alloc); - ac_clean_find_all(&state); - BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR); - return DO_BIN_MATCH_OK; - } - } else { - if (bfs->type == am_bm) { - BMData *bm; - Sint pos; - BMFindFirstState state; - Uint reds = get_reds(p, BM_LOOP_FACTOR); - Uint save_reds = reds; - - bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin); -#ifdef HARDDEBUG - dump_bm_data(bm); -#endif - if (state_term == NIL) { - bm_init_find_first_match(&state, bfs->hsstart, bfs->hsend); } else { - memcpy(&state, &state_ptr->data.bmffs, sizeof(BMFindFirstState)); - } - -#ifdef HARDDEBUG - erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos, - state.len); -#endif - pos = bm_find_first_match(&state, bm, bytes, &reds); - if (pos == BM_NOT_FOUND) { - *res_term = bfs->not_found_result(p, subject, bfs); - } else if (pos == BM_RESTART) { - int x = - (SIZEOF_BINARY_FIND_STATE(state) / sizeof(Eterm)) + - !!(SIZEOF_BINARY_FIND_STATE(state) % sizeof(Eterm)); -#ifdef HARDDEBUG erts_printf("Trap bm!\n"); + } #endif - state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1); - state_ptr->bignum_hdr = make_pos_bignum_header(x); - memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState)); - memcpy(&state_ptr->data.acffs, &state, sizeof(BMFindFirstState)); - *res_term = make_big(&state_ptr->bignum_hdr); - erts_free_aligned_binary_bytes(temp_alloc); - return DO_BIN_MATCH_RESTART; - } else { - *res_term = bfs->single_result(p, subject, bfs, pos, bm->len); + if (is_first_call) { + ctx = bf_context_export(p, ctx); + *ctxp = ctx; + erts_set_gc_state(p, 0); } erts_free_aligned_binary_bytes(temp_alloc); - BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR); - return DO_BIN_MATCH_OK; - } else if (bfs->type == am_ac) { - ACTrie *act; - Uint pos, rlen; - int acr; - ACFindFirstState state; - Uint reds = get_reds(p, AC_LOOP_FACTOR); - Uint save_reds = reds; - - act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin); -#ifdef HARDDEBUG - dump_ac_trie(act); -#endif - if (state_term == NIL) { - ac_init_find_first_match(&state, act, bfs->hsstart, bfs->hsend); - } else { - memcpy(&state, &state_ptr->data.acffs, sizeof(ACFindFirstState)); + *res_term = THE_NON_VALUE; + BUMP_ALL_REDS(p); + return BF_RESTART; + } else { + *res_term = ctx->found(p, subject, &ctx); + *ctxp = ctx; + } + erts_free_aligned_binary_bytes(temp_alloc); + if (*res_term == THE_NON_VALUE) { + if (is_first_call) { + erts_set_gc_state(p, 0); } - acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds); - if (acr == AC_NOT_FOUND) { - *res_term = bfs->not_found_result(p, subject, bfs); - } else if (acr == AC_RESTART) { - int x = - (SIZEOF_BINARY_FIND_STATE(state) / sizeof(Eterm)) + - !!(SIZEOF_BINARY_FIND_STATE(state) % sizeof(Eterm)); -#ifdef HARDDEBUG - erts_printf("Trap ac!\n"); -#endif - state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1); - state_ptr->bignum_hdr = make_pos_bignum_header(x); - memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState)); - memcpy(&state_ptr->data.acffs, &state, sizeof(ACFindFirstState)); - *res_term = make_big(&state_ptr->bignum_hdr); - erts_free_aligned_binary_bytes(temp_alloc); - return DO_BIN_MATCH_RESTART; - } else { - *res_term = bfs->single_result(p, subject, bfs, pos, rlen); + BUMP_ALL_REDS(p); + return BF_RESTART; + } + if (ctx->search->done != NULL) { + ctx->search->done(ctx); + } + ctx->state = BFDone; + if (!is_first_call) { + erts_set_gc_state(p, 1); + } + BUMP_REDS(p, (initial_reds - ctx->reds) / ctx->loop_factor); + return BF_OK; + } + case BFResult: { + *res_term = ctx->found(p, subject, &ctx); + *ctxp = ctx; + if (*res_term == THE_NON_VALUE) { + if (is_first_call) { + erts_set_gc_state(p, 0); } - erts_free_aligned_binary_bytes(temp_alloc); - BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR); - return DO_BIN_MATCH_OK; + BUMP_ALL_REDS(p); + return BF_RESTART; + } + if (ctx->search->done != NULL) { + ctx->search->done(ctx); } + ctx->state = BFDone; + if (!is_first_call) { + erts_set_gc_state(p, 1); + } + BUMP_REDS(p, (initial_reds - ctx->reds) / ctx->loop_factor); + return BF_OK; } - badarg: - return DO_BIN_MATCH_BADARG; + default: + ASSERT(!"Unknown state in do_binary_find"); + } + +badarg: + if (!is_first_call) { + if (ctx->search->done != NULL) { + ctx->search->done(ctx); + } + ctx->state = BFDone; + erts_set_gc_state(p, 1); + } + return BF_BADARG; } static BIF_RETTYPE binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags) { - BinaryFindState bfs; - Eterm *tp; - Binary *bin; - Eterm bin_term = NIL; + BinaryFindContext c_buff; + BinaryFindContext *ctx = &c_buff; + Binary *pat_bin; int runres; Eterm result; - if (is_not_binary(arg1)) { + if (is_not_binary(arg1) || binary_bitsize(arg1) != 0) { goto badarg; } - bfs.flags = flags; - if (parse_match_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend))) { + ctx->flags = flags; + if (parse_match_opts_list(arg3, arg1, &(ctx->hsstart), &(ctx->hsend))) { goto badarg; } - if (bfs.hsend == 0) { - BIF_RET(do_match_not_found_result(p, arg1, &bfs)); + if (ctx->hsend == 0) { + result = do_match_not_found_result(p, arg1, &ctx); + BIF_RET(result); } - if (is_tuple(arg2)) { - tp = tuple_val(arg2); - if (arityval(*tp) != 2 || is_not_atom(tp[1])) { - goto badarg; - } - if (((tp[1] != am_bm) && (tp[1] != am_ac)) || - !is_internal_magic_ref(tp[2])) { - goto badarg; - } - bfs.type = tp[1]; - bin = erts_magic_ref2bin(tp[2]); - if (bfs.type == am_bm && - ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) { - goto badarg; - } - if (bfs.type == am_ac && - ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) { - goto badarg; - } - bin_term = tp[2]; - } else if (do_binary_match_compile(arg2, &(bfs.type), &bin)) { + if (maybe_binary_match_compile(ctx, arg2, &pat_bin) != BF_OK) { goto badarg; } - bfs.not_found_result = &do_match_not_found_result; - bfs.single_result = &do_match_single_result; - bfs.global_result = &do_match_global_result; - runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result); - if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { - Eterm *hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); - bin_term = erts_mk_magic_ref(&hp, &MSO(p), bin); - } else if (bin_term == NIL) { - erts_bin_free(bin); + bf_context_init(ctx, do_match_not_found_result, do_match_single_result, + do_match_global_result, pat_bin); + runres = do_binary_find(p, arg1, &ctx, pat_bin, NULL, &result); + if (runres == BF_OK && ctx->pat_term == THE_NON_VALUE) { + erts_bin_free(pat_bin); } switch (runres) { - case DO_BIN_MATCH_OK: + case BF_OK: BIF_RET(result); - case DO_BIN_MATCH_RESTART: - BUMP_ALL_REDS(p); - BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term); + case BF_RESTART: + ASSERT(result == THE_NON_VALUE && ctx->trap_term != result && ctx->pat_term != result); + BIF_TRAP3(&binary_find_trap_export, p, arg1, ctx->trap_term, ctx->pat_term); default: goto badarg; } - badarg: - BIF_ERROR(p,BADARG); +badarg: + BIF_ERROR(p, BADARG); } BIF_RETTYPE binary_match_2(BIF_ALIST_2) @@ -1471,76 +1512,52 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3) BIF_RETTYPE binary_matches_2(BIF_ALIST_2) { - return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, BINARY_FIND_ALL); + return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, BF_FLAG_GLOBAL); } BIF_RETTYPE binary_matches_3(BIF_ALIST_3) { - return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BINARY_FIND_ALL); + return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BF_FLAG_GLOBAL); } static BIF_RETTYPE binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) { - BinaryFindState bfs; - Eterm *tp; - Binary *bin; - Eterm bin_term = NIL; + BinaryFindContext c_buff; + BinaryFindContext *ctx = &c_buff; + Binary *pat_bin; int runres; Eterm result; - if (is_not_binary(arg1)) { + if (is_not_binary(arg1) || binary_bitsize(arg1) != 0) { goto badarg; } - if (parse_split_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend), &(bfs.flags))) { + if (parse_split_opts_list(arg3, arg1, &(ctx->hsstart), &(ctx->hsend), &(ctx->flags))) { goto badarg; } - if (bfs.hsend == 0) { - result = do_split_not_found_result(p, arg1, &bfs); + if (ctx->hsend == 0) { + result = do_split_not_found_result(p, arg1, &ctx); BIF_RET(result); } - if (is_tuple(arg2)) { - tp = tuple_val(arg2); - if (arityval(*tp) != 2 || is_not_atom(tp[1])) { - goto badarg; - } - if (((tp[1] != am_bm) && (tp[1] != am_ac)) || - !is_internal_magic_ref(tp[2])) { - goto badarg; - } - bfs.type = tp[1]; - bin = erts_magic_ref2bin(tp[2]); - if (bfs.type == am_bm && - ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) { - goto badarg; - } - if (bfs.type == am_ac && - ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) { - goto badarg; - } - bin_term = tp[2]; - } else if (do_binary_match_compile(arg2, &(bfs.type), &bin)) { + if (maybe_binary_match_compile(ctx, arg2, &pat_bin) != BF_OK) { goto badarg; } - bfs.not_found_result = &do_split_not_found_result; - bfs.single_result = &do_split_single_result; - bfs.global_result = &do_split_global_result; - runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result); - if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { - Eterm *hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); - bin_term = erts_mk_magic_ref(&hp, &MSO(p), bin); - } else if (bin_term == NIL) { - erts_bin_free(bin); - } - switch(runres) { - case DO_BIN_MATCH_OK: + bf_context_init(ctx, do_split_not_found_result, do_split_single_result, + do_split_global_result, pat_bin); + runres = do_binary_find(p, arg1, &ctx, pat_bin, NULL, &result); + if (runres == BF_OK && ctx->pat_term == THE_NON_VALUE) { + erts_bin_free(pat_bin); + } + switch (runres) { + case BF_OK: BIF_RET(result); - case DO_BIN_MATCH_RESTART: - BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term); + case BF_RESTART: + ASSERT(result == THE_NON_VALUE && ctx->trap_term != result && ctx->pat_term != result); + BIF_TRAP3(&binary_find_trap_export, p, arg1, ctx->trap_term, ctx->pat_term); default: goto badarg; } - badarg: +badarg: BIF_ERROR(p, BADARG); } @@ -1554,72 +1571,117 @@ BIF_RETTYPE binary_split_3(BIF_ALIST_3) return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); } -static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs) +static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindContext **ctxp) { - if (bfs->flags & BINARY_FIND_ALL) { + if ((*ctxp)->flags & BF_FLAG_GLOBAL) { return NIL; } else { return am_nomatch; } } -static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs, - Sint pos, Sint len) +static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindContext **ctxp) { + BinaryFindContext *ctx = (*ctxp); + BinaryFindFirstContext *ff = &(ctx->u.ff); Eterm erlen; Eterm *hp; Eterm ret; - erlen = erts_make_integer((Uint)(len), p); - ret = erts_make_integer(pos, p); + erlen = erts_make_integer((Uint)(ff->len), p); + ret = erts_make_integer(ff->pos, p); hp = HAlloc(p, 3); ret = TUPLE2(hp, ret, erlen); return ret; } -static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindState *bfs, - FindallData *fad, Uint fad_sz) +static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindContext **ctxp) { - Sint i; + BinaryFindContext *ctx = (*ctxp); + BinaryFindAllContext *fa = &(ctx->u.fa); + FindallData *fad; Eterm tpl; - Eterm *hp; - Eterm ret; + Sint i; + register Uint reds = ctx->reds; - for (i = 0; i < fad_sz; ++i) { - fad[i].epos = erts_make_integer(fad[i].pos, p); - fad[i].elen = erts_make_integer(fad[i].len, p); + if (ctx->state == BFSearch) { + if (ctx->pat_type == am_ac) { + fa->data = fa->d.ac.out; + fa->size = fa->d.ac.m; + } else { + fa->data = fa->d.bm.out; + fa->size = fa->d.bm.m; + } + fa->tail = fa->size - 1; + fa->head = 0; + fa->end_pos = 0; + fa->term = NIL; + if (ctx->exported == 0 && ((fa->size * 2) >= reds)) { + ctx = bf_context_export(p, ctx); + *ctxp = ctx; + fa = &(ctx->u.fa); + } + erts_factory_proc_prealloc_init(&(fa->factory), p, fa->size * (3 + 2)); + ctx->state = BFResult; + } + + fad = fa->data; + + if (fa->end_pos == 0) { + for (i = fa->head; i < fa->size; ++i) { + if (--reds == 0) { + ASSERT(ctx->exported == 1); + fa->head = i; + ctx->reds = reds; + return THE_NON_VALUE; + } + fad[i].epos = erts_make_integer(fad[i].pos, p); + fad[i].elen = erts_make_integer(fad[i].len, p); + } + fa->end_pos = 1; + fa->head = fa->tail; } - hp = HAlloc(p, fad_sz * (3 + 2)); - ret = NIL; - for (i = fad_sz - 1; i >= 0; --i) { - tpl = TUPLE2(hp, fad[i].epos, fad[i].elen); - hp += 3; - ret = CONS(hp, tpl, ret); - hp += 2; + + for (i = fa->head; i >= 0; --i) { + if (--reds == 0) { + ASSERT(ctx->exported == 1); + fa->head = i; + ctx->reds = reds; + return THE_NON_VALUE; + } + tpl = TUPLE2(fa->factory.hp, fad[i].epos, fad[i].elen); + fa->factory.hp += 3; + fa->term = CONS(fa->factory.hp, tpl, fa->term); + fa->factory.hp += 2; } + ctx->reds = reds; + erts_factory_close(&(fa->factory)); - return ret; + return fa->term; } -static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs) +static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindContext **ctxp) { + BinaryFindContext *ctx = (*ctxp); Eterm *hp; Eterm ret; - if (bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL) + if (ctx->flags & (BF_FLAG_SPLIT_TRIM | BF_FLAG_SPLIT_TRIM_ALL) && binary_size(subject) == 0) { - return NIL; + return NIL; } hp = HAlloc(p, 2); ret = CONS(hp, subject, NIL); - return ret; } -static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *bfs, - Sint pos, Sint len) +static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindContext **ctxp) { + BinaryFindContext *ctx = (*ctxp); + BinaryFindFirstContext *ff = &(ctx->u.ff); + Sint pos; + Sint len; size_t orig_size; Eterm orig; Uint offset; @@ -1630,9 +1692,12 @@ static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState * Eterm *hp; Eterm ret; + pos = ff->pos; + len = ff->len; + orig_size = binary_size(subject); - if ((bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) && + if ((ctx->flags & (BF_FLAG_SPLIT_TRIM | BF_FLAG_SPLIT_TRIM_ALL)) && (orig_size - pos - len) == 0) { if (pos == 0) { ret = NIL; @@ -1653,7 +1718,7 @@ static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState * hp += 2; } } else { - if ((bfs->flags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) { + if ((ctx->flags & BF_FLAG_SPLIT_TRIM_ALL) && (pos == 0)) { hp = HAlloc(p, 1 * (ERL_SUB_BIN_SIZE + 2)); ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size); sb1 = NULL; @@ -1691,39 +1756,60 @@ static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState * return ret; } -static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs, - FindallData *fad, Uint fad_sz) +static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindContext **ctxp) { - size_t orig_size; + BinaryFindContext *ctx = (*ctxp); + BinaryFindAllContext *fa = &(ctx->u.fa); + FindallData *fad; Eterm orig; + size_t orig_size; Uint offset; Uint bit_offset; Uint bit_size; ErlSubBin *sb; + Uint do_trim; Sint i; - Sint tail; - Uint list_size; - Uint end_pos; - Uint do_trim = bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL); - Eterm *hp; - Eterm *hendp; - Eterm ret; + register Uint reds = ctx->reds; - tail = fad_sz - 1; - list_size = fad_sz + 1; - orig_size = binary_size(subject); - end_pos = (Uint)(orig_size); + if (ctx->state == BFSearch) { + if (ctx->pat_type == am_ac) { + fa->data = fa->d.ac.out; + fa->size = fa->d.ac.m; + } else { + fa->data = fa->d.bm.out; + fa->size = fa->d.bm.m; + } + fa->tail = fa->size - 1; + fa->head = fa->tail; + orig_size = binary_size(subject); + fa->end_pos = (Uint)(orig_size); + fa->term = NIL; + if (ctx->exported == 0 && ((fa->head + 1) >= reds)) { + ctx = bf_context_export(p, ctx); + *ctxp = ctx; + fa = &(ctx->u.fa); + } + erts_factory_proc_prealloc_init(&(fa->factory), p, (fa->size + 1) * (ERL_SUB_BIN_SIZE + 2)); + ctx->state = BFResult; + } - hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2)); - hendp = hp + list_size * (ERL_SUB_BIN_SIZE + 2); ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size); ASSERT(bit_size == 0); + fad = fa->data; + do_trim = ctx->flags & (BF_FLAG_SPLIT_TRIM | BF_FLAG_SPLIT_TRIM_ALL); - ret = NIL; - - for (i = tail; i >= 0; --i) { - sb = (ErlSubBin *)(hp); - sb->size = end_pos - (fad[i].pos + fad[i].len); + for (i = fa->head; i >= 0; --i) { + if (--reds == 0) { + ASSERT(ctx->exported == 1); + fa->head = i; + ctx->reds = reds; + if (!do_trim && (ctx->flags & BF_FLAG_SPLIT_TRIM)) { + ctx->flags &= ~BF_FLAG_SPLIT_TRIM; + } + return THE_NON_VALUE; + } + sb = (ErlSubBin *)(fa->factory.hp); + sb->size = fa->end_pos - (fad[i].pos + fad[i].len); if (!(sb->size == 0 && do_trim)) { sb->thing_word = HEADER_SUB_BIN; sb->offs = offset + fad[i].pos + fad[i].len; @@ -1731,15 +1817,18 @@ static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState * sb->bitoffs = bit_offset; sb->bitsize = 0; sb->is_writable = 0; - hp += ERL_SUB_BIN_SIZE; - ret = CONS(hp, make_binary(sb), ret); - hp += 2; - do_trim &= ~BINARY_SPLIT_TRIM; + fa->factory.hp += ERL_SUB_BIN_SIZE; + fa->term = CONS(fa->factory.hp, make_binary(sb), fa->term); + fa->factory.hp += 2; + do_trim &= ~BF_FLAG_SPLIT_TRIM; } - end_pos = fad[i].pos; + fa->end_pos = fad[i].pos; } - sb = (ErlSubBin *)(hp); + fa->head = i; + ctx->reds = reds; + + sb = (ErlSubBin *)(fa->factory.hp); sb->size = fad[0].pos; if (!(sb->size == 0 && do_trim)) { sb->thing_word = HEADER_SUB_BIN; @@ -1748,26 +1837,31 @@ static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState * sb->bitoffs = bit_offset; sb->bitsize = 0; sb->is_writable = 0; - hp += ERL_SUB_BIN_SIZE; - ret = CONS(hp, make_binary(sb), ret); - hp += 2; + fa->factory.hp += ERL_SUB_BIN_SIZE; + fa->term = CONS(fa->factory.hp, make_binary(sb), fa->term); + fa->factory.hp += 2; } - HRelease(p, hendp, hp); - return ret; + erts_factory_close(&(fa->factory)); + + return fa->term; } static BIF_RETTYPE binary_find_trap(BIF_ALIST_3) { int runres; Eterm result; - Binary *bin = erts_magic_ref2bin(BIF_ARG_3); - - runres = do_binary_find(BIF_P, BIF_ARG_1, NULL, bin, BIF_ARG_2, &result); - if (runres == DO_BIN_MATCH_OK) { + Binary *ctx_bin = erts_magic_ref2bin(BIF_ARG_2); + Binary *pat_bin = erts_magic_ref2bin(BIF_ARG_3); + BinaryFindContext *ctx = NULL; + + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(ctx_bin) == bf_context_destructor); + runres = do_binary_find(BIF_P, BIF_ARG_1, &ctx, pat_bin, ctx_bin, &result); + if (runres == BF_OK) { + ASSERT(result != THE_NON_VALUE); BIF_RET(result); } else { - BUMP_ALL_REDS(BIF_P); - BIF_TRAP3(&binary_find_trap_export, BIF_P, BIF_ARG_1, result, BIF_ARG_3); + ASSERT(result == THE_NON_VALUE && ctx->trap_term != result && ctx->pat_term != result); + BIF_TRAP3(&binary_find_trap_export, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); } } diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index a21b9b9c0c..3ba0886464 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -3550,14 +3550,8 @@ static SWord proc_cleanup_fixed_table(Process* p, DbFixation* fix) ASSERT(sizeof(DbFixation) == ERTS_ALC_DBG_BLK_SZ(fix)); ERTS_DB_ALC_MEM_UPDATE_(tb, sizeof(DbFixation), 0); } - else { - ASSERT(fix->counter == 0); - } db_unlock(tb, LCK_WRITE_REC); } - else { - ASSERT(fix->counter == 0); - } erts_bin_release(fix->tabs.btid); erts_free(ERTS_ALC_T_DB_FIXATION, fix); @@ -3785,11 +3779,8 @@ static void free_fixations_op(DbFixation* fix, void* vctx) { struct free_fixations_ctx* ctx = (struct free_fixations_ctx*) vctx; erts_aint_t diff; -#ifdef DEBUG - DbTable* dbg_tb = btid2tab(fix->tabs.btid); -#endif - ASSERT(!dbg_tb || dbg_tb == ctx->tb); + ASSERT(!btid2tab(fix->tabs.btid)); ASSERT(fix->counter > 0); ASSERT(ctx->tb->common.status & DB_DELETE); diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 1c99b661e4..6b126f35d6 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -220,6 +220,9 @@ typedef struct db_fixation { Process* p; } procs; + /* Number of fixations on table from procs.p + * Protected by table write lock or read lock + fixlock + */ Uint counter; } DbFixation; diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 1420fb9c06..14977dfa17 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -1438,10 +1438,10 @@ erts_port_task_schedule(Eterm id, erts_thr_progress_unmanaged_continue(dhndl); } - if (!pp) - goto fail; - if (type != ERTS_PORT_TASK_PROC_SIG) { + if (!pp) + goto fail; + ptp = port_task_alloc(); ptp->type = type; @@ -1479,6 +1479,9 @@ erts_port_task_schedule(Eterm id, ptp->u.alive.td.psig.callback = va_arg(argp, ErtsProc2PortSigCallback); ptp->u.alive.flags |= va_arg(argp, int); va_end(argp); + if (!pp) + goto fail; + if (!(ptp->u.alive.flags & ERTS_PT_FLG_NOSUSPEND)) set_tmp_handle(ptp, pthp); else { diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index ab5030e5b9..d5cbf811cc 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -1564,6 +1564,12 @@ erts_proclist_create(Process *p) return proclist_create(p); } +ErtsProcList * +erts_proclist_copy(ErtsProcList *plp) +{ + return proclist_copy(plp); +} + void erts_proclist_destroy(ErtsProcList *plp) { @@ -12127,6 +12133,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->msg.first = NULL; p->msg.last = &p->msg.first; p->msg.save = &p->msg.first; + p->msg.saved_last = &p->msg.first; p->msg.len = 0; p->msg_inq.first = NULL; p->msg_inq.last = &p->msg_inq.first; diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 150f22556c..ff803fcec0 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1585,6 +1585,7 @@ Uint64 erts_ensure_later_proc_interval(Uint64); Uint64 erts_step_proc_interval(void); ErtsProcList *erts_proclist_create(Process *); +ErtsProcList *erts_proclist_copy(ErtsProcList *); void erts_proclist_destroy(ErtsProcList *); ERTS_GLB_INLINE int erts_proclist_same(ErtsProcList *, Process *); diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 1c2f8f9843..60cf09dc07 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -1929,7 +1929,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla } result_bin = erts_bin_nrml_alloc(size); - result_bin->orig_bytes[0] = VERSION_MAGIC; + result_bin->orig_bytes[0] = (byte)VERSION_MAGIC; /* Next state immediately, no need to export context */ context->state = TTBEncode; context->s.ec.flags = flags; @@ -1987,7 +1987,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla context->s.cc.result_bin = result_bin; result_bin = erts_bin_nrml_alloc(real_size); - result_bin->orig_bytes[0] = VERSION_MAGIC; + result_bin->orig_bytes[0] = (byte) VERSION_MAGIC; context->s.cc.destination_bin = result_bin; context->s.cc.dest_len = 0; diff --git a/erts/emulator/beam/macros.tab b/erts/emulator/beam/macros.tab index debeafa651..6f9b78af6f 100644 --- a/erts/emulator/beam/macros.tab +++ b/erts/emulator/beam/macros.tab @@ -80,7 +80,7 @@ GC_TEST_PRESERVE(NeedHeap, Live, PreserveTerm) { $PreserveTerm = reg[$Live]; SWAPIN; } - HEAP_SPACE_VERIFIED($Nh); + HEAP_SPACE_VERIFIED($NeedHeap); } diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 52a13d4e18..87ff92d354 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -431,9 +431,18 @@ send # Optimized comparisons with one immediate/literal operand. # -is_eq_exact Lbl R=xy C=ian => i_is_eq_exact_immed Lbl R C +is_eq_exact Lbl S S => +is_eq_exact Lbl C1=c C2=c => move C1 x | is_eq_exact Lbl x C2 +is_eq_exact Lbl C=c R=xy => is_eq_exact Lbl R C + +is_eq_exact Lbl R=xy n => is_nil Lbl R +is_eq_exact Lbl R=xy C=ia => i_is_eq_exact_immed Lbl R C is_eq_exact Lbl R=xy C=q => i_is_eq_exact_literal Lbl R C +is_ne_exact Lbl S S => jump Lbl +is_ne_exact Lbl C1=c C2=c => move C1 x | is_ne_exact Lbl x C2 +is_ne_exact Lbl C=c R=xy => is_ne_exact Lbl R C + is_ne_exact Lbl R=xy C=ian => i_is_ne_exact_immed Lbl R C is_ne_exact Lbl R=xy C=q => i_is_ne_exact_literal Lbl R C @@ -447,7 +456,9 @@ i_is_ne_exact_literal f xy c is_eq_exact Lbl Y=y X=x => is_eq_exact Lbl X Y is_eq_exact f x xy -is_eq_exact f s s +is_eq_exact f y y + +is_ne_exact f S S is_lt f x x is_lt f x c @@ -463,8 +474,6 @@ is_ge f c x is_ge f s s %hot -is_ne_exact f s s - is_eq f s s is_ne f s s @@ -699,7 +708,7 @@ is_boolean f xy is_function2 Fail=f acq Arity => jump Fail is_function2 Fail=f Fun a => jump Fail -is_function2 f s s +is_function2 f S s # Allocating & initializing. allocate Need Regs | init Y => allocate_init Need Regs Y @@ -1065,13 +1074,13 @@ func_info M F A => i_func_info u M F A %warm bs_start_match2 Fail=f ica X Y D => jump Fail bs_start_match2 Fail Bin X Y D => i_bs_start_match2 Bin Fail X Y D -i_bs_start_match2 xy f I I x +i_bs_start_match2 xy f t t x bs_save2 Reg Index => gen_bs_save(Reg, Index) -i_bs_save2 x I +i_bs_save2 x t bs_restore2 Reg Index => gen_bs_restore(Reg, Index) -i_bs_restore2 x I +i_bs_restore2 x t # Matching integers bs_match_string Fail Ms Bits Val => i_bs_match_string Ms Fail Bits Val @@ -1084,7 +1093,7 @@ bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ i_bs_get_integer_small_imm x W f t x i_bs_get_integer_imm x W t f t x -i_bs_get_integer f I I s s x +i_bs_get_integer f t t x s x i_bs_get_integer_8 x f x i_bs_get_integer_16 x f x @@ -1097,9 +1106,9 @@ bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst) i_bs_get_binary_imm2 f x t W t x -i_bs_get_binary2 f x I s I x -i_bs_get_binary_all2 f x I I x -i_bs_get_binary_all_reuse x f I +i_bs_get_binary2 f x t s t x +i_bs_get_binary_all2 f x t t x +i_bs_get_binary_all_reuse x f t # Fetching float from binaries. bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \ @@ -1107,7 +1116,7 @@ bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \ bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail -i_bs_get_float2 f x I s I x +i_bs_get_float2 f x t s t x # Miscellanous @@ -1115,8 +1124,8 @@ bs_skip_bits2 Fail=f Ms=x Sz=sq Unit=u Flags=u => \ gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) i_bs_skip_bits_imm2 f x W -i_bs_skip_bits2 f x xy I -i_bs_skip_bits_all2 f x I +i_bs_skip_bits2 f x xy t +i_bs_skip_bits_all2 f x t bs_test_tail2 Fail=f Ms=x Bits=u==0 => bs_test_zero_tail2 Fail Ms bs_test_tail2 Fail=f Ms=x Bits=u => bs_test_tail_imm2 Fail Ms Bits @@ -1124,7 +1133,7 @@ bs_test_zero_tail2 f x bs_test_tail_imm2 f x W bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms -bs_test_unit f x I +bs_test_unit f x t bs_test_unit8 f x # An y register operand for bs_context_to_binary is rare, @@ -1145,7 +1154,7 @@ bs_skip_utf8 Fail=f Ms=x u u => i_bs_get_utf8 Ms Fail x bs_get_utf16 Fail=f Ms=x u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst bs_skip_utf16 Fail=f Ms=x u Flags=u => i_bs_get_utf16 Ms Fail Flags x -i_bs_get_utf16 x f I x +i_bs_get_utf16 x f t x bs_get_utf32 Fail=f Ms=x Live=u Flags=u Dst=d => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags Dst | \ @@ -1154,7 +1163,7 @@ bs_skip_utf32 Fail=f Ms=x Live=u Flags=u => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags x | \ i_bs_validate_unicode_retract Fail x Ms -i_bs_validate_unicode_retract j s s +i_bs_validate_unicode_retract j s S %hot # @@ -1213,7 +1222,7 @@ bs_private_append Fail Size Unit Bin Flags Dst => \ bs_init_writable i_bs_append j I t t s x -i_bs_private_append j t s s x +i_bs_private_append j t s S x # # Storing integers into binaries. @@ -1499,7 +1508,9 @@ i_band s s j t d i_bor j I s s d i_bxor j I s s d -i_int_bnot j s t d +i_int_bnot Fail Src=c Live Dst => move Src x | i_int_bnot Fail x Live Dst + +i_int_bnot j S t d # # Old guard BIFs that creates heap fragments are no longer allowed. diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 8efe35e321..7355df6059 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -936,10 +936,10 @@ static int put_chars(byte *s, int l) int n; n = insert_buf(s, l); + if (lpos > llen) + llen = lpos; if (n > 0) write_buf(lbuf + lpos - n, n); - if (lpos > llen) - llen = lpos; return TRUE; } @@ -1016,7 +1016,7 @@ static int del_chars(int n) outc(' '); move_left(1); } - move_cursor(llen + l, lpos); + move_cursor(llen + gcs, lpos); } else if (pos < lpos) { l = lpos - pos; /* Buffer characters */ @@ -1036,7 +1036,7 @@ static int del_chars(int n) outc(' '); move_left(1); } - move_cursor(llen + l, lpos); + move_cursor(llen + gcs, lpos); } return TRUE; } @@ -1095,6 +1095,7 @@ static int insert_buf(byte *s, int n) ch = 0; } while (lpos % 8); } else if (ch == '\e') { + DEBUGLOG(("insert_buf: ANSI Escape: \\e")); lbuf[lpos++] = (CONTROL_TAG | ((Uint32) ch)); } else if (ch == '\n' || ch == '\r') { write_buf(lbuf + buffpos, lpos - buffpos); @@ -1156,7 +1157,7 @@ static int write_buf(Uint32 *s, int n) --n; s++; } } else if (*s == (CONTROL_TAG | ((Uint32) '\e'))) { - outc('\e'); + outc(lastput = '\e'); --n; ++s; } else if (*s & CONTROL_TAG) { @@ -1251,26 +1252,63 @@ static int move_cursor(int from_pos, int to_pos) return to_col-from_col; } -static int cp_pos_to_col(int cp_pos) +/* + * Returns the length of an ANSI escape code in a buffer, this function only consider + * color escape sequences like `\e[33m` or `\e[21;33m`. If a sequence has no valid + * terminator, the length is equal the number of characters between `\e` and the first + * invalid character, inclusive. + */ + +static int ansi_escape_width(Uint32 *s, int max_length) { -#ifdef HAVE_WCWIDTH int i; - int col = 0; - - for (i = 0; i < cp_pos; i++) { - int w = wcwidth(lbuf[i]); - if (w > 0) { - col += w; - } + + if (*s != (CONTROL_TAG | ((Uint32) '\e'))) { + return 0; + } else if (max_length <= 1) { + return 1; + } else if (s[1] != '[') { + return 2; } - return col; -#else + + for (i = 2; i < max_length && (s[i] == ';' || (s[i] >= '0' && s[i] <= '9')); i++); + + return i + 1; +} + +static int cp_pos_to_col(int cp_pos) +{ /* - * We dont' have any character width information. Assume that - * code points are one column wide. + * If we don't have any character width information. Assume that + * code points are one column wide */ - return cp_pos; + int w = 1; + int col = 0; + int i = 0; + int j; + + if (cp_pos > llen) { + col += cp_pos - llen; + cp_pos = llen; + } + + while (i < cp_pos) { + j = ansi_escape_width(lbuf + i, llen - i); + + if (j > 0) { + i += j; + } else { +#ifdef HAVE_WCWIDTH + w = wcwidth(lbuf[i]); #endif + if (w > 0) { + col += w; + } + i++; + } + } + + return col; } static int start_termcap(void) diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 237614b0fb..d05028cabc 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -739,7 +739,6 @@ signum_to_signalterm(int signum) } } - static RETSIGTYPE generic_signal_handler(int signum) { smp_sig_notify(signum); diff --git a/erts/emulator/test/iovec_SUITE.erl b/erts/emulator/test/iovec_SUITE.erl index a5f605bfff..28df36d293 100644 --- a/erts/emulator/test/iovec_SUITE.erl +++ b/erts/emulator/test/iovec_SUITE.erl @@ -20,7 +20,7 @@ -module(iovec_SUITE). --export([all/0, suite/0]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). -export([integer_lists/1, binary_lists/1, empty_lists/1, empty_binary_lists/1, mixed_lists/1, improper_lists/1, illegal_lists/1, cons_bomb/1, @@ -37,6 +37,13 @@ all() -> illegal_lists, improper_lists, cons_bomb, iolist_to_iovec_idempotence, iolist_to_iovec_correctness]. +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + application:stop(os_mon), + Config. + integer_lists(Config) when is_list(Config) -> Variations = gen_variations([I || I <- lists:seq(1, 255)]), diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 6ded7ff1c9..a9f20f9928 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -152,7 +152,11 @@ spawn_with_binaries(Config) when is_list(Config) -> TwoMeg = lists:duplicate(1024, L), Fun = fun() -> spawn(?MODULE, binary_owner, [list_to_binary(TwoMeg)]), receive after 1 -> ok end end, - test_server:do_times(150, Fun), + Iter = case test_server:is_valgrind() of + true -> 10; + false -> 150 + end, + test_server:do_times(Iter, Fun), ok. binary_owner(Bin) when is_binary(Bin) -> diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index d156bd83c0..bb31db7eb5 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -269,6 +269,16 @@ if ($wordsize == 64) { } # +# Add placeholders for built-in macros. +# + +$c_code{'IS_PACKED'} = ['$Expr',"built-in macro",('Expr')]; +$c_code{'ARG_POSITION'} = ['$Expr',"built-in macro",('Expr')]; +foreach my $name (keys %c_code) { + $c_code_used{$name} = 1; +} + +# # Parse the input files. # @@ -1388,14 +1398,8 @@ sub expand_all { my $keep = substr($code, 0, $-[0]); my $after = substr($code, $+[0]); - # Keep the special, pre-defined bindings. - my %new_bindings; - foreach my $key (qw(NEXT_INSTRUCTION)) { - $new_bindings{$key} = $bindings{$key}; - } - my $body; - ($body,$code) = expand_macro($macro_name, $after, \%new_bindings); + ($body,$code) = expand_macro($macro_name, $after, \%bindings); $res .= "$keep$body"; } @@ -1442,21 +1446,49 @@ sub expand_macro { $arg =~ s/^\s*//; } - # Now combine bindings from the parameter names and arguments. - my %bindings = %{$bindings_ref}; + # Make sure that the number of arguments are correct. if (@vars != @args) { error("calling $name with ", scalar(@args), " arguments instead of expected ", scalar(@vars), " arguments..."); } + + # Now combine bindings from the parameter names and arguments. + my %bindings = %{$bindings_ref}; + my %new_bindings; + + # Keep the special, pre-defined bindings. + foreach my $key (qw(NEXT_INSTRUCTION)) { + $new_bindings{$key} = $bindings{$key}; + } + for (my $i = 0; $i < @vars; $i++) { - $bindings{$vars[$i]} = $args[$i]; + my $arg = $args[$i]; + $arg = eval { expand_all($arg, \%bindings) }; + unless (defined $arg) { + warn $@; + die "... from the body of $name at $where\n"; + } + $new_bindings{$vars[$i]} = $arg; } - $body = eval { expand_all($body, \%bindings) }; + $body = eval { expand_all($body, \%new_bindings) }; unless (defined $body) { warn $@; die "... from the body of $name at $where\n"; } + + # Handle built-in macros. + if ($name eq 'ARG_POSITION') { + if ($body =~ /^I\[(\d+)\]$/) { + $body = $1; + } else { + $body = 0; + } + } elsif ($name eq 'IS_PACKED') { + $body = ($body =~ /^I\[\d+\]$/) ? 0 : 1; + } + + # Wrap body if needed and return resul.t $body = "do {\n$body\n} while (0)" if needs_do_wrapper($body); ($body,$rest); @@ -1482,6 +1514,7 @@ sub needs_do_wrapper { return 0 if /^[A-Z_]*SWAPOUT/; return 0 if /^if\s*[(]/; return 0 if /^goto\b/; + return 0 if /^\d+/; return 1; # Not sure, say that it is needed. } diff --git a/erts/emulator/valgrind/suppress.patched.3.6.0 b/erts/emulator/valgrind/suppress.patched.3.6.0 index fcde4a0123..29f2d3d62d 100644 --- a/erts/emulator/valgrind/suppress.patched.3.6.0 +++ b/erts/emulator/valgrind/suppress.patched.3.6.0 @@ -374,3 +374,10 @@ fun:erts_debug_set_internal_state_2 fun:process_main } +{ +Thread specific dlerror buffer. Either bug in libc or valgrind. +Memcheck:Leak +... +fun:_dlerror_run +... +} diff --git a/erts/emulator/valgrind/suppress.standard b/erts/emulator/valgrind/suppress.standard index bb07c92fc1..99a3ee4048 100644 --- a/erts/emulator/valgrind/suppress.standard +++ b/erts/emulator/valgrind/suppress.standard @@ -342,3 +342,11 @@ fun:erts_debug_set_internal_state_2 fun:process_main } +{ +Thread specific dlerror buffer. Either bug in libc or valgrind. +Memcheck:Leak +... +fun:_dlerror_run +... +} + diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index c61cecca4c..b98a704e28 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -266,7 +266,7 @@ replace_path(PathA, PathB) -> true = code:add_patha(PathB). join(Rule, Opts) -> - string:join([atom_to_list(Rule)|lists:map(fun atom_to_list/1, Opts)], "_"). + lists:join("_", [atom_to_list(Rule)|lists:map(fun atom_to_list/1, Opts)]). %%------------------------------------------------------------------------------ %% Test cases diff --git a/lib/asn1/test/testUniqueObjectSets.erl b/lib/asn1/test/testUniqueObjectSets.erl index 476d190651..cabdb44a0c 100644 --- a/lib/asn1/test/testUniqueObjectSets.erl +++ b/lib/asn1/test/testUniqueObjectSets.erl @@ -60,7 +60,7 @@ main(CaseDir, Rule, Opts) -> Objs = [gen_obj(I) || {I,_,_} <- D1], DupObjs = [gen_dup_obj(I, T) || {I,T,_} <- D1], DupObjRefs0 = [gen_dup_obj_refs(I) || {I,_,_} <- D1], - DupObjRefs = string:join(DupObjRefs0, " |\n"), + DupObjRefs = lists:join(" |\n", DupObjRefs0), Asn1Spec = 'UniqueObjectSets', A = ["UniqueObjectSets DEFINITIONS AUTOMATIC TAGS ::=\n", "BEGIN\n\n", diff --git a/lib/asn1/test/test_modified_x420.erl b/lib/asn1/test/test_modified_x420.erl index 6cd9e0e33b..15f7c70978 100644 --- a/lib/asn1/test/test_modified_x420.erl +++ b/lib/asn1/test/test_modified_x420.erl @@ -38,7 +38,7 @@ read_pem(File) -> extract_base64(Binary) -> - extract_base64_lines(string:tokens(binary_to_list(Binary), "\n")). + extract_base64_lines(string:lexemes(binary_to_list(Binary), "\n")). extract_base64_lines(["-----BEGIN"++_ | Lines]) -> take_base64_lines(Lines, _Acc = []); diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index ee3a5e4bba..dc6b7a536c 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -21,7 +21,7 @@ -define(DEFAULT_TIMETRAP_SECS, 60). %%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([run_test_case_apply/1,init_target_info/0]). +-export([run_test_case_apply/1,init_target_info/0,init_valgrind/0]). -export([cover_compile/1,cover_analyse/2]). %%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -49,6 +49,10 @@ -export([break/1,break/2,break/3,continue/0,continue/1]). +%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([valgrind_new_leaks/0, valgrind_format/2, + is_valgrind/0]). + %%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([]). @@ -69,6 +73,10 @@ init_target_info() -> username=test_server_sup:get_username(), cookie=atom_to_list(erlang:get_cookie())}. +init_valgrind() -> + valgrind_new_leaks(). + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% cover_compile(#cover{app=App,incl=Include,excl=Exclude,cross=Cross}) -> %% {ok,#cover{mods=AnalyseModules}} | {error,Reason} @@ -358,11 +366,12 @@ stick_all_sticky(Node,Sticky) -> %% compensate timetraps for runtime delays introduced by e.g. tools like %% cover. -run_test_case_apply({Mod,Func,Args,Name,RunInit,TimetrapData}) -> +run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) -> case is_valgrind() of false -> ok; true -> + valgrind_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]), os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++ atom_to_list(Func)++"-") end, @@ -370,6 +379,7 @@ run_test_case_apply({Mod,Func,Args,Name,RunInit,TimetrapData}) -> Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData), ProcAft = erlang:system_info(process_count), + valgrind_new_leaks(), DetFail = get(test_server_detected_fail), {Result,DetFail,ProcBef,ProcAft}. @@ -2735,11 +2745,36 @@ is_commercial() -> %% %% Returns true if valgrind is running, else false is_valgrind() -> - case os:getenv("TS_RUN_VALGRIND") of - false -> false; - _ -> true + case catch erlang:system_info({valgrind, running}) of + {'EXIT', _} -> false; + Res -> Res end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% DEBUGGER INTERFACE %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% valgrind_new_leaks() -> ok +%% +%% Checks for new memory leaks if Valgrind is active. +valgrind_new_leaks() -> + catch erlang:system_info({valgrind, memory}), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% valgrind_format(Format, Args) -> ok +%% Format = string() +%% Args = lists() +%% +%% Outputs the formatted string to Valgrind's logfile,if Valgrind is active. +valgrind_format(Format, Args) -> + (catch erlang:system_info({valgrind, io_lib:format(Format, Args)})), + ok. + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% Apply given function and reply to caller or proxy. diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 9412c43187..71978c7267 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -2163,6 +2163,7 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) -> %% Runs the specified tests, then displays/logs the summary. run_test_cases(TestSpec, Config, TimetrapData) -> + test_server:init_valgrind(), case lists:member(no_src, get(test_server_logopts)) of true -> ok; @@ -3796,7 +3797,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, %% run the test case {Result,DetectedFail,ProcsBefore,ProcsAfter} = - run_test_case_apply(Mod, Func, [UpdatedArgs], GrName, + run_test_case_apply(Num, Mod, Func, [UpdatedArgs], GrName, RunInit, TimetrapData), {Time,RetVal,Loc,Opts,Comment} = case Result of @@ -4366,7 +4367,7 @@ do_format_exception(Reason={Error,Stack}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_case_apply(Mod, Func, Args, Name, RunInit, +%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, %% TimetrapData) -> %% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} | %% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} @@ -4380,9 +4381,9 @@ do_format_exception(Reason={Error,Stack}) -> %% ProcessesBefore = ProcessesAfter = integer() %% -run_test_case_apply(Mod, Func, Args, Name, RunInit, +run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, TimetrapData) -> - test_server:run_test_case_apply({Mod,Func,Args,Name,RunInit, + test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, TimetrapData}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/common_test/test_server/ts_lib.erl b/lib/common_test/test_server/ts_lib.erl index a7be740c5c..ea039a2c2b 100644 --- a/lib/common_test/test_server/ts_lib.erl +++ b/lib/common_test/test_server/ts_lib.erl @@ -120,7 +120,8 @@ specs(Dir) -> [] end end, Specs), - sort_tests(MainSpecs). + + sort_tests(filter_tests(MainSpecs)). test_categories(Dir, App) -> Specs = filelib:wildcard(filename:join([filename:dirname(Dir), @@ -141,10 +142,29 @@ suites(Dir, App) -> "*_SUITE.erl"]), Suites=filelib:wildcard(Glob), [filename_to_atom(Name) || Name <- Suites]. - + filename_to_atom(Name) -> list_to_atom(filename:rootname(filename:basename(Name))). +%% Filter out tests of applications that are not accessible + +filter_tests(Tests) -> + lists:filter( + fun(Special) when Special == epmd; + Special == emulator; + Special == system -> + true; + (Test) -> + case application:load(filename_to_atom(Test)) of + {error, {already_loaded, _}} -> + true; + {error,_NoSuchApplication} -> + false; + _ -> + true + end + end, Tests). + %% Sorts a list of either log files directories or spec files. sort_tests(Tests) -> diff --git a/lib/common_test/test_server/ts_run.erl b/lib/common_test/test_server/ts_run.erl index ec4a54b249..2736010551 100644 --- a/lib/common_test/test_server/ts_run.erl +++ b/lib/common_test/test_server/ts_run.erl @@ -96,6 +96,9 @@ ct_run_test(Dir, CommonTestArgs) -> case ct:run_test(CommonTestArgs) of {_,_,_} -> ok; + {error,{make_failed, _Modules} = Error} -> + io:format("ERROR: ~P\n", [Error,20]), + erlang:halt(123, [{flush,false}]); {error,Error} -> io:format("ERROR: ~P\n", [Error,20]); Other -> @@ -284,6 +287,10 @@ tricky_print_data(Port, Timeout) -> receive {Port, {exit_status, 0}} -> ok; + {Port, {exit_status, 123 = N}} -> + io:format(user, "Test run exited with status ~p," + "aborting rest of test~n", [N]), + erlang:halt(123, [{flush,false}]); {Port, {exit_status, N}} -> io:format(user, "Test run exited with status ~p~n", [N]) after 1 -> diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 52ed1c7ca0..a4c65397df 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -32,6 +32,11 @@ -import(lists, [map/2,member/2,sort/1,reverse/1,splitwith/2]). +-define(is_const(Val), (element(1, Val) =:= integer orelse + element(1, Val) =:= float orelse + element(1, Val) =:= atom orelse + element(1, Val) =:= literal)). + %% instruction() describes all instructions that are used during optimzation %% (from beam_a to beam_z). -type instruction() :: atom() | tuple(). @@ -197,10 +202,20 @@ bif_to_test('>', [A,B], Fail) -> {test,is_lt,Fail,[B,A]}; bif_to_test('<', [_,_]=Ops, Fail) -> {test,is_lt,Fail,Ops}; bif_to_test('>=', [_,_]=Ops, Fail) -> {test,is_ge,Fail,Ops}; bif_to_test('==', [A,nil], Fail) -> {test,is_nil,Fail,[A]}; +bif_to_test('==', [nil,A], Fail) -> {test,is_nil,Fail,[A]}; +bif_to_test('==', [C,A], Fail) when ?is_const(C) -> + {test,is_eq,Fail,[A,C]}; bif_to_test('==', [_,_]=Ops, Fail) -> {test,is_eq,Fail,Ops}; +bif_to_test('/=', [C,A], Fail) when ?is_const(C) -> + {test,is_ne,Fail,[A,C]}; bif_to_test('/=', [_,_]=Ops, Fail) -> {test,is_ne,Fail,Ops}; bif_to_test('=:=', [A,nil], Fail) -> {test,is_nil,Fail,[A]}; +bif_to_test('=:=', [nil,A], Fail) -> {test,is_nil,Fail,[A]}; +bif_to_test('=:=', [C,A], Fail) when ?is_const(C) -> + {test,is_eq_exact,Fail,[A,C]}; bif_to_test('=:=', [_,_]=Ops, Fail) -> {test,is_eq_exact,Fail,Ops}; +bif_to_test('=/=', [C,A], Fail) when ?is_const(C) -> + {test,is_ne_exact,Fail,[A,C]}; bif_to_test('=/=', [_,_]=Ops, Fail) -> {test,is_ne_exact,Fail,Ops}; bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index ccb9b58225..d96cfdb7ac 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -1291,6 +1291,10 @@ rel_ops(Config) when is_list(Config) -> true = any_atom /= id(42), true = [] /= id(42), + %% Coverage of beam_utils:bif_to_test/3 + Empty = id([]), + ?T(==, [], Empty), + ok. -undef(TestOp). diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 0fd99bbc04..95c8b5ebce 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -772,12 +772,16 @@ tab_is_disj(K1, T1, T2) -> end. merge_tables(T1, T2) -> - ets:safe_fixtable(T1, true), tab_merge(ets:first(T1), T1, T2). tab_merge('$end_of_table', T1, T2) -> - true = ets:delete(T1), - T2; + case ets:first(T1) of % no safe_fixtable()... + '$end_of_table' -> + true = ets:delete(T1), + T2; + Key -> + tab_merge(Key, T1, T2) + end; tab_merge(K1, T1, T2) -> Vs = ets:lookup(T1, K1), NextK1 = ets:next(T1, K1), diff --git a/lib/diameter/src/base/diameter_gen.erl b/lib/diameter/src/base/diameter_gen.erl index 6add06ea38..d3b9f704fe 100644 --- a/lib/diameter/src/base/diameter_gen.erl +++ b/lib/diameter/src/base/diameter_gen.erl @@ -471,9 +471,6 @@ field(_) -> %% AVP not in dictionary: try an alternate. -dec(_, _, 'AVP', _Mod, none, _, Avp) -> %% none decode is no-op - Avp; - dec(Data, Name, 'AVP', Mod, Fmt, Opts, Avp) -> dec_AVP(dicts(Mod, Opts), Data, Name, Mod, Fmt, Opts, Avp); @@ -596,13 +593,9 @@ dec_AVP([], _, _, _, _, _, _, _, Avp) -> %% A Grouped AVP is represented as a #diameter_avp{} list with AVP %% as head and component AVPs as tail. -set('Grouped', none, Avp, V) -> - {_Rec, As} = V, - [Avp | As]; - -set('Grouped', _, Avp, V) -> +set('Grouped', Fmt, Avp, V) -> {Rec, As} = V, - [Avp#diameter_avp{value = Rec} | As]; + [set(Fmt, Avp, Rec) | As]; set(_, _, Avp, V) -> Avp#diameter_avp{value = V}. @@ -611,15 +604,23 @@ set(_, _, Avp, V) -> %% %% Error when decoding a grouped AVP. -decode_error(true, none, _, Avp) -> - Avp; - -decode_error(true, _, {Rec, _, _}, Avp) -> - Avp#diameter_avp{value = Rec}; +%% Ignoring errors in Failed-AVP. +decode_error(true, Fmt, {Rec, ComponentAvps, _Errors}, Avp) -> + [set(Fmt, Avp, Rec) | ComponentAvps]; +%% Or not. A faulty component is encoded by itself in Failed-AVP, as +%% suggested by 7.5 of RFC 6733 (quoted below), so that errors are +%% reported unambigiously. decode_error(false, _, {_, ComponentAvps, [{RC,A} | _]}, Avp) -> {RC, [Avp | ComponentAvps], Avp#diameter_avp{data = [A]}}. +%% set/3 + +set(none, Avp, _Name) -> + Avp; +set(_, Avp, Rec) -> + Avp#diameter_avp{value = Rec}. + %% decode_error/6 %% %% Error when decoding a non-grouped AVP. @@ -633,7 +634,22 @@ decode_error(false, Reason, Name, Mod, Opts, Avp) -> ?MODULE, ?LINE, {Reason, Name, Avp#diameter_avp.name, Mod, Stack}), - rc(Reason, Avp, Opts, Mod). + case Reason of + {'DIAMETER', 5014 = RC, _} -> + %% Length error communicated from diameter_types or a + %% @custom_types/@codecs module. + AvpName = Avp#diameter_avp.name, + {RC, Avp#diameter_avp{data = Mod:empty_value(AvpName, Opts)}}; + _ -> + {5004, Avp} + end. + +%% 3588/6733: +%% +%% DIAMETER_INVALID_AVP_VALUE 5004 +%% The request contained an AVP with an invalid value in its data +%% portion. A Diameter message indicating this error MUST include +%% the offending AVPs within a Failed-AVP AVP. %% avp/6 @@ -789,22 +805,6 @@ avp_arity(Name, 'AVP' = AvpName, Mod, Opts, M) -> avp_arity(Name, AvpName, Mod, _, _) -> Mod:avp_arity(Name, AvpName). -%% rc/4 - -%% Length error communicated from diameter_types or a -%% @custom_types/@codecs module. -rc({'DIAMETER', 5014 = RC, _}, #diameter_avp{name = AvpName} = A, Opts, Mod) -> - {RC, A#diameter_avp{data = Mod:empty_value(AvpName, Opts)}}; - -%% 3588: -%% -%% DIAMETER_INVALID_AVP_VALUE 5004 -%% The request contained an AVP with an invalid value in its data -%% portion. A Diameter message indicating this error MUST include -%% the offending AVPs within a Failed-AVP AVP. -rc(_, Avp, _, _) -> - {5004, Avp}. - %% pack/5 pack(Arity, F, Avp, Mod, [Failed | Rec]) -> @@ -812,9 +812,9 @@ pack(Arity, F, Avp, Mod, [Failed | Rec]) -> %% set/5 -set(_, _, _, _, None) - when is_atom(None) -> - None; +set(_, _, _, _, Name) + when is_atom(Name) -> + Name; set(1, F, Value, _, Map) when is_map(Map) -> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index d74635fc01..edf8731a82 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -279,7 +279,18 @@ requests defined by <c>max_keep_alive_requests</c>, the server closes the connection. The server closes it even if there are queued request. Default is no limit.</p> - </item> + </item> + + + <tag><marker id="max_client_body_chunk"></marker>{max_client_body_chunk, integer()}</tag> + <item> + <p>Enforces chunking of a HTTP PUT or POST body data to be deliverd + to the mod_esi callback. Note this is not supported for mod_cgi. + Default is no limit e.i the whole body is deliverd as one entity, which could + be very memory consuming. <seealso marker="mod_esi">mod_esi(3)</seealso>. + </p> + </item> + </taglist> <marker id="props_admin"></marker> diff --git a/lib/inets/doc/src/mod_esi.xml b/lib/inets/doc/src/mod_esi.xml index 46cc796c8a..e2f0758cdf 100644 --- a/lib/inets/doc/src/mod_esi.xml +++ b/lib/inets/doc/src/mod_esi.xml @@ -121,35 +121,61 @@ <funcs> <func> - <name>Module:Function(SessionID, Env, Input)-> _ </name> + <name>Module:Function(SessionID, Env, Input)-> {continue, State} | _ </name> <fsummary>Creates a dynamic web page and returns it chunk by chunk to the server process by calling <c>mod_esi:deliver/2</c>.</fsummary> <type> <v>SessionID = term()</v> <v>Env = env()</v> - <v>Input = string()</v> + <v>Input = string() | chunked_data()</v> + <v>chunked_data() = {first, Data::binary()} | + {continue, Data::binary(), State::term()} | + {last, Data::binary(), State::term()} </v> + <v>State = term()</v> </type> <desc> <p><c>Module</c> must be found in the code path and export <c>Function</c> with an arity of three. An <c>erlScriptAlias</c> must also be set up in the configuration file for the web server.</p> - <p>If the HTTP request is a 'post' request and a body is sent, - <c>content_length</c> is the length of the posted - data. If 'get' is used, <c>query_string</c> is the data after - <em>?</em> in the URL.</p> - <p><c>ParsedHeader</c> is the HTTP request as a key-value tuple - list. The keys in <c>ParsedHeader</c> are in lower case.</p> - <p><c>SessionID</c> is an identifier - the server uses when <c>deliver/2</c> is called. Do not - assume anything about the datatype.</p> - <p>Use this callback function to generate dynamic web - content dynamically. When a part of the page is generated, send the - data back to the client through <c>deliver/2</c>. Notice - that the first chunk of data sent to the client must at - least contain all HTTP header fields that the response - will generate. If the first chunk does not contain the - <em>end of HTTP header</em>, that is, <c>"\r\n\r\n",</c> - the server assumes that no HTTP header fields will be generated.</p> + + <p><c>mod_esi:deliver/2</c> shall be used to generate the response + to the client and <c>SessionID</c> is an identifier that shall by used when + calling this function, do not assume anything about + the datatype. This function may be called + several times to chunk the the respons data. Notice that the + first chunk of data sent to the client must at least contain + all HTTP header fields that the response will generate. If the + first chunk does not contain the <em>end of HTTP header</em>, + that is, <c>"\r\n\r\n",</c> the server assumes that no HTTP + header fields will be generated.</p> + + <p><c>Env</c> environment data of the request see description above.</p> + + <p><c>Input</c> is query data of a GET request or the body of + a PUT or POST request. The default behavior (legacy reasons) + for delivering the body, is that the whole body is gathered and + converted to a string. But if the httpd config parameter + <seealso + marker="httpd#max_client_body_chunk">max_client_body_chunk</seealso> + is set, the body will be delivered as binary chunks + instead. The maximum size of the chunks is either <seealso + marker="httpd#max_client_body_chunk">max_client_body_chunk</seealso> + or decide by the client if it uses HTTP chunked encoding + to send the body. When using the chunking + mechanism this callback must return {continue, State::term()} + for all calls where <c>Input</c> is <c>{first, + Data::binary()}</c> or <c>{continue, Data::binary(), + State::term()}</c>. When <c>Input</c> is <c>{last, + Data::binary(), State::term()}</c> the return value will be ignored. + <note><p>Note that if the body is + small all data may be delivered in only one chunk and then the + callback will be called with {last, Data::binary(), undefined} + without getting called with <c>{first, + Data::binary()}</c>.</p></note> The input <c>State</c> is + the last returned <c>State</c>, in it the callback can include + any data that it needs to keep track of when handling the chunks. + </p> + <p></p> </desc> </func> @@ -159,14 +185,13 @@ This function is deprecated and is only kept for backwards compatibility.</fsummary> <type> <v>Env = env()</v> - <v>Input = string()</v> + <v>Input = string() </v> <v>Response = string()</v> </type> <desc> <p>This callback format consumes much memory, as the whole response must be generated before it is sent to the - user. This function is deprecated and is only kept for backwards - compatibility. + user. This callback format is deprecated. For new development, use <c>Module:Function/3</c>.</p> </desc> </func> diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl index c893b10dca..45b6deba97 100644 --- a/lib/inets/src/http_server/httpd_example.erl +++ b/lib/inets/src/http_server/httpd_example.erl @@ -22,7 +22,7 @@ -export([print/1]). -export([get/2, put/2, post/2, yahoo/2, test1/2, get_bin/2, peer/2]). --export([newformat/3]). +-export([newformat/3, post_chunked/3]). %% These are used by the inets test-suite -export([delay/1, chunk_timeout/3]). @@ -131,15 +131,31 @@ footer() -> "</BODY> </HTML>\n". - -newformat(SessionID, _Env, _Input)-> +post_chunked(_SessionID, _Env, {first, _Body} = _Bodychunk) -> + {continue, {state, 1}}; +post_chunked(_SessionID, _Env, {continue, _Body, {state, N}} = _Bodychunk) -> + {continue, {state, N+1}}; +post_chunked(SessionID, _Env, {last, _Body, {state, N}} = _Bodychunk) -> + mod_esi:deliver(SessionID, "Content-Type:text/html\r\n\r\n"), + mod_esi:deliver(SessionID, top("Received chunked body")), + mod_esi:deliver(SessionID, "Received" ++ integer_to_list(N) ++ "chunks"), + mod_esi:deliver(SessionID, footer()); +post_chunked(SessionID, _Env, {last, _Body, undefined} = _Bodychunk) -> + mod_esi:deliver(SessionID, "Content-Type:text/html\r\n\r\n"), + mod_esi:deliver(SessionID, top("Received chunked body")), + mod_esi:deliver(SessionID, "Received 1 chunk"), + mod_esi:deliver(SessionID, footer()); +post_chunked(_, _, _Body) -> + exit(body_not_chunked). + +newformat(SessionID,_,_) -> mod_esi:deliver(SessionID, "Content-Type:text/html\r\n\r\n"), mod_esi:deliver(SessionID, top("new esi format test")), mod_esi:deliver(SessionID, "This new format is nice<BR>"), mod_esi:deliver(SessionID, "This new format is nice<BR>"), mod_esi:deliver(SessionID, "This new format is nice<BR>"), mod_esi:deliver(SessionID, footer()). - + %% ------------------------------------------------------ delay(Time) when is_integer(Time) -> diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 749f58c197..0eaf073255 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -36,7 +36,7 @@ %% little at a time on a socket. -export([ parse_method/1, parse_uri/1, parse_version/1, parse_headers/1, - whole_body/1 + whole_body/1, body_chunk_first/3, body_chunk/3, add_chunk/1 ]). @@ -76,13 +76,12 @@ body_data(Headers, Body) -> ContentLength = list_to_integer(Headers#http_request_h.'content-length'), case size(Body) - ContentLength of 0 -> - {binary_to_list(Body), <<>>}; + {Body, <<>>}; _ -> <<BodyThisReq:ContentLength/binary, Next/binary>> = Body, - {binary_to_list(BodyThisReq), Next} + {BodyThisReq, Next} end. - %%------------------------------------------------------------------------- %% validate(Method, Uri, Version) -> ok | {error, {bad_request, Reason} | %% {error, {not_supported, {Method, Uri, Version}} @@ -292,10 +291,46 @@ parse_headers(<<Octet, Rest/binary>>, Header, Headers, Current, parse_headers(Rest, [Octet | Header], Headers, Current + 1, Max, Options, Result). +body_chunk_first(Body, 0 = Length, _) -> + whole_body(Body, Length); +body_chunk_first(Body, Length, MaxChunk) -> + case body_chunk(Body, Length, MaxChunk) of + {ok, {last, NewBody}} -> + {ok, NewBody}; + Other -> + Other + end. +%% Used to chunk non chunk decoded post/put data +add_chunk([<<>>, Body, Length, MaxChunk]) -> + body_chunk(Body, Length, MaxChunk); +add_chunk([More, Body, Length, MaxChunk]) -> + body_chunk(<<Body/binary, More/binary>>, Length, MaxChunk). + +body_chunk(<<>> = Body, Length, MaxChunk) -> + {ok, {continue, ?MODULE, add_chunk, [Body, Length, MaxChunk]}}; +body_chunk(Body, Length, nolimit) -> + whole_body(Body, Length); + +body_chunk(Body, Length, MaxChunk) when Length > MaxChunk -> + case size(Body) >= MaxChunk of + true -> + <<Chunk:MaxChunk/binary, Rest/binary>> = Body, + {ok, {{continue, Chunk}, ?MODULE, add_chunk, [Rest, Length - MaxChunk, MaxChunk]}}; + false -> + {ok, {continue, ?MODULE, add_chunk, [Body, Length, MaxChunk]}} + end; +body_chunk(Body, Length, MaxChunk) -> + case size(Body) of + Length -> + {ok, {last, Body}}; + _ -> + {ok, {continue, ?MODULE, add_chunk, [Body, Length, MaxChunk]}} + end. + whole_body(Body, Length) -> case size(Body) of N when N < Length, Length > 0 -> - {?MODULE, whole_body, [Body, Length]}; + {?MODULE, add_chunk, [Body, Length, nolimit]}; N when N >= Length, Length >= 0 -> %% When a client uses pipelining trailing data %% may be part of the next request! @@ -443,6 +478,3 @@ check_header({"content-length", Value}, Maxsizes) -> end; check_header(_, _) -> ok. - - - diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index 538d52b98d..bd4fdd3832 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -49,7 +49,8 @@ headers, %% #http_request_h{} body, %% binary() data, %% The total data received in bits, checked after 10s - byte_limit %% Bit limit per second before kick out + byte_limit, %% Bit limit per second before kick out + chunk }). %%==================================================================== @@ -124,7 +125,8 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> NrOfRequest = max_keep_alive_request(ConfigDB), MaxContentLen = max_content_length(ConfigDB), Customize = customize(ConfigDB), - + MaxChunk = max_client_body_chunk(ConfigDB), + {_, Status} = httpd_manager:new_connection(Manager), MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, @@ -139,7 +141,8 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> status = Status, timeout = TimeOut, max_keep_alive_request = NrOfRequest, - mfa = MFA}, + mfa = MFA, + chunk = chunk_start(MaxChunk)}, http_transport:setopts(SocketType, Socket, [binary, {packet, 0}, {active, once}]), @@ -194,6 +197,7 @@ handle_cast(Msg, #state{mod = ModData} = State) -> %%-------------------------------------------------------------------- handle_info({Proto, Socket, Data}, #state{mfa = {Module, Function, Args}, + chunk = {ChunkState, _}, mod = #mod{socket_type = SockType, socket = Socket} = ModData} = State) when (((Proto =:= tcp) orelse @@ -207,7 +211,8 @@ handle_info({Proto, Socket, Data}, _ -> State#state.data + byte_size(Data) end, - case PROCESSED of + + case PROCESSED of {ok, Result} -> NewState = case NewDataSize of undefined -> @@ -215,7 +220,7 @@ handle_info({Proto, Socket, Data}, _ -> set_new_data_size(cancel_request_timeout(State), NewDataSize) end, - handle_http_msg(Result, NewState); + handle_msg(Result, NewState); {error, {size_error, MaxSize, ErrCode, ErrStr}, Version} -> NewModData = ModData#mod{http_version = Version}, httpd_response:send_status(NewModData, ErrCode, ErrStr), @@ -224,7 +229,10 @@ handle_info({Proto, Socket, Data}, error_log(Reason, NewModData), {stop, normal, State#state{response_sent = true, mod = NewModData}}; - + + {http_chunk = Module, Function, Args} when ChunkState =/= undefined -> + NewState = handle_chunk(Module, Function, Args, State), + {noreply, NewState}; NewMFA -> http_transport:setopts(SockType, Socket, [{active, once}]), case NewDataSize of @@ -349,6 +357,34 @@ await_socket_ownership_transfer(AcceptTimeout) -> exit(accept_socket_timeout) end. + +%%% Internal chunking of client body +handle_msg({{continue, Chunk}, Module, Function, Args}, #state{chunk = {_, CbState}} = State) -> + handle_internal_chunk(State#state{chunk = {continue, CbState}, + body = Chunk}, Module, Function, Args); +handle_msg({continue, Module, Function, Args}, #state{mod = ModData} = State) -> + http_transport:setopts(ModData#mod.socket_type, + ModData#mod.socket, + [{active, once}]), + {noreply, State#state{mfa = {Module, Function, Args}}}; +handle_msg({last, Body}, #state{headers = Headers, chunk = {_, CbState}} = State) -> + NewHeaders = Headers#http_request_h{'content-length' = integer_to_list(size(Body))}, + handle_response(State#state{chunk = {last, CbState}, + headers = NewHeaders, + body = Body}); +%%% Last data chunked by client +handle_msg({ChunkedHeaders, Body}, #state{headers = Headers , chunk = {ChunkState, CbState}} = State) when ChunkState =/= undefined -> + NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), + handle_response(State#state{chunk = {last, CbState}, + headers = NewHeaders, + body = Body}); +handle_msg({ChunkedHeaders, Body}, #state{headers = Headers , chunk = {undefined, _}} = State) -> + NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), + handle_response(State#state{headers = NewHeaders, + body = Body}); +handle_msg(Result, State) -> + handle_http_msg(Result, State). + handle_http_msg({_, _, Version, {_, _}, _}, #state{status = busy, mod = ModData} = State) -> handle_manager_busy(State#state{mod = @@ -405,10 +441,6 @@ handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body}, error_log(Reason, ModData), {stop, normal, State#state{response_sent = true}} end; -handle_http_msg({ChunkedHeaders, Body}, - State = #state{headers = Headers}) -> - NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), - handle_response(State#state{headers = NewHeaders, body = Body}); handle_http_msg(Body, State) -> handle_response(State#state{body = Body}). @@ -443,22 +475,25 @@ handle_body(#state{mod = #mod{config_db = ConfigDB}} = State) -> end. -handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, +handle_body(#state{headers = Headers, body = Body, + chunk = {ChunkState, CbState}, mod = #mod{config_db = ConfigDB} = ModData} = State, MaxHeaderSize, MaxBodySize) -> + MaxChunk = max_client_body_chunk(ConfigDB), case Headers#http_request_h.'transfer-encoding' of "chunked" -> try http_chunk:decode(Body, MaxBodySize, MaxHeaderSize) of - {Module, Function, Args} -> + {Module, Function, Args} -> http_transport:setopts(ModData#mod.socket_type, ModData#mod.socket, [{active, once}]), {noreply, State#state{mfa = - {Module, Function, Args}}}; - {ok, {ChunkedHeaders, NewBody}} -> - NewHeaders = - http_chunk:handle_headers(Headers, ChunkedHeaders), - handle_response(State#state{headers = NewHeaders, - body = NewBody}) + {Module, Function, Args}, + chunk = chunk_start(MaxChunk)}}; + {ok, {ChunkedHeaders, NewBody}} -> + NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), + handle_response(State#state{headers = NewHeaders, + body = NewBody, + chunk = chunk_finish(ChunkState, CbState, MaxChunk)}) catch throw:Error -> httpd_response:send_status(ModData, 400, @@ -476,21 +511,25 @@ handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, error_log(Reason, ModData), {stop, normal, State#state{response_sent = true}}; _ -> - Length = list_to_integer(Headers#http_request_h.'content-length'), + Length = list_to_integer(Headers#http_request_h.'content-length'), + MaxChunk = max_client_body_chunk(ConfigDB), case ((Length =< MaxBodySize) or (MaxBodySize == nolimit)) of true -> - case httpd_request:whole_body(Body, Length) of - {Module, Function, Args} -> - http_transport:setopts(ModData#mod.socket_type, + case httpd_request:body_chunk_first(Body, Length, MaxChunk) of + {ok, {continue, Module, Function, Args}} -> + http_transport:setopts(ModData#mod.socket_type, ModData#mod.socket, [{active, once}]), {noreply, State#state{mfa = {Module, Function, Args}}}; - - {ok, NewBody} -> - handle_response( - State#state{headers = Headers, - body = NewBody}) + {ok, {{continue, Chunk}, Module, Function, Args}} -> + handle_internal_chunk(State#state{chunk = chunk_start(MaxChunk), + body = Chunk}, Module, Function, Args); + {ok, NewBody} -> + handle_response(State#state{chunk = chunk_finish(ChunkState, + CbState, MaxChunk), + headers = Headers, + body = NewBody}) end; false -> httpd_response:send_status(ModData, 413, "Body too long"), @@ -550,15 +589,61 @@ expect(Headers, _, ConfigDB) -> end end. +handle_chunk(http_chunk = Module, decode_data = Function, + [ChunkSize, TotalChunk, {MaxBodySize, BodySoFar, _AccLength, MaxHeaderSize}], + #state{chunk = {_, CbState}, + mod = #mod{socket_type = SockType, + socket = Socket} = ModData} = State) -> + {continue, NewCbState} = httpd_response:handle_continuation(ModData#mod{entity_body = + {continue, BodySoFar, CbState}}), + http_transport:setopts(SockType, Socket, [{active, once}]), + State#state{chunk = {continue, NewCbState}, mfa = {Module, Function, [ChunkSize, TotalChunk, {MaxBodySize, <<>>, 0, MaxHeaderSize}]}}; + +handle_chunk(http_chunk = Module, decode_size = Function, + [Data, HexList, _AccSize, {MaxBodySize, BodySoFar, _AccLength, MaxHeaderSize}], + #state{chunk = {_, CbState}, + mod = #mod{socket_type = SockType, + socket = Socket} = ModData} = State) -> + {continue, NewCbState} = httpd_response:handle_continuation(ModData#mod{entity_body = {continue, BodySoFar, CbState}}), + http_transport:setopts(SockType, Socket, [{active, once}]), + State#state{chunk = {continue, NewCbState}, mfa = {Module, Function, [Data, HexList, 0, {MaxBodySize, <<>>, 0, MaxHeaderSize}]}}; +handle_chunk(Module, Function, Args, #state{mod = #mod{socket_type = SockType, + socket = Socket}} = State) -> + http_transport:setopts(SockType, Socket, [{active, once}]), + State#state{mfa = {Module, Function, Args}}. + +handle_internal_chunk(#state{chunk = {ChunkState, CbState}, body = Chunk, + mod = #mod{socket_type = SockType, + socket = Socket} = ModData} = State, Module, Function, Args)-> + Bodychunk = body_chunk(ChunkState, CbState, Chunk), + {continue, NewCbState} = httpd_response:handle_continuation(ModData#mod{entity_body = Bodychunk}), + case Args of + [<<>> | _] -> + http_transport:setopts(SockType, Socket, [{active, once}]), + {noreply, State#state{chunk = {continue, NewCbState}, mfa = {Module, Function, Args}}}; + _ -> + handle_info({dummy, Socket, <<>>}, State#state{chunk = {continue, NewCbState}, + mfa = {Module, Function, Args}}) + end. + +handle_response(#state{body = Body, + headers = Headers, + mod = ModData, + chunk = {last, CbState}, + max_keep_alive_request = Max} = State) when Max > 0 -> + {NewBody, Data} = httpd_request:body_data(Headers, Body), + ok = httpd_response:generate_and_send_response( + ModData#mod{entity_body = {last, NewBody, CbState}}), + handle_next_request(State#state{response_sent = true}, Data); handle_response(#state{body = Body, mod = ModData, headers = Headers, max_keep_alive_request = Max} = State) when Max > 0 -> {NewBody, Data} = httpd_request:body_data(Headers, Body), + %% Backwards compatible, may cause memory explosion ok = httpd_response:generate_and_send_response( - ModData#mod{entity_body = NewBody}), + ModData#mod{entity_body = binary_to_list(NewBody)}), handle_next_request(State#state{response_sent = true}, Data); - handle_response(#state{body = Body, headers = Headers, mod = ModData} = State) -> @@ -578,6 +663,7 @@ handle_next_request(#state{mod = #mod{connection = true} = ModData, MaxURISize = max_uri_size(ModData#mod.config_db), MaxContentLen = max_content_length(ModData#mod.config_db), Customize = customize(ModData#mod.config_db), + MaxChunk = max_client_body_chunk(ModData#mod.config_db), MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, {max_version, ?HTTP_MAX_VERSION_STRING}, @@ -590,6 +676,7 @@ handle_next_request(#state{mod = #mod{connection = true} = ModData, max_keep_alive_request = decrease(Max), headers = undefined, body = undefined, + chunk = chunk_start(MaxChunk), response_sent = false}, NewState = activate_request_timeout(TmpState), @@ -647,6 +734,9 @@ error_log(ReasonString, #mod{config_db = ConfigDB}) -> max_header_size(ConfigDB) -> httpd_util:lookup(ConfigDB, max_header_size, ?HTTP_MAX_HEADER_SIZE). +max_client_body_chunk(ConfigDB) -> + httpd_util:lookup(ConfigDB, max_client_body_chunk, nolimit). + max_uri_size(ConfigDB) -> httpd_util:lookup(ConfigDB, max_uri_size, ?HTTP_MAX_URI_SIZE). @@ -661,3 +751,17 @@ max_content_length(ConfigDB) -> customize(ConfigDB) -> httpd_util:lookup(ConfigDB, customize, httpd_custom). + +chunk_start(nolimit) -> + {undefined, undefined}; +chunk_start(_) -> + {first, undefined}. +chunk_finish(_, _, nolimit) -> + {undefined, undefined}; +chunk_finish(_, CbState, _) -> + {last, CbState}. + +body_chunk(first, _, Chunk) -> + {first, Chunk}; +body_chunk(ChunkState, CbState, Chunk) -> + {ChunkState, Chunk, CbState}. diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl index effa273e92..6b9053fda6 100644 --- a/lib/inets/src/http_server/httpd_response.erl +++ b/lib/inets/src/http_server/httpd_response.erl @@ -21,7 +21,7 @@ -module(httpd_response). -export([generate_and_send_response/1, send_status/3, send_header/3, send_body/3, send_chunk/3, send_final_chunk/2, send_final_chunk/3, - split_header/2, is_disable_chunked_send/1, cache_headers/2]). + split_header/2, is_disable_chunked_send/1, cache_headers/2, handle_continuation/1]). -export([map_status_code/2]). -include_lib("inets/src/inets_app/inets_internal.hrl"). @@ -31,6 +31,9 @@ -define(VMODULE,"RESPONSE"). +handle_continuation(Mod) -> + generate_and_send_response(Mod). + %% If peername does not exist the client already discarded the %% request so we do not need to send a reply. generate_and_send_response(#mod{init_data = @@ -39,6 +42,8 @@ generate_and_send_response(#mod{init_data = generate_and_send_response(#mod{config_db = ConfigDB} = ModData) -> Modules = httpd_util:lookup(ConfigDB, modules, ?DEFAULT_MODS), case traverse_modules(ModData, Modules) of + {continue, _} = Continue -> + Continue; done -> ok; {proceed, Data} -> @@ -69,17 +74,15 @@ generate_and_send_response(#mod{config_db = ConfigDB} = ModData) -> traverse_modules(ModData,[]) -> {proceed,ModData#mod.data}; traverse_modules(ModData,[Module|Rest]) -> - ?hdrd("traverse modules", [{callback_module, Module}]), try apply(Module, do, [ModData]) of + {continue, _} = Continue -> + Continue; done -> - ?hdrt("traverse modules - done", []), - done; + done; {break, NewData} -> - ?hdrt("traverse modules - break", [{new_data, NewData}]), - {proceed, NewData}; + {proceed, NewData}; {proceed, NewData} -> - ?hdrt("traverse modules - proceed", [{new_data, NewData}]), - traverse_modules(ModData#mod{data = NewData}, Rest) + traverse_modules(ModData#mod{data = NewData}, Rest) catch T:E -> String = @@ -104,15 +107,10 @@ send_status(#mod{socket_type = SocketType, socket = Socket, config_db = ConfigDB} = ModData, StatusCode, PhraseArgs) -> - ?hdrd("send status", [{status_code, StatusCode}, - {phrase_args, PhraseArgs}]), - ReasonPhrase = httpd_util:reason_phrase(StatusCode), Message = httpd_util:message(StatusCode, PhraseArgs, ConfigDB), Body = get_body(ReasonPhrase, Message), - ?hdrt("send status - header", [{reason_phrase, ReasonPhrase}, - {message, Message}]), send_header(ModData, StatusCode, [{content_type, "text/html"}, {content_length, integer_to_list(length(Body))}]), diff --git a/lib/inets/src/http_server/httpd_script_env.erl b/lib/inets/src/http_server/httpd_script_env.erl index e15613273e..055f08fdb0 100644 --- a/lib/inets/src/http_server/httpd_script_env.erl +++ b/lib/inets/src/http_server/httpd_script_env.erl @@ -74,9 +74,13 @@ which_peercert(#mod{socket_type = {Type, _}, socket = Socket}) when Type == essl which_peercert(_) -> %% Not an ssl connection undefined. + which_resolve(#mod{init_data = #init_data{resolve = Resolve}}) -> Resolve. +which_name(#mod{config_db = ConfigDB}) -> + httpd_util:lookup(ConfigDB, server_name). + which_method(#mod{method = Method}) -> Method. @@ -85,7 +89,8 @@ which_request_uri(#mod{request_uri = RUri}) -> create_basic_elements(esi, ModData) -> [{server_software, which_server(ModData)}, - {server_name, which_resolve(ModData)}, + {server_name, which_name(ModData)}, + {host_name, which_resolve(ModData)}, {gateway_interface, ?GATEWAY_INTERFACE}, {server_protocol, ?SERVER_PROTOCOL}, {server_port, which_port(ModData)}, @@ -96,7 +101,8 @@ create_basic_elements(esi, ModData) -> create_basic_elements(cgi, ModData) -> [{"SERVER_SOFTWARE", which_server(ModData)}, - {"SERVER_NAME", which_resolve(ModData)}, + {"SERVER_NAME", which_name(ModData)}, + {"HOST_NAME", which_resolve(ModData)}, {"GATEWAY_INTERFACE", ?GATEWAY_INTERFACE}, {"SERVER_PROTOCOL", ?SERVER_PROTOCOL}, {"SERVER_PORT", integer_to_list(which_port(ModData))}, diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index b21af1418c..3a589ca5f0 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -31,7 +31,6 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -define(VMODULE,"ESI"). -define(DEFAULT_ERL_TIMEOUT,15000). @@ -69,7 +68,6 @@ deliver(_SessionID, _Data) -> %% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS %%------------------------------------------------------------------------- do(ModData) -> - ?hdrt("do", []), case proplists:get_value(status, ModData#mod.data) of {_StatusCode, _PhraseArgs, _Reason} -> {proceed, ModData#mod.data}; @@ -190,7 +188,6 @@ store({erl_script_nocache, Value}, _) -> %%% Internal functions %%%======================================================================== generate_response(ModData) -> - ?hdrt("generate response", []), case scheme(ModData#mod.request_uri, ModData#mod.config_db) of {eval, ESIBody, Modules} -> eval(ModData, ESIBody, Modules); @@ -242,7 +239,6 @@ alias_match_str(Alias, eval_script_alias) -> erl(#mod{method = Method} = ModData, ESIBody, Modules) when (Method =:= "GET") orelse (Method =:= "HEAD") orelse (Method =:= "DELETE") -> - ?hdrt("erl", [{method, Method}]), case httpd_util:split(ESIBody,":|%3A|/",2) of {ok, [ModuleName, FuncAndInput]} -> case httpd_util:split(FuncAndInput,"[\?/]",2) of @@ -273,14 +269,12 @@ erl(#mod{method = "PUT", entity_body = Body} = ModData, generate_webpage(ModData, ESIBody, Modules, list_to_atom(ModuleName), FunctionName, {Input,Body}, - [{entity_body, Body} | - script_elements(FuncAndInput, Input)]); + script_elements(FuncAndInput, Input)); {ok, [FunctionName]} -> generate_webpage(ModData, ESIBody, Modules, list_to_atom(ModuleName), FunctionName, {undefined,Body}, - [{entity_body, Body} | - script_elements(FuncAndInput, "")]); + script_elements(FuncAndInput, "")); {ok, BadRequest} -> {proceed,[{status,{400,none, BadRequest}} | ModData#mod.data]} @@ -290,12 +284,11 @@ erl(#mod{method = "PUT", entity_body = Body} = ModData, end; erl(#mod{method = "POST", entity_body = Body} = ModData, ESIBody, Modules) -> - ?hdrt("erl", [{method, post}]), case httpd_util:split(ESIBody,":|%3A|/",2) of {ok,[ModuleName, Function]} -> generate_webpage(ModData, ESIBody, Modules, list_to_atom(ModuleName), - Function, Body, [{entity_body, Body}]); + Function, Body, []); {ok, BadRequest} -> {proceed,[{status, {400, none, BadRequest}} | ModData#mod.data]} end; @@ -304,7 +297,6 @@ erl(#mod{request_uri = ReqUri, method = "PATCH", http_version = Version, data = Data}, _ESIBody, _Modules) -> - ?hdrt("erl", [{method, patch}]), {proceed, [{status,{501,{"PATCH", ReqUri, Version}, ?NICE("Erl mechanism doesn't support method PATCH")}}| Data]}. @@ -315,7 +307,6 @@ generate_webpage(ModData, ESIBody, [all], Module, FunctionName, FunctionName, Input, ScriptElements); generate_webpage(ModData, ESIBody, Modules, Module, FunctionName, Input, ScriptElements) -> - ?hdrt("generate webpage", []), Function = list_to_atom(FunctionName), case lists:member(Module, Modules) of true -> @@ -337,7 +328,6 @@ generate_webpage(ModData, ESIBody, Modules, Module, FunctionName, %% Old API that waits for the dymnamic webpage to be totally generated %% before anythig is sent back to the client. erl_scheme_webpage_whole(Mod, Func, Env, Input, ModData) -> - ?hdrt("erl_scheme_webpage_whole", [{module, Mod}, {function, Func}]), case (catch Mod:Func(Env, Input)) of {'EXIT',{undef, _}} -> {proceed, [{status, {404, ModData#mod.request_uri, "Not found"}} @@ -375,7 +365,6 @@ erl_scheme_webpage_whole(Mod, Func, Env, Input, ModData) -> %% in small chunks at the time during generation. erl_scheme_webpage_chunk(Mod, Func, Env, Input, ModData) -> process_flag(trap_exit, true), - ?hdrt("erl_scheme_webpage_chunk", [{module, Mod}, {function, Func}]), Self = self(), %% Spawn worker that generates the webpage. %% It would be nicer to use erlang:function_exported/3 but if the @@ -386,7 +375,9 @@ erl_scheme_webpage_chunk(Mod, Func, Env, Input, ModData) -> {'EXIT', {undef,_}} -> %% Will force fallback on the old API exit(erl_scheme_webpage_chunk_undefined); - _ -> + {continue, _} = Continue -> + exit(Continue); + _ -> ok end end), @@ -400,13 +391,12 @@ deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid) -> deliver_webpage_chunk(ModData, Pid, Timeout). deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) -> - ?hdrt("deliver_webpage_chunk", [{timeout, Timeout}]), case receive_headers(Timeout) of {error, Reason} -> %% Happens when webpage generator callback/3 is undefined - ?hdrv("deliver_webpage_chunk - failed receiving headers", - [{reason, Reason}]), {error, Reason}; + {continue, _} = Continue -> + Continue; {Headers, Body} -> case httpd_esi:handle_headers(Headers) of {proceed, AbsPath} -> @@ -430,7 +420,6 @@ deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) -> IsDisableChunkedSend) end; timeout -> - ?hdrv("deliver_webpage_chunk - timeout", []), send_headers(ModData, 504, [{"connection", "close"}]), httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket), {proceed,[{response, {already_sent, 200, 0}} | ModData#mod.data]} @@ -439,16 +428,14 @@ deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) -> receive_headers(Timeout) -> receive {esi_data, Chunk} -> - ?hdrt("receive_headers - received esi data (esi)", []), httpd_esi:parse_headers(lists:flatten(Chunk)); {ok, Chunk} -> - ?hdrt("receive_headers - received esi data (ok)", []), httpd_esi:parse_headers(lists:flatten(Chunk)); {'EXIT', Pid, erl_scheme_webpage_chunk_undefined} when is_pid(Pid) -> - ?hdrd("receive_headers - exit:chunk-undef", []), {error, erl_scheme_webpage_chunk_undefined}; - {'EXIT', Pid, Reason} when is_pid(Pid) -> - ?hdrv("receive_headers - exit", [{reason, Reason}]), + {'EXIT', Pid, {continue, _} = Continue} when is_pid(Pid) -> + Continue; + {'EXIT', Pid, Reason} when is_pid(Pid) -> exit({mod_esi_linked_process_died, Pid, Reason}) after Timeout -> timeout @@ -463,7 +450,6 @@ handle_body(_, #mod{method = "HEAD"} = ModData, _, _, Size, _) -> {proceed, [{response, {already_sent, 200, Size}} | ModData#mod.data]}; handle_body(Pid, ModData, Body, Timeout, Size, IsDisableChunkedSend) -> - ?hdrt("handle_body - send chunk", [{timeout, Timeout}, {size, Size}]), httpd_response:send_chunk(ModData, Body, IsDisableChunkedSend), receive {esi_data, Data} when is_binary(Data) -> @@ -543,7 +529,6 @@ eval(#mod{request_uri = ReqUri, method = "PUT", http_version = Version, data = Data}, _ESIBody, _Modules) -> - ?hdrt("eval", [{method, put}]), {proceed,[{status,{501,{"PUT", ReqUri, Version}, ?NICE("Eval mechanism doesn't support method PUT")}}| Data]}; @@ -552,7 +537,6 @@ eval(#mod{request_uri = ReqUri, method = "DELETE", http_version = Version, data = Data}, _ESIBody, _Modules) -> - ?hdrt("eval", [{method, delete}]), {proceed,[{status,{501,{"DELETE", ReqUri, Version}, ?NICE("Eval mechanism doesn't support method DELETE")}}| Data]}; @@ -561,14 +545,12 @@ eval(#mod{request_uri = ReqUri, method = "POST", http_version = Version, data = Data}, _ESIBody, _Modules) -> - ?hdrt("eval", [{method, post}]), {proceed,[{status,{501,{"POST", ReqUri, Version}, ?NICE("Eval mechanism doesn't support method POST")}}| Data]}; eval(#mod{method = Method} = ModData, ESIBody, Modules) when (Method =:= "GET") orelse (Method =:= "HEAD") -> - ?hdrt("eval", [{method, Method}]), case is_authorized(ESIBody, Modules) of true -> case generate_webpage(ESIBody) of diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index b4f0f2aa7d..6c8728470b 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -74,6 +74,7 @@ all() -> {group, https_reload}, {group, http_mime_types}, {group, http_logging}, + {group, http_post}, mime_types_format ]. @@ -100,6 +101,7 @@ groups() -> {http_logging, [], [{group, logging}]}, {http_reload, [], [{group, reload}]}, {https_reload, [], [{group, reload}]}, + {http_post, [], [{group, post}]}, {http_mime_types, [], [alias_1_1, alias_1_0, alias_0_9]}, {limit, [], [max_clients_1_1, max_clients_1_0, max_clients_0_9]}, {custom, [], [customize, add_default]}, @@ -112,6 +114,7 @@ groups() -> disturbing_1_0, disturbing_0_9 ]}, + {post, [], [chunked_post, chunked_chunked_encoded_post]}, {basic_auth, [], [basic_auth_1_1, basic_auth_1_0, basic_auth_0_9]}, {auth_api, [], [auth_api_1_1, auth_api_1_0, auth_api_0_9 ]}, @@ -152,6 +155,7 @@ http_get() -> ipv6 ]. + load() -> [light, medium %%,heavy @@ -218,6 +222,7 @@ init_per_group(Group, Config0) when Group == http_basic; Group == http_auth_api_mnesia; Group == http_security; Group == http_reload; + Group == http_post; Group == http_mime_types -> ok = start_apps(Group), @@ -275,6 +280,7 @@ end_per_group(Group, _Config) when Group == http_basic; Group == http_htaccess; Group == http_security; Group == http_reload; + Group == http_post; Group == http_mime_types -> inets:stop(); @@ -299,7 +305,7 @@ end_per_group(_, _) -> %%-------------------------------------------------------------------- init_per_testcase(Case, Config) when Case == host; Case == trace -> - ct:timetrap({seconds, 20}), + ct:timetrap({seconds, 40}), Prop = proplists:get_value(tc_group_properties, Config), Name = proplists:get_value(name, Prop), Cb = case Name of @@ -677,6 +683,51 @@ ipv6(Config) when is_list(Config) -> end. %%------------------------------------------------------------------------- +chunked_post() -> + [{doc,"Test option max_client_body_chunk"}]. +chunked_post(Config) when is_list(Config) -> + ok = http_status("POST /cgi-bin/erl/httpd_example:post_chunked ", + {"Content-Length:833 \r\n", + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ"}, + [{http_version, "HTTP/1.1"} |Config], + [{statuscode, 200}]), + ok = http_status("POST /cgi-bin/erl/httpd_example:post_chunked ", + {"Content-Length:2 \r\n", + "ZZ" + }, + [{http_version, "HTTP/1.1"} |Config], + [{statuscode, 200}]). + +chunked_chunked_encoded_post() -> + [{doc,"Test option max_client_body_chunk with chunked client encoding"}]. +chunked_chunked_encoded_post(Config) when is_list(Config) -> + Chunk = http_chunk:encode("ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ"), + LastChunk = http_chunk:encode_last(), + Chunks = lists:duplicate(10000, Chunk), + ok = http_status("POST /cgi-bin/erl/httpd_example:post_chunked ", + {"Transfer-Encoding:chunked \r\n", + [Chunks | LastChunk]}, + [{http_version, "HTTP/1.1"} | Config], + [{statuscode, 200}]). + + +%%------------------------------------------------------------------------- htaccess_1_1(Config) when is_list(Config) -> htaccess([{http_version, "HTTP/1.1"} | Config]). @@ -1685,6 +1736,7 @@ start_apps(Group) when Group == http_basic; Group == http_security; Group == http_logging; Group == http_reload; + Group == http_post; Group == http_mime_types-> inets_test_lib:start_apps([inets]). @@ -1731,6 +1783,8 @@ server_config(https_basic, Config) -> basic_conf() ++ server_config(https, Config); server_config(http_reload, Config) -> [{keep_alive_timeout, 2}] ++ server_config(http, Config); +server_config(http_post, Config) -> + [{max_client_body_chunk, 10}] ++ server_config(http, Config); server_config(https_reload, Config) -> [{keep_alive_timeout, 2}] ++ server_config(https, Config); server_config(http_limit, Config) -> diff --git a/lib/public_key/src/pubkey_ssh.erl b/lib/public_key/src/pubkey_ssh.erl index 9bda76d670..75c1880655 100644 --- a/lib/public_key/src/pubkey_ssh.erl +++ b/lib/public_key/src/pubkey_ssh.erl @@ -79,7 +79,9 @@ dh_gex_group(Min, N, Max, undefined) -> dh_gex_group(Min, N, Max, Groups) -> case select_by_keylen(Min-10, N, Max+10, Groups) of {ok,{Sz,GPs}} -> - {ok, {Sz,lists:nth(crypto:rand_uniform(1, 1+length(GPs)), GPs)}}; + Rnd = rand:uniform( length(GPs) ), + %% 1 =< Rnd =< length(GPs) + {ok, {Sz, lists:nth(Rnd,GPs)}}; Other -> Other end. diff --git a/lib/public_key/test/erl_make_certs.erl b/lib/public_key/test/erl_make_certs.erl index e4118bab0d..e772ea1734 100644 --- a/lib/public_key/test/erl_make_certs.erl +++ b/lib/public_key/test/erl_make_certs.erl @@ -178,8 +178,9 @@ make_tbs(SubjectKey, Opts) -> _ -> subject(proplists:get_value(subject, Opts),false) end, - - {#'OTPTBSCertificate'{serialNumber = trunc(random:uniform()*100000000)*10000 + 1, + Rnd = rand:uniform( 1000000000000 ), + %% 1 =< Rnd < 1000000000001 + {#'OTPTBSCertificate'{serialNumber = Rnd, signature = SignAlgo, issuer = Issuer, validity = validity(Opts), @@ -466,7 +467,8 @@ odd_rand(Size) -> odd_rand(Min, Max). odd_rand(Min,Max) -> - Rand = crypto:rand_uniform(Min,Max), + %% Odd random number N such that Min =< N =< Max + Rand = (Min-1) + rand:uniform(Max-Min), % Min =< Rand < Max case Rand rem 2 of 0 -> Rand + 1; diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index ef7c3de7af..f44fe6a2bf 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -78,7 +78,7 @@ name(normal) -> ?MODULE; name(dist) -> - list_to_atom(atom_to_list(?MODULE) ++ "dist"). + list_to_atom(atom_to_list(?MODULE) ++ "_dist"). %%-------------------------------------------------------------------- -spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}. diff --git a/lib/ssl/src/ssl_pem_cache.erl b/lib/ssl/src/ssl_pem_cache.erl index 6cc0729208..115ab4451d 100644 --- a/lib/ssl/src/ssl_pem_cache.erl +++ b/lib/ssl/src/ssl_pem_cache.erl @@ -65,7 +65,7 @@ name(normal) -> ?MODULE; name(dist) -> - list_to_atom(atom_to_list(?MODULE) ++ "dist"). + list_to_atom(atom_to_list(?MODULE) ++ "_dist"). %%-------------------------------------------------------------------- -spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}. diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl index b28636569d..8828c3a0d8 100644 --- a/lib/ssl/src/ssl_pkix_db.erl +++ b/lib/ssl/src/ssl_pkix_db.erl @@ -76,10 +76,17 @@ remove(Dbs) -> true = ets:delete(Db1); (undefined) -> ok; - (ssl_pem_cache) -> - ok; - (ssl_pem_cache_dist) -> - ok; + (Name) when is_atom(Name) -> + NormalName = ssl_pem_cache:name(normal), + DistName = ssl_pem_cache:name(dist), + case Name of + NormalName -> + ok; + DistName -> + ok; + _ -> + true = ets:delete(Name) + end; (Db) -> true = ets:delete(Db) end, Dbs). diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index 64d5a71f3c..5df9c504f9 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -412,12 +412,12 @@ do_op(backward_word, Bef0, Aft0, Rs) -> {Bef1,Aft1,N0} = over_non_word(Bef0, Aft0, 0), {Bef,Aft,N} = over_word(Bef1, Aft1, N0), {{Bef,Aft},[{move_rel,-N}|Rs]}; -do_op(beginning_of_line, [C|Bef], Aft, Rs) -> - {{[],reverse(Bef, [C|Aft])},[{move_rel,-(cp_len(Bef)+1)}|Rs]}; +do_op(beginning_of_line, [_|_]=Bef, Aft, Rs) -> + {{[],reverse(Bef, Aft)},[{move_rel,-(cp_len(Bef))}|Rs]}; do_op(beginning_of_line, [], Aft, Rs) -> {{[],Aft},Rs}; -do_op(end_of_line, Bef, [C|Aft], Rs) -> - {{reverse(Aft, [C|Bef]),[]},[{move_rel,cp_len(Aft)+1}|Rs]}; +do_op(end_of_line, Bef, [_|_]=Aft, Rs) -> + {{reverse(Aft, Bef),[]},[{move_rel,cp_len(Aft)}|Rs]}; do_op(end_of_line, Bef, [], Rs) -> {{Bef,[]},Rs}; do_op(ctlu, Bef, Aft, Rs) -> diff --git a/lib/stdlib/test/id_transform_SUITE.erl b/lib/stdlib/test/id_transform_SUITE.erl index 3d4ae1a189..186df41d3f 100644 --- a/lib/stdlib/test/id_transform_SUITE.erl +++ b/lib/stdlib/test/id_transform_SUITE.erl @@ -61,8 +61,13 @@ id_transform(Config) when is_list(Config) -> "erl_id_trans.erl"]), {ok,erl_id_trans,Bin} = compile:file(File,[binary]), {module,erl_id_trans} = code:load_binary(erl_id_trans, File, Bin), - ct:timetrap({hours,1}), - run_in_test_suite(). + case test_server:is_valgrind() of + false -> + ct:timetrap({hours,1}), + run_in_test_suite(); + true -> + {skip,"Valgrind (too slow)"} + end. run_in_test_suite() -> SuperDir = filename:dirname(filename:dirname(code:which(?MODULE))), diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 46256daca9..429188b028 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1,10 +1,10 @@ -;;; erlang.el --- Major modes for editing and running Erlang +;;; erlang.el --- Major modes for editing and running Erlang -*- lexical-binding: t; -*- ;; Copyright (C) 2004 Free Software Foundation, Inc. ;; Author: Anders Lindgren ;; Keywords: erlang, languages, processes ;; Date: 2011-12-11 -;; Version: 2.7.0 +;; Version: 2.8.0 ;; Package-Requires: ((emacs "24.1")) ;; %CopyrightBegin% @@ -84,7 +84,7 @@ "The Erlang programming language." :group 'languages) -(defconst erlang-version "2.7" +(defconst erlang-version "2.8.0" "The version number of Erlang mode.") (defcustom erlang-root-dir nil @@ -1025,26 +1025,15 @@ files written in other languages than Erlang.") If nil, the inferior shell replaces the window. This is the traditional behaviour.") -(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist) - "Non-nil means use `compilation-minor-mode' in Erlang shell.") - (defvar erlang-mode-map (let ((map (make-sparse-keymap))) - (unless (boundp 'indent-line-function) - (define-key map "\t" 'erlang-indent-command)) (define-key map ";" 'erlang-electric-semicolon) (define-key map "," 'erlang-electric-comma) (define-key map "<" 'erlang-electric-lt) (define-key map ">" 'erlang-electric-gt) (define-key map "\C-m" 'erlang-electric-newline) - (if (not (boundp 'delete-key-deletes-forward)) - (define-key map "\177" 'backward-delete-char-untabify) - (define-key map [(backspace)] 'backward-delete-char-untabify)) - ;;(unless (boundp 'fill-paragraph-function) + (define-key map [(backspace)] 'backward-delete-char-untabify) (define-key map "\M-q" 'erlang-fill-paragraph) - (unless (boundp 'beginning-of-defun-function) - (define-key map "\M-\C-a" 'erlang-beginning-of-function) - (define-key map "\M-\C-e" 'erlang-end-of-function)) (define-key map "\M-\t" 'erlang-complete-tag) (define-key map "\C-c\M-\t" 'tempo-complete-tag) (define-key map "\M-+" 'erlang-find-next-tag) @@ -1063,8 +1052,6 @@ behaviour.") (define-key map "\C-c\C-y" 'erlang-clone-arguments) (define-key map "\C-c\C-a" 'erlang-align-arrows) (define-key map "\C-c\C-z" 'erlang-shell-display) - (unless inferior-erlang-use-cmm - (define-key map "\C-x`" 'erlang-next-error)) map) "Keymap used in Erlang mode.") (defvar erlang-mode-abbrev-table nil @@ -2089,12 +2076,6 @@ This function is aware of imported functions." (when funcname (erlang-man-find-function (current-buffer) funcname)))))) -(defun erlang-default-function-or-module () - (let ((id (erlang-get-identifier-at-point))) - (if (eq (erlang-id-kind id) 'qualified-function) - (format "%s:%s" (erlang-id-module id) (erlang-id-name id)) - (erlang-id-name id)))) - ;; Should the defadvice be at the top level, the package `advice' would ;; be required. Now it is only required when this functionality @@ -3402,14 +3383,6 @@ at the end." ;;; Information retrieval functions. -(defun erlang-buffer-substring (beg end) - "Like `buffer-substring-no-properties'. -Although, this function works on all versions of Emacs." - (if (fboundp 'buffer-substring-no-properties) - (funcall (symbol-function 'buffer-substring-no-properties) beg end) - (buffer-substring beg end))) - - (defun erlang-get-module () "Return the name of the module as specified by `-module'. @@ -3427,7 +3400,7 @@ Return nil if file contains no `-module' attribute." "\\)?\\)\\s *)\\s *\\.")) (point-max) t) (erlang-remove-quotes - (erlang-buffer-substring (match-beginning 1) + (buffer-substring-no-properties (match-beginning 1) (match-end 1))) nil) (store-match-data md)))))) @@ -3481,10 +3454,10 @@ corresponds to the order of the parsed Erlang list." (setq res (cons (cons (erlang-remove-quotes - (erlang-buffer-substring + (buffer-substring-no-properties (match-beginning 1) (match-end 1))) (string-to-number - (erlang-buffer-substring + (buffer-substring-no-properties (match-beginning (+ 1 erlang-atom-regexp-matches)) (match-end @@ -3531,7 +3504,7 @@ function and arity as cdr part." (erlang-skip-blank) (if (looking-at erlang-atom-regexp) (let ((module (erlang-remove-quotes - (erlang-buffer-substring + (buffer-substring-no-properties (match-beginning 0) (match-end 0))))) (goto-char (match-end 0)) @@ -3564,7 +3537,7 @@ Normally used in conjunction with `erlang-beginning-of-clause', e.g.: (let ((n (if arg 0 1))) (and (looking-at (eval-when-compile (concat "^" erlang-atom-regexp "\\s *("))) - (erlang-buffer-substring (match-beginning n) (match-end n))))) + (buffer-substring-no-properties (match-beginning n) (match-end n))))) (defun erlang-get-function-arrow () @@ -3578,7 +3551,7 @@ Normally used in conjunction with `erlang-beginning-of-clause', e.g.: (and (save-excursion (re-search-forward "->" (point-max) t) - (erlang-buffer-substring (- (point) 2) (+ (point) 1))))) + (buffer-substring-no-properties (- (point) 2) (+ (point) 1))))) (defun erlang-get-function-arity () "Return the number of arguments of function at point, or nil." @@ -3644,7 +3617,7 @@ The return value is a string of the form \"foo/1\"." (let ((start (match-end 0))) (goto-char (- start 1)) (forward-sexp) - (erlang-buffer-substring start (- (point) 1))) + (buffer-substring-no-properties start (- (point) 1))) (error nil))))) @@ -3709,10 +3682,10 @@ of arguments could be found, otherwise nil." (defun erlang-get-qualified-function-id-at-point () (let ((kind 'qualified-function) (module (erlang-remove-quotes - (erlang-buffer-substring + (buffer-substring-no-properties (match-beginning 1) (match-end 1)))) (name (erlang-remove-quotes - (erlang-buffer-substring + (buffer-substring-no-properties (match-beginning (1+ erlang-atom-regexp-matches)) (match-end (1+ erlang-atom-regexp-matches))))) (arity (progn @@ -3724,14 +3697,14 @@ of arguments could be found, otherwise nil." (let ((kind 'module) (module nil) (name (erlang-remove-quotes - (erlang-buffer-substring (match-beginning 1) + (buffer-substring-no-properties (match-beginning 1) (match-end 1)))) (arity nil)) (list kind module name arity))) (defun erlang-get-some-other-id-at-point () (let ((name (erlang-remove-quotes - (erlang-buffer-substring + (buffer-substring-no-properties (match-beginning 0) (match-end 0)))) (imports (erlang-get-import)) kind module arity) @@ -3798,6 +3771,21 @@ of arguments could be found, otherwise nil." (nth 3 (erlang-id-to-list id))) +(defun erlang-default-function-or-module () + (erlang-with-id (kind module name) (erlang-get-identifier-at-point) + (let ((x (cond ((eq kind 'module) + (format "%s:" name)) + ((eq kind 'record) + (format "-record(%s" name)) + ((eq kind 'macro) + (format "-define(%s" name)) + (t + name)))) + (if module + (format "%s:%s" module x) + x)))) + + ;; TODO: Escape single quotes inside the string without ;; replace-regexp-in-string. (defun erlang-add-quotes-if-needed (str) @@ -5005,9 +4993,10 @@ considered first when it is time to jump to the definition.") (and (fboundp 'xref-make) (fboundp 'xref-make-file-location) (let* ((first-time t) + (cbuf (current-buffer)) xrefs matching-files) (save-excursion - (while (visit-tags-table-buffer (not first-time)) + (while (erlang-visit-tags-table-buffer (not first-time) cbuf) (setq first-time nil) (let ((files (tags-table-files))) (while files @@ -5023,6 +5012,10 @@ considered first when it is time to jump to the definition.") (setq files (cdr files)))))) (nreverse xrefs)))) +(defun erlang-visit-tags-table-buffer (cont cbuf) + (if (< emacs-major-version 26) + (visit-tags-table-buffer cont) + (visit-tags-table-buffer cont cbuf))) (defun erlang-xref-find-definitions-module-tag (module tag @@ -5126,7 +5119,7 @@ Erlang compilation package.") "Command to execute to go to the next error. Change this variable to use your favorite Erlang compilation -package. Not used in Emacs 21.") +package.") ;;;###autoload @@ -5185,6 +5178,13 @@ future, a new shell on an already running host will be started." (defvar erlang-shell-buffer-name "*erlang*" "The name of the Erlang link shell buffer.") +(defcustom erlang-shell-prompt-read-only t + "If non-nil, the prompt will be read-only. + +Also see the description of `ielm-prompt-read-only'." + :type 'boolean + :package-version '(erlang . "2.8.0")) + (defvar erlang-shell-mode-map nil "Keymap used by Erlang shells.") @@ -5225,17 +5225,11 @@ The following special commands are available: (setq erlang-shell-mode-map (copy-keymap comint-mode-map)) (erlang-shell-mode-commands erlang-shell-mode-map)) (use-local-map erlang-shell-mode-map) - (unless inferior-erlang-use-cmm - ;; This was originally not a marker, but it needs to be, at least - ;; in Emacs 21, and should be backwards-compatible. Otherwise, - ;; would need to test whether compilation-parsing-end is a marker - ;; after requiring `compile'. - (set (make-local-variable 'compilation-parsing-end) (copy-marker 1)) - (set (make-local-variable 'compilation-error-list) nil) - (set (make-local-variable 'compilation-old-error-list) nil)) ;; Needed when compiling directly from the Erlang shell. (setq compilation-last-buffer (current-buffer)) (setq comint-prompt-regexp "^[^>=]*> *") + (make-local-variable 'comint-prompt-read-only) + (setq comint-prompt-read-only erlang-shell-prompt-read-only) (setq comint-eol-on-send t) (setq comint-input-ignoredups t) (setq comint-scroll-show-maximum-output t) @@ -5249,24 +5243,20 @@ The following special commands are available: (comint-read-input-ring t) (make-local-variable 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'comint-write-input-ring) - ;; At least in Emacs 21, we need to be in `compilation-minor-mode' - ;; for `next-error' to work. We can avoid it clobbering the shell - ;; keys thus. - (when inferior-erlang-use-cmm - (compilation-minor-mode 1) - (set (make-local-variable 'minor-mode-overriding-map-alist) - `((compilation-minor-mode - . ,(let ((map (make-sparse-keymap))) - ;; It would be useful to put keymap properties on the - ;; error lines so that we could use RET and mouse-2 - ;; on them directly. - (when (boundp 'compilation-skip-threshold) ; new compile.el - (define-key map [mouse-2] #'erlang-mouse-2-command) - (define-key map "\C-m" #'erlang-RET-command)) - (if (boundp 'compilation-menu-map) - (define-key map [menu-bar compilation] - (cons "Errors" compilation-menu-map))) - map))))) + (compilation-minor-mode 1) + (set (make-local-variable 'minor-mode-overriding-map-alist) + `((compilation-minor-mode + . ,(let ((map (make-sparse-keymap))) + ;; It would be useful to put keymap properties on the + ;; error lines so that we could use RET and mouse-2 + ;; on them directly. + (when (boundp 'compilation-skip-threshold) ; new compile.el + (define-key map [mouse-2] #'erlang-mouse-2-command) + (define-key map "\C-m" #'erlang-RET-command)) + (if (boundp 'compilation-menu-map) + (define-key map [menu-bar compilation] + (cons "Errors" compilation-menu-map))) + map)))) (erlang-tags-init) (run-hooks 'erlang-shell-mode-hook)) @@ -5295,9 +5285,7 @@ Selects Comint or Compilation mode command as appropriate." (define-key map "\C-a" 'comint-bol) ; Normally the other way around. (define-key map "\C-c\C-a" 'beginning-of-line) (define-key map "\C-d" nil) ; Was `comint-delchar-or-maybe-eof' - (define-key map "\M-\C-m" 'compile-goto-error) - (unless inferior-erlang-use-cmm - (define-key map "\C-x`" 'erlang-next-error))) + (define-key map "\M-\C-m" 'compile-goto-error)) ;;; ;;; Inferior Erlang -- Run an Erlang shell as a subprocess. @@ -5908,35 +5896,6 @@ Tab characters are counted by their visual width." (if (looking-at "[a-z0-9_]+") (match-string 0)))) -;; Aliases for backward compatibility with older versions of Erlang Mode. -;; -;; Unfortuantely, older versions of Emacs doesn't have `defalias' and -;; `make-obsolete' so we have to define our own `obsolete' function. - -(defun erlang-obsolete (sym newdef) - "Make the obsolete function SYM refer to the defined function NEWDEF. - -Simplified version of a combination `defalias' and `make-obsolete', -it assumes that NEWDEF is loaded." - (defalias sym (symbol-function newdef)) - (make-obsolete sym newdef "long ago")) - - -(erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent) -(erlang-obsolete 'calculate-erlang-stack-indent - 'erlang-calculate-stack-indent) -(erlang-obsolete 'at-erlang-keyword 'erlang-at-keyword) -(erlang-obsolete 'at-erlang-operator 'erlang-at-operator) -(erlang-obsolete 'beginning-of-erlang-clause 'erlang-beginning-of-clause) -(erlang-obsolete 'end-of-erlang-clause 'erlang-end-of-clause) -(erlang-obsolete 'mark-erlang-clause 'erlang-mark-clause) -(erlang-obsolete 'beginning-of-erlang-function 'erlang-beginning-of-function) -(erlang-obsolete 'end-of-erlang-function 'erlang-end-of-function) -(erlang-obsolete 'mark-erlang-function 'erlang-mark-function) -(erlang-obsolete 'pass-over-erlang-clause 'erlang-pass-over-function) -(erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function) - - (defconst erlang-unload-hook (list (lambda () (ad-unadvise 'Man-notify-when-ready) |