417 lines
13 KiB
ArmAsm
417 lines
13 KiB
ArmAsm
/*********************************************************************/
|
|
/* */
|
|
/* Objective Caml */
|
|
/* */
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 1996 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$ */
|
|
|
|
.macro Addrglobal /* reg, glob */
|
|
addis $0, 0, ha16($1)
|
|
addi $0, $0, lo16($1)
|
|
.endmacro
|
|
.macro Loadglobal /* reg,glob,tmp */
|
|
addis $2, 0, ha16($1)
|
|
lwz $0, lo16($1)($2)
|
|
.endmacro
|
|
.macro Storeglobal /* reg,glob,tmp */
|
|
addis $2, 0, ha16($1)
|
|
stw $0, lo16($1)($2)
|
|
.endmacro
|
|
|
|
.text
|
|
|
|
/* Invoke the garbage collector. */
|
|
|
|
.globl _caml_call_gc
|
|
_caml_call_gc:
|
|
/* Set up stack frame */
|
|
stwu r1, -0x1A0(r1)
|
|
/* 0x1A0 = 4*32 (int regs) + 8*32 (float regs) + 32 (space for C call) */
|
|
/* Record return address into Caml code */
|
|
mflr r0
|
|
Storeglobal r0, _caml_last_return_address, r11
|
|
/* Record lowest stack address */
|
|
addi r0, r1, 0x1A0
|
|
Storeglobal r0, _caml_bottom_of_stack, r11
|
|
/* Record pointer to register array */
|
|
addi r0, r1, 8*32 + 32
|
|
Storeglobal r0, _caml_gc_regs, r11
|
|
/* Save current allocation pointer for debugging purposes */
|
|
Storeglobal r31, _young_ptr, r11
|
|
/* Save exception pointer (if e.g. a sighandler raises) */
|
|
Storeglobal r29, _caml_exception_pointer, r11
|
|
/* Save all registers used by the code generator */
|
|
addi r11, r1, 8*32 + 32 - 4
|
|
stwu r3, 4(r11)
|
|
stwu r4, 4(r11)
|
|
stwu r5, 4(r11)
|
|
stwu r6, 4(r11)
|
|
stwu r7, 4(r11)
|
|
stwu r8, 4(r11)
|
|
stwu r9, 4(r11)
|
|
stwu r10, 4(r11)
|
|
stwu r14, 4(r11)
|
|
stwu r15, 4(r11)
|
|
stwu r16, 4(r11)
|
|
stwu r17, 4(r11)
|
|
stwu r18, 4(r11)
|
|
stwu r19, 4(r11)
|
|
stwu r20, 4(r11)
|
|
stwu r21, 4(r11)
|
|
stwu r22, 4(r11)
|
|
stwu r23, 4(r11)
|
|
stwu r24, 4(r11)
|
|
stwu r25, 4(r11)
|
|
stwu r26, 4(r11)
|
|
stwu r27, 4(r11)
|
|
stwu r28, 4(r11)
|
|
addi r11, r1, 32 - 8
|
|
stfdu f1, 8(r11)
|
|
stfdu f2, 8(r11)
|
|
stfdu f3, 8(r11)
|
|
stfdu f4, 8(r11)
|
|
stfdu f5, 8(r11)
|
|
stfdu f6, 8(r11)
|
|
stfdu f7, 8(r11)
|
|
stfdu f8, 8(r11)
|
|
stfdu f9, 8(r11)
|
|
stfdu f10, 8(r11)
|
|
stfdu f11, 8(r11)
|
|
stfdu f12, 8(r11)
|
|
stfdu f13, 8(r11)
|
|
stfdu f14, 8(r11)
|
|
stfdu f15, 8(r11)
|
|
stfdu f16, 8(r11)
|
|
stfdu f17, 8(r11)
|
|
stfdu f18, 8(r11)
|
|
stfdu f19, 8(r11)
|
|
stfdu f20, 8(r11)
|
|
stfdu f21, 8(r11)
|
|
stfdu f22, 8(r11)
|
|
stfdu f23, 8(r11)
|
|
stfdu f24, 8(r11)
|
|
stfdu f25, 8(r11)
|
|
stfdu f26, 8(r11)
|
|
stfdu f27, 8(r11)
|
|
stfdu f28, 8(r11)
|
|
stfdu f29, 8(r11)
|
|
stfdu f30, 8(r11)
|
|
stfdu f31, 8(r11)
|
|
/* Call the GC */
|
|
bl _garbage_collection
|
|
/* Reload new allocation pointer and allocation limit */
|
|
Loadglobal r31, _young_ptr, r11
|
|
Loadglobal r30, _young_limit, r11
|
|
/* Restore all regs used by the code generator */
|
|
addi r11, r1, 8*32 + 32 - 4
|
|
lwzu r3, 4(r11)
|
|
lwzu r4, 4(r11)
|
|
lwzu r5, 4(r11)
|
|
lwzu r6, 4(r11)
|
|
lwzu r7, 4(r11)
|
|
lwzu r8, 4(r11)
|
|
lwzu r9, 4(r11)
|
|
lwzu r10, 4(r11)
|
|
lwzu r14, 4(r11)
|
|
lwzu r15, 4(r11)
|
|
lwzu r16, 4(r11)
|
|
lwzu r17, 4(r11)
|
|
lwzu r18, 4(r11)
|
|
lwzu r19, 4(r11)
|
|
lwzu r20, 4(r11)
|
|
lwzu r21, 4(r11)
|
|
lwzu r22, 4(r11)
|
|
lwzu r23, 4(r11)
|
|
lwzu r24, 4(r11)
|
|
lwzu r25, 4(r11)
|
|
lwzu r26, 4(r11)
|
|
lwzu r27, 4(r11)
|
|
lwzu r28, 4(r11)
|
|
addi r11, r1, 32 - 8
|
|
lfdu f1, 8(r11)
|
|
lfdu f2, 8(r11)
|
|
lfdu f3, 8(r11)
|
|
lfdu f4, 8(r11)
|
|
lfdu f5, 8(r11)
|
|
lfdu f6, 8(r11)
|
|
lfdu f7, 8(r11)
|
|
lfdu f8, 8(r11)
|
|
lfdu f9, 8(r11)
|
|
lfdu f10, 8(r11)
|
|
lfdu f11, 8(r11)
|
|
lfdu f12, 8(r11)
|
|
lfdu f13, 8(r11)
|
|
lfdu f14, 8(r11)
|
|
lfdu f15, 8(r11)
|
|
lfdu f16, 8(r11)
|
|
lfdu f17, 8(r11)
|
|
lfdu f18, 8(r11)
|
|
lfdu f19, 8(r11)
|
|
lfdu f20, 8(r11)
|
|
lfdu f21, 8(r11)
|
|
lfdu f22, 8(r11)
|
|
lfdu f23, 8(r11)
|
|
lfdu f24, 8(r11)
|
|
lfdu f25, 8(r11)
|
|
lfdu f26, 8(r11)
|
|
lfdu f27, 8(r11)
|
|
lfdu f28, 8(r11)
|
|
lfdu f29, 8(r11)
|
|
lfdu f30, 8(r11)
|
|
lfdu f31, 8(r11)
|
|
/* Return to caller, restarting the allocation */
|
|
Loadglobal r0, _caml_last_return_address, r11
|
|
addic r0, r0, -16 /* Restart the allocation (4 instructions) */
|
|
mtlr r0
|
|
/* Say we are back into Caml code */
|
|
li r12, 0
|
|
Storeglobal r12, _caml_last_return_address, r11
|
|
/* Deallocate stack frame */
|
|
addi r1, r1, 0x1A0
|
|
/* Return */
|
|
blr
|
|
|
|
/* Call a C function from Caml */
|
|
|
|
.globl _caml_c_call
|
|
_caml_c_call:
|
|
/* Save return address */
|
|
mflr r25
|
|
/* Get ready to call C function (address in 11) */
|
|
mtlr r11
|
|
/* Record lowest stack address and return address */
|
|
Storeglobal r1, _caml_bottom_of_stack, r12
|
|
Storeglobal r25, _caml_last_return_address, r12
|
|
/* Make the exception handler and alloc ptr available to the C code */
|
|
Storeglobal r31, _young_ptr, r11
|
|
Storeglobal r29, _caml_exception_pointer, r11
|
|
/* Call the function (address in link register) */
|
|
blrl
|
|
/* Restore return address (in 25, preserved by the C function) */
|
|
mtlr r25
|
|
/* Reload allocation pointer and allocation limit*/
|
|
Loadglobal r31, _young_ptr, r11
|
|
Loadglobal r30, _young_limit, r11
|
|
/* Say we are back into Caml code */
|
|
li r12, 0
|
|
Storeglobal r12, _caml_last_return_address, r11
|
|
/* Return to caller */
|
|
blr
|
|
|
|
/* Raise an exception from C */
|
|
|
|
.globl _raise_caml_exception
|
|
_raise_caml_exception:
|
|
/* Reload Caml global registers */
|
|
Loadglobal r1, _caml_exception_pointer, r11
|
|
Loadglobal r31, _young_ptr, r11
|
|
Loadglobal r30, _young_limit, r11
|
|
/* Say we are back into Caml code */
|
|
li r0, 0
|
|
Storeglobal r0, _caml_last_return_address, r11
|
|
/* Pop trap frame */
|
|
lwz r0, 0(r1)
|
|
lwz r29, 4(r1)
|
|
mtlr r0
|
|
addi r1, r1, 8
|
|
/* Branch to handler */
|
|
blr
|
|
|
|
/* Start the Caml program */
|
|
|
|
.globl _caml_start_program
|
|
_caml_start_program:
|
|
Addrglobal r12, _caml_program
|
|
|
|
/* Code shared between caml_start_program and callback */
|
|
L102:
|
|
/* Allocate and link stack frame */
|
|
stwu r1, -256(r1)
|
|
/* Save return address */
|
|
mflr r0
|
|
stw r0, 256+4(r1)
|
|
/* Save all callee-save registers */
|
|
/* GPR 14 at sp+16 ... GPR 31 at sp+84
|
|
FPR 14 at sp+92 ... FPR 31 at sp+228 */
|
|
addi r11, r1, 16-4
|
|
stwu r14, 4(r11)
|
|
stwu r15, 4(r11)
|
|
stwu r16, 4(r11)
|
|
stwu r17, 4(r11)
|
|
stwu r18, 4(r11)
|
|
stwu r19, 4(r11)
|
|
stwu r20, 4(r11)
|
|
stwu r21, 4(r11)
|
|
stwu r22, 4(r11)
|
|
stwu r23, 4(r11)
|
|
stwu r24, 4(r11)
|
|
stwu r25, 4(r11)
|
|
stwu r26, 4(r11)
|
|
stwu r27, 4(r11)
|
|
stwu r28, 4(r11)
|
|
stwu r29, 4(r11)
|
|
stwu r30, 4(r11)
|
|
stwu r31, 4(r11)
|
|
stfdu f14, 8(r11)
|
|
stfdu f15, 8(r11)
|
|
stfdu f16, 8(r11)
|
|
stfdu f17, 8(r11)
|
|
stfdu f18, 8(r11)
|
|
stfdu f19, 8(r11)
|
|
stfdu f20, 8(r11)
|
|
stfdu f21, 8(r11)
|
|
stfdu f22, 8(r11)
|
|
stfdu f23, 8(r11)
|
|
stfdu f24, 8(r11)
|
|
stfdu f25, 8(r11)
|
|
stfdu f26, 8(r11)
|
|
stfdu f27, 8(r11)
|
|
stfdu f28, 8(r11)
|
|
stfdu f29, 8(r11)
|
|
stfdu f30, 8(r11)
|
|
stfdu f31, 8(r11)
|
|
/* Set up a callback link */
|
|
addi r1, r1, -16
|
|
Loadglobal r9, _caml_bottom_of_stack, r11
|
|
Loadglobal r10, _caml_last_return_address, r11
|
|
Loadglobal r11, _caml_gc_regs, r11
|
|
stw r9, 0(r1)
|
|
stw r10, 4(r1)
|
|
stw r11, 8(r1)
|
|
/* Build an exception handler to catch exceptions escaping out of Caml */
|
|
bl L103
|
|
b L104
|
|
L103:
|
|
addi r1, r1, -8
|
|
mflr r0
|
|
stw r0, 0(r1)
|
|
Loadglobal r11, _caml_exception_pointer, r11
|
|
stw r11, 4(r1)
|
|
mr r29, r1
|
|
/* Reload allocation pointers */
|
|
Loadglobal r31, _young_ptr, r11
|
|
Loadglobal r30, _young_limit, r11
|
|
/* Say we are back into Caml code */
|
|
li r0, 0
|
|
Storeglobal r0, _caml_last_return_address, r11
|
|
/* Call the Caml code */
|
|
mtlr r12
|
|
L105:
|
|
blrl
|
|
/* Pop the trap frame, restoring caml_exception_pointer */
|
|
lwz r9, 4(r1)
|
|
Storeglobal r9, _caml_exception_pointer, r11
|
|
addi r1, r1, 8
|
|
/* Pop the callback link, restoring the global variables */
|
|
L106:
|
|
lwz r9, 0(r1)
|
|
lwz r10, 4(r1)
|
|
lwz r11, 8(r1)
|
|
Storeglobal r9, _caml_bottom_of_stack, r12
|
|
Storeglobal r10, _caml_last_return_address, r12
|
|
Storeglobal r11, _caml_gc_regs, r12
|
|
addi r1, r1, 16
|
|
/* Update allocation pointer */
|
|
Storeglobal r31, _young_ptr, r11
|
|
/* Restore callee-save registers */
|
|
addi r11, r1, 16-4
|
|
lwzu r14, 4(r11)
|
|
lwzu r15, 4(r11)
|
|
lwzu r16, 4(r11)
|
|
lwzu r17, 4(r11)
|
|
lwzu r18, 4(r11)
|
|
lwzu r19, 4(r11)
|
|
lwzu r20, 4(r11)
|
|
lwzu r21, 4(r11)
|
|
lwzu r22, 4(r11)
|
|
lwzu r23, 4(r11)
|
|
lwzu r24, 4(r11)
|
|
lwzu r25, 4(r11)
|
|
lwzu r26, 4(r11)
|
|
lwzu r27, 4(r11)
|
|
lwzu r28, 4(r11)
|
|
lwzu r29, 4(r11)
|
|
lwzu r30, 4(r11)
|
|
lwzu r31, 4(r11)
|
|
lfdu f14, 8(r11)
|
|
lfdu f15, 8(r11)
|
|
lfdu f16, 8(r11)
|
|
lfdu f17, 8(r11)
|
|
lfdu f18, 8(r11)
|
|
lfdu f19, 8(r11)
|
|
lfdu f20, 8(r11)
|
|
lfdu f21, 8(r11)
|
|
lfdu f22, 8(r11)
|
|
lfdu f23, 8(r11)
|
|
lfdu f24, 8(r11)
|
|
lfdu f25, 8(r11)
|
|
lfdu f26, 8(r11)
|
|
lfdu f27, 8(r11)
|
|
lfdu f28, 8(r11)
|
|
lfdu f29, 8(r11)
|
|
lfdu f30, 8(r11)
|
|
lfdu f31, 8(r11)
|
|
/* Reload return address */
|
|
lwz r0, 256+4(r1)
|
|
mtlr r0
|
|
/* Return */
|
|
addi r1, r1, 256
|
|
blr
|
|
|
|
/* The trap handler: */
|
|
L104:
|
|
/* Update caml_exception_pointer */
|
|
Storeglobal r29, _caml_exception_pointer, r11
|
|
/* Encode exception bucket as an exception result and return it */
|
|
ori r3, r3, 2
|
|
b L106
|
|
|
|
/* Callback from C to Caml */
|
|
|
|
.globl _callback_exn
|
|
_callback_exn:
|
|
/* Initial shuffling of arguments */
|
|
mr r0, r3 /* Closure */
|
|
mr r3, r4 /* Argument */
|
|
mr r4, r0
|
|
lwz r12, 0(r4) /* Code pointer */
|
|
b L102
|
|
|
|
.globl _callback2_exn
|
|
_callback2_exn:
|
|
mr r0, r3 /* Closure */
|
|
mr r3, r4 /* First argument */
|
|
mr r4, r5 /* Second argument */
|
|
mr r5, r0
|
|
Addrglobal r12, _caml_apply2
|
|
b L102
|
|
|
|
.globl _callback3_exn
|
|
_callback3_exn:
|
|
mr r0, r3 /* Closure */
|
|
mr r3, r4 /* First argument */
|
|
mr r4, r5 /* Second argument */
|
|
mr r5, r6 /* Third argument */
|
|
mr r6, r0
|
|
Addrglobal r12, _caml_apply3
|
|
b L102
|
|
|
|
/* Frame table */
|
|
|
|
.const
|
|
.globl _system_frametable
|
|
_system_frametable:
|
|
.long 1 /* one descriptor */
|
|
.long L105 + 4 /* return address into callback */
|
|
.short -1 /* negative size count => use callback link */
|
|
.short 0 /* no roots here */
|
|
|