374 lines
12 KiB
NASM
374 lines
12 KiB
NASM
/***********************************************************************/
|
|
/* */
|
|
/* Caml Special Light */
|
|
/* */
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 1995 Institut National de Recherche en Informatique et */
|
|
/* Automatique. Distributed only by permission. */
|
|
/* */
|
|
/***********************************************************************/
|
|
|
|
/* $Id$ */
|
|
|
|
/* Asm part of the runtime system for the Sparc processor. */
|
|
/* Must be preprocessed by cpp */
|
|
|
|
/* SunOS 4 and BSD prefix identifiers with _, Solaris does not */
|
|
|
|
#ifndef SYS_solaris
|
|
|
|
.common _young_limit, 4, "bss"
|
|
.common _young_ptr, 4, "bss"
|
|
.common _gc_entry_regs, 22 * 4, "bss"
|
|
.common _gc_entry_float_regs, 30 * 4, "bss"
|
|
.common _caml_top_of_stack, 4, "bss"
|
|
.common _caml_bottom_of_stack, 4, "bss"
|
|
.common _caml_last_return_address, 4, "bss"
|
|
.common _caml_exception_pointer, 4, "bss"
|
|
.common _caml_required_size, 4, "bss"
|
|
|
|
#define Young_limit _young_limit
|
|
#define Young_ptr _young_ptr
|
|
#define Gc_entry_regs _gc_entry_regs
|
|
#define Gc_entry_float_regs _gc_entry_float_regs
|
|
#define Caml_top_of_stack _caml_top_of_stack
|
|
#define Caml_bottom_of_stack _caml_bottom_of_stack
|
|
#define Caml_last_return_address _caml_last_return_address
|
|
#define Caml_exception_pointer _caml_exception_pointer
|
|
#define Caml_required_size _caml_required_size
|
|
#define Caml_alloc _caml_alloc
|
|
#define Caml_call_gc _caml_call_gc
|
|
#define Garbage_collection _garbage_collection
|
|
#define Caml_c_call _caml_c_call
|
|
#define Caml_start_program _caml_start_program
|
|
#define Caml_program _caml_program
|
|
#define Raise_caml_exception _raise_caml_exception
|
|
#define Callback _callback
|
|
#define Callback2 _callback2
|
|
#define Callback3 _callback3
|
|
#define Caml_apply2 _caml_apply2
|
|
#define Caml_apply3 _caml_apply3
|
|
#define Mlraise _mlraise
|
|
#define System_frametable _system_frametable
|
|
|
|
#else
|
|
|
|
.common young_limit, 4, 4
|
|
.common young_end, 4, 4
|
|
.common young_ptr, 4, 4
|
|
.common gc_entry_regs, 22 * 4, 4
|
|
.common gc_entry_float_regs, 30 * 4, 8
|
|
.common caml_top_of_stack, 4, 4
|
|
.common caml_bottom_of_stack, 4, 4
|
|
.common caml_last_return_address, 4, 4
|
|
.common caml_exception_pointer, 4, 4
|
|
.common caml_required_size, 4, 4
|
|
|
|
#define Young_limit young_limit
|
|
#define Young_ptr young_ptr
|
|
#define Gc_entry_regs gc_entry_regs
|
|
#define Gc_entry_float_regs gc_entry_float_regs
|
|
#define Caml_top_of_stack caml_top_of_stack
|
|
#define Caml_bottom_of_stack caml_bottom_of_stack
|
|
#define Caml_last_return_address caml_last_return_address
|
|
#define Caml_exception_pointer caml_exception_pointer
|
|
#define Caml_required_size caml_required_size
|
|
#define Caml_alloc caml_alloc
|
|
#define Caml_call_gc caml_call_gc
|
|
#define Garbage_collection garbage_collection
|
|
#define Caml_c_call caml_c_call
|
|
#define Caml_start_program caml_start_program
|
|
#define Caml_program caml_program
|
|
#define Raise_caml_exception raise_caml_exception
|
|
#define Callback callback
|
|
#define Callback2 callback2
|
|
#define Callback3 callback3
|
|
#define Caml_apply2 caml_apply2
|
|
#define Caml_apply3 caml_apply3
|
|
#define Mlraise mlraise
|
|
#define System_frametable system_frametable
|
|
|
|
#endif
|
|
|
|
/* libc functions appear to clobber %g2 ... %g7 */
|
|
/* Remember to save and restore %g5 %g6 %g7. */
|
|
|
|
#define Load(symb,reg) sethi %hi(symb), %g1; ld [%g1 + %lo(symb)], reg
|
|
#define Store(reg,symb) sethi %hi(symb), %g1; st reg, [%g1 + %lo(symb)]
|
|
#define Address(symb,reg) sethi %hi(symb), reg; or reg, %lo(symb), reg
|
|
|
|
/* Allocation functions */
|
|
|
|
.text
|
|
.global Caml_alloc
|
|
.global Caml_call_gc
|
|
|
|
/* Required size in %g4 */
|
|
Caml_alloc:
|
|
ld [%g7], %g1
|
|
sub %g6, %g4, %g6
|
|
cmp %g6, %g1
|
|
blu Caml_call_gc
|
|
nop
|
|
retl
|
|
nop
|
|
|
|
/* Required size in %g4 */
|
|
Caml_call_gc:
|
|
/* Save %g4 (required size) */
|
|
Store(%g4, Caml_required_size)
|
|
/* Save %g5 (exception pointer) */
|
|
Store(%g5, Caml_exception_pointer)
|
|
/* Save current allocation pointer for debugging purposes */
|
|
Store(%g6, Young_ptr)
|
|
/* Record lowest stack address */
|
|
Store(%sp, Caml_bottom_of_stack)
|
|
/* Record last return address */
|
|
Store(%o7, Caml_last_return_address)
|
|
/* Save all regs used by the code generator */
|
|
Address(Gc_entry_regs, %g1)
|
|
std %l0, [%g1]
|
|
std %l2, [%g1 + 0x8]
|
|
std %l4, [%g1 + 0x10]
|
|
std %l6, [%g1 + 0x18]
|
|
std %o0, [%g1 + 0x20]
|
|
std %o2, [%g1 + 0x28]
|
|
std %o4, [%g1 + 0x30]
|
|
std %i0, [%g1 + 0x38]
|
|
std %i2, [%g1 + 0x40]
|
|
std %i4, [%g1 + 0x48]
|
|
std %g2, [%g1 + 0x50]
|
|
Address(Gc_entry_float_regs, %g1)
|
|
std %f0, [%g1]
|
|
std %f2, [%g1 + 0x8]
|
|
std %f4, [%g1 + 0x10]
|
|
std %f6, [%g1 + 0x18]
|
|
std %f8, [%g1 + 0x20]
|
|
std %f10, [%g1 + 0x28]
|
|
std %f12, [%g1 + 0x30]
|
|
std %f14, [%g1 + 0x38]
|
|
std %f16, [%g1 + 0x40]
|
|
std %f18, [%g1 + 0x48]
|
|
std %f20, [%g1 + 0x50]
|
|
std %f22, [%g1 + 0x58]
|
|
std %f24, [%g1 + 0x60]
|
|
std %f26, [%g1 + 0x68]
|
|
std %f28, [%g1 + 0x70]
|
|
/* Call the garbage collector */
|
|
call Garbage_collection
|
|
nop
|
|
/* Restore all regs used by the code generator */
|
|
Address(Gc_entry_regs, %g1)
|
|
ldd [%g1], %l0
|
|
ldd [%g1 + 0x8], %l2
|
|
ldd [%g1 + 0x10], %l4
|
|
ldd [%g1 + 0x18], %l6
|
|
ldd [%g1 + 0x20], %o0
|
|
ldd [%g1 + 0x28], %o2
|
|
ldd [%g1 + 0x30], %o4
|
|
ldd [%g1 + 0x38], %i0
|
|
ldd [%g1 + 0x40], %i2
|
|
ldd [%g1 + 0x48], %i4
|
|
ldd [%g1 + 0x50], %g2
|
|
Address(Gc_entry_float_regs, %g1)
|
|
ldd [%g1], %f0
|
|
ldd [%g1 + 0x8], %f2
|
|
ldd [%g1 + 0x10], %f4
|
|
ldd [%g1 + 0x18], %f6
|
|
ldd [%g1 + 0x20], %f8
|
|
ldd [%g1 + 0x28], %f10
|
|
ldd [%g1 + 0x30], %f12
|
|
ldd [%g1 + 0x38], %f14
|
|
ldd [%g1 + 0x40], %f16
|
|
ldd [%g1 + 0x48], %f18
|
|
ldd [%g1 + 0x50], %f20
|
|
ldd [%g1 + 0x58], %f22
|
|
ldd [%g1 + 0x60], %f24
|
|
ldd [%g1 + 0x68], %f26
|
|
ldd [%g1 + 0x70], %f28
|
|
/* Reload %g5 - %g7 registers */
|
|
Load(Caml_exception_pointer, %g5)
|
|
Load(Young_ptr, %g6)
|
|
Address(Young_limit, %g7)
|
|
/* Allocate space for block */
|
|
Load(Caml_required_size, %g4)
|
|
sub %g6, %g4, %g6
|
|
/* Return to caller */
|
|
Load(Caml_last_return_address, %o7)
|
|
retl
|
|
nop
|
|
|
|
/* Call a C function from Caml */
|
|
|
|
.global Caml_c_call
|
|
/* Function to call is in %g4 */
|
|
Caml_c_call:
|
|
/* Record lowest stack address and return address */
|
|
Store(%sp, Caml_bottom_of_stack)
|
|
Store(%o7, Caml_last_return_address)
|
|
/* Save the exception handler and alloc pointer */
|
|
Store(%g5, Caml_exception_pointer)
|
|
sethi %hi(Young_ptr), %g1
|
|
/* Call the C function */
|
|
call %g4
|
|
st %g6, [%g1 + %lo(Young_ptr)] /* in delay slot */
|
|
/* Reload return address */
|
|
Load(Caml_last_return_address, %o7)
|
|
/* Reload %g5 - %g7 */
|
|
Load(Caml_exception_pointer, %g5)
|
|
Load(Young_ptr, %g6)
|
|
sethi %hi(Young_limit), %g7
|
|
/* Return to caller */
|
|
retl
|
|
or %g7, %lo(Young_limit), %g7 /* in delay slot */
|
|
|
|
/* Start the Caml program */
|
|
|
|
.global Caml_start_program
|
|
Caml_start_program:
|
|
/* Save all callee-save registers */
|
|
save %sp, -96, %sp
|
|
/* Build an exception handler */
|
|
call L100
|
|
nop
|
|
b L101
|
|
mov %o0, %i0 /* return exn bucket */
|
|
L100: sub %sp, 8, %sp
|
|
st %o7, [%sp + 96]
|
|
mov %sp, %g5
|
|
/* Record highest stack address */
|
|
Store(%sp, Caml_top_of_stack)
|
|
/* Initialize allocation registers */
|
|
Load(Young_ptr, %g6)
|
|
Address(Young_limit, %g7)
|
|
/* Go for it */
|
|
call Caml_program
|
|
nop
|
|
/* Pop handler */
|
|
add %sp, 8, %sp
|
|
/* Return with zero code */
|
|
mov %g0, %i0
|
|
L101: ret
|
|
restore
|
|
|
|
/* Raise an exception from C */
|
|
|
|
.global Raise_caml_exception
|
|
Raise_caml_exception:
|
|
/* Reload %g5 - %g7 */
|
|
Load(Caml_exception_pointer, %g5)
|
|
Load(Young_ptr, %g6)
|
|
Address(Young_limit, %g7)
|
|
/* Save exception bucket in a register outside the reg windows */
|
|
mov %o0, %g1
|
|
/* Pop some frames until the trap pointer is in the current frame. */
|
|
cmp %g5, %fp
|
|
blt L107 /* if Trap_handler_reg < %fp, over */
|
|
nop
|
|
L106: restore
|
|
cmp %fp, %g5 /* if %fp <= Trap_handler_reg, loop */
|
|
ble L106
|
|
nop
|
|
L107: mov %g5, %sp
|
|
ldd [%sp+96], %g4
|
|
add %sp, 8, %sp
|
|
jmp %g4 + 8
|
|
/* Restore bucket, in delay slot */
|
|
mov %g1, %o0
|
|
|
|
/* Callbacks C -> ML */
|
|
|
|
.global Callback
|
|
Callback:
|
|
/* Save callee-save registers and return address */
|
|
save %sp, -96, %sp
|
|
/* Initial shuffling of arguments */
|
|
mov %i0, %g1
|
|
mov %i1, %i0 /* first arg */
|
|
mov %g1, %i1 /* environment */
|
|
ld [%g1], %l2 /* code pointer */
|
|
L108:
|
|
/* Set up a callback link on the stack. */
|
|
sub %sp, 8, %sp
|
|
Load(Caml_bottom_of_stack, %l0)
|
|
Load(Caml_last_return_address, %l1)
|
|
std %l0, [%sp + 96]
|
|
/* Set up a trap frame to catch exceptions escaping the Caml code */
|
|
call L111
|
|
mov %o7, %g4 /* in delay slot */
|
|
b L110
|
|
nop
|
|
L111: sub %sp, 8, %sp
|
|
Load(Caml_exception_pointer, %g5)
|
|
std %g4, [%sp + 96]
|
|
mov %sp, %g5
|
|
/* Reload allocation pointers */
|
|
Load(Young_ptr, %g6)
|
|
Address(Young_limit, %g7)
|
|
/* Call the Caml code */
|
|
L109: call %l2
|
|
nop
|
|
/* Pop trap frame and restore caml_exception_pointer */
|
|
ld [%sp + 100], %g5
|
|
add %sp, 8, %sp
|
|
Store(%g5, Caml_exception_pointer)
|
|
/* Pop callback link, restoring the global variables used by caml_c_call */
|
|
ldd [%sp + 96], %l0
|
|
add %sp, 8, %sp
|
|
Store(%l0, Caml_bottom_of_stack)
|
|
Store(%l1, Caml_last_return_address)
|
|
/* Save allocation pointer */
|
|
Store(%g6, Young_ptr)
|
|
/* Move result where the C function expects it */
|
|
mov %o0, %i0 /* %i0 will become %o0 after restore */
|
|
/* Reload callee-save registers and return */
|
|
ret
|
|
restore
|
|
L110:
|
|
/* The trap handler */
|
|
Store(%g5, Caml_exception_pointer)
|
|
Store(%g6, Young_ptr)
|
|
ldd [%sp + 96], %l0
|
|
Store(%l0, Caml_bottom_of_stack)
|
|
Store(%l1, Caml_last_return_address)
|
|
/* Re-raise the exception through mlraise,
|
|
so that local C roots are cleaned up correctly. */
|
|
call Mlraise /* never returns */
|
|
nop
|
|
|
|
.global Callback2
|
|
Callback2:
|
|
/* Save callee-save registers and return address */
|
|
save %sp, -104, %sp
|
|
/* Initial shuffling of arguments */
|
|
mov %i0, %g1
|
|
mov %i1, %i0 /* first arg */
|
|
mov %i2, %i1 /* second arg */
|
|
mov %g1, %i2 /* environment */
|
|
sethi %hi(Caml_apply2), %l2
|
|
b L108
|
|
or %l2, %lo(Caml_apply2), %l2
|
|
|
|
.global Callback3
|
|
Callback3:
|
|
/* Save callee-save registers and return address */
|
|
save %sp, -104, %sp
|
|
/* Initial shuffling of arguments */
|
|
mov %i0, %g1
|
|
mov %i1, %i0 /* first arg */
|
|
mov %i2, %i1 /* second arg */
|
|
mov %i3, %i2 /* third arg */
|
|
mov %g1, %i3 /* environment */
|
|
sethi %hi(Caml_apply3), %l2
|
|
b L108
|
|
or %l2, %lo(Caml_apply3), %l2
|
|
|
|
.data
|
|
.global System_frametable
|
|
System_frametable:
|
|
.word 1 /* one descriptor */
|
|
.word L109 /* return address into callback */
|
|
.half -1 /* negative frame size => use callback link */
|
|
.half 0 /* no roots */
|