path: root/erts/emulator/beam/emu/generators.tab

// -*- c -*-
//
// %CopyrightBegin%
//
// Copyright Ericsson AB 2020. 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.
// You may obtain a copy of the License at
//
//     http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// %CopyrightEnd%
//

// Generate the fastest instruction to fetch an integer from a binary.
gen.get_integer2(Fail, Ms, Live, Size, Unit, Flags, Dst) {
    BeamOp* op;
    UWord bits;

    $NewBeamOp(S, op);
    $NativeEndian(Flags);
    if (Size.type == TAG_i) {
        if (!beam_load_safe_mul(Size.val, Unit.val, &bits)) {
            goto error;
        } else if ((Flags.val & BSF_SIGNED) != 0) {
            goto generic;
        } else if (bits == 8) {
            $BeamOpNameArity(op, i_bs_get_integer_8, 3);
            op->a[0] = Ms;
            op->a[1] = Fail;
            op->a[2] = Dst;
        } else if (bits == 16 && (Flags.val & BSF_LITTLE) == 0) {
            $BeamOpNameArity(op, i_bs_get_integer_16, 3);
            op->a[0] = Ms;
            op->a[1] = Fail;
            op->a[2] = Dst;
#ifdef ARCH_64
        } else if (bits == 32 && (Flags.val & BSF_LITTLE) == 0) {
            $BeamOpNameArity(op, i_bs_get_integer_32, 3);
            op->a[0] = Ms;
            op->a[1] = Fail;
            op->a[2] = Dst;
#endif
        } else {
        generic:
            if (bits < SMALL_BITS) {
                $BeamOpNameArity(op, i_bs_get_integer_small_imm, 5);
                op->a[0] = Ms;
                op->a[1].type = TAG_u;
                op->a[1].val = bits;
                op->a[2] = Fail;
                op->a[3] = Flags;
                op->a[4] = Dst;
            } else {
                $BeamOpNameArity(op, i_bs_get_integer_imm, 6);
                op->a[0] = Ms;
                op->a[1].type = TAG_u;
                op->a[1].val = bits;
                op->a[2] = Live;
                op->a[3] = Fail;
                op->a[4] = Flags;
                op->a[5] = Dst;
            }
        }
    } else if (Size.type == TAG_q) {
        Eterm big = beamfile_get_literal(&S->beam, Size.val);
        Uint bigval;

        if (!term_to_Uint(big, &bigval)) {
        error:
            $BeamOpNameArity(op, jump, 1);
            op->a[0] = Fail;
        } else {
            if (!beam_load_safe_mul(bigval, Unit.val, &bits)) {
                goto error;
            }
            goto generic;
        }
    } else if (Size.type == TAG_x || Size.type == TAG_y) {
        $BeamOpNameArity(op, i_bs_get_integer, 6);
        op->a[0] = Ms;
        op->a[1] = Fail;
        op->a[2] = Live;
        op->a[3].type = TAG_u;
        op->a[3].val = (Unit.val << 3) | Flags.val;
        op->a[4] = Size;
        op->a[5] = Dst;
        return op;
    } else {
        /* Invalid literal size. */
        goto error;
    }
    return op;
}

gen.jump_tab(Src, Fail, Size, Rest) {
    Sint min, max;
    Sint i;
    Sint size;
    Sint arity;
    int fixed_args;
    BeamOp* op;

    ASSERT(Size.val >= 2 && Size.val % 2 == 0);

    /* Don't generate a jump table if there's only one choice */
    if (Size.val == 2) {
        BeamOp* jump;

        $NewBeamOp(S, op);
        $BeamOpNameArity(op, is_ne_exact, 3);
        op->a[0] = Rest[1];
        op->a[1] = Src;
        op->a[2] = Rest[0];

        $NewBeamOp(S, jump);
        $BeamOpNameArity(jump, jump, 1);
        jump->a[0] = Fail;

        op->next = jump;
        jump->next = NULL;
        return op;
    }

    /* Calculate the minimum and maximum values and size of jump table. */
    ASSERT(Rest[0].type == TAG_i);
    min = max = Rest[0].val;
    for (i = 2; i < Size.val; i += 2) {
        ASSERT(Rest[i].type == TAG_i && Rest[i+1].type == TAG_f);
        if (Rest[i].val < min) {
            min = Rest[i].val;
        } else if (max < Rest[i].val) {
            max = Rest[i].val;
        }
    }
    size = max - min + 1;

    /* Allocate structure and fill in the fixed fields. */
    $NewBeamOp(S, op);
    op->next = NULL;
    if (min == 0) {
        $BeamOpNameArity(op, i_jump_on_val_zero, 3);
    } else {
        $BeamOpNameArity(op, i_jump_on_val, 4);
    }
    fixed_args = op->arity;
    arity = fixed_args + size;
    $BeamOpArity(op, arity);
    op->a[0] = Src;
    op->a[1] = Fail;
    op->a[2].type = TAG_u;
    op->a[2].val = size;
    op->a[3].type = TAG_u;
    op->a[3].val = min;

    /* Fill in the jump table. */
    for (i = fixed_args; i < arity; i++) {
        op->a[i] = Fail;
    }

    for (i = 0; i < Size.val; i += 2) {
        Sint index = fixed_args + Rest[i].val - min;
        ASSERT(fixed_args <= index && index < arity);
        op->a[index] = Rest[i+1];
    }

    return op;
}

//
// Generate a select_val instruction.  We know that a jump table
// is not suitable, and that all values are of the same type
// (integer or atoms).
//
gen.select_val(Src, Fail, Size, Rest) {
    BeamOp* op;
    BeamOpArg *tmp;
    int arity = Size.val + 3;
    int size = Size.val / 2;
    int i, j, align = 0;

    if (size == 2) {
        /*
         * Use a special-cased instruction if there are only two values.
         */

        $NewBeamOp(S, op);
        op->next = NULL;
        $BeamOpNameArity(op, i_select_val2, 4);
        $BeamOpArity(op, arity - 1);
        op->a[0] = Src;
        op->a[1] = Fail;
        op->a[2] = Rest[0];
        op->a[3] = Rest[2];
        op->a[4] = Rest[1];
        op->a[5] = Rest[3];

        return op;
    }

    if (size <= 10) {
        /* Use linear search. Reserve place for a sentinel. */
        align = 1;
    }

    arity += 2*align;
    size  += align;

    $NewBeamOp(S, op);
    op->next = NULL;
    if (align == 0) {
        $BeamOpNameArity(op, i_select_val_bins, 3);
    } else {
        $BeamOpNameArity(op, i_select_val_lins, 3);
    }
    $BeamOpArity(op, arity);
    op->a[0] = Src;
    op->a[1] = Fail;
    op->a[2].type = TAG_u;
    op->a[2].val = size;

    tmp = (BeamOpArg *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(BeamOpArg)*(arity-2*align));

    for (i = 3; i < arity - 2*align; i++) {
        tmp[i-3] = Rest[i-3];
    }

    /* Sort the values to make them useful for a binary or sentinel search. */
    beam_load_sort_select_vals(tmp, size - align);

    j = 3;
    for (i = 3; i < arity - 2*align; i += 2) {
        op->a[j]      = tmp[i-3];
        op->a[j+size] = tmp[i-2];
        j++;
    }

    erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp);

    if (align) {
        /* Add sentinel for linear search. */
        op->a[j].type = TAG_u;
        op->a[j].val  = ~((BeamInstr)0);
        op->a[j+size] = Fail;
    }

#ifdef DEBUG
    for (i = 0; i < size - 1; i++) {
        ASSERT(op->a[i+3].val <= op->a[i+4].val);
    }
#endif

    return op;
}

//
// Generate a select_val instruction for big numbers.
//
gen.select_literals(Src, Fail, Size, Rest) {
    BeamOp* op;
    BeamOp* jump;
    BeamOp** prev_next = &op;

    int i;

    for (i = 0; i < Size.val; i += 2) {
        BeamOp* op;
        ASSERT(Rest[i].type == TAG_q);

        $NewBeamOp(S, op);
        $BeamOpNameArity(op, is_ne_exact, 3);
        op->a[0] = Rest[i+1];
        op->a[1] = Src;
        op->a[2] = Rest[i];
        *prev_next = op;
        prev_next = &op->next;
    }

    $NewBeamOp(S, jump);
    $BeamOpNameArity(jump, jump, 1);
    jump->next = NULL;
    jump->a[0] = Fail;
    *prev_next = jump;
    return op;
}

//
// Replace a select_val instruction with a constant controlling expression
// with a jump instruction.
//
gen.const_select_val(Src, Fail, Size, Rest) {
    BeamOp* op;
    int i;

    ASSERT(Size.type == TAG_u);

    $NewBeamOp(S, op);
    $BeamOpNameArity(op, jump, 1);
    op->next = NULL;

    /* Search for a literal matching the controlling expression. */
    switch (Src.type) {
    case TAG_q:
        {
            Eterm expr = beamfile_get_literal(&S->beam, Src.val);
            for (i = 0; i < Size.val; i += 2) {
                if (Rest[i].type == TAG_q) {
                    Eterm term = beamfile_get_literal(&S->beam, Rest[i].val);
                    if (eq(term, expr)) {
                        ASSERT(Rest[i+1].type == TAG_f);
                        op->a[0] = Rest[i+1];
                        return op;
                    }
                }
            }
        }
        break;
    case TAG_i:
    case TAG_a:
        for (i = 0; i < Size.val; i += 2) {
            if (Rest[i].val == Src.val && Rest[i].type == Src.type) {
                ASSERT(Rest[i+1].type == TAG_f);
                op->a[0] = Rest[i+1];
                return op;
            }
        }
        break;
    }

    /*
     * No match.  Use the failure label.
     */

    op->a[0] = Fail;
    return op;
}

//
// Split a list consisting of both small and bignumbers into two
// select_val instructions.
//
gen.split_values(Src, TypeFail, Fail, Size, Rest) {
    BeamOp* op1;
    BeamOp* op2;
    BeamOp* label;
    BeamOp* is_integer;
    int i;

    ASSERT(Size.val >= 2 && Size.val % 2 == 0);

    $NewBeamOp(S, is_integer);
    $BeamOpNameArity(is_integer, is_integer, 2);
    is_integer->a[0] = TypeFail;
    is_integer->a[1] = Src;

    $NewBeamOp(S, label);
    $BeamOpNameArity(label, label, 1);
    label->a[0].type = TAG_u;
    label->a[0].val = beam_load_new_label(S);

    $NewBeamOp(S, op1);
    $BeamOpNameArity(op1, select_val, 3);
    $BeamOpArity(op1, 3 + Size.val);
    op1->a[0] = Src;
    op1->a[1].type = TAG_f;
    op1->a[1].val = label->a[0].val;
    op1->a[2].type = TAG_u;
    op1->a[2].val = 0;

    $NewBeamOp(S, op2);
    $BeamOpNameArity(op2, select_val, 3);
    $BeamOpArity(op2, 3 + Size.val);
    op2->a[0] = Src;
    op2->a[1] = Fail;
    op2->a[2].type = TAG_u;
    op2->a[2].val = 0;

    /* Split the list. */
    ASSERT(Size.type == TAG_u);
    for (i = 0; i < Size.val; i += 2) {
        BeamOp* op = (Rest[i].type == TAG_q) ? op2 : op1;
        int dst = 3 + op->a[2].val;

        ASSERT(Rest[i+1].type == TAG_f);
        op->a[dst] = Rest[i];
        op->a[dst+1] = Rest[i+1];
        op->arity += 2;
        op->a[2].val += 2;
    }
    ASSERT(op1->a[2].val > 0);
    ASSERT(op2->a[2].val > 0);

    /* Order the instruction sequence appropriately. */
    if (TypeFail.val == Fail.val) {
        /*
         * select_val L1 S ... (small numbers)
         * label L1
         * is_integer Fail S
         * select_val Fail S ... (bignums)
         */
        op1->next = label;
        label->next = is_integer;
        is_integer->next = op2;
    } else {
        /*
         * is_integer TypeFail S
         * select_val L1 S ... (small numbers)
         * label L1
         * select_val Fail S ... (bignums)
         */
        is_integer->next = op1;
        op1->next = label;
        label->next = op2;
        op1 = is_integer;
    }
    op2->next = NULL;

    return op1;
}


//
// Tag the list of values with tuple arity tags.
//
gen.select_tuple_arity(Src, Fail, Size, Rest) {
    BeamOp* op;
    BeamOpArg *tmp;
    int arity = Size.val + 3;
    int size = Size.val / 2;
    int i, j, align = 0;

    /* Verify the validity of the list. */

    if (Size.val % 2 != 0) {
        return NULL;
    }

    for (i = 0; i < Size.val; i += 2) {
        if (Rest[i].type != TAG_u || Rest[i+1].type != TAG_f) {
            return NULL;
        }
    }

    /*
     * Use a special-cased instruction if there are only two values.
     */
    if (size == 2) {
        $NewBeamOp(S, op);
        $BeamOpNameArity(op, i_select_tuple_arity2, 4);
        $BeamOpArity(op, arity - 1);
        op->next = NULL;
        op->a[0] = Src;
        op->a[1] = Fail;
        op->a[2].type = TAG_u;
        op->a[2].val  = Rest[0].val;
        op->a[3].type = TAG_u;
        op->a[3].val  = Rest[2].val;
        op->a[4] = Rest[1];
        op->a[5] = Rest[3];

        return op;
    }

    /*
     * Generate the generic instruction.
     * Assumption:
     *   Few different tuple arities to select on (fewer than 20).
     *   Use linear scan approach.
     */

    align = 1;

    arity += 2*align;
    size  += align;

    $NewBeamOp(S, op);
    $BeamOpNameArity(op, i_select_tuple_arity, 3);
    $BeamOpArity(op, arity);
    op->next = NULL;
    op->a[0] = Src;
    op->a[1] = Fail;
    op->a[2].type = TAG_u;
    op->a[2].val = size;

    tmp = (BeamOpArg *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(BeamOpArg)*(arity-2*align));

    for (i = 3; i < arity - 2*align; i+=2) {
        tmp[i-3].type = TAG_v;
        tmp[i-3].val  = make_arityval(Rest[i-3].val);
        tmp[i-2]      = Rest[i-2];
    }

    /* Sort the values to make them useful for a binary or sentinel search. */
    beam_load_sort_select_vals(tmp, size - align);

    j = 3;
    for (i = 3; i < arity - 2*align; i += 2) {
        op->a[j]        = tmp[i-3];
        op->a[j + size] = tmp[i-2];
        j++;
    }

    erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp);

    op->a[j].type = TAG_u;
    op->a[j].val  = ~((BeamInstr)0);
    op->a[j+size] = Fail;

    return op;
}

gen.new_small_map_lit(Dst, Live, Size, Rest) {
    unsigned size = Size.val;
    Uint lit;
    unsigned i;
    BeamOp* op;
    BeamOpArg* dst;
    Eterm* tmp;
    Eterm* thp;
    Eterm keys;

    $NewBeamOp(S, op);
    $BeamOpNameArity(op, i_new_small_map_lit, 3);
    $BeamOpArity(op, 3 + size/2);
    op->next = NULL;

    tmp = thp = erts_alloc(ERTS_ALC_T_LOADER_TMP, (1 + size/2) * sizeof(*tmp));
    keys = make_tuple(thp);
    *thp++ = make_arityval(size/2);

    dst = op->a+3;

    for (i = 0; i < size; i += 2) {
        switch (Rest[i].type) {
        case TAG_a:
            *thp++ = Rest[i].val;
            ASSERT(is_atom(Rest[i].val));
            break;
        case TAG_i:
            *thp++ = make_small(Rest[i].val);
            break;
        case TAG_n:
            *thp++ = NIL;
            break;
        case TAG_q:
            *thp++ = beamfile_get_literal(&S->beam, Rest[i].val);
            break;
        }
        *dst++ = Rest[i + 1];
    }

    lit = beamfile_add_literal(&S->beam, keys);
    erts_free(ERTS_ALC_T_LOADER_TMP, tmp);

    op->a[0] = Dst;
    op->a[1] = Live;
    op->a[2].type = TAG_q;
    op->a[2].val = lit;

    return op;
}

// Macro for generating a timeout instruction for a literal timeout value.
gen_literal_timeout(stp, fail, time, succ_instr, fail_instr) {
    BeamOp* op;
    Sint timeout;

    $NewBeamOp($stp, op);
    $BeamOpNameArity(op, $succ_instr, 2);
    op->a[0].type = TAG_u;
    op->a[1] = $fail;

    if ($time.type == TAG_i && (timeout = $time.val) >= 0 &&
#if defined(ARCH_64)
        (timeout >> 32) == 0
#else
        1
#endif
        ) {
        op->a[0].val = timeout;
#if !defined(ARCH_64)
    } else if ($time.type == TAG_q) {
        Eterm big = beamfile_get_literal(&S->beam, $time.val);

        if (is_not_big(big)) {
            goto error;
        }

        if (big_arity(big) > 1 || big_sign(big)) {
            goto error;
        } else {
            Uint u;
            (void) term_to_Uint(big, &u);
            op->a[0].val = (BeamInstr) u;
        }
#endif
    } else {
#if !defined(ARCH_64)
    error:
#endif
        $BeamOpNameArity(op, $fail_instr, 0);
    }
    return op;
}

gen.literal_timeout(Fail, Time) {
    $gen_literal_timeout(S, Fail, Time, wait_timeout_unlocked_int, i_wait_error);
}

gen.literal_timeout_locked(Fail, Time) {
    $gen_literal_timeout(S, Fail, Time, wait_timeout_locked_int, i_wait_error_locked);
}

// Generate an instruction for element/2.
gen.element(Fail, Index, Tuple, Dst) {
    BeamOp* op;

    $NewBeamOp(S, op);
    op->next = NULL;

    if (Index.type == TAG_i && Index.val > 0 &&
        Index.val <= ERTS_MAX_TUPLE_SIZE &&
        (Tuple.type == TAG_x || Tuple.type == TAG_y)) {
        $BeamOpNameArity(op, i_fast_element, 4);
        op->a[0] = Tuple;
        op->a[1] = Fail;
        op->a[2].type = TAG_u;
        op->a[2].val = Index.val;
        op->a[3] = Dst;
    } else {
        $BeamOpNameArity(op, i_element, 4);
        op->a[0] = Tuple;
        op->a[1] = Fail;
        op->a[2] = Index;
        op->a[3] = Dst;
    }

    return op;
}

// Generate the fastest instruction to fetch a binary from a binary.
gen.get_binary2(Fail, Ms, Live, Size, Unit, Flags, Dst) {
    BeamOp* op;

    $NewBeamOp(S, op);
    $NativeEndian(Flags);

    if (Size.type == TAG_a && Size.val == am_all) {
        $BeamOpNameArity(op, i_bs_get_binary_all2, 5);
        op->a[0] = Ms;
        op->a[1] = Fail;
        op->a[2] = Live;
        op->a[3] = Unit;
        op->a[4] = Dst;
    } else if (Size.type == TAG_i) {
        $BeamOpNameArity(op, i_bs_get_binary_imm2, 6);
        op->a[0] = Ms;
        op->a[1] = Fail;
        op->a[2] = Live;
        op->a[3].type = TAG_u;
        if (!beam_load_safe_mul(Size.val, Unit.val, &op->a[3].val)) {
            goto error;
        }
        op->a[4] = Flags;
        op->a[5] = Dst;
    } else if (Size.type == TAG_q) {
        Eterm big = beamfile_get_literal(&S->beam, Size.val);
        Uint bigval;

        if (!term_to_Uint(big, &bigval)) {
        error:
            $BeamOpNameArity(op, jump, 1);
            op->a[0] = Fail;
        } else {
            $BeamOpNameArity(op, i_bs_get_binary_imm2, 6);
            op->a[0] = Ms;
            op->a[1] = Fail;
            op->a[2] = Live;
            op->a[3].type = TAG_u;
            if (!beam_load_safe_mul(bigval, Unit.val, &op->a[3].val)) {
                goto error;
            }
            op->a[4] = Flags;
            op->a[5] = Dst;
        }
    } else if (Size.type == TAG_x || Size.type == TAG_y) {
        $BeamOpNameArity(op, i_bs_get_binary2, 6);
        op->a[0] = Ms;
        op->a[1] = Fail;
        op->a[2] = Live;
        op->a[3] = Size;
        op->a[4].type = TAG_u;
        op->a[4].val = (Unit.val << 3) | Flags.val;
        op->a[5] = Dst;
    } else {
        /* Invalid literal size. */
        goto error;
    }
    op->next = NULL;
    return op;
}

gen.is_function2(Fail, Fun, Arity) {
    BeamOp* op;
    int literal_arity = Arity.type == TAG_i;
    int fun_is_reg = Fun.type == TAG_x || Fun.type == TAG_y;

    $NewBeamOp(S, op);

    if (fun_is_reg && literal_arity) {
        /*
         * Most common case. Fun in a register and arity
         * is an integer literal.
         */
        if (Arity.val > MAX_ARG) {
            /* Arity is negative or too big. */
            $BeamOpNameArity(op, jump, 1);
            op->a[0] = Fail;
            return op;
        } else {
            $BeamOpNameArity(op, hot_is_function2, 3);
            op->a[0] = Fail;
            op->a[1] = Fun;
            op->a[2].type = TAG_u;
            op->a[2].val = Arity.val;
            return op;
        }
    } else {
        /*
         * Handle extremely uncommon cases by a slower sequence.
         */
        BeamOp* move_fun;
        BeamOp* move_arity;

        $NewBeamOp(S, move_fun);
        $NewBeamOp(S, move_arity);

        move_fun->next = move_arity;
        move_arity->next = op;

        $BeamOpNameArity(move_fun, move, 2);
        move_fun->a[0] = Fun;
        move_fun->a[1].type = TAG_x;
        move_fun->a[1].val = 1022;

        $BeamOpNameArity(move_arity, move, 2);
        move_arity->a[0] = Arity;
        move_arity->a[1].type = TAG_x;
        move_arity->a[1].val = 1023;

        $BeamOpNameArity(op, cold_is_function2, 3);
        op->a[0] = Fail;
        op->a[1].type = TAG_x;
        op->a[1].val = 1022;
        op->a[2].type = TAG_x;
        op->a[2].val = 1023;
        return move_fun;
    }
}

INIT_YREGS(S, N) {
    int i;
    for (i = 0; i < $N; i++) {
	BeamOp* init;

	$NewBeamOp($S, init);
	$BeamOpNameArity(init, init, 1);
	init->a[0] = Yregs[i];
	*p = init;
	p = &init->next;
    }
}

gen.allocate(Ns, Live, N, Yregs) {
    BeamOp* alloc;
    BeamOp** p;

    $NewBeamOp(S, alloc);
    alloc->a[0] = Ns;
    alloc->a[1] = Live;

    if (Ns.val <= 2 * N.val) {
	/*
	 * At least half of the Y registers need explicit
	 * initialization. It will be cheaper to zero all Y registers.
	 */
	$BeamOpNameArity(alloc, allocate_zero, 2);
    } else {
	$BeamOpNameArity(alloc, allocate, 2);
	p = &alloc->next;
	$INIT_YREGS(S, N.val);
    }
    return alloc;
}

gen.allocate_heap(Ns, Nh, Live, N, Yregs) {
    BeamOp* alloc;
    BeamOp** p;

    $NewBeamOp(S, alloc);
    alloc->a[0] = Ns;
    alloc->a[1] = Nh;
    alloc->a[2] = Live;

    if (Ns.val <= 2 * N.val) {
	/*
	 * At least half of the Y registers need explicit
	 * initialization. It will be cheaper to zero all Y registers.
	 */
	$BeamOpNameArity(alloc, allocate_heap_zero, 3);
    } else {
	$BeamOpNameArity(alloc, allocate_heap, 3);
	p = &alloc->next;
	$INIT_YREGS(S, N.val);
    }
    return alloc;
}

gen.init_yregs(N, Yregs) {
    BeamOp* first = NULL;
    BeamOp** p;

    p = &first;
    $INIT_YREGS(S, N.val);
    return first;
}

gen.create_bin(Fail, Alloc, Live, Unit, Dst, N, Segments) {
    BeamOp* op;
    int fixed_args;
    BeamOpArg* src;
    BeamOpArg* dst;
    BeamOpArg* endp;

    endp = Segments + N.val;
    N.val = 5*N.val/6;

    $NewBeamOp(S, op);
    $BeamOpNameArity(op, i_bs_create_bin, 5);
    fixed_args = op->arity;
    $BeamOpArity(op, (N.val + fixed_args));

    op->a[0] = Fail;
    op->a[1] = Alloc;
    op->a[2] = Live;
    op->a[3] = Dst;
    op->a[4] = N;

    for (src = Segments, dst = op->a+fixed_args; src < endp; src += 6, dst += 5) {
        UWord unit;
        BeamOpArg Flags;
        Uint flags = 0;
        BeamOpArg Size;
        Uint type;
        Uint segment;

        ASSERT(src[0].type = TAG_a);
        ASSERT(src[1].type == TAG_u);
        ASSERT(src[2].type == TAG_u);
        segment = src[1].val;

        /* Get unit. */
        dst[1] = src[2];
        unit = dst[1].val;

        /* Translate flags. */
        Flags = src[3];              /* Flags */
        if (Flags.type != TAG_n) {
            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;
                    }
                    term = CDR(consp);
                }
                ASSERT(is_nil(term));
            }
        }
        Flags.type = TAG_u;
        Flags.val = flags;
        $NativeEndian(Flags);
        Flags.val = (segment << 3) | Flags.val;
        dst[2] = Flags;

        /* Store source. */
        dst[3] = src[4];        /* Src */

        /* Get size */
        Size = src[5];          /* Size */

        /* Translate type. */
        switch (src[0].val) {
        case am_append:
            type = BSC_APPEND;
            break;
        case am_private_append:
            type = BSC_PRIVATE_APPEND;
            break;
        case am_binary:
            {
                UWord bits;
                type = BSC_BINARY;
                if (Size.type == TAG_a && Size.val == am_all) {
                    type = BSC_BINARY_ALL;
                } else if (Size.type == TAG_i &&
                           (Sint) Size.val >= 0 &&
                           beam_load_safe_mul(Size.val, unit, &bits) &&
                           (bits >> (sizeof(Uint)-1)*8) == 0) {
                    type = BSC_BINARY_FIXED_SIZE;
                    Size.type = TAG_u;
                    Size.val = bits;
                    unit = 0;
                }
            }
            break;
        case am_float:
            {
                UWord bits;
                type = BSC_FLOAT;
                if (Size.type == TAG_i &&
                    (Sint) Size.val >= 0 &&
                    beam_load_safe_mul(Size.val, unit, &bits) &&
                    (bits >> (sizeof(Uint)-1)*8) == 0) {
                    type = BSC_FLOAT_FIXED_SIZE;
                    Size.type = TAG_u;
                    Size.val = bits;
                    unit = 0;
                }
            }
            break;
        case am_integer:
            {
                UWord bits;
                type = BSC_INTEGER;
                if (Size.type == TAG_i &&
                    (Sint) Size.val >= 0 &&
                    beam_load_safe_mul(Size.val, unit, &bits) &&
                    (bits >> (sizeof(Uint)-1)*8) == 0) {
                    type = BSC_INTEGER_FIXED_SIZE;
                    Size.type = TAG_u;
                    Size.val = bits;
                    unit = 0;
                }
            }
            break;
        case am_string:
            type = BSC_STRING;
            ASSERT(Size.type == TAG_i);
            ASSERT(unit == 8);
            Size.type = TAG_u;
            Size.val = Size.val; /* Size of string in bytes. */
            unit = 0;
            break;
        case am_utf8:
            type = BSC_UTF8;
            break;
        case am_utf16:
            type = BSC_UTF16;
            break;
        case am_utf32:
            type = BSC_UTF32;
            Size.type = TAG_u;
            Size.val = 32;
            break;
        default:
            abort();
        }
        dst[0].type = TAG_u;
        dst[0].val = type;

        /* Store value of unit. */
        dst[1].val = unit;

        /* Store size. */
        dst[4] = Size;
    }
    return op;
}