path: root/runtime/amd64.S

/**************************************************************************/
/*                                                                        */
/*                                 OCaml                                  */
/*                                                                        */
/*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           */
/*                                                                        */
/*   Copyright 2003 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, AMD64 processor */
/* Must be preprocessed by cpp */

/* PIC mode support based on contribution by Paul Stravers (see PR#4795) */

#include "caml/m.h"

#if defined(SYS_macosx)

#define LBL(x) L##x
#define G(r) _##r
#define GREL(r) _##r@GOTPCREL
#define GCALL(r) _##r
#define TEXT_SECTION(name) .text
#define FUNCTION_ALIGN 2
#define EIGHT_ALIGN 3
#define SIXTEEN_ALIGN 4
#define FUNCTION(name) \
        .globl name; \
        .align FUNCTION_ALIGN; \
        name:

#elif defined(SYS_mingw64) || defined(SYS_cygwin)

#define LBL(x) .L##x
#define G(r) r
#undef  GREL
#define GCALL(r) r
#define TEXT_SECTION(name)
#define FUNCTION_ALIGN 4
#define EIGHT_ALIGN 8
#define SIXTEEN_ALIGN 16
#define FUNCTION(name) \
        TEXT_SECTION(name); \
        .globl name; \
        .align FUNCTION_ALIGN; \
        name:

#else

#define LBL(x) .L##x
#define G(r) r
#define GREL(r) r@GOTPCREL
#define GCALL(r) r@PLT
#if defined(FUNCTION_SECTIONS)
#define TEXT_SECTION(name) .section .text.caml.##name,"ax",%progbits
#else
#define TEXT_SECTION(name)
#endif
#define FUNCTION_ALIGN 4
#define EIGHT_ALIGN 8
#define SIXTEEN_ALIGN 16
#define FUNCTION(name) \
        TEXT_SECTION(name); \
        .globl name; \
        .type name,@function; \
        .align FUNCTION_ALIGN; \
        name:

#endif

#if defined(SYS_linux) || defined(SYS_gnu)
#define ENDFUNCTION(name) \
        .size name, . - name
#else
#define ENDFUNCTION(name)
#endif

#ifdef ASM_CFI_SUPPORTED
#define CFI_STARTPROC .cfi_startproc
#define CFI_ENDPROC .cfi_endproc
#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
#define CFI_OFFSET(r, n) .cfi_offset r, n
#define CFI_DEF_CFA_OFFSET(n) .cfi_def_cfa_offset n
#define CFI_DEF_CFA_REGISTER(r) .cfi_def_cfa_register r
#define CFI_SAME_VALUE(r) .cfi_same_value r
#define CFI_SIGNAL_FRAME .cfi_signal_frame
#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_OFFSET(r, n)
#define CFI_DEF_CFA_OFFSET(n)
#define CFI_DEF_CFA_REGISTER(r)
#define CFI_SAME_VALUE(r)
#define CFI_SIGNAL_FRAME
#define CFI_REMEMBER_STATE
#define CFI_RESTORE_STATE
#endif

#ifdef WITH_FRAME_POINTERS
#define RETADDR_ENTRY_SIZE   16 /* rbp + retaddr */
#else
#define RETADDR_ENTRY_SIZE   8 /* retaddr */
#endif

#ifdef WITH_FRAME_POINTERS
#define ENTER_FUNCTION                      \
        pushq   %rbp; CFI_ADJUST(8);        \
        movq    %rsp, %rbp;
#define LEAVE_FUNCTION                      \
        popq    %rbp; CFI_ADJUST(-8);
#else
#define ENTER_FUNCTION
#define LEAVE_FUNCTION
#endif


#ifdef DEBUG
#define CHECK_STACK_ALIGNMENT \
        test $0xf, %rsp; jz 9f; int3; 9:
#define IF_DEBUG(...) __VA_ARGS__
#else
#define CHECK_STACK_ALIGNMENT
#define IF_DEBUG(...)
#endif

/* struct stack_info */
#define Stack_sp                 0
#define Stack_exception          8
#define Stack_handler            16

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

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

/******************************************************************************/
/* DWARF */
/******************************************************************************/

/* These constants are taken from:

     DWARF Debugging Information Format, Version 3
     http://dwarfstd.org/doc/Dwarf3.pdf

   with the amd64-specific register numbers coming from
   Fig. 3.36 ("DWARF Register Number Mapping") of:

     System V Application Binary Interface
     AMD64 Architecture Processor Supplement
     Version 1.0
     https://github.com/hjl-tools/x86-psABI/wiki/x86-64-psABI-1.0.pdf */

#define DW_CFA_def_cfa_expression 0x0f
#define DW_REG_rbx                3
#define DW_REG_rsp                7
#define DW_REG_r13                13
#define DW_OP_breg                0x70
#define DW_OP_deref               0x06
#define DW_OP_plus_uconst         0x23

/******************************************************************************/
/* Access to the current domain state block. */
/******************************************************************************/

#define CAML_CONFIG_H_NO_TYPEDEFS
#include "../runtime/caml/config.h"

        .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)(%r14)

/* Load address of global [label] in register [dst]. */
#if defined(__PIC__) && !defined(SYS_mingw64) && !defined(SYS_cygwin)
#define LEA_VAR(label,dst) \
        movq    GREL(label)(%rip), dst
#else
#define LEA_VAR(label,dst) \
        leaq    G(label)(%rip), dst
#endif

/* Push the current exception handler. Clobbers %r11 */
#define PUSH_EXN_HANDLER \
        movq    Caml_state(exn_handler), %r11; \
        pushq   %r11; CFI_ADJUST(8);

/* Pop the current exception handler. Undoes PUSH_EXN_HANDLER. Clobbers %r11 */
#define POP_EXN_HANDLER \
        leaq    Caml_state(exn_handler), %r11; \
        popq    (%r11); CFI_ADJUST(-8)

/******************************************************************************/
/* Stack switching operations */
/******************************************************************************/

/* Switch from OCaml to C stack. Clobbers %r10, %r11. */
#ifdef ASM_CFI_SUPPORTED
#define SWITCH_OCAML_TO_C_CFI                                   \
        CFI_REMEMBER_STATE;                                     \
          /* %rsp points to the c_stack_link. */                \
        .cfi_escape DW_CFA_def_cfa_expression, 5,               \
           DW_OP_breg + DW_REG_rsp, Cstack_sp, DW_OP_deref,     \
           DW_OP_plus_uconst, RETADDR_ENTRY_SIZE
#else
#define SWITCH_OCAML_TO_C_CFI
#endif
#define SWITCH_OCAML_TO_C                                  \
    /* Fill in Caml_state->current_stack->sp */            \
        movq    Caml_state(current_stack), %r10;           \
        movq    %rsp, Stack_sp(%r10);                      \
    /* Fill in Caml_state->c_stack */                      \
        movq    Caml_state(c_stack), %r11;                 \
        movq    %rsp, Cstack_sp(%r11);                     \
        movq    %r10, Cstack_stack(%r11);                  \
    /* Switch to C stack */                                \
        movq    %r11, %rsp;                                \
        SWITCH_OCAML_TO_C_CFI

/* Switch from C to OCaml stack.  Clobbers %r11. */
#define SWITCH_C_TO_OCAML                                           \
    /* Assert that %rsp == Caml_state->c_stack &&
        Caml_state->c_stack->sp == Caml_state->current_stack->sp */ \
        IF_DEBUG(cmpq %rsp, Caml_state(c_stack); je 8f; int3; 8:    \
                 movq Caml_state(current_stack), %r11;              \
                 movq Stack_sp(%r11), %r11;                         \
                 cmpq %r11, Cstack_sp(%rsp); je 8f; int3; 8:)       \
        movq    Cstack_sp(%rsp), %rsp;                              \
        CFI_RESTORE_STATE

/* Load Caml_state->exn_handler into %rsp and restores prior exn_handler.
   Clobbers %r10 and %r11. */
#define RESTORE_EXN_HANDLER_OCAML              \
        movq    Caml_state(exn_handler), %rsp; \
        CFI_DEF_CFA_OFFSET(16);                \
        POP_EXN_HANDLER

/* Switch between OCaml stacks. Clobbers %r12.
   Expects old stack in %rsi and target stack in %r10.
   Leaves old stack in %rsi and target stack in %r10. */
#define SWITCH_OCAML_STACKS                               \
        ENTER_FUNCTION                                    \
    /* Save OCaml SP and exn_handler in the stack info */ \
        movq    %rsp, Stack_sp(%rsi);                     \
        movq    Caml_state(exn_handler), %r12;            \
        movq    %r12, Stack_exception(%rsi);              \
    /* switch stacks */                                   \
        movq    %r10, Caml_state(current_stack);          \
        movq    Stack_sp(%r10), %rsp;                     \
        CFI_DEF_CFA_OFFSET(8);                            \
    /* restore exn_handler for new stack */               \
        movq    Stack_exception(%r10), %r12;              \
        movq    %r12, Caml_state(exn_handler);            \
        LEAVE_FUNCTION

/* Updates the oldest saved frame pointer in the target fiber.

   A fiber stack may need to grow, causing the reallocation of the entire fiber,
   including stack_info and stack_handler structures.
   caml_try_realloc_stack will not be able to update the linked list of
   frame-pointers if it has been split (ie, in a continuation).
   caml_resume and caml_reperform use this macro to update the oldest saved rbp
   (highest one in the stack) in case the fiber was reallocated to reattach the
   frame-pointer linked list.

   REG: Stack_handler(target_fiber)

   The frame pointer will be pushed into the stack immediately after these
   instructions. The offset of the oldest saved rbp in a fiber from the stack
   handler is 48 = 4 words (caml_runstack) + 2 words (rip and rbp).
   */
#ifdef WITH_FRAME_POINTERS
#define UPDATE_BASE_POINTER(REG)                          \
        leaq    -8(%rsp), %r11;                           \
        movq    %r11, -48(REG)
#else
#define UPDATE_BASE_POINTER(REG)
#endif

/******************************************************************************/
/* Save and restore all callee-save registers on stack.
   Keep the stack 16-aligned. */
/******************************************************************************/

#if defined(SYS_mingw64) || defined(SYS_cygwin)

/* Win64 API: callee-save regs are rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 */

#define PUSH_CALLEE_SAVE_REGS                               \
        pushq   %rbx; CFI_ADJUST (8); CFI_OFFSET(rbx, -16); \
        pushq   %rbp; CFI_ADJUST (8); CFI_OFFSET(rbp, -24); \
                    /* Allows debugger to walk the stack */ \
        pushq   %rsi; CFI_ADJUST (8); CFI_OFFSET(rsi, -32); \
        pushq   %rdi; CFI_ADJUST (8); CFI_OFFSET(rdi, -40); \
        pushq   %r12; CFI_ADJUST (8); CFI_OFFSET(r12, -48); \
        pushq   %r13; CFI_ADJUST (8); CFI_OFFSET(r13, -56); \
        pushq   %r14; CFI_ADJUST (8); CFI_OFFSET(r14, -64); \
        pushq   %r15; CFI_ADJUST (8); CFI_OFFSET(r15, -72); \
        subq    $(10*16), %rsp; CFI_ADJUST (10*16);         \
        movupd  %xmm6, 0*16(%rsp);                          \
        movupd  %xmm7, 1*16(%rsp);                          \
        movupd  %xmm8, 2*16(%rsp);                          \
        movupd  %xmm9, 3*16(%rsp);                          \
        movupd  %xmm10, 4*16(%rsp);                         \
        movupd  %xmm11, 5*16(%rsp);                         \
        movupd  %xmm12, 6*16(%rsp);                         \
        movupd  %xmm13, 7*16(%rsp);                         \
        movupd  %xmm14, 8*16(%rsp);                         \
        movupd  %xmm15, 9*16(%rsp)

#define POP_CALLEE_SAVE_REGS                                \
        movupd  0*16(%rsp), %xmm6;                          \
        movupd  1*16(%rsp), %xmm7;                          \
        movupd  2*16(%rsp), %xmm8;                          \
        movupd  3*16(%rsp), %xmm9;                          \
        movupd  4*16(%rsp), %xmm10;                         \
        movupd  5*16(%rsp), %xmm11;                         \
        movupd  6*16(%rsp), %xmm12;                         \
        movupd  7*16(%rsp), %xmm13;                         \
        movupd  8*16(%rsp), %xmm14;                         \
        movupd  9*16(%rsp), %xmm15;                         \
        addq    $(10*16), %rsp; CFI_ADJUST (-10*16);        \
        popq    %r15; CFI_ADJUST(-8); CFI_SAME_VALUE(r15);  \
        popq    %r14; CFI_ADJUST(-8); CFI_SAME_VALUE(r14);  \
        popq    %r13; CFI_ADJUST(-8); CFI_SAME_VALUE(r13);  \
        popq    %r12; CFI_ADJUST(-8); CFI_SAME_VALUE(r12);  \
        popq    %rdi; CFI_ADJUST(-8); CFI_SAME_VALUE(rdi);  \
        popq    %rsi; CFI_ADJUST(-8); CFI_SAME_VALUE(rsi);  \
        popq    %rbp; CFI_ADJUST(-8); CFI_SAME_VALUE(rbp);  \
        popq    %rbx; CFI_ADJUST(-8); CFI_SAME_VALUE(rbx)

#else

/* Unix API: callee-save regs are rbx, rbp, r12-r15 */

#define PUSH_CALLEE_SAVE_REGS \
        pushq   %rbx; CFI_ADJUST(8); CFI_OFFSET(rbx, -16); \
        pushq   %rbp; CFI_ADJUST(8); CFI_OFFSET(rbp, -24); \
        pushq   %r12; CFI_ADJUST(8); CFI_OFFSET(r12, -32); \
        pushq   %r13; CFI_ADJUST(8); CFI_OFFSET(r13, -40); \
        pushq   %r14; CFI_ADJUST(8); CFI_OFFSET(r14, -48); \
        pushq   %r15; CFI_ADJUST(8); CFI_OFFSET(r15, -56)

#define POP_CALLEE_SAVE_REGS \
        popq    %r15; CFI_ADJUST(-8); CFI_SAME_VALUE(r15); \
        popq    %r14; CFI_ADJUST(-8); CFI_SAME_VALUE(r14); \
        popq    %r13; CFI_ADJUST(-8); CFI_SAME_VALUE(r13); \
        popq    %r12; CFI_ADJUST(-8); CFI_SAME_VALUE(r12); \
        popq    %rbp; CFI_ADJUST(-8); CFI_SAME_VALUE(rbp); \
        popq    %rbx; CFI_ADJUST(-8); CFI_SAME_VALUE(rbx)

#endif

#if defined(SYS_mingw64) || defined (SYS_cygwin)
   /* Calls from OCaml to C must reserve 32 bytes of extra stack space */
#  define PREPARE_FOR_C_CALL subq $32, %rsp; CFI_ADJUST(32)
#  define CLEANUP_AFTER_C_CALL addq $32, %rsp; CFI_ADJUST(-32)
   /* Stack probing mustn't be larger than the page size */
#  define STACK_PROBE_SIZE 4096
#else
#  define PREPARE_FOR_C_CALL
#  define CLEANUP_AFTER_C_CALL
#  define STACK_PROBE_SIZE 4096
#endif

#define C_call(target) \
  PREPARE_FOR_C_CALL; CHECK_STACK_ALIGNMENT; call target; CLEANUP_AFTER_C_CALL

/******************************************************************************/
/* Registers holding arguments of C functions. */
/******************************************************************************/

#if defined(SYS_mingw64) || defined(SYS_cygwin)
#define C_ARG_1 %rcx
#define C_ARG_2 %rdx
#define C_ARG_3 %r8
#define C_ARG_4 %r9
#else
#define C_ARG_1 %rdi
#define C_ARG_2 %rsi
#define C_ARG_3 %rdx
#define C_ARG_4 %rcx
#endif

        .text

#if defined(FUNCTION_SECTIONS)
        TEXT_SECTION(caml_hot.code_begin)
        .globl  G(caml_hot.code_begin)
G(caml_hot.code_begin):

        TEXT_SECTION(caml_hot.code_end)
        .globl  G(caml_hot.code_end)
G(caml_hot.code_end):
#endif

/******************************************************************************/
/* text section */
/******************************************************************************/

        TEXT_SECTION(caml_system__code_begin)
        .globl  G(caml_system__code_begin)
G(caml_system__code_begin):
        ret  /* just one instruction, so that debuggers don't display
        caml_system__code_begin instead of caml_call_gc */

/******************************************************************************/
/* Allocation */
/******************************************************************************/

/* Save all of the registers that may be in use to a free gc_regs bucket.
   Returns: bucket in %r15. Clobbers %r11 (after saving it) */
#define SAVE_ALL_REGS                                  \
    /* First, save the young_ptr. */                   \
        movq    %r15, Caml_state(young_ptr);           \
    /* Now, use %r15 to point to the gc_regs bucket */ \
    /* We save %r11 first to allow it to be scratch */ \
        movq    Caml_state(gc_regs_buckets), %r15;     \
        movq    %r11, 11*8(%r15);                      \
        movq    0(%r15), %r11; /* next ptr */          \
        movq    %r11, Caml_state(gc_regs_buckets);     \
        movq    %rax,         0*8(%r15);               \
        movq    %rbx,         1*8(%r15);               \
        movq    %rdi,         2*8(%r15);               \
        movq    %rsi,         3*8(%r15);               \
        movq    %rdx,         4*8(%r15);               \
        movq    %rcx,         5*8(%r15);               \
        movq    %r8,          6*8(%r15);               \
        movq    %r9,          7*8(%r15);               \
        movq    %r12,         8*8(%r15);               \
        movq    %r13,         9*8(%r15);               \
        movq    %r10,        10*8(%r15);               \
             /* %r11 is at   11*8(%r15); */            \
        movq    %rbp,        12*8(%r15);               \
        movsd   %xmm0,   (0+13)*8(%r15);               \
        movsd   %xmm1,   (1+13)*8(%r15);               \
        movsd   %xmm2,   (2+13)*8(%r15);               \
        movsd   %xmm3,   (3+13)*8(%r15);               \
        movsd   %xmm4,   (4+13)*8(%r15);               \
        movsd   %xmm5,   (5+13)*8(%r15);               \
        movsd   %xmm6,   (6+13)*8(%r15);               \
        movsd   %xmm7,   (7+13)*8(%r15);               \
        movsd   %xmm8,   (8+13)*8(%r15);               \
        movsd   %xmm9,   (9+13)*8(%r15);               \
        movsd   %xmm10, (10+13)*8(%r15);               \
        movsd   %xmm11, (11+13)*8(%r15);               \
        movsd   %xmm12, (12+13)*8(%r15);               \
        movsd   %xmm13, (13+13)*8(%r15);               \
        movsd   %xmm14, (14+13)*8(%r15);               \
        movsd   %xmm15, (15+13)*8(%r15)

/* Undo SAVE_ALL_REGS. Expects gc_regs bucket in %r15 */
#define RESTORE_ALL_REGS                               \
    /* Restore %rax, freeing up the next ptr slot */   \
        movq    0*8(%r15), %rax;                       \
        movq    Caml_state(gc_regs_buckets), %r11;     \
        movq    %r11, 0(%r15); /* next ptr */          \
        movq    %r15, Caml_state(gc_regs_buckets);     \
           /* above:  0*8(%r15),%rax; */               \
        movq          1*8(%r15),%rbx;                  \
        movq          2*8(%r15),%rdi;                  \
        movq          3*8(%r15),%rsi;                  \
        movq          4*8(%r15),%rdx;                  \
        movq          5*8(%r15),%rcx;                  \
        movq          6*8(%r15),%r8;                   \
        movq          7*8(%r15),%r9;                   \
        movq          8*8(%r15),%r12;                  \
        movq          9*8(%r15),%r13;                  \
        movq         10*8(%r15),%r10;                  \
        movq         11*8(%r15),%r11;                  \
        movq         12*8(%r15),%rbp;                  \
        movsd    (0+13)*8(%r15),%xmm0;                 \
        movsd    (1+13)*8(%r15),%xmm1;                 \
        movsd    (2+13)*8(%r15),%xmm2;                 \
        movsd    (3+13)*8(%r15),%xmm3;                 \
        movsd    (4+13)*8(%r15),%xmm4;                 \
        movsd    (5+13)*8(%r15),%xmm5;                 \
        movsd    (6+13)*8(%r15),%xmm6;                 \
        movsd    (7+13)*8(%r15),%xmm7;                 \
        movsd    (8+13)*8(%r15),%xmm8;                 \
        movsd    (9+13)*8(%r15),%xmm9;                 \
        movsd   (10+13)*8(%r15),%xmm10;                \
        movsd   (11+13)*8(%r15),%xmm11;                \
        movsd   (12+13)*8(%r15),%xmm12;                \
        movsd   (13+13)*8(%r15),%xmm13;                \
        movsd   (14+13)*8(%r15),%xmm14;                \
        movsd   (15+13)*8(%r15),%xmm15;                \
        movq    Caml_state(young_ptr), %r15

FUNCTION(G(caml_call_realloc_stack))
CFI_STARTPROC
        CFI_SIGNAL_FRAME
        ENTER_FUNCTION
        SAVE_ALL_REGS
        movq    RETADDR_ENTRY_SIZE(%rsp), C_ARG_1 /* argument */
        SWITCH_OCAML_TO_C
        C_call  (GCALL(caml_try_realloc_stack))
        SWITCH_C_TO_OCAML
        cmpq    $0, %rax
        jz      1f
        RESTORE_ALL_REGS
        LEAVE_FUNCTION
        ret
1:      RESTORE_ALL_REGS
        LEA_VAR(caml_exn_Stack_overflow, %rax)
        add     $16, %rsp /* pop argument, retaddr */
        jmp     GCALL(caml_raise_exn)
CFI_ENDPROC
ENDFUNCTION(G(caml_call_realloc_stack))

FUNCTION(G(caml_call_gc))
CFI_STARTPROC
        CFI_SIGNAL_FRAME
        ENTER_FUNCTION
LBL(caml_call_gc):
        SAVE_ALL_REGS
        movq    %r15, Caml_state(gc_regs)
        SWITCH_OCAML_TO_C
        C_call (GCALL(caml_garbage_collection))
        SWITCH_C_TO_OCAML
        movq    Caml_state(gc_regs), %r15
        RESTORE_ALL_REGS
        LEAVE_FUNCTION
        ret
CFI_ENDPROC
ENDFUNCTION(G(caml_call_gc))

FUNCTION(G(caml_alloc1))
CFI_STARTPROC
        ENTER_FUNCTION
        subq    $16, %r15
        cmpq    Caml_state(young_limit), %r15
        jb      LBL(caml_call_gc)
        LEAVE_FUNCTION
        ret
CFI_ENDPROC
ENDFUNCTION(G(caml_alloc1))

FUNCTION(G(caml_alloc2))
CFI_STARTPROC
        ENTER_FUNCTION
        subq    $24, %r15
        cmpq    Caml_state(young_limit), %r15
        jb      LBL(caml_call_gc)
        LEAVE_FUNCTION
        ret
CFI_ENDPROC
ENDFUNCTION(G(caml_alloc2))

FUNCTION(G(caml_alloc3))
CFI_STARTPROC
        ENTER_FUNCTION
        subq    $32, %r15
        cmpq    Caml_state(young_limit), %r15
        jb      LBL(caml_call_gc)
        LEAVE_FUNCTION
        ret
CFI_ENDPROC
ENDFUNCTION(G(caml_alloc3))

FUNCTION(G(caml_allocN))
CFI_STARTPROC
        ENTER_FUNCTION
        cmpq    Caml_state(young_limit), %r15
        jb      LBL(caml_call_gc)
        LEAVE_FUNCTION
        ret
CFI_ENDPROC
ENDFUNCTION(G(caml_allocN))

/******************************************************************************/
/* Call a C function from OCaml */
/******************************************************************************/

FUNCTION(G(caml_c_call))
CFI_STARTPROC
        CFI_SIGNAL_FRAME
        ENTER_FUNCTION
LBL(caml_c_call):
    /* Arguments:
        C arguments         : %rdi, %rsi, %rdx, %rcx, %r8, and %r9
        C function          : %rax */
    /* Switch from OCaml to C */
        SWITCH_OCAML_TO_C
    /* Make the alloc ptr available to the C code */
        movq    %r15, Caml_state(young_ptr)
    /* Call the function (address in %rax) */
        C_call  (*%rax)
    /* Prepare for return to OCaml */
        movq    Caml_state(young_ptr), %r15
    /* Load ocaml stack and restore global variables */
        SWITCH_C_TO_OCAML
        LEAVE_FUNCTION
    /* Return to OCaml caller */
        ret
CFI_ENDPROC
ENDFUNCTION(G(caml_c_call))

FUNCTION(G(caml_c_call_stack_args))
CFI_STARTPROC
        CFI_SIGNAL_FRAME
        ENTER_FUNCTION
    /* Arguments:
        C arguments         : %rdi, %rsi, %rdx, %rcx, %r8, and %r9
        C function          : %rax
        C stack args        : begin=%r13 end=%r12 */
    /* Switch from OCaml to C */
        SWITCH_OCAML_TO_C
    /* we use %rbx (otherwise unused) to enable backtraces */
        movq    %rsp, %rbx
#ifdef ASM_CFI_SUPPORTED
        .cfi_escape DW_CFA_def_cfa_expression, 5,           \
          /* %rbp points to the c_stack_link structure */   \
          DW_OP_breg + DW_REG_rbx, Cstack_sp, DW_OP_deref,  \
          DW_OP_plus_uconst, RETADDR_ENTRY_SIZE
#endif
    /* Make the alloc ptr available to the C code */
        movq    %r15, Caml_state(young_ptr)
    /* Copy arguments from OCaml to C stack */
LBL(105):
        subq    $8, %r12
        cmpq    %r13,%r12
        jb      LBL(106)
        push    (%r12); CFI_ADJUST(8)
        jmp     LBL(105)
LBL(106):
    /* Call the function (address in %rax) */
        C_call  (*%rax)
    /* Pop arguments back off the stack */
        movq    Caml_state(c_stack), %rsp
    /* Prepare for return to OCaml */
        movq    Caml_state(young_ptr), %r15
    /* Load ocaml stack and restore global variables */
        SWITCH_C_TO_OCAML
    /* Return to OCaml caller */
        LEAVE_FUNCTION
        ret
CFI_ENDPROC
ENDFUNCTION(G(caml_c_call_stack_args))

/******************************************************************************/
/* Start the OCaml program */
/******************************************************************************/

FUNCTION(G(caml_start_program))
CFI_STARTPROC
        CFI_SIGNAL_FRAME
    /* Save callee-save registers */
        PUSH_CALLEE_SAVE_REGS
    /* Load Caml_state into r14 (was passed as an argument from C) */
        movq    C_ARG_1, %r14
    /* Initial entry point is G(caml_program) */
        LEA_VAR(caml_program, %r12)
#ifdef DEBUG
        movq    $0, %rax  /* dummy */
        movq    $0, %rbx  /* dummy */
        movq    $0, %rdi  /* dummy */
        movq    $0, %rsi  /* dummy */
#endif
    /* Common code for caml_start_program and caml_callback* */
LBL(caml_start_program):
    /* Load young_ptr into %r15 */
        movq    Caml_state(young_ptr), %r15
    /* Build struct c_stack_link on the C stack */
        subq    $24 /* sizeof struct c_stack_link */, %rsp; CFI_ADJUST(24)
        movq    $0, Cstack_stack(%rsp)
        movq    $0, Cstack_sp(%rsp)
        movq    Caml_state(c_stack), %r10
        movq    %r10, Cstack_prev(%rsp)
        movq    %rsp, Caml_state(c_stack)
        CHECK_STACK_ALIGNMENT
    /* Load the OCaml stack. */
        movq    Caml_state(current_stack), %r11
        movq    Stack_sp(%r11), %r10
    /* Store the stack pointer to allow DWARF unwind */
        subq    $16, %r10
        movq    %rsp, 0(%r10) /* C_STACK_SP */
    /* Store the gc_regs for callbacks during a GC */
        movq    Caml_state(gc_regs), %r11
        movq    %r11, 8(%r10)
    /* Build a handler for exceptions raised in OCaml on the OCaml stack. */
        subq    $16, %r10
        lea     LBL(109)(%rip), %r11
        movq    %r11, 8(%r10)
    /* link in the previous exn_handler so that copying stacks works */
        movq    Caml_state(exn_handler), %r11
        movq    %r11, 0(%r10)
        movq    %r10, Caml_state(exn_handler)
    /* Switch stacks and call the OCaml code */
        movq    %r10, %rsp
#ifdef ASM_CFI_SUPPORTED
        CFI_REMEMBER_STATE
        .cfi_escape DW_CFA_def_cfa_expression, 3 + 2,                 \
            /* %rsp points to the exn handler on the OCaml stack */   \
            /* %rsp + 16 contains the C_STACK_SP */                   \
          DW_OP_breg + DW_REG_rsp, 16 /* exn handler */, DW_OP_deref, \
          DW_OP_plus_uconst,                                          \
             24  /* struct c_stack_link */ +                          \
             6*8 /* callee save regs */ +                             \
             8   /* ret addr */
#endif
        call    *%r12
LBL(108):
    /* pop exn handler */
        movq    0(%rsp), %r11
        movq    %r11, Caml_state(exn_handler)
        leaq    16(%rsp), %r10
1:  /* restore GC regs */
        movq    8(%r10), %r11
        movq    %r11, Caml_state(gc_regs)
        addq    $16, %r10
    /* Update alloc ptr */
        movq    %r15, Caml_state(young_ptr)
    /* Return to C stack. */
        movq    Caml_state(current_stack), %r11
        movq    %r10, Stack_sp(%r11)
        movq    Caml_state(c_stack), %rsp
        CFI_RESTORE_STATE
    /* Pop the struct c_stack_link */
        movq    Cstack_prev(%rsp), %r10
        movq    %r10, Caml_state(c_stack)
        addq    $24, %rsp; CFI_ADJUST(-24)
    /* Restore callee-save registers. */
        POP_CALLEE_SAVE_REGS
    /* Return to caller. */
        ret
LBL(109):
    /* Exception handler*/
    /* Mark the bucket as an exception result and return it */
        orq     $2, %rax
        /* exn handler already popped here */
        movq    %rsp, %r10
        jmp     1b
CFI_ENDPROC
ENDFUNCTION(G(caml_start_program))

/******************************************************************************/
/* Exceptions */
/******************************************************************************/

/* Raise an exception from OCaml */

FUNCTION(G(caml_raise_exn))
CFI_STARTPROC
        ENTER_FUNCTION
LBL(caml_raise_exn):
        testq   $1, Caml_state(backtrace_active)
        jne   LBL(116)
        RESTORE_EXN_HANDLER_OCAML
        ret
LBL(116):
        movq    $0, Caml_state(backtrace_pos)
LBL(117):
        movq    %rsp, %r10        /* Save OCaml stack pointer */
        movq    %rax, %r12        /* Save exception bucket */
        movq    Caml_state(c_stack), %rsp
        movq    %rax, C_ARG_1     /* arg 1: exception bucket */
#ifdef WITH_FRAME_POINTERS
        movq    8(%r10), C_ARG_2   /* arg 2: pc of raise */
        leaq    16(%r10), C_ARG_3  /* arg 3: sp at raise */
#else
        movq    (%r10), C_ARG_2   /* arg 2: pc of raise */
        leaq    8(%r10), C_ARG_3  /* arg 3: sp at raise */
#endif
        movq    Caml_state(exn_handler), C_ARG_4
                                  /* arg 4: sp of handler */
        C_call  (GCALL(caml_stash_backtrace))
        movq    %r12, %rax        /* Recover exception bucket */
        RESTORE_EXN_HANDLER_OCAML
        ret
CFI_ENDPROC
ENDFUNCTION(G(caml_raise_exn))

FUNCTION(G(caml_reraise_exn))
CFI_STARTPROC
        ENTER_FUNCTION
        testq   $1, Caml_state(backtrace_active)
        jne   LBL(117)
        RESTORE_EXN_HANDLER_OCAML
        ret
CFI_ENDPROC
ENDFUNCTION(G(caml_reraise_exn))

/* Raise an exception from C */

FUNCTION(G(caml_raise_exception))
CFI_STARTPROC
        ENTER_FUNCTION
        movq    C_ARG_1, %r14                /* Caml_state */
        movq    C_ARG_2, %rax
    /* Load young_ptr into %r15 */
        movq    Caml_state(young_ptr), %r15
    /* Discard the C stack pointer and reset to ocaml stack */
        movq    Caml_state(current_stack), %r10
        movq    Stack_sp(%r10), %rsp         /* FIXME: CFI */
        jmp LBL(caml_raise_exn)
CFI_ENDPROC
ENDFUNCTION(G(caml_raise_exception))

/******************************************************************************/
/* Callback from C to OCaml */
/******************************************************************************/

FUNCTION(G(caml_callback_asm))
CFI_STARTPROC
    /* Save callee-save registers */
        PUSH_CALLEE_SAVE_REGS
    /* Initial loading of arguments */
        movq    C_ARG_1, %r14      /* Caml_state */
        movq    C_ARG_2, %rbx      /* closure */
        movq    0(C_ARG_3), %rax   /* argument */
        movq    0(%rbx), %r12      /* code pointer */
        movq    $0, %rdi           /* dummy */
        movq    $0, %rsi           /* dummy */
        jmp     LBL(caml_start_program)
CFI_ENDPROC
ENDFUNCTION(G(caml_callback_asm))

FUNCTION(G(caml_callback2_asm))
CFI_STARTPROC
    /* Save callee-save registers */
        PUSH_CALLEE_SAVE_REGS
    /* Initial loading of arguments */
        movq    C_ARG_1, %r14      /* Caml_state */
        movq    C_ARG_2, %rdi      /* closure */
        movq    0(C_ARG_3), %rax   /* first argument */
        movq    8(C_ARG_3), %rbx   /* second argument */
        LEA_VAR(caml_apply2, %r12) /* code pointer */
        movq    $0, %rsi           /* dummy */
        jmp     LBL(caml_start_program)
CFI_ENDPROC
ENDFUNCTION(G(caml_callback2_asm))

FUNCTION(G(caml_callback3_asm))
CFI_STARTPROC
    /* Save callee-save registers */
        PUSH_CALLEE_SAVE_REGS
    /* Initial loading of arguments */
        movq    C_ARG_1, %r14      /* Caml_state */
        movq    0(C_ARG_3), %rax   /* first argument */
        movq    8(C_ARG_3), %rbx   /* second argument */
        movq    C_ARG_2, %rsi      /* closure */
        movq    16(C_ARG_3), %rdi  /* third argument */
        LEA_VAR(caml_apply3, %r12) /* code pointer */
        jmp     LBL(caml_start_program)
CFI_ENDPROC
ENDFUNCTION(G(caml_callback3_asm))

/******************************************************************************/
/* Fibers */
/*
 * 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(G(caml_perform))
CFI_STARTPROC
    /*  %rax: effect to perform
        %rbx: freshly allocated continuation */
        movq    Caml_state(current_stack), %rsi /* %rsi := old stack */
        leaq    1(%rsi), %rdi /* %rdi (last_fiber) := Val_ptr(old stack) */
        movq    %rdi, 0(%rbx) /* Initialise continuation */
LBL(do_perform):
    /*  %rsi: old stack */
        movq    Stack_handler(%rsi), %r11  /* %r11 := old stack -> handler */
        movq    Handler_parent(%r11), %r10 /* %r10 := parent stack */
        cmpq    $0, %r10                   /* parent is NULL? */
        je      LBL(112)
        SWITCH_OCAML_STACKS /* preserves r11 and rsi */
     /* We have to null the Handler_parent after the switch because the
        Handler_parent is needed to unwind the stack for backtraces */
        movq    $0, Handler_parent(%r11) /* Set parent of performer to NULL */
        movq    Handler_effect(%r11), %rsi  /* %rsi := effect handler */
        jmp     GCALL(caml_apply3)
LBL(112):
    /* Switch back to original performer before raising Effect.Unhandled
       (no-op unless this is a reperform) */
        movq    0(%rbx), %r10  /* load performer stack from continuation */
        subq    $1, %r10       /* r10 := Ptr_val(r10) */
        movq    Caml_state(current_stack), %rsi
        SWITCH_OCAML_STACKS
    /* No parent stack. Raise Effect.Unhandled. */
        movq    %rax, C_ARG_1
        LEA_VAR(caml_raise_unhandled_effect, %rax)
        jmp     LBL(caml_c_call)
CFI_ENDPROC
ENDFUNCTION(G(caml_perform))

FUNCTION(G(caml_reperform))
CFI_STARTPROC
    /*  %rax: effect to reperform
        %rbx: continuation
        %rdi: last_fiber */
        movq    Caml_state(current_stack), %rsi  /* %rsi := old stack */
        movq    (Stack_handler-1)(%rdi), %r10
        movq    %rsi, Handler_parent(%r10)       /* Append to last_fiber */
        leaq    1(%rsi), %rdi  /* %rdi (last_fiber) := Val_ptr(old stack) */
     /* Need to update the oldest saved frame pointer here as the execution of
        the handler may have caused the current fiber stack to reallocate. */
        UPDATE_BASE_POINTER(%r10)
        jmp     LBL(do_perform)
CFI_ENDPROC
ENDFUNCTION(G(caml_reperform))

FUNCTION(G(caml_resume))
CFI_STARTPROC
    /* %rax -> fiber, %rbx -> fun, %rdi -> arg */
        leaq    -1(%rax), %r10  /* %r10 (new stack) = Ptr_val(%rax) */
        movq    %rdi, %rax      /* %rax := argument to function in %rbx */
    /*  check if stack null, then already used */
        testq   %r10, %r10
        jz      2f
    /* Find end of list of stacks and add current */
        movq    %r10, %rsi
1:      movq    Stack_handler(%rsi), %rcx
        movq    Handler_parent(%rcx), %rsi
        testq   %rsi, %rsi
        jnz     1b
        movq    Caml_state(current_stack), %rsi
        movq    %rsi, Handler_parent(%rcx)
     /* Need to update the oldest saved frame pointer here as the current fiber
        stack may have been reallocated or we may be resuming a computation
        that was not originally run here. */
        UPDATE_BASE_POINTER(%rcx)
        SWITCH_OCAML_STACKS
        jmp     *(%rbx)
2:      LEA_VAR(caml_raise_continuation_already_resumed, %rax)
        jmp LBL(caml_c_call)
CFI_ENDPROC
ENDFUNCTION(G(caml_resume))

/* Run a function on a new stack,
   then invoke either the value or exception handler */
FUNCTION(G(caml_runstack))
CFI_STARTPROC
        CFI_SIGNAL_FRAME
        ENTER_FUNCTION
    /* %rax -> fiber, %rbx -> fun, %rdi -> arg */
        andq    $-2, %rax       /* %rax = Ptr_val(%rax) */
    /* save old stack pointer and exception handler */
        movq    Caml_state(current_stack), %rcx
        movq    Caml_state(exn_handler), %r10
        movq    %rsp, Stack_sp(%rcx)
        movq    %r10, Stack_exception(%rcx)
    /* Load new stack pointer and set parent */
        movq    Stack_handler(%rax), %r11
        movq    %rcx, Handler_parent(%r11)
        movq    %rax, Caml_state(current_stack)
        movq    Stack_sp(%rax), %r11
    /* Create an exception handler on the target stack
       after 16byte DWARF & gc_regs block (which is unused here) */
        subq    $32, %r11
        leaq    LBL(fiber_exn_handler)(%rip), %r10
        movq    %r10, 8(%r11)
    /* link the previous exn_handler so that copying stacks works */
        movq    Stack_exception(%rax), %r10
        movq    %r10, 0(%r11)
        movq    %r11, Caml_state(exn_handler)
    /* Switch to the new stack */
        movq    %r11, %rsp
#ifdef ASM_CFI_SUPPORTED
        CFI_REMEMBER_STATE
        .cfi_escape DW_CFA_def_cfa_expression, 3+3+2, \
          DW_OP_breg + DW_REG_rsp,                    \
            16 /* exn */ +                            \
            8 /* gc_regs slot (unused) */ +           \
            8 /* C_STACK_SP for DWARF (unused) */     \
            + Handler_parent, DW_OP_deref,            \
          DW_OP_plus_uconst, Stack_sp, DW_OP_deref,   \
          DW_OP_plus_uconst, RETADDR_ENTRY_SIZE
#endif
        movq    %rdi, %rax /* first argument */
        callq   *(%rbx) /* closure in %rbx (second argument) */
LBL(frame_runstack):
        leaq    32(%rsp), %r11 /* SP with exn handler popped */
        movq    Handler_value(%r11), %rbx
1:      movq    Caml_state(current_stack), C_ARG_1 /* arg to caml_free_stack */
    /* restore parent stack and exn_handler into Caml_state */
        movq    Handler_parent(%r11), %r10
        movq    Stack_exception(%r10), %r11
        movq    %r10, Caml_state(current_stack)
        movq    %r11, Caml_state(exn_handler)
    /* free old stack by switching directly to c_stack; is a no-alloc call */
        movq    Stack_sp(%r10), %r13 /* saved across C call */
        CFI_RESTORE_STATE
        CFI_REMEMBER_STATE
        CFI_DEF_CFA_REGISTER(DW_REG_r13)
        movq    %rax, %r12 /* save %rax across C call */
        movq    Caml_state(c_stack), %rsp
        C_call  (GCALL(caml_free_stack))
    /* switch directly to parent stack with correct return */
        movq    %r13, %rsp
        CFI_RESTORE_STATE
        movq    %r12, %rax
    /* Invoke handle_value (or handle_exn) */
        LEAVE_FUNCTION
        jmp     *(%rbx)
LBL(fiber_exn_handler):
        leaq    16(%rsp), %r11
        movq    Handler_exception(%r11), %rbx
        jmp     1b
CFI_ENDPROC
ENDFUNCTION(G(caml_runstack))

FUNCTION(G(caml_ml_array_bound_error))
CFI_STARTPROC
        ENTER_FUNCTION
        LEA_VAR(caml_array_bound_error_asm, %rax)
        jmp     LBL(caml_c_call)
CFI_ENDPROC
ENDFUNCTION(G(caml_ml_array_bound_error))

FUNCTION(G(caml_assert_stack_invariants))
CFI_STARTPROC
/*      CHECK_STACK_ALIGNMENT */
        movq    Caml_state(current_stack), %r11
        movq    %rsp, %r10
        subq    %r11, %r10      /* %r10: number of bytes left on stack */
        /* can be two words over: the return addresses */
        cmp     $((Stack_threshold_words + Stack_ctx_words - 2)*8), %r10
        jge     1f
        int3
1:      ret
CFI_ENDPROC
ENDFUNCTION(G(caml_assert_stack_invariants))

        TEXT_SECTION(caml_system__code_end)
        .globl  G(caml_system__code_end)
G(caml_system__code_end):

        .data
        .globl  G(caml_system.frametable)
        .align  EIGHT_ALIGN
G(caml_system.frametable):
        .quad   2           /* two descriptors */
        .quad   LBL(108)    /* return address into callback */
        .value  -1          /* negative frame size => use callback link */
        .value  0           /* no roots here */
        .align  EIGHT_ALIGN
        .quad   LBL(frame_runstack) /* return address into fiber_val_handler */
        .value  -1          /* negative frame size => use callback link */
        .value  0           /* no roots here */

#if defined(SYS_macosx)
        .literal16
#elif defined(SYS_mingw64) || defined(SYS_cygwin)
        .section .rdata,"dr"
#else
        .section    .rodata.cst16,"aM",@progbits,16
#endif
        .globl  G(caml_negf_mask)
        .align  SIXTEEN_ALIGN
G(caml_negf_mask):
        .quad   0x8000000000000000, 0
        .globl  G(caml_absf_mask)
        .align  SIXTEEN_ALIGN
G(caml_absf_mask):
        .quad   0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF

#if defined(SYS_linux)
    /* Mark stack as non-executable, PR#4564 */
        .section .note.GNU-stack,"",%progbits
#endif