496 lines
15 KiB
ArmAsm
496 lines
15 KiB
ArmAsm
/***********************************************************************/
|
|
/* */
|
|
/* Objective Caml */
|
|
/* */
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
/* Automatique. Distributed only by permission. */
|
|
/* */
|
|
/***********************************************************************/
|
|
|
|
/* $Id$ */
|
|
|
|
/* Asm part of the runtime system, Alpha processor */
|
|
|
|
.comm young_start 8
|
|
.comm young_end 8
|
|
.comm young_ptr 8
|
|
.comm young_limit 8
|
|
.comm gc_entry_regs 8 * 32
|
|
.comm gc_entry_float_regs 8 * 32
|
|
.comm remembered_ptr 8
|
|
.comm remembered_end 8
|
|
.comm caml_top_of_stack 8
|
|
.comm caml_bottom_of_stack 8
|
|
.comm caml_last_return_address 8
|
|
.comm caml_exception_pointer 8
|
|
|
|
#define SAVE_ALL_REGS \
|
|
lda $24, gc_entry_regs; \
|
|
stq $0, 0 * 8 ($24); \
|
|
stq $1, 1 * 8 ($24); \
|
|
stq $2, 2 * 8 ($24); \
|
|
stq $3, 3 * 8 ($24); \
|
|
stq $4, 4 * 8 ($24); \
|
|
stq $5, 5 * 8 ($24); \
|
|
stq $6, 6 * 8 ($24); \
|
|
stq $7, 7 * 8 ($24); \
|
|
stq $8, 8 * 8 ($24); \
|
|
stq $9, 9 * 8 ($24); \
|
|
stq $10, 10 * 8 ($24); \
|
|
stq $11, 11 * 8 ($24); \
|
|
stq $12, 12 * 8 ($24); \
|
|
stq $16, 16 * 8 ($24); \
|
|
stq $17, 17 * 8 ($24); \
|
|
stq $18, 18 * 8 ($24); \
|
|
stq $19, 19 * 8 ($24); \
|
|
stq $20, 20 * 8 ($24); \
|
|
stq $21, 21 * 8 ($24); \
|
|
stq $22, 22 * 8 ($24); \
|
|
lda $24, gc_entry_float_regs; \
|
|
stt $f0, 0 * 8 ($24); \
|
|
stt $f1, 1 * 8 ($24); \
|
|
stt $f10, 10 * 8 ($24); \
|
|
stt $f11, 11 * 8 ($24); \
|
|
stt $f12, 12 * 8 ($24); \
|
|
stt $f13, 13 * 8 ($24); \
|
|
stt $f14, 14 * 8 ($24); \
|
|
stt $f15, 15 * 8 ($24); \
|
|
stt $f16, 16 * 8 ($24); \
|
|
stt $f17, 17 * 8 ($24); \
|
|
stt $f18, 18 * 8 ($24); \
|
|
stt $f19, 19 * 8 ($24); \
|
|
stt $f20, 20 * 8 ($24); \
|
|
stt $f21, 21 * 8 ($24); \
|
|
stt $f22, 22 * 8 ($24); \
|
|
stt $f23, 23 * 8 ($24); \
|
|
stt $f24, 24 * 8 ($24); \
|
|
stt $f25, 25 * 8 ($24); \
|
|
stt $f26, 26 * 8 ($24); \
|
|
stt $f27, 27 * 8 ($24); \
|
|
stt $f28, 28 * 8 ($24); \
|
|
stt $f29, 29 * 8 ($24)
|
|
|
|
#define LOAD_ALL_REGS \
|
|
lda $24, gc_entry_regs; \
|
|
ldq $0, 0 * 8 ($24); \
|
|
ldq $1, 1 * 8 ($24); \
|
|
ldq $2, 2 * 8 ($24); \
|
|
ldq $3, 3 * 8 ($24); \
|
|
ldq $4, 4 * 8 ($24); \
|
|
ldq $5, 5 * 8 ($24); \
|
|
ldq $6, 6 * 8 ($24); \
|
|
ldq $7, 7 * 8 ($24); \
|
|
ldq $8, 8 * 8 ($24); \
|
|
ldq $9, 9 * 8 ($24); \
|
|
ldq $10, 10 * 8 ($24); \
|
|
ldq $11, 11 * 8 ($24); \
|
|
ldq $12, 12 * 8 ($24); \
|
|
ldq $16, 16 * 8 ($24); \
|
|
ldq $17, 17 * 8 ($24); \
|
|
ldq $18, 18 * 8 ($24); \
|
|
ldq $19, 19 * 8 ($24); \
|
|
ldq $20, 20 * 8 ($24); \
|
|
ldq $21, 21 * 8 ($24); \
|
|
ldq $22, 22 * 8 ($24); \
|
|
lda $24, gc_entry_float_regs; \
|
|
ldt $f0, 0 * 8 ($24); \
|
|
ldt $f1, 1 * 8 ($24); \
|
|
ldt $f10, 10 * 8 ($24); \
|
|
ldt $f11, 11 * 8 ($24); \
|
|
ldt $f12, 12 * 8 ($24); \
|
|
ldt $f13, 13 * 8 ($24); \
|
|
ldt $f14, 14 * 8 ($24); \
|
|
ldt $f15, 15 * 8 ($24); \
|
|
ldt $f16, 16 * 8 ($24); \
|
|
ldt $f17, 17 * 8 ($24); \
|
|
ldt $f18, 18 * 8 ($24); \
|
|
ldt $f19, 19 * 8 ($24); \
|
|
ldt $f20, 20 * 8 ($24); \
|
|
ldt $f21, 21 * 8 ($24); \
|
|
ldt $f22, 22 * 8 ($24); \
|
|
ldt $f23, 23 * 8 ($24); \
|
|
ldt $f24, 24 * 8 ($24); \
|
|
ldt $f25, 25 * 8 ($24); \
|
|
ldt $f26, 26 * 8 ($24); \
|
|
ldt $f27, 27 * 8 ($24); \
|
|
ldt $f28, 28 * 8 ($24); \
|
|
ldt $f29, 29 * 8 ($24)
|
|
|
|
/* Allocation */
|
|
|
|
.text
|
|
.globl caml_alloc2
|
|
.globl caml_alloc3
|
|
.globl caml_alloc
|
|
.globl caml_call_gc
|
|
|
|
/* caml_alloc* : all code generator registers preserved,
|
|
$gp preserved, $27 not valid on entry */
|
|
|
|
.globl caml_alloc1
|
|
.ent caml_alloc1
|
|
.align 3
|
|
caml_alloc1:
|
|
subq $13, 16, $13
|
|
cmpult $13, $14, $25
|
|
bne $25, $100
|
|
ret ($26)
|
|
$100: ldiq $25, 16
|
|
br $110
|
|
.end caml_alloc1
|
|
|
|
.globl caml_alloc2
|
|
.ent caml_alloc2
|
|
.align 3
|
|
caml_alloc2:
|
|
subq $13, 24, $13
|
|
cmpult $13, $14, $25
|
|
bne $25, $101
|
|
ret ($26)
|
|
$101: ldiq $25, 24
|
|
br $110
|
|
.end caml_alloc2
|
|
|
|
.globl caml_alloc3
|
|
.ent caml_alloc3
|
|
.align 3
|
|
caml_alloc3:
|
|
subq $13, 32, $13
|
|
cmpult $13, $14, $25
|
|
bne $25, $102
|
|
ret ($26)
|
|
$102: ldiq $25, 32
|
|
br $110
|
|
.end caml_alloc3
|
|
|
|
.globl caml_alloc
|
|
.ent caml_alloc
|
|
.align 3
|
|
caml_alloc:
|
|
subq $13, $25, $13
|
|
.set noat
|
|
cmpult $13, $14, $at
|
|
bne $at, $110
|
|
.set at
|
|
ret ($26)
|
|
.end caml_alloc
|
|
|
|
.globl caml_call_gc
|
|
.ent caml_call_gc
|
|
.align 3
|
|
caml_call_gc:
|
|
ldiq $25, 0
|
|
$110: lda $sp, -32($sp)
|
|
stq $26, 0($sp)
|
|
stq $gp, 8($sp)
|
|
stq $25, 16($sp)
|
|
/* Rebuild $gp */
|
|
br $27, $103
|
|
$103: ldgp $gp, 0($27)
|
|
/* Record lowest stack address and return address */
|
|
ldq $24, 0($sp)
|
|
stq $24, caml_last_return_address
|
|
lda $24, 32($sp)
|
|
stq $24, caml_bottom_of_stack
|
|
/* Save current allocation pointer for debugging purposes */
|
|
stq $13, young_ptr
|
|
/* Save trap pointer in case an exception is raised (e.g. sighandler) */
|
|
stq $15, caml_exception_pointer
|
|
/* Save all regs used by the code generator in the arrays
|
|
/* gc_entry_regs and gc_entry_float_regs. */
|
|
SAVE_ALL_REGS
|
|
/* Call the garbage collector */
|
|
jsr garbage_collection
|
|
/* Restore all regs used by the code generator */
|
|
ldgp $gp, 0($26)
|
|
LOAD_ALL_REGS
|
|
/* Reload new allocation pointer and allocation limit */
|
|
ldq $13, young_ptr
|
|
ldq $14, young_limit
|
|
/* Allocate space for the block */
|
|
ldq $25, 16($sp)
|
|
subq $13, $25, $13
|
|
/* Say that we are back into Caml code */
|
|
stq $31, caml_last_return_address
|
|
/* Return to caller */
|
|
ldq $26, 0($sp)
|
|
ldq $gp, 8($sp)
|
|
lda $sp, 32($sp)
|
|
ret ($26)
|
|
|
|
.end caml_call_gc
|
|
|
|
/* Call a C function from Caml */
|
|
|
|
.globl caml_c_call
|
|
.ent caml_c_call
|
|
.align 3
|
|
caml_c_call:
|
|
/* Function to call is in $27 */
|
|
/* Preserve return address and caller's $gp in callee-save registers */
|
|
mov $26, $9
|
|
mov $gp, $10
|
|
/* Rebuild $gp */
|
|
br $25, $105
|
|
$105: ldgp $gp, 0($25)
|
|
/* Record lowest stack address and return address */
|
|
lda $11, caml_last_return_address
|
|
stq $26, 0($11)
|
|
stq $sp, caml_bottom_of_stack
|
|
/* Make the exception handler and alloc ptr available to the C code */
|
|
lda $12, young_ptr
|
|
stq $13, 0($12)
|
|
stq $15, caml_exception_pointer
|
|
/* Call the function */
|
|
jsr ($27)
|
|
/* Reload alloc ptr and alloc limit */
|
|
ldq $13, 0($12) /* $12 still points to young_ptr */
|
|
ldq $14, young_limit
|
|
/* Say that we are back into Caml code */
|
|
stq $31, 0($11) /* $11 still points to caml_last_return_address */
|
|
/* Restore $gp */
|
|
mov $10, $gp
|
|
/* Return */
|
|
ret ($9)
|
|
|
|
.end caml_c_call
|
|
|
|
/* Start the Caml program */
|
|
|
|
.globl caml_start_program
|
|
.globl stray_exn_handler
|
|
.ent caml_start_program
|
|
.align 3
|
|
caml_start_program:
|
|
ldgp $gp, 0($27)
|
|
lda $sp, -128($sp)
|
|
stq $26, 0($sp)
|
|
/* Save all callee-save registers */
|
|
stq $9, 8($sp)
|
|
stq $10, 16($sp)
|
|
stq $11, 24($sp)
|
|
stq $12, 32($sp)
|
|
stq $13, 40($sp)
|
|
stq $14, 48($sp)
|
|
stq $15, 56($sp)
|
|
stt $f2, 64($sp)
|
|
stt $f3, 72($sp)
|
|
stt $f4, 80($sp)
|
|
stt $f5, 88($sp)
|
|
stt $f6, 96($sp)
|
|
stt $f7, 104($sp)
|
|
stt $f8, 112($sp)
|
|
stt $f9, 120($sp)
|
|
/* Build an exception handler */
|
|
lda $sp, -16($sp)
|
|
lda $0, stray_exn_handler
|
|
stq $0, 8($sp)
|
|
mov $sp, $15
|
|
/* Record highest stack address */
|
|
stq $sp, caml_top_of_stack
|
|
/* Initialize allocation registers */
|
|
ldq $13, young_ptr
|
|
ldq $14, young_start
|
|
/* Go for it */
|
|
jsr caml_program
|
|
/* Pop handler */
|
|
lda $sp, 16($sp)
|
|
/* Return with zero code */
|
|
clr $0
|
|
/* Restore registers */
|
|
stray_exn_handler:
|
|
ldq $26, 0($sp)
|
|
ldq $9, 8($sp)
|
|
ldq $10, 16($sp)
|
|
ldq $11, 24($sp)
|
|
ldq $12, 32($sp)
|
|
ldq $13, 40($sp)
|
|
ldq $14, 48($sp)
|
|
ldq $15, 56($sp)
|
|
ldt $f2, 64($sp)
|
|
ldt $f3, 72($sp)
|
|
ldt $f4, 80($sp)
|
|
ldt $f5, 88($sp)
|
|
ldt $f6, 96($sp)
|
|
ldt $f7, 104($sp)
|
|
ldt $f8, 112($sp)
|
|
ldt $f9, 120($sp)
|
|
lda $sp, 128($sp)
|
|
ret ($26)
|
|
|
|
.end caml_start_program
|
|
|
|
/* Raise an exception from C */
|
|
|
|
.globl raise_caml_exception
|
|
.ent raise_caml_exception
|
|
.align 3
|
|
raise_caml_exception:
|
|
ldgp $gp, 0($27)
|
|
mov $16, $0 /* Move exn bucket */
|
|
ldq $13, young_ptr
|
|
ldq $14, young_limit
|
|
stq $31, caml_last_return_address /* We're back into Caml */
|
|
ldq $sp, caml_exception_pointer
|
|
ldq $15, 0($sp)
|
|
ldq $27, 8($sp)
|
|
lda $sp, 16($sp)
|
|
jmp $25, ($27) /* Keep retaddr in $25 to help debugging */
|
|
.end raise_caml_exception
|
|
|
|
/* Glue code to jump to array_bound_error after reinitializing $gp */
|
|
|
|
.globl call_array_bound_error
|
|
.ent call_array_bound_error
|
|
.align 3
|
|
call_array_bound_error:
|
|
nop
|
|
/* Rebuild $gp */
|
|
br $27, $106
|
|
$106: ldgp $gp, 0($27)
|
|
/* Branch to array_bound_error -- never returns */
|
|
jsr array_bound_error
|
|
.end call_array_bound_error
|
|
|
|
/* Callback from C to Caml */
|
|
|
|
.globl callback
|
|
.ent callback
|
|
.align 3
|
|
callback:
|
|
/* Initial shuffling of arguments */
|
|
ldgp $gp, 0($27)
|
|
mov $16, $25
|
|
mov $17, $16 /* first arg */
|
|
mov $25, $17 /* environment */
|
|
ldq $25, 0($25) /* code pointer */
|
|
$107:
|
|
/* Save return address */
|
|
lda $sp, -128($sp)
|
|
stq $26, 0($sp)
|
|
/* Save all callee-save registers */
|
|
stq $9, 8($sp)
|
|
stq $10, 16($sp)
|
|
stq $11, 24($sp)
|
|
stq $12, 32($sp)
|
|
stq $13, 40($sp)
|
|
stq $14, 48($sp)
|
|
stq $15, 56($sp)
|
|
stt $f2, 64($sp)
|
|
stt $f3, 72($sp)
|
|
stt $f4, 80($sp)
|
|
stt $f5, 88($sp)
|
|
stt $f6, 96($sp)
|
|
stt $f7, 104($sp)
|
|
stt $f8, 112($sp)
|
|
stt $f9, 120($sp)
|
|
/* Set up a callback link on the stack. */
|
|
lda $sp, -16($sp)
|
|
ldq $0, caml_bottom_of_stack
|
|
stq $0, 0($sp)
|
|
ldq $1, caml_last_return_address
|
|
stq $1, 8($sp)
|
|
/* Set up a trap frame to catch exceptions escaping the Caml code */
|
|
lda $sp, -16($sp)
|
|
ldq $15, caml_exception_pointer
|
|
stq $15, 0($sp)
|
|
lda $0, $109
|
|
stq $0, 8($sp)
|
|
mov $sp, $15
|
|
/* Reload allocation pointers */
|
|
ldq $13, young_ptr
|
|
ldq $14, young_limit
|
|
/* We are back into Caml code */
|
|
stq $31, caml_last_return_address
|
|
/* Call the Caml code */
|
|
$108: jsr ($25)
|
|
/* Reload $gp */
|
|
bic $26, 1, $26 /* return address may have "scanned" bit set */
|
|
ldgp $gp, 4($26)
|
|
/* Pop the trap frame, restoring caml-exception_pointer */
|
|
ldq $15, 0($sp)
|
|
stq $15, caml_exception_pointer
|
|
lda $sp, 16($sp)
|
|
/* Restore the global variables used by caml_c_call */
|
|
ldq $24, 0($sp)
|
|
stq $24, caml_bottom_of_stack
|
|
ldq $25, 8($sp)
|
|
stq $25, caml_last_return_address
|
|
lda $sp, 16($sp)
|
|
/* Update allocation pointer */
|
|
stq $13, young_ptr
|
|
/* Reload callee-save registers */
|
|
ldq $9, 8($sp)
|
|
ldq $10, 16($sp)
|
|
ldq $11, 24($sp)
|
|
ldq $12, 32($sp)
|
|
ldq $13, 40($sp)
|
|
ldq $14, 48($sp)
|
|
ldq $15, 56($sp)
|
|
ldt $f2, 64($sp)
|
|
ldt $f3, 72($sp)
|
|
ldt $f4, 80($sp)
|
|
ldt $f5, 88($sp)
|
|
ldt $f6, 96($sp)
|
|
ldt $f7, 104($sp)
|
|
ldt $f8, 112($sp)
|
|
ldt $f9, 120($sp)
|
|
/* Return to caller */
|
|
ldq $26, 0($sp)
|
|
lda $sp, 128($sp)
|
|
ret ($26)
|
|
/* The trap handler */
|
|
$109: ldgp $gp, 0($27)
|
|
/* Restore the global variables used by caml_c_call */
|
|
ldq $24, 0($sp)
|
|
stq $24, caml_bottom_of_stack
|
|
ldq $25, 8($sp)
|
|
stq $25, caml_last_return_address
|
|
lda $sp, 16($sp)
|
|
/* Re-raise the exception through mlraise,
|
|
so that local C roots are cleaned up correctly. */
|
|
stq $13, young_ptr
|
|
stq $15, caml_exception_pointer
|
|
mov $0, $16 /* bucket as first argument */
|
|
jsr mlraise /* never returns */
|
|
|
|
.end callback
|
|
|
|
.globl callback2
|
|
.ent callback2
|
|
.align 3
|
|
callback2:
|
|
ldgp $gp, 0($27)
|
|
mov $16, $25
|
|
mov $17, $16 /* first arg */
|
|
mov $18, $17 /* second arg */
|
|
mov $25, $18 /* environment */
|
|
lda $25, caml_apply2
|
|
br $107
|
|
.end callback2
|
|
|
|
.globl callback3
|
|
.ent callback3
|
|
.align 3
|
|
callback3:
|
|
ldgp $gp, 0($27)
|
|
mov $16, $25
|
|
mov $17, $16 /* first arg */
|
|
mov $18, $17 /* second arg */
|
|
mov $19, $18 /* third arg */
|
|
mov $25, $19 /* environment */
|
|
lda $25, caml_apply3
|
|
br $107
|
|
.end callback3
|
|
|
|
.rdata
|
|
.globl system_frametable
|
|
system_frametable:
|
|
.quad 1 /* one descriptor */
|
|
.quad $108 + 4 /* return address into callback */
|
|
.word -1 /* negative frame size => use callback link */
|
|
.word 0 /* no roots here */
|
|
.align 3
|