path: root/runtime/riscv.S

/**************************************************************************/
/*                                                                        */
/*                                 OCaml                                  */
/*                                                                        */
/*                Nicolas Ojeda Bar <n.oje.bar@gmail.com>                 */
/*                                                                        */
/*   Copyright 2016 Institut National de Recherche en Informatique et     */
/*     en Automatique.                                                    */
/*                                                                        */
/*   All rights reserved.  This file is distributed under the terms of    */
/*   the GNU Lesser General Public License version 2.1, with the          */
/*   special exception on linking described in the file LICENSE.          */
/*                                                                        */
/**************************************************************************/

/* Asm part of the runtime system, RISC-V processor, 64-bit mode */
/* Must be preprocessed by cpp */

#include "caml/m.h"

#define DOMAIN_STATE_PTR s11
#define TRAP_PTR s1
#define ALLOC_PTR s10
#define ADDITIONAL_ARG t2
#define STACK_ARG_BEGIN s3
#define STACK_ARG_END s4
#define TMP t0
#define TMP2 t1

#define C_ARG_1 a0
#define C_ARG_2 a1
#define C_ARG_3 a2
#define C_ARG_4 a3

/* Support for CFI directives */

#if defined(ASM_CFI_SUPPORTED)
#define CFI_STARTPROC .cfi_startproc
#define CFI_ENDPROC .cfi_endproc
#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
#define CFI_REGISTER(r1,r2) .cfi_register r1,r2
#define CFI_OFFSET(r,n) .cfi_offset r,n
#define CFI_DEF_CFA_REGISTER(r) .cfi_def_cfa_register r
#define CFI_REMEMBER_STATE .cfi_remember_state
#define CFI_RESTORE_STATE .cfi_restore_state
#else
#define CFI_STARTPROC
#define CFI_ENDPROC
#define CFI_ADJUST(n)
#define CFI_REGISTER(r1,r2)
#define CFI_OFFSET(r,n)
#define CFI_DEF_CFA_REGISTER(r)
#define CFI_REMEMBER_STATE
#define CFI_RESTORE_STATE
#endif

        .set    domain_curr_field, 0
#define DOMAIN_STATE(c_type, name) \
        .equ    domain_field_caml_##name, domain_curr_field ; \
        .set    domain_curr_field, domain_curr_field + 1
#include "../runtime/caml/domain_state.tbl"
#undef DOMAIN_STATE

#define Caml_state(var) (8*domain_field_caml_##var)(DOMAIN_STATE_PTR)

/* Globals and labels */
#define L(lbl) .L##lbl

#define FUNCTION(name) \
        .align 2; \
        .globl name; \
        .type  name, @function; \
name:; \
        CFI_STARTPROC

#define END_FUNCTION(name) \
        CFI_ENDPROC; \
        .size name, .-name

#if defined(__PIC__)
        .option pic
#define PLT(r) r@plt
#else
        .option nopic
#define PLT(r) r
#endif

#define OBJECT(name) \
        .data; \
        .align  3; \
        .globl  name; \
        .type   name, @object; \
name:
#define END_OBJECT(name) \
        .size   name, .-name

/* Stack switching operations */

/* struct stack_info */
#define Stack_sp(reg)           0(reg)
#define Stack_exception(reg)    8(reg)
#define Stack_handler(reg)      16(reg)
#define Stack_handler_from_cont(reg) 15(reg)

/* struct c_stack_link */
#define Cstack_stack(reg)       0(reg)
#define Cstack_sp(reg)          8(reg)
#define Cstack_prev(reg)        16(reg)

/* struct stack_handler */
#define Handler_value(reg)      0(reg)
#define Handler_exception(reg)  8(reg)
#define Handler_effect(reg)     16(reg)
#define Handler_parent(reg)     24(reg)

/* Switch from OCaml to C stack. */
.macro SWITCH_OCAML_TO_C
    /* Fill in Caml_state->current_stack->sp */
        ld      TMP, Caml_state(current_stack)
        sd      sp, Stack_sp(TMP)
    /* Fill in Caml_state->c_stack */
        ld      TMP2, Caml_state(c_stack)
        sd      TMP, Cstack_stack(TMP2)
        sd      sp, Cstack_sp(TMP2)
    /* Switch to C stack */
        mv      sp, TMP2
        CFI_REMEMBER_STATE
.endm

/* Switch from C to OCaml stack. */
.macro SWITCH_C_TO_OCAML
        ld      sp, Cstack_sp(sp)
        CFI_RESTORE_STATE
.endm

/* Save all of the registers that may be in use to a free gc_regs bucket
   and store ALLOC_PTR and TRAP_PTR back to Caml_state
   At the end the saved registers are placed in Caml_state(gc_regs)
 */
.macro SAVE_ALL_REGS
    /* First, save the young_ptr & exn_handler */
        sd      ALLOC_PTR, Caml_state(young_ptr)
        sd      TRAP_PTR, Caml_state(exn_handler)
    /* Now, use TMP to point to the gc_regs bucket */
        ld      TMP, Caml_state(gc_regs_buckets)
        ld      TMP2, 0(TMP) /* next ptr */
        sd      TMP2, Caml_state(gc_regs_buckets)
    /* Save allocatable integer registers */
        sd      a0, (2*8)(TMP)
        sd      a1, (3*8)(TMP)
        sd      a2, (4*8)(TMP)
        sd      a3, (5*8)(TMP)
        sd      a4, (6*8)(TMP)
        sd      a5, (7*8)(TMP)
        sd      a6, (8*8)(TMP)
        sd      a7, (9*8)(TMP)
        sd      s2, (10*8)(TMP)
        sd      s3, (11*8)(TMP)
        sd      s4, (12*8)(TMP)
        sd      s5, (13*8)(TMP)
        sd      s6, (14*8)(TMP)
        sd      s7, (15*8)(TMP)
        sd      s8, (16*8)(TMP)
        sd      s9, (17*8)(TMP)
        sd      t2, (18*8)(TMP)
        sd      t3, (19*8)(TMP)
        sd      t4, (20*8)(TMP)
        sd      t5, (21*8)(TMP)
        sd      t6, (22*8)(TMP)
        sd      s0, (23*8)(TMP)
    /* Save caller-save floating-point registers
       (callee-saves are preserved by C functions) */
        fsd     ft0, (24*8)(TMP)
        fsd     ft1, (25*8)(TMP)
        fsd     ft2, (26*8)(TMP)
        fsd     ft3, (27*8)(TMP)
        fsd     ft4, (28*8)(TMP)
        fsd     ft5, (29*8)(TMP)
        fsd     ft6, (30*8)(TMP)
        fsd     ft7, (31*8)(TMP)
        fsd     fa0, (32*8)(TMP)
        fsd     fa1, (33*8)(TMP)
        fsd     fa2, (34*8)(TMP)
        fsd     fa3, (35*8)(TMP)
        fsd     fa4, (36*8)(TMP)
        fsd     fa5, (37*8)(TMP)
        fsd     fa6, (38*8)(TMP)
        fsd     fa7, (39*8)(TMP)
        fsd     ft8, (40*8)(TMP)
        fsd     ft9, (41*8)(TMP)
        fsd     ft10, (42*8)(TMP)
        fsd     ft11, (43*8)(TMP)
        addi    TMP, TMP, 16
        sd      TMP, Caml_state(gc_regs)
.endm

/* Undo SAVE_ALL_REGS by loading the registers saved in Caml_state(gc_regs)
   and refreshing ALLOC_PTR & TRAP_PTR from Caml_state */
.macro RESTORE_ALL_REGS
    /* Restore a0, a1, freeing up the next ptr slot */
        ld      TMP, Caml_state(gc_regs)
        addi    TMP, TMP, -16
    /* Restore registers */
        ld      a0, (2*8)(TMP)
        ld      a1, (3*8)(TMP)
        ld      a2, (4*8)(TMP)
        ld      a3, (5*8)(TMP)
        ld      a4, (6*8)(TMP)
        ld      a5, (7*8)(TMP)
        ld      a6, (8*8)(TMP)
        ld      a7, (9*8)(TMP)
        ld      s2, (10*8)(TMP)
        ld      s3, (11*8)(TMP)
        ld      s4, (12*8)(TMP)
        ld      s5, (13*8)(TMP)
        ld      s6, (14*8)(TMP)
        ld      s7, (15*8)(TMP)
        ld      s8, (16*8)(TMP)
        ld      s9, (17*8)(TMP)
        ld      t2, (18*8)(TMP)
        ld      t3, (19*8)(TMP)
        ld      t4, (20*8)(TMP)
        ld      t5, (21*8)(TMP)
        ld      t6, (22*8)(TMP)
        ld      s0, (23*8)(TMP)
        fld     ft0, (24*8)(TMP)
        fld     ft1, (25*8)(TMP)
        fld     ft2, (26*8)(TMP)
        fld     ft3, (27*8)(TMP)
        fld     ft4, (28*8)(TMP)
        fld     ft5, (29*8)(TMP)
        fld     ft6, (30*8)(TMP)
        fld     ft7, (31*8)(TMP)
        fld     fa0, (32*8)(TMP)
        fld     fa1, (33*8)(TMP)
        fld     fa2, (34*8)(TMP)
        fld     fa3, (35*8)(TMP)
        fld     fa4, (36*8)(TMP)
        fld     fa5, (37*8)(TMP)
        fld     fa6, (38*8)(TMP)
        fld     fa7, (39*8)(TMP)
        fld     ft8, (40*8)(TMP)
        fld     ft9, (41*8)(TMP)
        fld     ft10, (42*8)(TMP)
        fld     ft11, (43*8)(TMP)
    /* Put gc_regs struct back in bucket linked list */
        ld      TMP2, Caml_state(gc_regs_buckets)
        sd      TMP2, 0(TMP) /* next ptr */
        sd      TMP, Caml_state(gc_regs_buckets)
    /* Reload new allocation pointer & exn handler */
        ld      ALLOC_PTR, Caml_state(young_ptr)
        ld      TRAP_PTR, Caml_state(exn_handler)
.endm

        .section        .text
/* Invoke the garbage collector. */

        .globl  caml_system__code_begin
caml_system__code_begin:

FUNCTION(caml_call_realloc_stack)
    /* Save return address */
        CFI_OFFSET(ra, -8)
        addi    sp, sp, -16
        sd      ra, 8(sp)
        CFI_ADJUST(16)
    /* Save all registers (including ALLOC_PTR & TRAP_PTR) */
        SAVE_ALL_REGS
        ld      C_ARG_1, 16(sp) /* argument */
        SWITCH_OCAML_TO_C
        call    PLT(caml_try_realloc_stack)
        SWITCH_C_TO_OCAML
        beqz    a0, 1f
        RESTORE_ALL_REGS
    /* Free stack space and return to caller */
        ld      ra, 8(sp)
        addi    sp, sp, 16
        ret
1:      RESTORE_ALL_REGS
    /* Raise the Stack_overflow exception */
        ld      ra, 8(sp)
        addi    sp, sp, 16
        addi    sp, sp, 16 /* pop argument */
        la      a0, caml_exn_Stack_overflow
        j       caml_raise_exn
END_FUNCTION(caml_call_realloc_stack)

FUNCTION(caml_call_gc)
L(caml_call_gc):
    /* Save return address */
        CFI_OFFSET(ra, -8)
        addi    sp, sp, -16
        sd      ra, 8(sp)
        CFI_ADJUST(16)
    /* Store all registers (including ALLOC_PTR & TRAP_PTR) */
        SAVE_ALL_REGS
        SWITCH_OCAML_TO_C
    /* Call the garbage collector */
        call    PLT(caml_garbage_collection)
        SWITCH_C_TO_OCAML
        RESTORE_ALL_REGS
    /* Free stack space and return to caller */
        ld      ra, 8(sp)
        addi    sp, sp, 16
        ret
END_FUNCTION(caml_call_gc)

FUNCTION(caml_alloc1)
        ld      TMP, Caml_state(young_limit)
        addi    ALLOC_PTR, ALLOC_PTR, -16
        bltu    ALLOC_PTR, TMP, L(caml_call_gc)
        ret
END_FUNCTION(caml_alloc1)

FUNCTION(caml_alloc2)
        ld      TMP, Caml_state(young_limit)
        addi    ALLOC_PTR, ALLOC_PTR, -24
        bltu    ALLOC_PTR, TMP, L(caml_call_gc)
        ret
END_FUNCTION(caml_alloc2)

FUNCTION(caml_alloc3)
        ld      TMP, Caml_state(young_limit)
        addi    ALLOC_PTR, ALLOC_PTR, -32
        bltu    ALLOC_PTR, TMP, L(caml_call_gc)
        ret
END_FUNCTION(caml_alloc3)

FUNCTION(caml_allocN)
        ld      TMP, Caml_state(young_limit)
        sub     ALLOC_PTR, ALLOC_PTR, ADDITIONAL_ARG
        bltu    ALLOC_PTR, TMP, L(caml_call_gc)
        ret
END_FUNCTION(caml_allocN)

/* Call a C function from OCaml */
/* Function to call is in ADDITIONAL_ARG */

FUNCTION(caml_c_call)
        CFI_OFFSET(ra, -8)
        addi    sp, sp, -16
        sd      ra, 8(sp)
        CFI_ADJUST(16)
    /* Switch form OCaml to C */
        SWITCH_OCAML_TO_C
    /* Make the exception handler alloc ptr available to the C code */
        sd      ALLOC_PTR, Caml_state(young_ptr)
        sd      TRAP_PTR, Caml_state(exn_handler)
    /* Call the function */
        jalr    ADDITIONAL_ARG
    /* Reload alloc ptr */
        ld      ALLOC_PTR, Caml_state(young_ptr)
    /* Load ocaml stack */
        SWITCH_C_TO_OCAML
    /* Return */
        ld      ra, 8(sp)
        addi    sp, sp, 16
        ret
END_FUNCTION(caml_c_call)

FUNCTION(caml_c_call_stack_args)
    /* Arguments:
        C arguments  : a0 to a7, fa0 to fa7
        C function   : ADDITIONAL_ARG
        C stack args : begin=STACK_ARG_BEGIN
                       end=STACK_ARG_END */
        CFI_OFFSET(ra, -8)
        addi    sp, sp, -16
        sd      ra, 8(sp)
        CFI_ADJUST(16)
    /* Switch from OCaml to C */
        SWITCH_OCAML_TO_C
    /* Make the exception handler alloc ptr available to the C code */
        sd      ALLOC_PTR, Caml_state(young_ptr)
        sd      TRAP_PTR, Caml_state(exn_handler)
    /* Store sp to restore after call */
        mv      s2, sp
    /* Copy arguments from OCaml to C stack
       NB: STACK_ARG_{BEGIN,END} are 16-byte aligned */
1:      addi    STACK_ARG_END, STACK_ARG_END, -16
        bltu    STACK_ARG_END, STACK_ARG_BEGIN, 2f
        ld      TMP, 0(STACK_ARG_END)
        ld      TMP2, 8(STACK_ARG_END)
        addi    sp, sp, -16
        sd      TMP, 0(sp)
        sd      TMP2, 8(sp)
        CFI_ADJUST(16)
        j       1b
2:  /* Call the function */
        jalr    ADDITIONAL_ARG
    /* Restore stack */
        mv      sp, s2
    /* Reload alloc ptr */
        ld      ALLOC_PTR, Caml_state(young_ptr)
    /* Switch from C to OCaml */
        SWITCH_C_TO_OCAML
    /* Return */
        ld      ra, 8(sp)
        addi    sp, sp, 16
        ret
END_FUNCTION(caml_c_call_stack_args)

/* Start the OCaml program */

FUNCTION(caml_start_program)
    /* domain state is passed as arg from C */
        mv      TMP, C_ARG_1
        la      TMP2, caml_program

/* Code shared with caml_callback* */
/* Address of domain state is in TMP */
/* Address of OCaml code to call is in TMP2 */
/* Arguments to the OCaml code are in a0...a7 */

L(jump_to_caml):
    /* Set up stack frame and save callee-save registers */
        CFI_OFFSET(ra, -200)
        addi    sp, sp, -208
        sd      ra, 8(sp)
        CFI_ADJUST(208)
        sd      s0, (2*8)(sp)
        sd      s1, (3*8)(sp)
        sd      s2, (4*8)(sp)
        sd      s3, (5*8)(sp)
        sd      s4, (6*8)(sp)
        sd      s5, (7*8)(sp)
        sd      s6, (8*8)(sp)
        sd      s7, (9*8)(sp)
        sd      s8, (10*8)(sp)
        sd      s9, (11*8)(sp)
        sd      s10, (12*8)(sp)
        sd      s11, (13*8)(sp)
        fsd     fs0, (14*8)(sp)
        fsd     fs1, (15*8)(sp)
        fsd     fs2, (16*8)(sp)
        fsd     fs3, (17*8)(sp)
        fsd     fs4, (18*8)(sp)
        fsd     fs5, (19*8)(sp)
        fsd     fs6, (20*8)(sp)
        fsd     fs7, (21*8)(sp)
        fsd     fs8, (22*8)(sp)
        fsd     fs9, (23*8)(sp)
        fsd     fs10, (24*8)(sp)
        fsd     fs11, (25*8)(sp)
    /* Load domain state pointer from argument */
        mv      DOMAIN_STATE_PTR, TMP
    /* Reload allocation pointer */
        ld      ALLOC_PTR, Caml_state(young_ptr)
    /* Build (16-byte aligned) struct c_stack_link on the C stack */
        ld      t2, Caml_state(c_stack)
        addi    sp, sp, -32
        sd      t2, Cstack_prev(sp)
        sd      x0, Cstack_stack(sp)
        sd      x0, Cstack_sp(sp)
        CFI_ADJUST(32)
        sd      sp, Caml_state(c_stack)
    /* Load the OCaml stack */
        ld      t2, Caml_state(current_stack)
        ld      t2, Stack_sp(t2)
    /* Store the gc_regs for callbacks during a GC */
        ld      t3, Caml_state(gc_regs)
        addi    t2, t2, -8
        sd      t3, 0(t2)
    /* Store the stack pointer to allow DWARF unwind */
        addi    t2, t2, -8
        sd      sp, 0(t2) /* C_stack_sp */
    /* Setup a trap frame to catch exceptions escaping the OCaml code */
        ld      t3, Caml_state(exn_handler)
        la      t4, L(trap_handler)
        addi    t2, t2, -16
        sd      t3, 0(t2)
        sd      t4, 8(t2)
        mv      TRAP_PTR, t2
    /* Switch stacks and call the OCaml code */
        mv      sp, t2
        CFI_REMEMBER_STATE
    /* Call the OCaml code */
        jalr    TMP2
L(caml_retaddr):
    /* Pop the trap frame, restoring Caml_state->exn_handler */
        ld      t2, 0(sp)
        addi    sp, sp, 16
        CFI_ADJUST(-16)
        sd      t2, Caml_state(exn_handler)
L(return_result):
    /* Restore GC regs */
        ld      t2, 0(sp)
        ld      t3, 8(sp)
        addi    sp, sp, 16
        CFI_ADJUST(-16)
        sd      t3, Caml_state(gc_regs)
    /* Update allocation pointer */
        sd      ALLOC_PTR, Caml_state(young_ptr)
    /* Return to C stack */
        ld      t2, Caml_state(current_stack)
        sd      sp, Stack_sp(t2)
        ld      t3, Caml_state(c_stack)
        mv      sp, t3
        CFI_RESTORE_STATE
    /* Pop the struct c_stack_link */
        ld      t2, Cstack_prev(sp)
        addi    sp, sp, 32
        CFI_ADJUST(-32)
        sd      t2, Caml_state(c_stack)
    /* Reload callee-save register and return address */
        ld      s0, (2*8)(sp)
        ld      s1, (3*8)(sp)
        ld      s2, (4*8)(sp)
        ld      s3, (5*8)(sp)
        ld      s4, (6*8)(sp)
        ld      s5, (7*8)(sp)
        ld      s6, (8*8)(sp)
        ld      s7, (9*8)(sp)
        ld      s8, (10*8)(sp)
        ld      s9, (11*8)(sp)
        ld      s10, (12*8)(sp)
        ld      s11, (13*8)(sp)
        fld     fs0, (14*8)(sp)
        fld     fs1, (15*8)(sp)
        fld     fs2, (16*8)(sp)
        fld     fs3, (17*8)(sp)
        fld     fs4, (18*8)(sp)
        fld     fs5, (19*8)(sp)
        fld     fs6, (20*8)(sp)
        fld     fs7, (21*8)(sp)
        fld     fs8, (22*8)(sp)
        fld     fs9, (23*8)(sp)
        fld     fs10, (24*8)(sp)
        fld     fs11, (25*8)(sp)
        ld      ra, 8(sp)
        addi    sp, sp, 208
        CFI_ADJUST(-208)
    /* Return to C caller */
        ret
END_FUNCTION(caml_start_program)

/* The trap handler */

        .align  2
L(trap_handler):
        CFI_STARTPROC
    /* Save exception pointer */
        sd      TRAP_PTR, Caml_state(exn_handler)
    /* Encode exception pointer */
        ori     a0, a0, 2
    /* Return it */
        j       L(return_result)
        CFI_ENDPROC

/* Exceptions */

.macro JUMP_TO_TRAP_PTR
    /* Cut stack at current trap handler */
        mv      sp, TRAP_PTR
    /* Pop previous handler and jump to it */
        ld      TMP, 8(sp)
        ld      TRAP_PTR, 0(sp)
        addi    sp, sp, 16
        jr      TMP
.endm

/* Raise an exception from OCaml */
FUNCTION(caml_raise_exn)
    /* Test if backtrace is active */
        ld      TMP, Caml_state(backtrace_active)
        bnez    TMP, 2f
1:
        JUMP_TO_TRAP_PTR
2:  /* Zero backtrace_pos */
        sd      x0, Caml_state(backtrace_pos)
L(caml_reraise_exn_stash):
    /* Preserve exception bucket in callee-save register s2 */
        mv      s2, a0
    /* Stash the backtrace */
                                  /* arg1: exn bucket, already in a0 */
        mv      a1, ra            /* arg2: pc of raise */
        mv      a2, sp            /* arg3: sp of raise */
        mv      a3, TRAP_PTR      /* arg4: sp of handler */
    /* Switch to C stack */
        ld      TMP, Caml_state(c_stack)
        mv      sp, TMP
        call    PLT(caml_stash_backtrace)
    /* Restore exception bucket and raise */
        mv      a0, s2
        j       1b
END_FUNCTION(caml_raise_exn)

FUNCTION(caml_reraise_exn)
        ld      TMP, Caml_state(backtrace_active)
        bnez    TMP, L(caml_reraise_exn_stash)
        JUMP_TO_TRAP_PTR
END_FUNCTION(caml_reraise_exn)

/* Raise an exception from C */

FUNCTION(caml_raise_exception)
    /* Load the domain state ptr */
        mv      DOMAIN_STATE_PTR, C_ARG_1
    /* Load the exception bucket */
        mv      a0, C_ARG_2
    /* Reload trap ptr and alloc ptr */
        ld      TRAP_PTR, Caml_state(exn_handler)
        ld      ALLOC_PTR, Caml_state(young_ptr)
    /* Discard the C stack pointer and reset to ocaml stack */
        ld      TMP, Caml_state(current_stack)
        ld      TMP, Stack_sp(TMP)
        mv      sp, TMP
    /* Restore frame and link on return to OCaml */
        ld      ra, 8(sp)
        addi    sp, sp, 16
        j       caml_raise_exn
END_FUNCTION(caml_raise_exception)

/* Callback from C to OCaml */

FUNCTION(caml_callback_asm)
    /* Initial shuffling of arguments */
    /* (a0 = Caml_state, a1 = closure, 0(a2) = first arg) */
        mv      TMP, a0
        ld      a0, 0(a2)           /* a0 = first arg */
                                    /* a1 = closure environment */
        ld      TMP2, 0(a1)          /* code pointer */
        j       L(jump_to_caml)
END_FUNCTION(caml_callback_asm)

FUNCTION(caml_callback2_asm)
    /* Initial shuffling of arguments */
    /* (a0 = Caml_state, a1 = closure, 0(a2) = arg1, 8(a2) = arg2) */
        mv      TMP, a0
        mv      TMP2, a1
        ld      a0, 0(a2) /* a0 = first arg */
        ld      a1, 8(a2) /* a1 = second arg */
        mv      a2, TMP2   /* a2 = closure environment */
        la      TMP2, caml_apply2
        j       L(jump_to_caml)
END_FUNCTION(caml_callback2_asm)

FUNCTION(caml_callback3_asm)
    /* Initial shuffling of arguments */
    /* (a0 = Caml_state, a1 = closure, 0(a2) = arg1, 8(a2) = arg2,
        16(a2) = arg3) */
        mv      TMP, a0
        mv      a3, a1       /* a3 = closure environment */
        ld      a0, 0(a2)    /* a0 = first arg */
        ld      a1, 8(a2)    /* a1 = second arg */
        ld      a2, 16(a2)   /* a2 = third arg */
        la      TMP2, caml_apply3
        j       L(jump_to_caml)
END_FUNCTION(caml_callback3_asm)

/* Fibers */

/* Switch between OCaml stacks. Clobbers TMP and switches TRAP_PTR
   Preserves old_stack and new_stack registers */
.macro SWITCH_OCAML_STACKS old_stack, new_stack
    /* Save frame pointer and return address for old_stack */
        addi    sp, sp, -16
        sd      ra, 8(sp)
        CFI_ADJUST(16)
    /* Save OCaml SP and exn_handler in the stack info */
        sd      sp, Stack_sp(\old_stack)
        sd      TRAP_PTR, Stack_exception(\old_stack)
    /* switch stacks */
        sd      \new_stack, Caml_state(current_stack)
        ld      TMP, Stack_sp(\new_stack)
        mv      sp, TMP
    /* restore exn_handler for new stack */
        ld      TRAP_PTR, Stack_exception(\new_stack)
    /* Restore frame pointer and return address for new_stack */
        ld      ra, 8(sp)
        addi    sp, sp, 16
.endm

/*
 * A continuation is a one word object that points to a fiber. A fiber [f] will
 * point to its parent at Handler_parent(Stack_handler(f)). In the following,
 * the [last_fiber] refers to the last fiber in the linked-list formed by the
 * parent pointer.
 */

FUNCTION(caml_perform)
    /*  a0: effect to perform
        a1: freshly allocated continuation */
        ld      a2, Caml_state(current_stack) /* a2 := old stack */
        addi    a3, a2, 1 /* a3 := Val_ptr(old stack) */
        sd      a3, 0(a1) /* Iniitalize continuation */
L(do_perform):
    /*  a0: effect to perform
        a1: continuation
        a2: old_stack
        a3: last_fiber */

        ld      t3, Stack_handler(a2)  /* t3 := old stack -> handler */
        ld      t4, Handler_parent(t3) /* t4 := parent stack */
        beqz    t4, 1f
        SWITCH_OCAML_STACKS a2, t4
    /*  we have to null the Handler_parent after the switch because
        the Handler_parent is needed to unwind the stack for backtraces */
        sd      x0, Handler_parent(t3) /* Set parent of performer to NULL */
        ld      TMP, Handler_effect(t3)
        mv      a2, a3                 /* a2 := last_fiber */
        mv      a3, TMP                /* a3 := effect handler */
        tail    PLT(caml_apply3)
1:
    /*  switch back to original performer before raising Effect.Unhandled
        (no-op unless this is a reperform) */
        ld      t4, 0(a1) /* load performer stack from continuation */
        addi    t4, t4, -1 /* t4 := Ptr_val(t4) */
        ld      t3, Caml_state(current_stack)
        SWITCH_OCAML_STACKS t3, t4
    /*  No parent stack. Raise Effect.Unhandled. */
        la      ADDITIONAL_ARG, caml_raise_unhandled_effect
        j       caml_c_call
END_FUNCTION(caml_perform)

FUNCTION(caml_reperform)
    /*  a0: effect to perform
        a1: continuation
        a2: last_fiber */
        ld      TMP, Stack_handler_from_cont(a2)
        ld      a2, Caml_state(current_stack) /* a2 := old stack */
        sd      a2, Handler_parent(TMP) /* Append to last_fiber */
        addi    a3, a2, 1 /* a3 (last_fiber) := Val_ptr(old stack) */
        j       L(do_perform)
END_FUNCTION(caml_reperform)

FUNCTION(caml_resume)
    /*  a0: new fiber
        a1: fun
        a2: arg */
        addi    a0, a0, -1 /* a0 = Ptr_val(a0) */
        ld      a3, 0(a1)  /* code pointer */
    /* Check if stack null, then already used */
        beqz    a0, 2f
    /* Find end of list of stacks (put in t2) */
        mv      TMP, a0
1:      ld      t2, Stack_handler(TMP)
        ld      TMP, Handler_parent(t2)
        bnez    TMP, 1b
    /* Add current stack to the end */
        ld      t3, Caml_state(current_stack)
        sd      t3, Handler_parent(t2)
        SWITCH_OCAML_STACKS t3, a0
        mv      a0, a2
        jr      a3
2:      la      ADDITIONAL_ARG, caml_raise_continuation_already_resumed
        j       caml_c_call
END_FUNCTION(caml_resume)

/* Run a function on a new stack, then either
   return the value or invoke exception handler */
FUNCTION(caml_runstack)
    /*  a0: fiber
        a1: fun
        a2: arg */
        CFI_OFFSET(ra, -8)
        addi    sp, sp, -16
        sd      ra, 8(sp)
        CFI_ADJUST(16)
        addi    a0, a0, -1  /* a0 := Ptr_val(a0) */
        ld      a3, 0(a1)   /* code pointer */
    /*  save old stack pointer and exception handler */
        ld      t2, Caml_state(current_stack) /* t2 := old stack */
        sd      sp, Stack_sp(t2)
        sd      TRAP_PTR, Stack_exception(t2)
    /* Load new stack pointer and set parent */
        ld      TMP, Stack_handler(a0)
        sd      t2, Handler_parent(TMP)
        sd      a0, Caml_state(current_stack)
        ld      t3, Stack_sp(a0) /* t3 := sp of new stack */
    /* Create an exception handler on the target stack
       after 16byte DWARF & gc_regs block (which is unused here) */
        addi    t3, t3, -32
        la      TMP, L(fiber_exn_handler)
        sd      TMP, 8(t3)
    /* link the previous exn_handler so that copying stacks works */
        ld      TMP, Stack_exception(a0)
        sd      TMP, 0(t3)
        mv      TRAP_PTR, t3
    /* Switch to the new stack */
        mv      sp, t3
        CFI_REMEMBER_STATE
    /* Call the function on the new stack */
        mv      a0, a2
        jalr    a3
L(frame_runstack):
        addi    t2, sp, 32 /* t2 := stack_handler */
        ld      s2, Handler_value(t2) /* saved across C call */
1:
        mv      s3, a0     /* save return across C call */
        ld      a0, Caml_state(current_stack) /* arg to caml_free_stack */
    /* restore parent stack and exn_handler into Caml_state */
        ld      TMP, Handler_parent(t2)
        sd      TMP, Caml_state(current_stack)
        ld      TRAP_PTR, Stack_exception(TMP)
        sd      TRAP_PTR, Caml_state(exn_handler)
    /* free old stack by switching directly to c_stack;
       is a no-alloc call */
        ld      s4, Stack_sp(TMP) /* saved across C call */
        CFI_RESTORE_STATE
        CFI_REMEMBER_STATE
        ld      TMP, Caml_state(c_stack)
        mv      sp, TMP
        call    PLT(caml_free_stack)
    /* switch directly to parent stack with correct return */
        mv      a0, s3
        mv      a1, s2
        mv      sp, s4
        CFI_RESTORE_STATE
        ld      TMP, 0(s2)  /* code pointer */
    /* Invoke handle_value (or handle_exn) */
        ld      ra, 8(sp)
        addi    sp, sp, 16
        CFI_ADJUST(-16)
        jr      TMP
L(fiber_exn_handler):
        addi    t2, sp, 16  /* t2 := stack_handler */
        ld      s2, Handler_exception(t2)
        j       1b
END_FUNCTION(caml_runstack)

FUNCTION(caml_ml_array_bound_error)
    /* Load address of [caml_array_bound_error_asm] in ADDITIONAL_ARG */
        la      ADDITIONAL_ARG, caml_array_bound_error_asm
    /* Call that function */
        j       caml_c_call
END_FUNCTION(caml_ml_array_bound_error)

        .globl  caml_system__code_end
caml_system__code_end:

/* GC roots for callback */

OBJECT(caml_system.frametable)
        .quad   2                 /* two descriptors */
        .quad   L(caml_retaddr)   /* return address into callback */
        .short  -1                /* negative frame size => use callback link */
        .short  0                 /* no roots */
        .align  3
        .quad   L(frame_runstack) /* return address into fiber handler */
        .short  -1                /* negative frame size => use callback link */
        .short  0                 /* no roots */
        .align  3
END_OBJECT(caml_system.frametable)