/**************************************************************************/ /* */ /* OCaml */ /* */ /* Benedikt Meurer, University of Siegen */ /* */ /* Copyright 1998 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* Copyright 2012 Benedikt Meurer. */ /* */ /* 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, ARM processor */ /* Must be preprocessed by cpp */ #include "caml/m.h" .syntax unified .text #if defined(SYS_linux_eabihf) && defined(MODEL_armv6) .arch armv6 .fpu vfpv2 .arm /* Compatibility macros */ .macro cbz reg, lbl cmp \reg, #0 beq \lbl .endm #elif defined(SYS_linux_eabihf) .arch armv7-a .fpu vfpv3-d16 .thumb #elif defined(SYS_linux_eabi) .arch armv4t .arm /* Compatibility macros */ .macro blx reg mov lr, pc bx \reg .endm .macro cbz reg, lbl cmp \reg, #0 beq \lbl .endm #elif defined(SYS_netbsd) #if defined(MODEL_armv6) .arch armv6 .fpu vfpv2 .arm /* Compatibility macros */ .macro cbz reg, lbl cmp \reg, #0 beq \lbl .endm #elif defined(MODEL_armv7) .arch armv7-a .fpu vfpv3-d16 .thumb #else #error "Only NetBSD eabihf supported" #endif #elif defined(SYS_freebsd) .arch armv6 .arm /* Compatibility macros */ .macro cbz reg, lbl cmp \reg, #0 beq \lbl .endm #endif trap_ptr .req r8 alloc_ptr .req r10 alloc_limit .req r11 /* 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 #else #define CFI_STARTPROC #define CFI_ENDPROC #define CFI_ADJUST(n) #define CFI_REGISTER(r1,r2) #define CFI_OFFSET(r,n) #endif /* Support for profiling with gprof */ #if defined(PROFILING) && (defined(SYS_linux_eabihf) \ || defined(SYS_linux_eabi) \ || defined(SYS_netbsd)) #define PROFILE \ push {lr}; CFI_ADJUST(4); \ bl __gnu_mcount_nc; CFI_ADJUST(-4) #else #define PROFILE #endif /* Allocation functions and GC interface */ .globl caml_system__code_begin caml_system__code_begin: .align 2 .globl caml_call_gc caml_call_gc: CFI_STARTPROC PROFILE /* Record return address */ ldr r12, =caml_last_return_address str lr, [r12] .Lcaml_call_gc: /* Record lowest stack address */ ldr r12, =caml_bottom_of_stack str sp, [r12] #if defined(SYS_linux_eabihf) || defined(SYS_netbsd) /* Save caller floating-point registers on the stack */ vpush {d0-d7}; CFI_ADJUST(64) #endif /* Save integer registers and return address on the stack */ push {r0-r7,r12,lr}; CFI_ADJUST(40) #if defined(SYS_linux_eabihf) || defined(SYS_netbsd) CFI_OFFSET(lr, -68) #else CFI_OFFSET(lr, -4) #endif /* Store pointer to saved integer registers in caml_gc_regs */ ldr r12, =caml_gc_regs str sp, [r12] /* Save current allocation pointer for debugging purposes */ ldr alloc_limit, =caml_young_ptr str alloc_ptr, [alloc_limit] /* Save trap pointer in case an exception is raised during GC */ ldr r12, =caml_exception_pointer str trap_ptr, [r12] /* Call the garbage collector */ bl caml_garbage_collection /* Restore integer registers and return address from the stack */ pop {r0-r7,r12,lr}; CFI_ADJUST(-40) #if defined(SYS_linux_eabihf) || defined(SYS_netbsd) /* Restore floating-point registers from the stack */ vpop {d0-d7}; CFI_ADJUST(-64) #endif /* Reload new allocation pointer and limit */ /* alloc_limit still points to caml_young_ptr */ ldr r12, =caml_young_limit ldr alloc_ptr, [alloc_limit] ldr alloc_limit, [r12] /* Return to caller */ bx lr CFI_ENDPROC .type caml_call_gc, %function .size caml_call_gc, .-caml_call_gc .align 2 .globl caml_alloc1 caml_alloc1: CFI_STARTPROC PROFILE .Lcaml_alloc1: sub alloc_ptr, alloc_ptr, 8 cmp alloc_ptr, alloc_limit bcc 1f bx lr 1: /* Record return address */ ldr r7, =caml_last_return_address str lr, [r7] /* Call GC (preserves r7) */ bl .Lcaml_call_gc /* Restore return address */ ldr lr, [r7] /* Try again */ b .Lcaml_alloc1 CFI_ENDPROC .type caml_alloc1, %function .size caml_alloc1, .-caml_alloc1 .align 2 .globl caml_alloc2 caml_alloc2: CFI_STARTPROC PROFILE .Lcaml_alloc2: sub alloc_ptr, alloc_ptr, 12 cmp alloc_ptr, alloc_limit bcc 1f bx lr 1: /* Record return address */ ldr r7, =caml_last_return_address str lr, [r7] /* Call GC (preserves r7) */ bl .Lcaml_call_gc /* Restore return address */ ldr lr, [r7] /* Try again */ b .Lcaml_alloc2 CFI_ENDPROC .type caml_alloc2, %function .size caml_alloc2, .-caml_alloc2 .align 2 .globl caml_alloc3 .type caml_alloc3, %function caml_alloc3: CFI_STARTPROC PROFILE .Lcaml_alloc3: sub alloc_ptr, alloc_ptr, 16 cmp alloc_ptr, alloc_limit bcc 1f bx lr 1: /* Record return address */ ldr r7, =caml_last_return_address str lr, [r7] /* Call GC (preserves r7) */ bl .Lcaml_call_gc /* Restore return address */ ldr lr, [r7] /* Try again */ b .Lcaml_alloc3 CFI_ENDPROC .type caml_alloc3, %function .size caml_alloc3, .-caml_alloc3 .align 2 .globl caml_allocN caml_allocN: CFI_STARTPROC PROFILE .Lcaml_allocN: sub alloc_ptr, alloc_ptr, r7 cmp alloc_ptr, alloc_limit bcc 1f bx lr 1: /* Record return address */ ldr r12, =caml_last_return_address str lr, [r12] /* Call GC (preserves r7) */ bl .Lcaml_call_gc /* Restore return address */ ldr r12, =caml_last_return_address ldr lr, [r12] /* Try again */ b .Lcaml_allocN CFI_ENDPROC .type caml_allocN, %function .size caml_allocN, .-caml_allocN /* Call a C function from OCaml */ /* Function to call is in r7 */ .align 2 .globl caml_c_call caml_c_call: CFI_STARTPROC PROFILE /* Record lowest stack address and return address */ ldr r5, =caml_last_return_address ldr r6, =caml_bottom_of_stack str lr, [r5] str sp, [r6] /* Preserve return address in callee-save register r4 */ mov r4, lr CFI_REGISTER(lr, r4) /* Make the exception handler alloc ptr available to the C code */ ldr r5, =caml_young_ptr ldr r6, =caml_exception_pointer str alloc_ptr, [r5] str trap_ptr, [r6] /* Call the function */ blx r7 /* Reload alloc ptr and alloc limit */ ldr r6, =caml_young_limit ldr alloc_ptr, [r5] /* r5 still points to caml_young_ptr */ ldr alloc_limit, [r6] /* Return */ bx r4 CFI_ENDPROC .type caml_c_call, %function .size caml_c_call, .-caml_c_call /* Start the OCaml program */ .align 2 .globl caml_start_program caml_start_program: CFI_STARTPROC PROFILE ldr r12, =caml_program /* Code shared with caml_callback* */ /* Address of OCaml code to call is in r12 */ /* Arguments to the OCaml code are in r0...r3 */ .Ljump_to_caml: #if defined(SYS_linux_eabihf) || defined(SYS_netbsd) /* Save callee-save floating-point registers */ vpush {d8-d15}; CFI_ADJUST(64) #endif /* Save return address and callee-save registers */ push {r4-r8,r10,r11,lr}; CFI_ADJUST(32) /* 8-byte alignment */ #if defined(SYS_linux_eabihf) || defined(SYS_netbsd) CFI_OFFSET(lr, -68) #else CFI_OFFSET(lr, -4) #endif /* Setup a callback link on the stack */ sub sp, sp, 16; CFI_ADJUST(16) /* 8-byte alignment */ ldr r4, =caml_bottom_of_stack ldr r5, =caml_last_return_address ldr r6, =caml_gc_regs ldr r4, [r4] ldr r5, [r5] ldr r6, [r6] str r4, [sp, 0] str r5, [sp, 4] str r6, [sp, 8] /* Setup a trap frame to catch exceptions escaping the OCaml code */ sub sp, sp, 8; CFI_ADJUST(8) ldr r6, =caml_exception_pointer ldr r5, =.Ltrap_handler ldr r4, [r6] str r4, [sp, 0] str r5, [sp, 4] mov trap_ptr, sp /* Reload allocation pointers */ ldr r4, =caml_young_ptr ldr alloc_ptr, [r4] ldr r4, =caml_young_limit ldr alloc_limit, [r4] /* Call the OCaml code */ blx r12 .Lcaml_retaddr: /* Pop the trap frame, restoring caml_exception_pointer */ ldr r4, =caml_exception_pointer ldr r5, [sp, 0] str r5, [r4] add sp, sp, 8; CFI_ADJUST(-8) /* Pop the callback link, restoring the global variables */ .Lreturn_result: ldr r4, =caml_bottom_of_stack ldr r5, [sp, 0] str r5, [r4] ldr r4, =caml_last_return_address ldr r5, [sp, 4] str r5, [r4] ldr r4, =caml_gc_regs ldr r5, [sp, 8] str r5, [r4] add sp, sp, 16; CFI_ADJUST(-16) /* Update allocation pointer */ ldr r4, =caml_young_ptr str alloc_ptr, [r4] /* Reload callee-save registers and return address */ pop {r4-r8,r10,r11,lr}; CFI_ADJUST(-32) #if defined(SYS_linux_eabihf) || defined(SYS_netbsd) /* Reload callee-save floating-point registers */ vpop {d8-d15}; CFI_ADJUST(-64) #endif bx lr CFI_ENDPROC .type .Lcaml_retaddr, %function .size .Lcaml_retaddr, .-.Lcaml_retaddr .type caml_start_program, %function .size caml_start_program, .-caml_start_program /* The trap handler */ .align 2 .Ltrap_handler: CFI_STARTPROC /* Save exception pointer */ ldr r12, =caml_exception_pointer str trap_ptr, [r12] /* Encode exception bucket as an exception result */ orr r0, r0, 2 /* Return it */ b .Lreturn_result CFI_ENDPROC .type .Ltrap_handler, %function .size .Ltrap_handler, .-.Ltrap_handler /* Raise an exception from OCaml */ .align 2 .globl caml_raise_exn caml_raise_exn: CFI_STARTPROC PROFILE /* Test if backtrace is active */ ldr r1, =caml_backtrace_active ldr r1, [r1] cbz r1, 1f /* Preserve exception bucket in callee-save register r4 */ mov r4, r0 /* Stash the backtrace */ mov r1, lr /* arg2: pc of raise */ mov r2, sp /* arg3: sp of raise */ mov r3, trap_ptr /* arg4: sp of handler */ bl caml_stash_backtrace /* Restore exception bucket */ mov r0, r4 1: /* Cut stack at current trap handler */ mov sp, trap_ptr /* Pop previous handler and addr of trap, and jump to it */ pop {trap_ptr, pc} CFI_ENDPROC .type caml_raise_exn, %function .size caml_raise_exn, .-caml_raise_exn /* Raise an exception from C */ .align 2 .globl caml_raise_exception caml_raise_exception: CFI_STARTPROC PROFILE /* Reload trap ptr, alloc ptr and alloc limit */ ldr trap_ptr, =caml_exception_pointer ldr alloc_ptr, =caml_young_ptr ldr alloc_limit, =caml_young_limit ldr trap_ptr, [trap_ptr] ldr alloc_ptr, [alloc_ptr] ldr alloc_limit, [alloc_limit] /* Test if backtrace is active */ ldr r1, =caml_backtrace_active ldr r1, [r1] cbz r1, 1f /* Preserve exception bucket in callee-save register r4 */ mov r4, r0 ldr r1, =caml_last_return_address /* arg2: pc of raise */ ldr r1, [r1] ldr r2, =caml_bottom_of_stack /* arg3: sp of raise */ ldr r2, [r2] mov r3, trap_ptr /* arg4: sp of handler */ bl caml_stash_backtrace /* Restore exception bucket */ mov r0, r4 1: /* Cut stack at current trap handler */ mov sp, trap_ptr /* Pop previous handler and addr of trap, and jump to it */ pop {trap_ptr, pc} CFI_ENDPROC .type caml_raise_exception, %function .size caml_raise_exception, .-caml_raise_exception /* Callback from C to OCaml */ .align 2 .globl caml_callback_exn caml_callback_exn: CFI_STARTPROC PROFILE /* Initial shuffling of arguments (r0 = closure, r1 = first arg) */ mov r12, r0 mov r0, r1 /* r0 = first arg */ mov r1, r12 /* r1 = closure environment */ ldr r12, [r12] /* code pointer */ b .Ljump_to_caml CFI_ENDPROC .type caml_callback_exn, %function .size caml_callback_exn, .-caml_callback_exn .align 2 .globl caml_callback2_exn caml_callback2_exn: CFI_STARTPROC PROFILE /* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */ mov r12, r0 mov r0, r1 /* r0 = first arg */ mov r1, r2 /* r1 = second arg */ mov r2, r12 /* r2 = closure environment */ ldr r12, =caml_apply2 b .Ljump_to_caml CFI_ENDPROC .type caml_callback2_exn, %function .size caml_callback2_exn, .-caml_callback2_exn .align 2 .globl caml_callback3_exn caml_callback3_exn: CFI_STARTPROC PROFILE /* Initial shuffling of arguments */ /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */ mov r12, r0 mov r0, r1 /* r0 = first arg */ mov r1, r2 /* r1 = second arg */ mov r2, r3 /* r2 = third arg */ mov r3, r12 /* r3 = closure environment */ ldr r12, =caml_apply3 b .Ljump_to_caml CFI_ENDPROC .type caml_callback3_exn, %function .size caml_callback3_exn, .-caml_callback3_exn .align 2 .globl caml_ml_array_bound_error caml_ml_array_bound_error: CFI_STARTPROC PROFILE /* Load address of [caml_array_bound_error] in r7 */ ldr r7, =caml_array_bound_error /* Call that function */ b caml_c_call CFI_ENDPROC .type caml_ml_array_bound_error, %function .size caml_ml_array_bound_error, .-caml_ml_array_bound_error .globl caml_system__code_end caml_system__code_end: /* GC roots for callback */ .data .align 2 .globl caml_system__frametable caml_system__frametable: .word 1 /* one descriptor */ .word .Lcaml_retaddr /* return address into callback */ .short -1 /* negative frame size => use callback link */ .short 0 /* no roots */ .align 2 .type caml_system__frametable, %object .size caml_system__frametable, .-caml_system__frametable /* Mark stack as non-executable */ .section .note.GNU-stack,"",%progbits