File 1144-AArch64-Eliminate-branch-instruction-before-embedded.patch of Package erlang

From 92a4ef529e60f4010594b3ad5a3e3985969e9e44 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Sat, 30 Sep 2023 07:37:14 +0200
Subject: [PATCH 24/25] AArch64: Eliminate branch instruction before embedded
 data

---
 erts/emulator/beam/jit/arm/beam_asm.hpp       | 23 ++++++++
 .../emulator/beam/jit/arm/beam_asm_module.cpp | 59 ++++++++++++++++---
 erts/emulator/beam/jit/arm/instr_select.cpp   | 18 +++++-
 3 files changed, 90 insertions(+), 10 deletions(-)

diff --git a/erts/emulator/beam/jit/arm/beam_asm.hpp b/erts/emulator/beam/jit/arm/beam_asm.hpp
index 9f7f5361ae..11b796dfbf 100644
--- a/erts/emulator/beam/jit/arm/beam_asm.hpp
+++ b/erts/emulator/beam/jit/arm/beam_asm.hpp
@@ -905,6 +905,17 @@ class BeamModuleAssembler : public BeamAssembler,
         }
     };
 
+    struct EmbeddedLabel {
+        ssize_t latestOffset;
+        Label anchor;
+
+        Label label;
+
+        constexpr bool operator>(const EmbeddedLabel &other) const {
+            return latestOffset > other.latestOffset;
+        }
+    };
+
     /* ArgVal -> Constant
      *
      * `_pending_constants` points directly into this container, which is
@@ -922,6 +933,11 @@ class BeamModuleAssembler : public BeamAssembler,
                                 std::deque<std::reference_wrapper<const T>>,
                                 std::greater<const T &>>;
 
+    /* Index of Label -> EmbeddedLabel
+     *
+     * `_pending_labels` points directly into this container. */
+    std::unordered_map<uint32_t, EmbeddedLabel> _embedded_labels;
+
     /* All pending stubs, segregated by type and sorted by `latestOffset` in
      * ascending order.
      *
@@ -929,6 +945,7 @@ class BeamModuleAssembler : public BeamAssembler,
      * different sizes and alignment requirements. */
     PendingStubs<Constant> _pending_constants;
     PendingStubs<Veneer> _pending_veneers;
+    PendingStubs<EmbeddedLabel> _pending_labels;
 
     /* Maps code pointers to thunks that jump to them, letting us treat global
      * fragments as if they were local. */
@@ -1051,6 +1068,8 @@ class BeamModuleAssembler : public BeamAssembler,
         }
     }
 
+    arm::Mem embed_label(const Label &label, enum Displacement disp);
+
 public:
     BeamModuleAssembler(BeamGlobalAssembler *ga,
                         Eterm mod,
@@ -1329,6 +1348,10 @@ protected:
      * every `STUB_CHECK_INTERVAL` bytes for veneers and constants to work. */
     void check_pending_stubs();
 
+    /* Unconditionally emits all pending labels. Must only be called when
+     * the current code position is unreachable. */
+    void flush_pending_labels();
+
     /* Calls the given shared fragment, ensuring that the redzone is unused and
      * that the return address forms a valid CP. */
     template<typename Any>
diff --git a/erts/emulator/beam/jit/arm/beam_asm_module.cpp b/erts/emulator/beam/jit/arm/beam_asm_module.cpp
index 211f60dd77..c66c10e6bf 100644
--- a/erts/emulator/beam/jit/arm/beam_asm_module.cpp
+++ b/erts/emulator/beam/jit/arm/beam_asm_module.cpp
@@ -105,14 +105,7 @@ void BeamModuleAssembler::embed_vararg_rodata(const Span<ArgVal> &args,
         a.adr(reg, data);
         a.b(next);
     } else {
-        Label pointer = a.newLabel();
-
-        a.ldr(reg, arm::Mem(pointer));
-        a.b(next);
-
-        a.align(AlignMode::kCode, 8);
-        a.bind(pointer);
-        a.embedLabel(data, 8);
+        a.ldr(reg, embed_label(data, disp32K));
 
         a.section(rodata);
     }
@@ -597,13 +590,31 @@ arm::Mem BeamModuleAssembler::embed_constant(const ArgVal &value,
                                  Constant{.latestOffset = maxOffset,
                                           .anchor = a.newLabel(),
                                           .value = value});
-
     const Constant &constant = it->second;
     _pending_constants.emplace(constant);
 
     return arm::Mem(constant.anchor);
 }
 
+arm::Mem BeamModuleAssembler::embed_label(const Label &label,
+                                          enum Displacement disp) {
+    ssize_t currOffset = a.offset();
+
+    ssize_t maxOffset = currOffset + disp;
+
+    ASSERT(disp >= dispMin && disp <= dispMax);
+
+    auto it = _embedded_labels.emplace(label.id(),
+                                       EmbeddedLabel{.latestOffset = maxOffset,
+                                                     .anchor = a.newLabel(),
+                                                     .label = label});
+    ASSERT(it.second);
+    const EmbeddedLabel &embedded_label = it.first->second;
+    _pending_labels.emplace(embedded_label);
+
+    return arm::Mem(embedded_label.anchor);
+}
+
 void BeamModuleAssembler::emit_i_flush_stubs() {
     /* Flush all stubs that are due within the next two check intervals
      * to prevent them from being emitted inside function prologues or
@@ -626,12 +637,27 @@ void BeamModuleAssembler::check_pending_stubs() {
 
         flush_pending_stubs(STUB_CHECK_INTERVAL * 2);
     }
+
+    if (is_unreachable()) {
+        flush_pending_labels();
+    }
 }
 
 void BeamModuleAssembler::flush_pending_stubs(size_t range) {
     ssize_t effective_offset = a.offset() + range;
     Label next;
 
+    if (!_pending_labels.empty()) {
+        next = a.newLabel();
+
+        comment("Begin stub section");
+        if (!is_unreachable()) {
+            a.b(next);
+        }
+
+        flush_pending_labels();
+    }
+
     while (!_pending_veneers.empty()) {
         const Veneer &veneer = _pending_veneers.top();
 
@@ -689,6 +715,21 @@ void BeamModuleAssembler::flush_pending_stubs(size_t range) {
     }
 }
 
+void BeamModuleAssembler::flush_pending_labels() {
+    if (!_pending_labels.empty()) {
+        a.align(AlignMode::kCode, 8);
+    }
+
+    while (!_pending_labels.empty()) {
+        const EmbeddedLabel &embedded_label = _pending_labels.top();
+
+        a.bind(embedded_label.anchor);
+        a.embedLabel(embedded_label.label, 8);
+
+        _pending_labels.pop();
+    }
+}
+
 void BeamModuleAssembler::emit_veneer(const Veneer &veneer) {
     const Label &anchor = veneer.anchor;
     const Label &target = veneer.target;
diff --git a/erts/emulator/beam/jit/arm/instr_select.cpp b/erts/emulator/beam/jit/arm/instr_select.cpp
index 3c0c2c966c..9037d63bf1 100644
--- a/erts/emulator/beam/jit/arm/instr_select.cpp
+++ b/erts/emulator/beam/jit/arm/instr_select.cpp
@@ -412,6 +412,7 @@ void BeamModuleAssembler::emit_i_jump_on_val(const ArgSource &Src,
                                              const ArgWord &Size,
                                              const Span<ArgVal> &args) {
     Label fail;
+    Label data = a.newLabel();
     auto src = load_source(Src, TMP1);
 
     ASSERT(Size.get() == args.size());
@@ -451,11 +452,26 @@ void BeamModuleAssembler::emit_i_jump_on_val(const ArgSource &Src,
         a.b_hs(fail);
     }
 
-    embed_vararg_rodata(args, TMP2);
+    bool embedInText = args.size() <= 6;
+    if (embedInText) {
+        a.adr(TMP2, data);
+    } else {
+        embed_vararg_rodata(args, TMP2);
+    }
+
     a.ldr(TMP3, arm::Mem(TMP2, TMP1, arm::lsl(3)));
     a.br(TMP3);
+
     mark_unreachable_check_pending_stubs();
 
+    a.bind(data);
+    if (embedInText) {
+        for (const ArgVal &arg : args) {
+            ASSERT(arg.getType() ==  ArgVal::Label);
+            a.embedLabel(rawLabels[arg.as<ArgLabel>().get()]);
+        }
+    }
+
     if (Fail.getType() == ArgVal::Immediate) {
         a.bind(fail);
     }
-- 
2.35.3

openSUSE Build Service is sponsored by