path: root/erts/emulator/beam/arith_instrs.tab

// -*- c -*-
//
// %CopyrightBegin%
//
// Copyright Ericsson AB 2017. 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%
//

OUTLINED_ARITH_2(Fail, Name, BIF, Op1, Op2, Dst) {
    Eterm result;
#ifdef DEBUG
    Eterm* orig_htop = HTOP;
    Eterm* orig_stop = E;
#endif
    DEBUG_SWAPOUT;
    result = erts_$Name (c_p, $Op1, $Op2);
    DEBUG_SWAPIN;
    ASSERT(orig_htop == HTOP && orig_stop == E);
    ERTS_HOLE_CHECK(c_p);
    if (ERTS_LIKELY(is_value(result))) {
        $Dst = result;
        $NEXT0();
    }
    $BIF_ERROR_ARITY_2($Fail, $BIF, $Op1, $Op2);
}


i_plus := plus.fetch.execute;

plus.head() {
    Eterm PlusOp1, PlusOp2;
}

plus.fetch(Op1, Op2) {
    PlusOp1 = $Op1;
    PlusOp2 = $Op2;
}

plus.execute(Fail, Dst) {
    if (ERTS_LIKELY(is_both_small(PlusOp1, PlusOp2))) {
#ifdef HAVE_OVERFLOW_CHECK_BUILTINS
        Sint lhs_tagged, rhs_untagged, res;

        /* The value part of immediate integers start right after the tag and
         * occupy the rest of the word, so if you squint a bit they look like
         * fixed-point integers; as long as you mask the tag away you will get
         * correct results from addition/subtraction since they share the same
         * notion of zero. It's fairly easy to see that the following holds
         * when (a + b) is in range:
         *
         *     (a >> s) + (b >> s) == ((a & ~m) + (b & ~m)) >> s
         *
         * Where 's' is the tag size and 'm' is the tag mask.
         *
         * The left-hand side is our fallback in the #else clause and is the
         * fastest way to do this safely in plain C. The actual addition will
         * never overflow since `Sint` has a much greater range than our
         * smalls, so we can use the IS_SSMALL macro to see if the result is
         * within range.
         *
         * What we're doing below is an extension of the right-hand side. By
         * treating `a` and `b` as fixed-point integers, all additions whose
         * result is out of range will also overflow `Sint` and we can use the
         * compiler's overflow intrinsics to check for this condition.
         *
         * In addition, since the tag lives in the lowest bits we can further
         * optimize this by only stripping the tag from either side. The higher
         * bits can't influence the tag bits since we bail on overflow, so the
         * tag bits from the tagged side will simply appear in the result. */
        lhs_tagged = PlusOp1;
        rhs_untagged = PlusOp2 & ~_TAG_IMMED1_MASK;

        if (ERTS_LIKELY(!__builtin_add_overflow(lhs_tagged, rhs_untagged, &res))) {
            ASSERT(is_small(res));
            $Dst = res;
            $NEXT0();
        }
#else
        Sint i = signed_val(PlusOp1) + signed_val(PlusOp2);
        if (ERTS_LIKELY(IS_SSMALL(i))) {
            $Dst = make_small(i);
            $NEXT0();
        }
#endif
    }
    $OUTLINED_ARITH_2($Fail, mixed_plus, BIF_splus_2, PlusOp1, PlusOp2, $Dst);
}

i_minus := minus.fetch.execute;

minus.head() {
    Eterm MinusOp1, MinusOp2;
}

minus.fetch(Op1, Op2) {
    MinusOp1 = $Op1;
    MinusOp2 = $Op2;
}

minus.execute(Fail, Dst) {
    if (ERTS_LIKELY(is_both_small(MinusOp1, MinusOp2))) {
#ifdef HAVE_OVERFLOW_CHECK_BUILTINS
        Sint lhs_tagged, rhs_untagged, res;

        /* See plus.execute */
        lhs_tagged = MinusOp1;
        rhs_untagged = MinusOp2 & ~_TAG_IMMED1_MASK;

        if (ERTS_LIKELY(!__builtin_sub_overflow(lhs_tagged, rhs_untagged, &res))) {
            ASSERT(is_small(res));
            $Dst = res;
            $NEXT0();
        }
#else
        Sint i = signed_val(MinusOp1) - signed_val(MinusOp2);

        if (ERTS_LIKELY(IS_SSMALL(i))) {
            $Dst = make_small(i);
            $NEXT0();
        }
#endif
    }
    $OUTLINED_ARITH_2($Fail, mixed_minus, BIF_sminus_2, MinusOp1, MinusOp2, $Dst);
}

i_increment := increment.fetch.execute;

increment.head() {
    Eterm increment_reg_val;
}

increment.fetch(Src) {
    increment_reg_val = $Src;
}

increment.execute(IncrementVal, Dst) {
    Eterm increment_val = $IncrementVal;
    Eterm result;

    if (ERTS_LIKELY(is_small(increment_reg_val))) {
#ifdef HAVE_OVERFLOW_CHECK_BUILTINS
        Sint lhs_tagged, rhs_untagged, res;

        /* See plus.execute */
        lhs_tagged = increment_reg_val;
        rhs_untagged = (Sint)increment_val << _TAG_IMMED1_SIZE;

        if (ERTS_LIKELY(!__builtin_add_overflow(lhs_tagged, rhs_untagged, &res))) {
            ASSERT(is_small(res));
            $Dst = res;
            $NEXT0();
        }
#else
        Sint i = signed_val(increment_reg_val) + increment_val;
        if (ERTS_LIKELY(IS_SSMALL(i))) {
            $Dst = make_small(i);
            $NEXT0();
        }
#endif
    }

    result = erts_mixed_plus(c_p, increment_reg_val, make_small(increment_val));
    ERTS_HOLE_CHECK(c_p);
    if (ERTS_LIKELY(is_value(result))) {
        $Dst = result;
        $NEXT0();
    }
    ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue));
    goto find_func_info;
}

i_times(Fail, Op1, Op2, Dst) {
    Eterm op1 = $Op1;
    Eterm op2 = $Op2;
#ifdef HAVE_OVERFLOW_CHECK_BUILTINS
    if (ERTS_LIKELY(is_both_small(op1, op2))) {
        /* See plus.execute */
        Sint lhs_untagged, rhs_actual, res;

        lhs_untagged = op1 & ~_TAG_IMMED1_MASK;
        rhs_actual = signed_val(op2);

        if (ERTS_LIKELY(!__builtin_mul_overflow(lhs_untagged, rhs_actual, &res))) {
            ASSERT(!(res & _TAG_IMMED1_MASK));
            $Dst = res | _TAG_IMMED1_SMALL;
            $NEXT0();
        }
    }
#endif
    $OUTLINED_ARITH_2($Fail, mixed_times, BIF_stimes_2, op1, op2, $Dst);
}

i_m_div(Fail, Op1, Op2, Dst) {
    Eterm op1 = $Op1;
    Eterm op2 = $Op2;
    $OUTLINED_ARITH_2($Fail, mixed_div, BIF_div_2, op1, op2, $Dst);
}

i_int_div(Fail, Op1, Op2, Dst) {
    Eterm op1 = $Op1;
    Eterm op2 = $Op2;
    if (ERTS_UNLIKELY(op2 == SMALL_ZERO)) {
        c_p->freason = BADARITH;
        $BIF_ERROR_ARITY_2($Fail, BIF_intdiv_2, op1, op2);
    } else if (ERTS_LIKELY(is_both_small(op1, op2))) {
        Sint ires = signed_val(op1) / signed_val(op2);
        if (ERTS_LIKELY(IS_SSMALL(ires))) {
            $Dst = make_small(ires);
            $NEXT0();
        }
    }
    $OUTLINED_ARITH_2($Fail, int_div, BIF_intdiv_2, op1, op2, $Dst);
}

i_rem := rem.fetch.execute;

rem.head() {
     Eterm RemOp1, RemOp2;
}

rem.fetch(Src1, Src2) {
    RemOp1 = $Src1;
    RemOp2 = $Src2;
}

rem.execute(Fail, Dst) {
    if (ERTS_UNLIKELY(RemOp2 == SMALL_ZERO)) {
        c_p->freason = BADARITH;
        $BIF_ERROR_ARITY_2($Fail, BIF_rem_2, RemOp1, RemOp2);
    } else if (ERTS_LIKELY(is_both_small(RemOp1, RemOp2))) {
        $Dst = make_small(signed_val(RemOp1) % signed_val(RemOp2));
        $NEXT0();
    } else {
        $OUTLINED_ARITH_2($Fail, int_rem, BIF_rem_2, RemOp1, RemOp2, $Dst);
    }
}

i_band := band.fetch.execute;

band.head() {
    Eterm BandOp1, BandOp2;
}

band.fetch(Src1, Src2) {
    BandOp1 = $Src1;
    BandOp2 = $Src2;
}

band.execute(Fail, Dst) {
    if (ERTS_LIKELY(is_both_small(BandOp1, BandOp2))) {
        /*
         * No need to untag -- TAG & TAG == TAG.
         */
        $Dst = BandOp1 & BandOp2;
        $NEXT0();
    }
    $OUTLINED_ARITH_2($Fail, band, BIF_band_2, BandOp1, BandOp2, $Dst);
}

i_bor(Fail, Src1, Src2, Dst) {
    if (ERTS_LIKELY(is_both_small($Src1, $Src2))) {
        /*
         * No need to untag -- TAG | TAG == TAG.
         */
        $Dst = $Src1 | $Src2;
        $NEXT0();
    }
    $OUTLINED_ARITH_2($Fail, bor, BIF_bor_2, $Src1, $Src2, $Dst);
}

i_bxor(Fail, Src1, Src2, Dst) {
    if (ERTS_LIKELY(is_both_small($Src1, $Src2))) {
        /*
         * TAG ^ TAG == 0.
         *
         * Therefore, we perform the XOR operation on the tagged values,
         * and OR in the tag bits.
         */
        $Dst = ($Src1 ^ $Src2) | make_small(0);
        $NEXT0();
    }
    $OUTLINED_ARITH_2($Fail, bxor, BIF_bxor_2, $Src1, $Src2, $Dst);
}

i_bsl := shift.setup_bsl.execute;
i_bsr := shift.setup_bsr.execute;

shift.head() {
    Eterm Op1, Op2;
    Sint shift_left_count;
}

shift.setup_bsr(Src1, Src2) {
    Op1 = $Src1;
    Op2 = $Src2;
    shift_left_count = 0;
    if (ERTS_LIKELY(is_small(Op2))) {
        shift_left_count = -signed_val(Op2);
    } else if (is_big(Op2)) {
        /*
         * N bsr NegativeBigNum == N bsl MAX_SMALL
         * N bsr PositiveBigNum == N bsl MIN_SMALL
         */
        shift_left_count = make_small(bignum_header_is_neg(*big_val(Op2)) ?
                                      MAX_SMALL : MIN_SMALL);
    }
}

shift.setup_bsl(Src1, Src2) {
    Op1 = $Src1;
    Op2 = $Src2;
    shift_left_count = 0;
    if (ERTS_LIKELY(is_small(Op2))) {
        shift_left_count = signed_val(Op2);
    } else if (is_big(Op2)) {
        if (bignum_header_is_neg(*big_val(Op2))) {
            /*
             * N bsl NegativeBigNum is either 0 or -1, depending on
             * the sign of N. Since we don't believe this case
             * is common, do the calculation with the minimum
             * amount of code.
             */
            shift_left_count = MIN_SMALL;
        } else if (is_integer(Op1)) {
            /*
             * N bsl PositiveBigNum is too large to represent.
             */
            shift_left_count = MAX_SMALL;
        }
    }
}

shift.execute(Fail, Dst) {
    Uint big_words_needed;

    if (ERTS_LIKELY(is_small(Op1))) {
        Sint int_res = signed_val(Op1);
        if (ERTS_UNLIKELY(shift_left_count == 0 || int_res == 0)) {
            if (ERTS_UNLIKELY(is_not_integer(Op2))) {
                goto shift_error;
            }
            if (int_res == 0) {
                $Dst = Op1;
                $NEXT0();
            }
        } else if (shift_left_count < 0)  { /* Right shift */
            Eterm bsr_res;
            shift_left_count = -shift_left_count;
            if (shift_left_count >= SMALL_BITS-1) {
                bsr_res = (int_res < 0) ? SMALL_MINUS_ONE : SMALL_ZERO;
            } else {
                bsr_res = make_small(int_res >> shift_left_count);
            }
            $Dst = bsr_res;
            $NEXT0();
        } else if (shift_left_count < SMALL_BITS-1) { /* Left shift */
            if ((int_res > 0 &&
                 ((~(Uint)0 << ((SMALL_BITS-1)-shift_left_count)) & int_res) == 0) ||
                ((~(Uint)0 << ((SMALL_BITS-1)-shift_left_count)) & ~int_res) == 0) {
                $Dst = make_small(int_res << shift_left_count);
                $NEXT0();
            }
        }
        big_words_needed = 1;   /* big_size(small_to_big(Op1)) */
        goto big_shift;
    } else if (is_big(Op1)) {
        if (shift_left_count == 0) {
            if (is_not_integer(Op2)) {
                goto shift_error;
            }
            $Dst = Op1;
            $NEXT0();
        }
        big_words_needed = big_size(Op1);

    big_shift:
        if (shift_left_count > 0) {	/* Left shift. */
            big_words_needed += (shift_left_count / D_EXP);
        } else {	/* Right shift. */
            if (big_words_needed <= (-shift_left_count / D_EXP)) {
                big_words_needed = 3;       /* ??? */
            } else {
                big_words_needed -= (-shift_left_count / D_EXP);
            }
        }
        {
            Eterm tmp_big[2];
            Sint big_need_size = 1 + BIG_NEED_SIZE(big_words_needed+1);
            Eterm* hp;
            Eterm* hp_end;

            /*
             * Slightly conservative check the size to avoid
             * allocating huge amounts of memory for bignums that
             * clearly would overflow the arity in the header
             * word.
             */
            if (big_need_size-8 > BIG_ARITY_MAX) {
                $SYSTEM_LIMIT($Fail);
            }
            hp = HeapFragOnlyAlloc(c_p, big_need_size);
            if (is_small(Op1)) {
                Op1 = small_to_big(signed_val(Op1), tmp_big);
            }
            Op1 = big_lshift(Op1, shift_left_count, hp);
            hp_end = hp + big_need_size;
            if (is_big(Op1)) {
                hp += bignum_header_arity(*hp) + 1;
            }
            HRelease(c_p, hp_end, hp);
            if (ERTS_UNLIKELY(is_nil(Op1))) {
                /*
                 * This result must have been only slighty larger
                 * than allowed since it wasn't caught by the
                 * previous test.
                 */
                $SYSTEM_LIMIT($Fail);
            }
            ERTS_HOLE_CHECK(c_p);
            $Dst = Op1;
            $NEXT0();
        }
    }

    /*
     * One or more non-integer arguments.
     */
 shift_error:
    c_p->freason = BADARITH;
    if ($Fail) {
        $FAIL($Fail);
    } else {
        reg[0] = Op1;
        reg[1] = Op2;
        SWAPOUT;
        if (IsOpCode(I[0], i_bsl_ssjd)) {
            I = handle_error(c_p, I, reg, &bif_export[BIF_bsl_2]->info.mfa);
        } else {
            ASSERT(IsOpCode(I[0], i_bsr_ssjd));
            I = handle_error(c_p, I, reg, &bif_export[BIF_bsr_2]->info.mfa);
        }
        goto post_error_handling;
    }
}

i_int_bnot(Fail, Src, Dst) {
    Eterm bnot_val = $Src;
    Eterm result;

    if (ERTS_LIKELY(is_small(bnot_val))) {
        result = make_small(~signed_val(bnot_val));
    } else {
        result = erts_bnot(c_p, bnot_val);
        ERTS_HOLE_CHECK(c_p);
        if (ERTS_UNLIKELY(is_nil(result))) {
            $BIF_ERROR_ARITY_1($Fail, BIF_bnot_1, bnot_val);
        }
    }
    $Dst = result;
}