448 lines
15 KiB
ArmAsm
448 lines
15 KiB
ArmAsm
/**************************************************************************/
|
|
/* */
|
|
/* 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
|
|
domain_state_ptr .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
|
|
|
|
#if defined(FUNCTION_SECTIONS)
|
|
#define TEXT_SECTION(name) .section .text.caml.##name,"ax",%progbits
|
|
#else
|
|
#define TEXT_SECTION(name)
|
|
#endif
|
|
|
|
#define FUNCTION(name) \
|
|
TEXT_SECTION(name); \
|
|
.align 2; \
|
|
.globl name; \
|
|
.type name, %function; \
|
|
name:
|
|
|
|
#if defined(FUNCTION_SECTIONS)
|
|
TEXT_SECTION(caml_hot__code_begin)
|
|
.globl caml_hot__code_begin
|
|
caml_hot__code_begin:
|
|
|
|
TEXT_SECTION(caml_hot__code_end)
|
|
.globl caml_hot__code_end
|
|
caml_hot__code_end:
|
|
#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) [domain_state_ptr, 8*domain_field_caml_##var]
|
|
|
|
/* Allocation functions and GC interface */
|
|
TEXT_SECTION(caml_system__code_begin)
|
|
.globl caml_system__code_begin
|
|
caml_system__code_begin:
|
|
|
|
FUNCTION(caml_call_gc)
|
|
CFI_STARTPROC
|
|
.Lcaml_call_gc:
|
|
/* Record return address */
|
|
str lr, Caml_state(last_return_address)
|
|
/* Record lowest stack address */
|
|
str sp, Caml_state(bottom_of_stack)
|
|
#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_state->gc_regs */
|
|
str sp, Caml_state(gc_regs)
|
|
/* Save current allocation pointer for debugging purposes */
|
|
str alloc_ptr, Caml_state(young_ptr)
|
|
/* Save trap pointer in case an exception is raised during GC */
|
|
str trap_ptr, Caml_state(exception_pointer)
|
|
/* 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 */
|
|
ldr alloc_ptr, Caml_state(young_ptr)
|
|
/* Return to caller */
|
|
bx lr
|
|
CFI_ENDPROC
|
|
.size caml_call_gc, .-caml_call_gc
|
|
|
|
FUNCTION(caml_alloc1)
|
|
CFI_STARTPROC
|
|
sub alloc_ptr, alloc_ptr, 8
|
|
ldr r7, Caml_state(young_limit)
|
|
cmp alloc_ptr, r7
|
|
bcc .Lcaml_call_gc
|
|
bx lr
|
|
CFI_ENDPROC
|
|
.size caml_alloc1, .-caml_alloc1
|
|
|
|
FUNCTION(caml_alloc2)
|
|
CFI_STARTPROC
|
|
sub alloc_ptr, alloc_ptr, 12
|
|
ldr r7, Caml_state(young_limit)
|
|
cmp alloc_ptr, r7
|
|
bcc .Lcaml_call_gc
|
|
bx lr
|
|
CFI_ENDPROC
|
|
.size caml_alloc2, .-caml_alloc2
|
|
|
|
FUNCTION(caml_alloc3)
|
|
CFI_STARTPROC
|
|
sub alloc_ptr, alloc_ptr, 16
|
|
ldr r7, Caml_state(young_limit)
|
|
cmp alloc_ptr, r7
|
|
bcc .Lcaml_call_gc
|
|
bx lr
|
|
CFI_ENDPROC
|
|
.size caml_alloc3, .-caml_alloc3
|
|
|
|
FUNCTION(caml_allocN)
|
|
CFI_STARTPROC
|
|
sub alloc_ptr, alloc_ptr, r7
|
|
ldr r7, Caml_state(young_limit)
|
|
cmp alloc_ptr, r7
|
|
bcc .Lcaml_call_gc
|
|
bx lr
|
|
CFI_ENDPROC
|
|
.size caml_allocN, .-caml_allocN
|
|
|
|
/* Call a C function from OCaml */
|
|
/* Function to call is in r7 */
|
|
|
|
FUNCTION(caml_c_call)
|
|
CFI_STARTPROC
|
|
/* Record lowest stack address and return address */
|
|
str lr, Caml_state(last_return_address)
|
|
str sp, Caml_state(bottom_of_stack)
|
|
/* 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 */
|
|
str alloc_ptr, Caml_state(young_ptr)
|
|
str trap_ptr, Caml_state(exception_pointer)
|
|
/* Call the function */
|
|
blx r7
|
|
/* Reload alloc ptr */
|
|
ldr alloc_ptr, Caml_state(young_ptr)
|
|
/* Return */
|
|
bx r4
|
|
CFI_ENDPROC
|
|
.size caml_c_call, .-caml_c_call
|
|
|
|
/* Start the OCaml program */
|
|
|
|
FUNCTION(caml_start_program)
|
|
CFI_STARTPROC
|
|
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
|
|
ldr domain_state_ptr, =Caml_state
|
|
ldr domain_state_ptr, [domain_state_ptr]
|
|
/* Setup a callback link on the stack */
|
|
sub sp, sp, 16; CFI_ADJUST(16) /* 8-byte alignment */
|
|
ldr r4, Caml_state(bottom_of_stack)
|
|
ldr r5, Caml_state(last_return_address)
|
|
ldr r6, Caml_state(gc_regs)
|
|
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 r5, =.Ltrap_handler
|
|
ldr r4, Caml_state(exception_pointer)
|
|
str r4, [sp, 0]
|
|
str r5, [sp, 4]
|
|
mov trap_ptr, sp
|
|
/* Reload allocation pointer */
|
|
ldr alloc_ptr, Caml_state(young_ptr)
|
|
/* Call the OCaml code */
|
|
blx r12
|
|
.Lcaml_retaddr:
|
|
/* Pop the trap frame, restoring caml_exception_pointer */
|
|
ldr r5, [sp, 0]
|
|
str r5, Caml_state(exception_pointer)
|
|
add sp, sp, 8; CFI_ADJUST(-8)
|
|
/* Pop the callback link, restoring the global variables */
|
|
.Lreturn_result:
|
|
ldr r5, [sp, 0]
|
|
str r5, Caml_state(bottom_of_stack)
|
|
ldr r5, [sp, 4]
|
|
str r5, Caml_state(last_return_address)
|
|
ldr r5, [sp, 8]
|
|
str r5, Caml_state(gc_regs)
|
|
add sp, sp, 16; CFI_ADJUST(-16)
|
|
/* Update allocation pointer */
|
|
str alloc_ptr, Caml_state(young_ptr)
|
|
/* 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
|
|
.size caml_start_program, .-caml_start_program
|
|
|
|
/* The trap handler */
|
|
|
|
.align 2
|
|
.Ltrap_handler:
|
|
CFI_STARTPROC
|
|
/* Save exception pointer */
|
|
str trap_ptr, Caml_state(exception_pointer)
|
|
/* 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 */
|
|
|
|
FUNCTION(caml_raise_exn)
|
|
CFI_STARTPROC
|
|
/* Test if backtrace is active */
|
|
ldr r1, Caml_state(backtrace_active)
|
|
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
|
|
.size caml_raise_exn, .-caml_raise_exn
|
|
|
|
/* Raise an exception from C */
|
|
|
|
FUNCTION(caml_raise_exception)
|
|
CFI_STARTPROC
|
|
/* Load the domain state ptr */
|
|
mov domain_state_ptr, r0
|
|
/* Load exception bucket */
|
|
mov r0, r1
|
|
/* Reload trap ptr and alloc ptr */
|
|
ldr trap_ptr, Caml_state(exception_pointer)
|
|
ldr alloc_ptr, Caml_state(young_ptr)
|
|
/* Test if backtrace is active */
|
|
ldr r1, Caml_state(backtrace_active)
|
|
cbz r1, 1f
|
|
/* Preserve exception bucket in callee-save register r4 */
|
|
mov r4, r0
|
|
ldr r1, Caml_state(last_return_address) /* arg2: pc of raise */
|
|
ldr r2, Caml_state(bottom_of_stack) /* 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
|
|
.size caml_raise_exception, .-caml_raise_exception
|
|
|
|
/* Callback from C to OCaml */
|
|
|
|
FUNCTION(caml_callback_asm)
|
|
CFI_STARTPROC
|
|
/* Initial shuffling of arguments */
|
|
/* (r0 = Caml_state, r1 = closure, [r2] = first arg) */
|
|
ldr r0, [r2] /* r0 = first arg */
|
|
/* r1 = closure environment */
|
|
ldr r12, [r1] /* code pointer */
|
|
b .Ljump_to_caml
|
|
CFI_ENDPROC
|
|
.size caml_callback_asm, .-caml_callback_asm
|
|
|
|
FUNCTION(caml_callback2_asm)
|
|
CFI_STARTPROC
|
|
/* Initial shuffling of arguments */
|
|
/* (r0 = Caml_state, r1 = closure, [r2] = arg1, [r2,4] = arg2) */
|
|
mov r12, r1
|
|
ldr r0, [r2] /* r0 = first arg */
|
|
ldr r1, [r2,4] /* r1 = second arg */
|
|
mov r2, r12 /* r2 = closure environment */
|
|
ldr r12, =caml_apply2
|
|
b .Ljump_to_caml
|
|
CFI_ENDPROC
|
|
.size caml_callback2_asm, .-caml_callback2_asm
|
|
|
|
FUNCTION(caml_callback3_asm)
|
|
CFI_STARTPROC
|
|
/* Initial shuffling of arguments */
|
|
/* (r0 = Caml_state, r1 = closure, [r2] = arg1, [r2,4] = arg2,
|
|
[r2,8] = arg3) */
|
|
mov r3, r1 /* r3 = closure environment */
|
|
ldr r0, [r2] /* r0 = first arg */
|
|
ldr r1, [r2,4] /* r1 = second arg */
|
|
ldr r2, [r2,8] /* r2 = third arg */
|
|
ldr r12, =caml_apply3
|
|
b .Ljump_to_caml
|
|
CFI_ENDPROC
|
|
.size caml_callback3_asm, .-caml_callback3_asm
|
|
|
|
FUNCTION(caml_ml_array_bound_error)
|
|
CFI_STARTPROC
|
|
/* Load address of [caml_array_bound_error] in r7 */
|
|
ldr r7, =caml_array_bound_error
|
|
/* Call that function */
|
|
b caml_c_call
|
|
CFI_ENDPROC
|
|
.size caml_ml_array_bound_error, .-caml_ml_array_bound_error
|
|
|
|
TEXT_SECTION(caml_system__code_end)
|
|
.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
|