diff options
Diffstat (limited to 'erts/emulator/beam/emu/generators.tab')
-rw-r--r-- | erts/emulator/beam/emu/generators.tab | 413 |
1 files changed, 411 insertions, 2 deletions
diff --git a/erts/emulator/beam/emu/generators.tab b/erts/emulator/beam/emu/generators.tab index 65d5c60175..1f20a19ecc 100644 --- a/erts/emulator/beam/emu/generators.tab +++ b/erts/emulator/beam/emu/generators.tab @@ -2,7 +2,7 @@ // // %CopyrightBegin% // -// Copyright Ericsson AB 2020-2021. All Rights Reserved. +// Copyright Ericsson AB 2020-2023. All Rights Reserved. // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. @@ -590,7 +590,7 @@ gen.new_small_map_lit(Dst, Live, Size, Rest) { *dst++ = Rest[i + 1]; } - lit = beamfile_add_literal(&S->beam, keys); + lit = beamfile_add_literal(&S->beam, keys, 1); erts_free(ERTS_ALC_T_LOADER_TMP, tmp); op->a[0] = Dst; @@ -1025,3 +1025,412 @@ gen.create_bin(Fail, Alloc, Live, Unit, Dst, N, Segments) { } return op; } + +gen.update_record(Size, Src, Dst, N, Updates) { + BeamOp *begin, *prev; + Sint count, i; + + ASSERT(Size.type == TAG_u && Size.val < SCRATCH_X_REG); + ASSERT(N.type == TAG_u && !(N.val % 2) && (N.val / 2) <= Size.val); + + $NewBeamOp(S, begin); + $BeamOpNameArity(begin, i_update_record, 5); + + begin->a[0] = Size; + begin->a[1] = Src; + begin->a[2] = Dst; + begin->a[3] = Updates[0]; + begin->a[4] = Updates[1]; + + count = N.val; + prev = begin; + + for (i = 2; i < count; i += 2) { + BeamOp *next; + + $NewBeamOp(S, next); + $BeamOpNameArity(next, i_update_record_continue, 2); + + /* Encode the offset from the _end_ of the tuple so that we can act + * relative to HTOP. */ + next->a[0].type = TAG_u; + next->a[0].val = (Size.val + 1) - Updates[i].val; + + /* The first instruction overwrites the destination register after + * stashing its contents to SCRATCH_X_REG, so all updates must be + * rewritten accordingly. */ + if (Updates[i + 1].type == Dst.type && Updates[i + 1].val == Dst.val) { + next->a[1].type = TAG_x; + next->a[1].val = SCRATCH_X_REG; + } else { + next->a[1] = Updates[i + 1]; + } + + next->next = NULL; + prev->next = next; + + prev = next; + } + + return begin; +} + +gen.bs_match(Fail, Ctx, N, List) { + BeamOp* first_op = 0; + BeamOp** next_ptr = &first_op; + BeamOp* test_heap_op = 0; + BeamOp* read_op = 0; +#ifdef ARCH_64 + BeamOp* eq_op = 0; +#endif + int src; + + src = 0; + while (src < N.val) { + Uint unit; + Uint size; + Uint words_needed; + BeamOp* op; + + /* Calculate the number of heap words needed for this + * instruction. */ + words_needed = 0; + switch (List[src].val) { + case am_binary: + ASSERT(List[src+3].type == TAG_u); + ASSERT(List[src+4].type == TAG_u); + size = List[src+3].val * List[src+4].val; + words_needed = heap_bin_size((size + 7) / 8); + break; + case am_integer: + ASSERT(List[src+3].type == TAG_u); + ASSERT(List[src+4].type == TAG_u); + size = List[src+3].val * List[src+4].val; + if (size >= SMALL_BITS) { + words_needed = BIG_NEED_FOR_BITS(size); + } + break; + case am_get_tail: + words_needed = EXTRACT_SUB_BIN_HEAP_NEED; + break; + } + + /* Emit a test_heap instrution if needed and there is + * no previous one. */ + if ((List[src].val == am_Eq || words_needed) && test_heap_op == 0 && + List[src+1].type == TAG_u) { + $NewBeamOp(S, test_heap_op); + $BeamOpNameArity(test_heap_op, test_heap, 2); + + test_heap_op->a[0].type = TAG_u; + test_heap_op->a[0].val = 0; /* Number of heap words */ + test_heap_op->a[1] = List[src+1]; /* Live */ + + *next_ptr = test_heap_op; + next_ptr = &test_heap_op->next; + } + + if (words_needed) { + test_heap_op->a[0].val += words_needed; + } + + /* Translate this sub-instruction to a BEAM instruction. */ + op = 0; + switch (List[src].val) { + case am_ensure_at_least: { + Uint size = List[src+1].val; + unit = List[src+2].val; + if (size != 0 && unit == 1) { + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_bs_ensure_bits, 3); + op->a[0] = Ctx; + op->a[1].type = TAG_u; + op->a[1].val = size; + op->a[2] = Fail; + } else if (size != 0 && unit != 1) { + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_bs_ensure_bits_unit, 4); + + op->a[0] = Ctx; + op->a[1].type = TAG_u; + op->a[1].val = size; /* Size */ + op->a[2].type = TAG_u; + op->a[2].val = unit; /* Unit */ + op->a[3] = Fail; + } else if (size == 0 && unit != 1) { + $NewBeamOp(S, op); + $BeamOpNameArity(op, bs_test_unit, 3); + + op->a[0] = Fail; + op->a[1] = Ctx; + op->a[2].type = TAG_u; + op->a[2].val = unit; + } else if (size == 0 && unit == 1) { + /* This test is redundant because it always + * succeeds. This should only happen for unoptimized + * code. Generate a dummy instruction to ensure that + * we don't trigger the sanity check at the end of + * this generator. */ + $NewBeamOp(S, op); + $BeamOpNameArity(op, delete_me, 0); + } + src += 3; + break; + } + case am_ensure_exactly: { + $NewBeamOp(S, op); + $BeamOpNameArity(op, bs_test_tail2, 3); + + op->a[0] = Fail; + op->a[1] = Ctx; + op->a[2]= List[src+1]; /* Size */ + + src += 2; + break; + } + case am_binary: { + ASSERT(List[src+3].type == TAG_u); + ASSERT(List[src+4].type == TAG_u); + size = List[src+3].val; + unit = List[src+4].val; + + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_bs_get_fixed_binary, 3); + + op->a[0] = Ctx; + op->a[1].type = TAG_u; + op->a[1].val = size * unit; /* Size */ + op->a[2] = List[src+5]; /* Dst */ + + read_op = 0; + src += 6; + break; + } + case am_integer: { + Uint flags = 0; + BeamOpArg Flags; + + /* Translate flags. */ + Flags = List[src+2]; + if (Flags.type == TAG_n) { + Flags.type = TAG_u; + Flags.val = 0; + } else if (Flags.type == TAG_q) { + Eterm term = beamfile_get_literal(&S->beam, Flags.val); + while (is_list(term)) { + Eterm* consp = list_val(term); + Eterm elem = CAR(consp); + switch (elem) { + case am_little: + flags |= BSF_LITTLE; + break; + case am_native: + flags |= BSF_NATIVE; + break; + case am_signed: + flags |= BSF_SIGNED; + break; + } + term = CDR(consp); + } + ASSERT(is_nil(term)); + Flags.type = TAG_u; + Flags.val = flags; + $NativeEndian(Flags); + } + + ASSERT(List[src+3].type == TAG_u); + ASSERT(List[src+4].type == TAG_u); + size = List[src+3].val * List[src+4].val; + +#define READ_OP_SIZE 1 + if (size < SMALL_BITS && flags == 0) { + /* This is a suitable segment -- an unsigned big + * endian integer that fits in a small. */ + if (read_op == 0 || read_op->a[READ_OP_SIZE].val + size > 8*sizeof(Uint)) { + /* There is either no previous i_bs_read_bits instruction or + * the size of this segment don't fit into it. */ + $NewBeamOp(S, read_op); + $BeamOpNameArity(read_op, i_bs_read_bits, 2); + + read_op->a[0] = Ctx; + read_op->a[1].type = TAG_u; + read_op->a[1].val = 0; + + *next_ptr = read_op; + next_ptr = &read_op->next; + } + + read_op->a[READ_OP_SIZE].val += size; + + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_bs_extract_integer, 2); + op->a[0].type = TAG_u; + op->a[0].val = size; + op->a[1] = List[src+5]; /* Dst */ + } else { + /* Little endian, signed, or might not fit in a small. */ + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_bs_get_fixed_integer, 4); + + op->a[0] = Ctx; + op->a[1].type = TAG_u; + op->a[1].val = size; /* Size */ + op->a[2] = Flags; /* Flags */ + op->a[3] = List[src+5]; /* Dst */ + + read_op = 0; + } + + src += 6; + break; + } + case am_Eq: { + ASSERT(List[src+2].type == TAG_u); + ASSERT(List[src+3].type == TAG_u); + size = List[src+2].val; + + if (read_op == 0 || read_op->a[READ_OP_SIZE].val + size > 8*sizeof(Uint)) { + /* There is either no previous i_bs_read_bits instruction or + * the size of this segment don't fit into it. */ + $NewBeamOp(S, read_op); + $BeamOpNameArity(read_op, i_bs_read_bits, 2); + + read_op->a[0] = Ctx; + read_op->a[1].type = TAG_u; + read_op->a[1].val = 0; + + *next_ptr = read_op; + next_ptr = &read_op->next; + } + + read_op->a[READ_OP_SIZE].val += size; + +#ifdef ARCH_64 + if (eq_op && + eq_op->next == 0 && /* Previous instruction? */ + eq_op->a[1].val + size <= 8*sizeof(Uint)) { + /* Coalesce with the previous `=:=` instruction. */ + eq_op->a[1].val += size; + eq_op->a[2].val = eq_op->a[2].val << size | List[src+3].val; + } +#else + if (0) { + ; + } +#endif + else { + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_bs_eq, 3); + +#ifdef ARCH_64 + eq_op = op; +#endif + + op->a[0] = Fail; + op->a[1] = List[src+2]; /* Size */ + op->a[2] = List[src+3]; /* Value */ + } + + src += 4; + break; + } + case am_get_tail: + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_bs_get_tail, 2); + + op->a[0] = Ctx; + op->a[1] = List[src+3]; /* Dst */ + + read_op = 0; + src += 4; + break; + case am_skip: + ASSERT(List[src+1].type == TAG_u); + size = List[src+1].val; + + $NewBeamOp(S, op); + + if (read_op && read_op->a[READ_OP_SIZE].val + size <= 8*sizeof(Uint)) { + read_op->a[READ_OP_SIZE].val += size; + $BeamOpNameArity(op, i_bs_drop, 1); + op->a[0] = List[src+1]; /* Size */ + } else { + $BeamOpNameArity(op, i_bs_skip, 2); + op->a[0] = Ctx; + op->a[1] = List[src+1]; /* Size */ + read_op = 0; + } + + src += 2; + break; + default: + /* + * This is an unknown sub command. It was probably produced by a later + * release of Erlang/OTP than the current one. Fail loading. + */ + + $NewBeamOp(S, op); + $BeamOpNameArity(op, bad_bs_match, 1); + op->a[0] = List[src]; + *next_ptr = op; + return first_op; + } + + if (op) { + *next_ptr = op; + next_ptr = &op->next; + } + } + + if (test_heap_op && test_heap_op->a[0].val == 0) { + /* This test_heap instruction was forced by the `=:=` sub + * instruction, but it turned out that no test_heap instruction was + * needed. */ + $BeamOpNameArity(test_heap_op, delete_me, 0); + } + + if (first_op == 0) { + erts_exit(ERTS_ERROR_EXIT, "loading bs_match in %T:%T/%d: no instructions loaded", + S->module, S->function, S->arity); + } + + ASSERT(first_op); + return first_op; +} + +gen_increment(stp, reg, val, dst) { + BeamOp* op; + $NewBeamOp($stp, op); + $BeamOpNameArity(op, i_increment, 3); + op->a[0] = $reg; + op->a[1].type = TAG_u; + op->a[1].val = $val; + op->a[2] = $dst; + return op; +} + +gen.increment(Reg, Integer, Dst) { + $gen_increment(S, Reg, Integer.val, Dst); +} + +gen.increment_from_minus(Reg, Integer, Dst) { + $gen_increment(S, Reg, -Integer.val, Dst); +} + +gen.plus_from_minus(Fail, Live, Src, Integer, Dst) { + BeamOp* op; + + ASSERT(Integer.type == TAG_i && IS_SSMALL(-(Sint)Integer.val)); + + $NewBeamOp(S, op); + $BeamOpNameArity(op, gen_plus, 5); + op->a[0] = Fail; + op->a[1] = Live; + op->a[2] = Src; + op->a[3].type = TAG_i; + op->a[3].val = -(Sint)Integer.val; + op->a[4] = Dst; + + return op; +} |