340 lines
12 KiB
ArmAsm
340 lines
12 KiB
ArmAsm
/***********************************************************************/
|
|
/* */
|
|
/* Objective Caml */
|
|
/* */
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 1998 Institut National de Recherche en Informatique et */
|
|
/* en Automatique. All rights reserved. This file is distributed */
|
|
/* under the terms of the GNU Library General Public License, with */
|
|
/* the special exception on linking described in file ../LICENSE. */
|
|
/* */
|
|
/***********************************************************************/
|
|
|
|
/* $Id$ */
|
|
|
|
/* Asm part of the runtime system, ARM processor */
|
|
|
|
trap_ptr .req r11
|
|
alloc_ptr .req r8
|
|
alloc_limit .req r9
|
|
sp .req r13
|
|
lr .req r14
|
|
pc .req r15
|
|
|
|
.text
|
|
|
|
/* Allocation functions and GC interface */
|
|
|
|
.global caml_call_gc
|
|
caml_call_gc:
|
|
/* Record return address */
|
|
/* We can use r10 as a temp reg since it's not live here */
|
|
ldr r10, .Lcaml_last_return_address
|
|
str lr, [r10, #0]
|
|
/* Branch to shared GC code */
|
|
bl .Linvoke_gc
|
|
/* Restart allocation sequence (4 instructions before) */
|
|
sub lr, lr, #16
|
|
mov pc, lr
|
|
|
|
.global caml_alloc1
|
|
caml_alloc1:
|
|
ldr r10, [alloc_limit, #0]
|
|
sub alloc_ptr, alloc_ptr, #8
|
|
cmp alloc_ptr, r10
|
|
movcs pc, lr /* Return if alloc_ptr >= alloc_limit */
|
|
/* Record return address */
|
|
ldr r10, .Lcaml_last_return_address
|
|
str lr, [r10, #0]
|
|
/* Invoke GC */
|
|
bl .Linvoke_gc
|
|
/* Try again */
|
|
b caml_alloc1
|
|
|
|
.global caml_alloc2
|
|
caml_alloc2:
|
|
ldr r10, [alloc_limit, #0]
|
|
sub alloc_ptr, alloc_ptr, #12
|
|
cmp alloc_ptr, r10
|
|
movcs pc, lr /* Return if alloc_ptr >= alloc_limit */
|
|
/* Record return address */
|
|
ldr r10, .Lcaml_last_return_address
|
|
str lr, [r10, #0]
|
|
/* Invoke GC */
|
|
bl .Linvoke_gc
|
|
/* Try again */
|
|
b caml_alloc2
|
|
|
|
.global caml_alloc3
|
|
caml_alloc3:
|
|
ldr r10, [alloc_limit, #0]
|
|
sub alloc_ptr, alloc_ptr, #16
|
|
cmp alloc_ptr, r10
|
|
movcs pc, lr /* Return if alloc_ptr >= alloc_limit */
|
|
/* Record return address */
|
|
ldr r10, .Lcaml_last_return_address
|
|
str lr, [r10, #0]
|
|
/* Invoke GC */
|
|
bl .Linvoke_gc
|
|
/* Try again */
|
|
b caml_alloc3
|
|
|
|
.global caml_allocN
|
|
caml_allocN:
|
|
str r12, [sp, #-4]!
|
|
ldr r12, [alloc_limit, #0]
|
|
sub alloc_ptr, alloc_ptr, r10
|
|
cmp alloc_ptr, r12
|
|
ldr r12, [sp], #4
|
|
movcs pc, lr /* Return if alloc_ptr >= alloc_limit */
|
|
/* Record return address and desired size */
|
|
ldr alloc_limit, .Lcaml_last_return_address
|
|
str lr, [alloc_limit, #0]
|
|
str r10, .Lcaml_requested_size
|
|
/* Invoke GC */
|
|
bl .Linvoke_gc
|
|
/* Try again */
|
|
ldr r10, .Lcaml_requested_size
|
|
b caml_allocN
|
|
|
|
/* Shared code to invoke the GC */
|
|
.Linvoke_gc:
|
|
/* Record lowest stack address */
|
|
ldr r10, .Lcaml_bottom_of_stack
|
|
str sp, [r10, #0]
|
|
/* Save integer registers and return address on stack */
|
|
stmfd sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r10,r12,lr}
|
|
/* Store pointer to saved integer registers in caml_gc_regs */
|
|
ldr r10, .Lcaml_gc_regs
|
|
str sp, [r10, #0]
|
|
/* Save non-callee-save float registers */
|
|
stfd f0, [sp, #-8]!
|
|
stfd f1, [sp, #-8]!
|
|
stfd f2, [sp, #-8]!
|
|
stfd f3, [sp, #-8]!
|
|
/* Save current allocation pointer for debugging purposes */
|
|
ldr r10, .Lcaml_young_ptr
|
|
str alloc_ptr, [r10, #0]
|
|
/* Save trap pointer in case an exception is raised during GC */
|
|
ldr r10, .Lcaml_exception_pointer
|
|
str trap_ptr, [r10, #0]
|
|
/* Call the garbage collector */
|
|
bl caml_garbage_collection
|
|
/* Restore the registers from the stack */
|
|
ldfd f4, [sp], #8
|
|
ldfd f5, [sp], #8
|
|
ldfd f6, [sp], #8
|
|
ldfd f7, [sp], #8
|
|
ldmfd sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r10,r12}
|
|
/* Reload return address */
|
|
ldr r10, .Lcaml_last_return_address
|
|
ldr lr, [r10, #0]
|
|
/* Say that we are back into Caml code */
|
|
mov alloc_ptr, #0
|
|
str alloc_ptr, [r10, #0]
|
|
/* Reload new allocation pointer and allocation limit */
|
|
ldr r10, .Lcaml_young_ptr
|
|
ldr alloc_ptr, [r10, #0]
|
|
ldr alloc_limit, .Lcaml_young_limit
|
|
/* Return to caller */
|
|
ldmfd sp!, {pc}
|
|
|
|
/* Call a C function from Caml */
|
|
/* Function to call is in r10 */
|
|
|
|
.global caml_c_call
|
|
caml_c_call:
|
|
/* Preserve return address in callee-save register r4 */
|
|
mov r4, lr
|
|
/* Record lowest stack address and return address */
|
|
ldr r5, .Lcaml_last_return_address
|
|
ldr r6, .Lcaml_bottom_of_stack
|
|
str lr, [r5, #0]
|
|
str sp, [r6, #0]
|
|
/* Make the exception handler and alloc ptr available to the C code */
|
|
ldr r6, .Lcaml_young_ptr
|
|
ldr r7, .Lcaml_exception_pointer
|
|
str alloc_ptr, [r6, #0]
|
|
str trap_ptr, [r7, #0]
|
|
/* Call the function */
|
|
mov lr, pc
|
|
mov pc, r10
|
|
/* Reload alloc ptr */
|
|
ldr alloc_ptr, [r6, #0] /* r6 still points to caml_young_ptr */
|
|
/* Say that we are back into Caml code */
|
|
mov r6, #0
|
|
str r6, [r5, #0] /* r5 still points to caml_last_return_address */
|
|
/* Return */
|
|
mov pc, r4
|
|
|
|
/* Start the Caml program */
|
|
|
|
.global caml_start_program
|
|
caml_start_program:
|
|
ldr r10, .Lcaml_program
|
|
|
|
/* Code shared with caml_callback* */
|
|
/* Address of Caml code to call is in r10 */
|
|
/* Arguments to the Caml code are in r0...r3 */
|
|
|
|
.Ljump_to_caml:
|
|
/* Save return address and callee-save registers */
|
|
stmfd sp!, {r4,r5,r6,r7,r8,r9,r11,lr}
|
|
stfd f7, [sp, #-8]!
|
|
stfd f6, [sp, #-8]!
|
|
stfd f5, [sp, #-8]!
|
|
stfd f4, [sp, #-8]!
|
|
/* Setup a callback link on the stack */
|
|
sub sp, sp, #4*3
|
|
ldr r4, .Lcaml_bottom_of_stack
|
|
ldr r4, [r4, #0]
|
|
str r4, [sp, #0]
|
|
ldr r4, .Lcaml_last_return_address
|
|
ldr r4, [r4, #0]
|
|
str r4, [sp, #4]
|
|
ldr r4, .Lcaml_gc_regs
|
|
ldr r4, [r4, #0]
|
|
str r4, [sp, #8]
|
|
/* Setup a trap frame to catch exceptions escaping the Caml code */
|
|
sub sp, sp, #4*2
|
|
ldr r4, .Lcaml_exception_pointer
|
|
ldr r4, [r4, #0]
|
|
str r4, [sp, #0]
|
|
ldr r4, .LLtrap_handler
|
|
str r4, [sp, #4]
|
|
mov trap_ptr, sp
|
|
/* Reload allocation pointers */
|
|
ldr r4, .Lcaml_young_ptr
|
|
ldr alloc_ptr, [r4, #0]
|
|
ldr alloc_limit, .Lcaml_young_limit
|
|
/* We are back into Caml code */
|
|
ldr r4, .Lcaml_last_return_address
|
|
mov r5, #0
|
|
str r5, [r4, #0]
|
|
/* Call the Caml code */
|
|
mov lr, pc
|
|
mov pc, r10
|
|
.Lcaml_retaddr:
|
|
/* Pop the trap frame, restoring caml_exception_pointer */
|
|
ldr r4, .Lcaml_exception_pointer
|
|
ldr r5, [sp, #0]
|
|
str r5, [r4, #0]
|
|
add sp, sp, #2 * 4
|
|
/* Pop the callback link, restoring the global variables */
|
|
.Lreturn_result:
|
|
ldr r4, .Lcaml_bottom_of_stack
|
|
ldr r5, [sp, #0]
|
|
str r5, [r4, #0]
|
|
ldr r4, .Lcaml_last_return_address
|
|
ldr r5, [sp, #4]
|
|
str r5, [r4, #0]
|
|
ldr r4, .Lcaml_gc_regs
|
|
ldr r5, [sp, #8]
|
|
str r5, [r4, #0]
|
|
add sp, sp, #4*3
|
|
/* Update allocation pointer */
|
|
ldr r4, .Lcaml_young_ptr
|
|
str alloc_ptr, [r4, #0]
|
|
/* Reload callee-save registers and return */
|
|
ldfd f4, [sp], #8
|
|
ldfd f5, [sp], #8
|
|
ldfd f6, [sp], #8
|
|
ldfd f7, [sp], #8
|
|
ldmfd sp!, {r4,r5,r6,r7,r8,r9,r11,pc}
|
|
|
|
/* The trap handler */
|
|
.Ltrap_handler:
|
|
/* Save exception pointer */
|
|
ldr r4, .Lcaml_exception_pointer
|
|
str trap_ptr, [r4, #0]
|
|
/* Encode exception bucket as an exception result */
|
|
orr r0, r0, #2
|
|
/* Return it */
|
|
b .Lreturn_result
|
|
|
|
/* Raise an exception from C */
|
|
|
|
.global caml_raise_exception
|
|
caml_raise_exception:
|
|
/* Reload Caml allocation pointers */
|
|
ldr r1, .Lcaml_young_ptr
|
|
ldr alloc_ptr, [r1, #0]
|
|
ldr alloc_limit, .Lcaml_young_limit
|
|
/* Say we're back into Caml */
|
|
ldr r1, .Lcaml_last_return_address
|
|
mov r2, #0
|
|
str r2, [r1, #0]
|
|
/* Cut stack at current trap handler */
|
|
ldr r1, .Lcaml_exception_pointer
|
|
ldr sp, [r1, #0]
|
|
/* Pop previous handler and addr of trap, and jump to it */
|
|
ldmfd sp!, {trap_ptr, pc}
|
|
|
|
/* Callback from C to Caml */
|
|
|
|
.global caml_callback_exn
|
|
caml_callback_exn:
|
|
/* Initial shuffling of arguments (r0 = closure, r1 = first arg) */
|
|
mov r10, r0
|
|
mov r0, r1 /* r0 = first arg */
|
|
mov r1, r10 /* r1 = closure environment */
|
|
ldr r10, [r10, #0] /* code pointer */
|
|
b .Ljump_to_caml
|
|
|
|
.global caml_callback2_exn
|
|
caml_callback2_exn:
|
|
/* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */
|
|
mov r10, r0
|
|
mov r0, r1 /* r0 = first arg */
|
|
mov r1, r2 /* r1 = second arg */
|
|
mov r2, r10 /* r2 = closure environment */
|
|
ldr r10, .Lcaml_apply2
|
|
b .Ljump_to_caml
|
|
|
|
.global caml_callback3_exn
|
|
caml_callback3_exn:
|
|
/* Initial shuffling of arguments */
|
|
/* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */
|
|
mov r10, r0
|
|
mov r0, r1 /* r0 = first arg */
|
|
mov r1, r2 /* r1 = second arg */
|
|
mov r2, r3 /* r2 = third arg */
|
|
mov r3, r10 /* r3 = closure environment */
|
|
ldr r10, .Lcaml_apply3
|
|
b .Ljump_to_caml
|
|
|
|
.global caml_ml_array_bound_error
|
|
caml_ml_array_bound_error:
|
|
/* Load address of [caml_array_bound_error] in r10 */
|
|
ldr r10, .Lcaml_array_bound_error
|
|
/* Call that function */
|
|
b caml_c_call
|
|
|
|
/* Global references */
|
|
|
|
.Lcaml_last_return_address: .word caml_last_return_address
|
|
.Lcaml_bottom_of_stack: .word caml_bottom_of_stack
|
|
.Lcaml_gc_regs: .word caml_gc_regs
|
|
.Lcaml_young_ptr: .word caml_young_ptr
|
|
.Lcaml_young_limit: .word caml_young_limit
|
|
.Lcaml_exception_pointer: .word caml_exception_pointer
|
|
.Lcaml_program: .word caml_program
|
|
.LLtrap_handler: .word .Ltrap_handler
|
|
.Lcaml_apply2: .word caml_apply2
|
|
.Lcaml_apply3: .word caml_apply3
|
|
.Lcaml_requested_size: .word 0
|
|
.Lcaml_array_bound_error: .word caml_array_bound_error
|
|
|
|
/* GC roots for callback */
|
|
|
|
.data
|
|
|
|
.global system__frametable
|
|
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
|