diff --git a/libguile/jit.c b/libguile/jit.c index 515882740..7d5b20a27 100644 --- a/libguile/jit.c +++ b/libguile/jit.c @@ -1647,6 +1647,35 @@ compile_tail_call_label_slow (scm_jit_state *j, const uint32_t *vcode) { } +static void +compile_indirect_tail_call (scm_jit_state *j) +{ + ASSERT_HAS_REGISTER_STATE (SP_IN_REGISTER); + restore_reloadable_register_state (j, FP_IN_REGISTER); + + // Pop the vcode from the stack. + emit_sp_ref_ptr (j, T0, 0); + jit_addi (j->jit, SP, SP, sizeof (union scm_vm_stack_element)); + emit_store_sp (j); + + j->frame_size_min--; + if (j->frame_size_max != INT32_MAX) + j->frame_size_max--; + + // See if there is mcode. If so, jump there. + emit_get_ip_relative_addr (j, T1, T0, 1); + emit_ldxi (j, T1, T1, 0); + add_slow_path_patch (j, jit_beqi (j->jit, T1, 0)); + ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER | SP_IN_REGISTER); + jit_jmpr (j->jit, T1); +} +static void +compile_indirect_tail_call_slow (scm_jit_state *j) +{ + emit_store_ip (j, T0); + emit_exit (j); +} + static void compile_instrument_entry (scm_jit_state *j, void *data) { diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 510563ce4..f34bc8556 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -3478,7 +3478,22 @@ VM_NAME (scm_thread *thread) NEXT (4); } - VM_DEFINE_OP (167, unused_167, NULL, NOP) + /* indirect-tail-call _:24 + * + * Pop a function pointer off the top of the stack and tail-call it. + */ + VM_DEFINE_OP (167, indirect_tail_call, "indirect-tail-call", OP1 (X32)) + { + VM_ASSERT (FRAME_LOCALS_COUNT () > 0, abort()); + + uint32_t *code = SP_REF_PTR (0); + VP->sp = sp = sp + 1; + + ip = code; + + NEXT (0); + } + VM_DEFINE_OP (168, unused_168, NULL, NOP) VM_DEFINE_OP (169, unused_169, NULL, NOP) VM_DEFINE_OP (170, unused_170, NULL, NOP) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 33f3018f6..a655e0a55 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -282,6 +282,7 @@ emit-call emit-call-label + emit-indirect-tail-call emit-tail-call emit-tail-call-label (emit-instrument-entry* . emit-instrument-entry) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index ac1d21639..583af2aa8 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -1,6 +1,6 @@ ;;; Guile bytecode disassembler -;;; Copyright (C) 2001, 2009-2010, 2012-2015, 2017-2020, 2022 Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2009-2010, 2012-2015, 2017-2023 Free Software Foundation, Inc. ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -584,7 +584,7 @@ address of that offset." (define non-fallthrough-set (static-opcode-set halt throw throw/value throw/value+data - tail-call tail-call-label + tail-call tail-call-label indirect-tail-call return-values subr-call foreign-call continuation-call j jtable)) @@ -656,7 +656,9 @@ address of that offset." #xfff)) (nlocals (ash (bytevector-u32-native-ref code pos) -20))) (+ nargs nlocals)))) - ((call call-label tail-call tail-call-label expand-apply-argument) + ((expand-apply-argument + call call-label + indirect-tail-call tail-call tail-call-label) #'(lambda (code pos size) #f)) ((shuffle-down) #'(lambda (code pos size)