From 1ea57e5498d92b730644cb37b659d16e51f56b4d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Thu, 6 Dec 2018 13:07:42 +0100
Subject: Make length/1 yielding

The guard BIF `length/1` would calculate the length of the list in one
go without yielding, even if the list was were long. To make it even
worse, the call to `length/1` would only cost a single reduction.

This commit reimplements `length/1` so that it eats a number of
reductions proportional to the length of the list, and yields if the
available reductions run out.
---
 erts/emulator/beam/bif_instrs.tab | 81 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 81 insertions(+)

(limited to 'erts/emulator/beam/bif_instrs.tab')

diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab
index 3abd062552..ce9e61a838 100644
--- a/erts/emulator/beam/bif_instrs.tab
+++ b/erts/emulator/beam/bif_instrs.tab
@@ -160,6 +160,87 @@ i_bif3_body(Bif, Src1, Src2, Src3, Dst) {
     goto post_error_handling;
 }
 
+//
+// length/1 is the only guard BIF that does not execute in constant
+// time. Here follows special instructions to allow the calculation of
+// the list length to be broken in several chunks to avoid hogging
+// the scheduler for a long time.
+//
+
+i_length_setup(Live, Src) {
+    Uint live = $Live;
+    Eterm src = $Src;
+
+    reg[live] = src;
+    reg[live+1] = make_small(0);
+    reg[live+2] = src;
+
+    /* This instruction is always followed by i_length */
+    SET_I($NEXT_INSTRUCTION);
+    goto i_length_start__;
+    //| -no_next
+}
+
+//
+// This instruction can be executed one or more times. When entering
+// this instruction, the X registers have the following contents:
+//
+// reg[live+0] The remainder of the list.
+// reg[live+1] The length so far (tagged integer).
+// reg[live+2] The original list. Only used if an error is generated
+//             (if the final tail of the list is not []).
+//
+
+i_length := i_length.start.execute;
+
+i_length.start() {
+ i_length_start__:
+    ;
+}
+
+i_length.execute(Fail, Live, Dst) {
+    Eterm result;
+    Uint live;
+
+    ERTS_DBG_CHK_REDS(c_p, FCALLS);
+    c_p->fcalls = FCALLS;
+    PROCESS_MAIN_CHK_LOCKS(c_p);
+    ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+    ERTS_CHK_MBUF_SZ(c_p);
+    DEBUG_SWAPOUT;
+
+    live = $Live;
+    result = erts_trapping_length_1(c_p, reg+live);
+
+    DEBUG_SWAPIN;
+    ERTS_CHK_MBUF_SZ(c_p);
+    ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
+    ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+    PROCESS_MAIN_CHK_LOCKS(c_p);
+    ERTS_HOLE_CHECK(c_p);
+    FCALLS = c_p->fcalls;
+    ERTS_DBG_CHK_REDS(c_p, FCALLS);
+    if (ERTS_LIKELY(is_value(result))) {
+        /* Successful calculation of the list length. */
+        $REFRESH_GEN_DEST();
+        $Dst = result;
+        $NEXT0();
+    } else if (c_p->freason == TRAP) {
+        /*
+         * Good so far, but there is more work to do. Yield.
+         */
+        $SET_CP_I_ABS(I);
+        SWAPOUT;
+        c_p->arity = live + 3;
+        c_p->current = NULL;
+        goto context_switch3;
+    } else {
+        /* Error. */
+        $BIF_ERROR_ARITY_1($Fail, BIF_length_1, reg[live+2]);
+    }
+    //| -no_next
+}
+
 //
 // The most general BIF call.  The BIF may build any amount of data
 // on the heap.  The result is always returned in r(0).
-- 
cgit v1.2.3