237 lines
7.2 KiB
ArmAsm
237 lines
7.2 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, Motorola 68k processor
|
|
|
|
.comm _gc_entry_regs, 48
|
|
.comm _caml_requested_size, 4
|
|
|
|
| Allocation
|
|
|
|
.text
|
|
.globl _caml_call_gc
|
|
.globl _caml_alloc1
|
|
.globl _caml_alloc2
|
|
.globl _caml_alloc3
|
|
.globl _caml_alloc
|
|
|
|
_caml_call_gc:
|
|
| Save desired size
|
|
movel d5, _caml_requested_size
|
|
| Record lowest stack address and return address
|
|
movel a7@, _caml_last_return_address
|
|
movel a7, d5
|
|
addql #4, d5
|
|
movel d5, _caml_bottom_of_stack
|
|
| Record current allocation pointer (for debugging)
|
|
movel d6, _young_ptr
|
|
| Save all regs used by the code generator
|
|
movel a0, _gc_entry_regs
|
|
movel a1, _gc_entry_regs + 4
|
|
movel a2, _gc_entry_regs + 8
|
|
movel a3, _gc_entry_regs + 12
|
|
movel a4, _gc_entry_regs + 16
|
|
movel a5, _gc_entry_regs + 20
|
|
movel a6, _gc_entry_regs + 24
|
|
movel d0, _gc_entry_regs + 28
|
|
movel d1, _gc_entry_regs + 32
|
|
movel d2, _gc_entry_regs + 36
|
|
movel d3, _gc_entry_regs + 40
|
|
movel d4, _gc_entry_regs + 44
|
|
fmovem fp0-fp7, a7@-
|
|
| Call the garbage collector
|
|
jbsr _garbage_collection
|
|
| Restore all regs used by the code generator
|
|
fmovem a7@+, fp0-fp7
|
|
movel _gc_entry_regs, a0
|
|
movel _gc_entry_regs + 4, a1
|
|
movel _gc_entry_regs + 8, a2
|
|
movel _gc_entry_regs + 12, a3
|
|
movel _gc_entry_regs + 16, a4
|
|
movel _gc_entry_regs + 20, a5
|
|
movel _gc_entry_regs + 24, a6
|
|
movel _gc_entry_regs + 28, d0
|
|
movel _gc_entry_regs + 32, d1
|
|
movel _gc_entry_regs + 36, d2
|
|
movel _gc_entry_regs + 40, d3
|
|
movel _gc_entry_regs + 44, d4
|
|
| Reload allocation pointer and allocate block
|
|
movel _young_ptr, d6
|
|
subl _caml_requested_size, d6
|
|
| Return to caller
|
|
rts
|
|
|
|
_caml_alloc1:
|
|
subql #8, d6
|
|
cmpl _young_limit, d6
|
|
bcs L100
|
|
rts
|
|
L100: moveq #8, d5
|
|
bra _caml_call_gc
|
|
|
|
_caml_alloc2:
|
|
subl #12, d6
|
|
cmpl _young_limit, d6
|
|
bcs L101
|
|
rts
|
|
L101: moveq #12, d5
|
|
bra _caml_call_gc
|
|
|
|
_caml_alloc3:
|
|
subl #16, d6
|
|
cmpl _young_limit, d6
|
|
bcs L102
|
|
rts
|
|
L102: moveq #16, d5
|
|
bra _caml_call_gc
|
|
|
|
_caml_alloc:
|
|
subl d5, d6
|
|
cmpl _young_limit, d6
|
|
bcs _caml_call_gc
|
|
rts
|
|
|
|
| Call a C function from Caml
|
|
|
|
.globl _caml_c_call
|
|
|
|
_caml_c_call:
|
|
| Record lowest stack address and return address
|
|
movel a7@+, _caml_last_return_address
|
|
movel a7, _caml_bottom_of_stack
|
|
| Save allocation pointer and exception pointer
|
|
movel d6, _young_ptr
|
|
movel d7, _caml_exception_pointer
|
|
| Call the function (address in a0)
|
|
jbsr a0@
|
|
| Reload allocation pointer
|
|
movel _young_ptr, d6
|
|
| Return to caller
|
|
movel _caml_last_return_address, a1
|
|
jmp a1@
|
|
|
|
| Start the Caml program
|
|
|
|
.globl _caml_start_program
|
|
|
|
_caml_start_program:
|
|
| Save callee-save registers
|
|
moveml a2-a6/d2-d7, a7@-
|
|
fmovem fp2-fp7, a7@-
|
|
| Initial code point is caml_program
|
|
lea _caml_program, a5
|
|
|
|
| Code shared between caml_start_program and callback*
|
|
|
|
L106:
|
|
| Build a callback link
|
|
movel _caml_last_return_address, a7@-
|
|
movel _caml_bottom_of_stack, a7@-
|
|
| Build an exception handler
|
|
pea L108
|
|
movel _caml_exception_pointer, a7@-
|
|
movel a7, d7
|
|
| Load allocation pointer
|
|
movel _young_ptr, d6
|
|
| Call the Caml code
|
|
jbsr a5@
|
|
L107:
|
|
| Move result where C code expects it
|
|
movel a0, d0
|
|
| Save allocation pointer
|
|
movel d6, _young_ptr
|
|
| Pop the exception handler
|
|
movel a7@+, _caml_exception_pointer
|
|
addql #4, a7
|
|
| Pop the callback link, restoring the global variables
|
|
| used by caml_c_call
|
|
movel a7@+, _caml_bottom_of_stack
|
|
movel a7@+, _caml_last_return_address
|
|
| Restore callee-save registers and return
|
|
fmovem a7@+, fp2-fp7
|
|
moveml a7@+, a2-a6/d2-d7
|
|
unlk a6
|
|
rts
|
|
L108:
|
|
| Exception handler
|
|
| Save allocation pointer and exception pointer
|
|
movel d6, _young_ptr
|
|
movel d7, _caml_exception_pointer
|
|
| Pop the callback link, restoring the global variables
|
|
| used by caml_c_call
|
|
movel a7@+, _caml_bottom_of_stack
|
|
movel a7@+, _caml_last_return_address
|
|
| Re-raise the exception through mlraise,
|
|
| so that local C roots are cleaned up correctly.
|
|
movel a0, a7@- | exn bucket is the argument
|
|
jbsr _mlraise | never returns
|
|
|
|
| Raise an exception from C
|
|
|
|
.globl _raise_caml_exception
|
|
_raise_caml_exception:
|
|
movel a7@(4), a0 | exception bucket
|
|
movel _young_ptr, d6
|
|
movel _caml_exception_pointer, a7
|
|
movel a7@+, d7
|
|
rts
|
|
|
|
| Callback from C to Caml
|
|
|
|
.globl _callback
|
|
_callback:
|
|
link a6, #0
|
|
| Save callee-save registers
|
|
moveml a2-a6/d2-d7, a7@-
|
|
fmovem fp2-fp7, a7@-
|
|
| Initial loading of arguments
|
|
movel a6@(8), a1 | closure
|
|
movel a6@(12), a0 | argument
|
|
movel a1@(0), a5 | code pointer
|
|
bra L106
|
|
|
|
.globl _callback2
|
|
_callback2:
|
|
link a6, #0
|
|
| Save callee-save registers
|
|
moveml a2-a6/d2-d7, a7@-
|
|
fmovem fp2-fp7, a7@-
|
|
| Initial loading of arguments
|
|
movel a6@(8), a2 | closure
|
|
movel a6@(12), a0 | first argument
|
|
movel a6@(16), a1 | second argument
|
|
lea _caml_apply2, a5 | code pointer
|
|
bra L106
|
|
|
|
.globl _callback3
|
|
_callback3:
|
|
link a6, #0
|
|
| Save callee-save registers
|
|
moveml a2-a6/d2-d7, a7@-
|
|
fmovem fp2-fp7, a7@-
|
|
| Initial loading of arguments
|
|
movel a6@(8), a3 | closure
|
|
movel a6@(12), a0 | first argument
|
|
movel a6@(16), a1 | second argument
|
|
movel a6@(20), a2 | third argument
|
|
lea _caml_apply3, a5 | code pointer
|
|
bra L106
|
|
|
|
.data
|
|
.globl _system_frametable
|
|
_system_frametable:
|
|
.long 1 | one descriptor
|
|
.long L107 | return address into callback
|
|
.word -1 | negative frame size => use callback link
|
|
.word 0 | no roots here
|