1995-11-26 06:38:29 -08:00
|
|
|
;*********************************************************************
|
|
|
|
|
;* *
|
1996-04-30 07:53:58 -07:00
|
|
|
;* Objective Caml *
|
1995-11-26 06:38:29 -08:00
|
|
|
;* *
|
|
|
|
|
;* Xavier Leroy, projet Cristal, INRIA Rocquencourt *
|
|
|
|
|
;* *
|
1996-04-30 07:53:58 -07:00
|
|
|
;* Copyright 1996 Institut National de Recherche en Informatique et *
|
1995-11-26 06:38:29 -08:00
|
|
|
;* Automatique. Distributed only by permission. *
|
|
|
|
|
;* *
|
|
|
|
|
;*********************************************************************
|
|
|
|
|
|
|
|
|
|
; $Id$
|
|
|
|
|
|
|
|
|
|
; Asm part of the suntime system for the HP PA-RISC processor.
|
|
|
|
|
|
1995-12-22 06:55:29 -08:00
|
|
|
.comm _young_limit, 8
|
1995-11-26 06:38:29 -08:00
|
|
|
.comm _young_ptr, 8
|
|
|
|
|
.comm _gc_entry_regs, 32 * 4
|
|
|
|
|
.comm _gc_entry_float_regs, 32 * 8
|
|
|
|
|
.comm _caml_top_of_stack, 8
|
|
|
|
|
.comm _caml_bottom_of_stack, 8
|
|
|
|
|
.comm _caml_last_return_address, 8
|
|
|
|
|
.comm _caml_exception_pointer, 8
|
|
|
|
|
.comm _caml_required_size, 8
|
|
|
|
|
|
|
|
|
|
; Allocation functions
|
|
|
|
|
|
|
|
|
|
.text
|
|
|
|
|
.align 2
|
|
|
|
|
.globl _caml_alloc
|
|
|
|
|
_caml_alloc:
|
|
|
|
|
; Required size in %r1
|
1995-12-22 06:55:29 -08:00
|
|
|
ldw 0(%r4), %r31
|
1995-11-26 06:38:29 -08:00
|
|
|
sub %r3, %r1, %r3
|
1995-12-22 06:55:29 -08:00
|
|
|
comb,<<,n %r3, %r31, _caml_call_gc ; nullify if taken (forward branch)
|
1995-11-26 06:38:29 -08:00
|
|
|
bv 0(%r2)
|
|
|
|
|
nop
|
|
|
|
|
|
|
|
|
|
.globl _caml_call_gc
|
|
|
|
|
_caml_call_gc:
|
|
|
|
|
; Save required size (%r1)
|
|
|
|
|
ldil L`_caml_required_size, %r31
|
|
|
|
|
stw %r1, R`_caml_required_size(%r31)
|
|
|
|
|
; Save current allocation pointer for debugging purposes
|
|
|
|
|
ldil L`_young_ptr, %r1
|
|
|
|
|
stw %r3, R`_young_ptr(%r1)
|
|
|
|
|
; Record lowest stack address
|
|
|
|
|
ldil L`_caml_bottom_of_stack, %r1
|
|
|
|
|
stw %r30, R`_caml_bottom_of_stack(%r1)
|
|
|
|
|
; Record return address
|
|
|
|
|
ldil L`_caml_last_return_address, %r1
|
|
|
|
|
stw %r2, R`_caml_last_return_address(%r1)
|
1996-02-01 07:02:04 -08:00
|
|
|
; Save the exception handler (if e.g. a sighandler raises)
|
|
|
|
|
ldil L`_caml_exception_pointer, %r1
|
|
|
|
|
stw %r5, R`_caml_exception_pointer(%r1)
|
1995-11-26 06:38:29 -08:00
|
|
|
; Save all regs used by the code generator
|
|
|
|
|
ldil L`_gc_entry_regs, %r1
|
|
|
|
|
ldo R`_gc_entry_regs(%r1), %r1
|
|
|
|
|
stws,ma %r6, 4(%r1)
|
|
|
|
|
stws,ma %r7, 4(%r1)
|
|
|
|
|
stws,ma %r8, 4(%r1)
|
|
|
|
|
stws,ma %r9, 4(%r1)
|
|
|
|
|
stws,ma %r10, 4(%r1)
|
|
|
|
|
stws,ma %r11, 4(%r1)
|
|
|
|
|
stws,ma %r12, 4(%r1)
|
|
|
|
|
stws,ma %r13, 4(%r1)
|
|
|
|
|
stws,ma %r14, 4(%r1)
|
|
|
|
|
stws,ma %r15, 4(%r1)
|
|
|
|
|
stws,ma %r16, 4(%r1)
|
|
|
|
|
stws,ma %r17, 4(%r1)
|
|
|
|
|
stws,ma %r18, 4(%r1)
|
|
|
|
|
stws,ma %r19, 4(%r1)
|
|
|
|
|
stws,ma %r20, 4(%r1)
|
|
|
|
|
stws,ma %r21, 4(%r1)
|
|
|
|
|
stws,ma %r22, 4(%r1)
|
|
|
|
|
stws,ma %r23, 4(%r1)
|
|
|
|
|
stws,ma %r24, 4(%r1)
|
|
|
|
|
stws,ma %r25, 4(%r1)
|
|
|
|
|
stws,ma %r26, 4(%r1)
|
|
|
|
|
stws,ma %r28, 4(%r1)
|
|
|
|
|
stws,ma %r29, 4(%r1)
|
|
|
|
|
ldil L`_gc_entry_float_regs, %r1
|
|
|
|
|
ldo R`_gc_entry_float_regs(%r1), %r1
|
|
|
|
|
fstds,ma %fr4, 8(%r1)
|
|
|
|
|
fstds,ma %fr5, 8(%r1)
|
|
|
|
|
fstds,ma %fr6, 8(%r1)
|
|
|
|
|
fstds,ma %fr7, 8(%r1)
|
|
|
|
|
fstds,ma %fr8, 8(%r1)
|
|
|
|
|
fstds,ma %fr9, 8(%r1)
|
|
|
|
|
fstds,ma %fr10, 8(%r1)
|
|
|
|
|
fstds,ma %fr11, 8(%r1)
|
|
|
|
|
fstds,ma %fr12, 8(%r1)
|
|
|
|
|
fstds,ma %fr13, 8(%r1)
|
|
|
|
|
fstds,ma %fr14, 8(%r1)
|
|
|
|
|
fstds,ma %fr15, 8(%r1)
|
|
|
|
|
fstds,ma %fr16, 8(%r1)
|
|
|
|
|
fstds,ma %fr17, 8(%r1)
|
|
|
|
|
fstds,ma %fr18, 8(%r1)
|
|
|
|
|
fstds,ma %fr19, 8(%r1)
|
|
|
|
|
fstds,ma %fr20, 8(%r1)
|
|
|
|
|
fstds,ma %fr21, 8(%r1)
|
|
|
|
|
fstds,ma %fr22, 8(%r1)
|
|
|
|
|
fstds,ma %fr23, 8(%r1)
|
|
|
|
|
fstds,ma %fr24, 8(%r1)
|
|
|
|
|
fstds,ma %fr25, 8(%r1)
|
|
|
|
|
fstds,ma %fr26, 8(%r1)
|
|
|
|
|
fstds,ma %fr27, 8(%r1)
|
|
|
|
|
fstds,ma %fr28, 8(%r1)
|
|
|
|
|
fstds,ma %fr29, 8(%r1)
|
|
|
|
|
fstds,ma %fr30, 8(%r1)
|
|
|
|
|
|
|
|
|
|
; Call the garbage collector
|
|
|
|
|
ldo 64(%r30), %r30
|
1995-12-22 06:55:29 -08:00
|
|
|
ldil L`_garbage_collection, %r1
|
|
|
|
|
ble R`_garbage_collection(4, %r1)
|
1995-11-26 06:38:29 -08:00
|
|
|
copy %r31, %r2
|
|
|
|
|
ldo -64(%r30), %r30
|
|
|
|
|
|
|
|
|
|
; Restore all regs used by the code generator
|
|
|
|
|
ldil L`_gc_entry_regs, %r1
|
|
|
|
|
ldo R`_gc_entry_regs(%r1), %r1
|
|
|
|
|
ldws,ma 4(%r1), %r6
|
|
|
|
|
ldws,ma 4(%r1), %r7
|
|
|
|
|
ldws,ma 4(%r1), %r8
|
|
|
|
|
ldws,ma 4(%r1), %r9
|
|
|
|
|
ldws,ma 4(%r1), %r10
|
|
|
|
|
ldws,ma 4(%r1), %r11
|
|
|
|
|
ldws,ma 4(%r1), %r12
|
|
|
|
|
ldws,ma 4(%r1), %r13
|
|
|
|
|
ldws,ma 4(%r1), %r14
|
|
|
|
|
ldws,ma 4(%r1), %r15
|
|
|
|
|
ldws,ma 4(%r1), %r16
|
|
|
|
|
ldws,ma 4(%r1), %r17
|
|
|
|
|
ldws,ma 4(%r1), %r18
|
|
|
|
|
ldws,ma 4(%r1), %r19
|
|
|
|
|
ldws,ma 4(%r1), %r20
|
|
|
|
|
ldws,ma 4(%r1), %r21
|
|
|
|
|
ldws,ma 4(%r1), %r22
|
|
|
|
|
ldws,ma 4(%r1), %r23
|
|
|
|
|
ldws,ma 4(%r1), %r24
|
|
|
|
|
ldws,ma 4(%r1), %r25
|
|
|
|
|
ldws,ma 4(%r1), %r26
|
|
|
|
|
ldws,ma 4(%r1), %r28
|
|
|
|
|
ldws,ma 4(%r1), %r29
|
|
|
|
|
ldil L`_gc_entry_float_regs, %r1
|
|
|
|
|
ldo R`_gc_entry_float_regs(%r1), %r1
|
|
|
|
|
fldds,ma 8(%r1), %fr4
|
|
|
|
|
fldds,ma 8(%r1), %fr5
|
|
|
|
|
fldds,ma 8(%r1), %fr6
|
|
|
|
|
fldds,ma 8(%r1), %fr7
|
|
|
|
|
fldds,ma 8(%r1), %fr8
|
|
|
|
|
fldds,ma 8(%r1), %fr9
|
|
|
|
|
fldds,ma 8(%r1), %fr10
|
|
|
|
|
fldds,ma 8(%r1), %fr11
|
|
|
|
|
fldds,ma 8(%r1), %fr12
|
|
|
|
|
fldds,ma 8(%r1), %fr13
|
|
|
|
|
fldds,ma 8(%r1), %fr14
|
|
|
|
|
fldds,ma 8(%r1), %fr15
|
|
|
|
|
fldds,ma 8(%r1), %fr16
|
|
|
|
|
fldds,ma 8(%r1), %fr17
|
|
|
|
|
fldds,ma 8(%r1), %fr18
|
|
|
|
|
fldds,ma 8(%r1), %fr19
|
|
|
|
|
fldds,ma 8(%r1), %fr20
|
|
|
|
|
fldds,ma 8(%r1), %fr21
|
|
|
|
|
fldds,ma 8(%r1), %fr22
|
|
|
|
|
fldds,ma 8(%r1), %fr23
|
|
|
|
|
fldds,ma 8(%r1), %fr24
|
|
|
|
|
fldds,ma 8(%r1), %fr25
|
|
|
|
|
fldds,ma 8(%r1), %fr26
|
|
|
|
|
fldds,ma 8(%r1), %fr27
|
|
|
|
|
fldds,ma 8(%r1), %fr28
|
|
|
|
|
fldds,ma 8(%r1), %fr29
|
|
|
|
|
fldds,ma 8(%r1), %fr30
|
|
|
|
|
|
|
|
|
|
; Reload the allocation pointer
|
|
|
|
|
ldil L`_young_ptr, %r1
|
|
|
|
|
ldw R`_young_ptr(%r1), %r3
|
|
|
|
|
; Allocate space for block
|
|
|
|
|
ldil L`_caml_required_size, %r1
|
|
|
|
|
ldw R`_caml_required_size(%r1), %r1
|
|
|
|
|
sub %r3, %r1, %r3
|
|
|
|
|
; Return to caller
|
|
|
|
|
ldil L`_caml_last_return_address, %r1
|
|
|
|
|
ldw R`_caml_last_return_address(%r1), %r2
|
|
|
|
|
bv 0(%r2)
|
|
|
|
|
nop
|
|
|
|
|
|
|
|
|
|
; Call a C function from Caml
|
|
|
|
|
; Function to call is in %r22
|
|
|
|
|
|
|
|
|
|
.align 2
|
|
|
|
|
.globl _caml_c_call
|
|
|
|
|
_caml_c_call:
|
|
|
|
|
; Record lowest stack address
|
|
|
|
|
ldil L`_caml_bottom_of_stack, %r1
|
|
|
|
|
stw %r30, R`_caml_bottom_of_stack(%r1)
|
|
|
|
|
; Record return address
|
|
|
|
|
ldil L`_caml_last_return_address, %r1
|
|
|
|
|
stw %r2, R`_caml_last_return_address(%r1)
|
|
|
|
|
; Save the exception handler
|
|
|
|
|
ldil L`_caml_exception_pointer, %r1
|
|
|
|
|
stw %r5, R`_caml_exception_pointer(%r1)
|
|
|
|
|
; Save the allocation pointer
|
|
|
|
|
ldil L`_young_ptr, %r1
|
|
|
|
|
stw %r3, R`_young_ptr(%r1) ; in delay slot
|
|
|
|
|
; Call the C function
|
|
|
|
|
ble 0(4, %r22)
|
|
|
|
|
copy %r31, %r2
|
|
|
|
|
; Reload return address
|
|
|
|
|
ldil L`_caml_last_return_address, %r1
|
|
|
|
|
ldw R`_caml_last_return_address(%r1), %r2
|
|
|
|
|
; Reload allocation pointer
|
|
|
|
|
ldil L`_young_ptr, %r1
|
|
|
|
|
; Return to caller
|
|
|
|
|
bv 0(%r2)
|
|
|
|
|
ldw R`_young_ptr(%r1), %r3 ; in delay slot
|
|
|
|
|
|
|
|
|
|
; Start the Caml program
|
|
|
|
|
|
|
|
|
|
.align 2
|
|
|
|
|
.globl _caml_start_program
|
|
|
|
|
_caml_start_program:
|
|
|
|
|
stw %r2,-20(%r30)
|
|
|
|
|
ldo 256(%r30), %r30
|
|
|
|
|
; Save the callee-save registers
|
|
|
|
|
ldo -32(%r30), %r1
|
|
|
|
|
stws,ma %r3, -4(%r1)
|
|
|
|
|
stws,ma %r4, -4(%r1)
|
|
|
|
|
stws,ma %r5, -4(%r1)
|
|
|
|
|
stws,ma %r6, -4(%r1)
|
|
|
|
|
stws,ma %r7, -4(%r1)
|
|
|
|
|
stws,ma %r8, -4(%r1)
|
|
|
|
|
stws,ma %r9, -4(%r1)
|
|
|
|
|
stws,ma %r10, -4(%r1)
|
|
|
|
|
stws,ma %r11, -4(%r1)
|
|
|
|
|
stws,ma %r12, -4(%r1)
|
|
|
|
|
stws,ma %r13, -4(%r1)
|
|
|
|
|
stws,ma %r14, -4(%r1)
|
|
|
|
|
stws,ma %r15, -4(%r1)
|
|
|
|
|
stws,ma %r16, -4(%r1)
|
|
|
|
|
stws,ma %r17, -4(%r1)
|
|
|
|
|
stws,ma %r18, -4(%r1)
|
|
|
|
|
fstds,ma %fr12, -8(%r1)
|
|
|
|
|
fstds,ma %fr13, -8(%r1)
|
|
|
|
|
fstds,ma %fr14, -8(%r1)
|
|
|
|
|
fstds,ma %fr15, -8(%r1)
|
|
|
|
|
fstds,ma %fr16, -8(%r1)
|
|
|
|
|
fstds,ma %fr17, -8(%r1)
|
|
|
|
|
fstds,ma %fr18, -8(%r1)
|
|
|
|
|
fstds,ma %fr19, -8(%r1)
|
|
|
|
|
fstds,ma %fr20, -8(%r1)
|
|
|
|
|
fstds,ma %fr21, -8(%r1)
|
|
|
|
|
fstds,ma %fr22, -8(%r1)
|
|
|
|
|
fstds,ma %fr23, -8(%r1)
|
|
|
|
|
fstds,ma %fr24, -8(%r1)
|
|
|
|
|
fstds,ma %fr25, -8(%r1)
|
|
|
|
|
fstds,ma %fr26, -8(%r1)
|
|
|
|
|
fstds,ma %fr27, -8(%r1)
|
|
|
|
|
fstds,ma %fr28, -8(%r1)
|
|
|
|
|
fstds,ma %fr29, -8(%r1)
|
|
|
|
|
fstds,ma %fr30, -8(%r1)
|
|
|
|
|
fstds,ma %fr31, -8(%r1)
|
|
|
|
|
|
|
|
|
|
; Build an exception handler
|
|
|
|
|
bl L100, %r1
|
|
|
|
|
nop
|
|
|
|
|
copy %r26, %r28 ; return exception bucket as result
|
|
|
|
|
b L101
|
|
|
|
|
nop
|
|
|
|
|
L100:
|
|
|
|
|
ldo 8(%r30), %r30
|
|
|
|
|
stw %r1, -4(%r30)
|
|
|
|
|
copy %r30, %r5
|
|
|
|
|
; Record highest stack address
|
|
|
|
|
ldil L`_caml_top_of_stack, %r1
|
|
|
|
|
stw %r30, R`_caml_top_of_stack(%r1)
|
|
|
|
|
; Initialize allocation registers
|
|
|
|
|
ldil L`_young_ptr, %r1
|
|
|
|
|
ldw R`_young_ptr(%r1), %r3
|
1995-12-22 06:55:29 -08:00
|
|
|
ldil L`_young_limit, %r1
|
|
|
|
|
ldo R`_young_limit(%r1), %r4
|
1995-11-26 06:38:29 -08:00
|
|
|
; Go for it
|
|
|
|
|
ldil L`_caml_program, %r1
|
|
|
|
|
ble R`_caml_program(4, %r1)
|
|
|
|
|
copy %r31, %r2
|
|
|
|
|
; Pop handler
|
|
|
|
|
ldo -8(%r30), %r30
|
|
|
|
|
; Return with zero result
|
|
|
|
|
ldi 0, %r28
|
|
|
|
|
; Restore callee-save registers
|
|
|
|
|
L101:
|
|
|
|
|
ldo -32(%r30), %r1
|
|
|
|
|
ldws,ma -4(%r1), %r3
|
|
|
|
|
ldws,ma -4(%r1), %r4
|
|
|
|
|
ldws,ma -4(%r1), %r5
|
|
|
|
|
ldws,ma -4(%r1), %r6
|
|
|
|
|
ldws,ma -4(%r1), %r7
|
|
|
|
|
ldws,ma -4(%r1), %r8
|
|
|
|
|
ldws,ma -4(%r1), %r9
|
|
|
|
|
ldws,ma -4(%r1), %r10
|
|
|
|
|
ldws,ma -4(%r1), %r11
|
|
|
|
|
ldws,ma -4(%r1), %r12
|
|
|
|
|
ldws,ma -4(%r1), %r13
|
|
|
|
|
ldws,ma -4(%r1), %r14
|
|
|
|
|
ldws,ma -4(%r1), %r15
|
|
|
|
|
ldws,ma -4(%r1), %r16
|
|
|
|
|
ldws,ma -4(%r1), %r17
|
|
|
|
|
ldws,ma -4(%r1), %r18
|
|
|
|
|
fldds,ma -8(%r1), %fr12
|
|
|
|
|
fldds,ma -8(%r1), %fr13
|
|
|
|
|
fldds,ma -8(%r1), %fr14
|
|
|
|
|
fldds,ma -8(%r1), %fr15
|
|
|
|
|
fldds,ma -8(%r1), %fr16
|
|
|
|
|
fldds,ma -8(%r1), %fr17
|
|
|
|
|
fldds,ma -8(%r1), %fr18
|
|
|
|
|
fldds,ma -8(%r1), %fr19
|
|
|
|
|
fldds,ma -8(%r1), %fr20
|
|
|
|
|
fldds,ma -8(%r1), %fr21
|
|
|
|
|
fldds,ma -8(%r1), %fr22
|
|
|
|
|
fldds,ma -8(%r1), %fr23
|
|
|
|
|
fldds,ma -8(%r1), %fr24
|
|
|
|
|
fldds,ma -8(%r1), %fr25
|
|
|
|
|
fldds,ma -8(%r1), %fr26
|
|
|
|
|
fldds,ma -8(%r1), %fr27
|
|
|
|
|
fldds,ma -8(%r1), %fr28
|
|
|
|
|
fldds,ma -8(%r1), %fr29
|
|
|
|
|
fldds,ma -8(%r1), %fr30
|
|
|
|
|
fldds,ma -8(%r1), %fr31
|
|
|
|
|
; Return to C
|
|
|
|
|
ldo -256(%r30), %r30
|
|
|
|
|
ldw -20(%r30), %r2
|
|
|
|
|
bv 0(%r2)
|
|
|
|
|
nop
|
|
|
|
|
|
|
|
|
|
; Raise an exception from C
|
|
|
|
|
|
|
|
|
|
.align 2
|
|
|
|
|
.globl _raise_caml_exception
|
|
|
|
|
_raise_caml_exception:
|
|
|
|
|
; Cut the stack
|
|
|
|
|
ldil L`_caml_exception_pointer, %r1
|
|
|
|
|
ldw R`_caml_exception_pointer(%r1), %r30
|
|
|
|
|
; Reload allocation registers
|
|
|
|
|
ldil L`_young_ptr, %r1
|
|
|
|
|
ldw R`_young_ptr(%r1), %r3
|
1995-12-22 06:55:29 -08:00
|
|
|
ldil L`_young_limit, %r1
|
|
|
|
|
ldo R`_young_limit(%r1), %r4
|
1995-11-26 06:38:29 -08:00
|
|
|
; Raise the exception
|
|
|
|
|
ldw -4(%r30), %r1
|
|
|
|
|
ldw -8(%r30), %r5
|
|
|
|
|
bv 0(%r1)
|
|
|
|
|
ldo -8(%r30), %r30 ; in delay slot
|
|
|
|
|
|
1995-12-22 06:55:29 -08:00
|
|
|
; Callbacks C -> ML
|
|
|
|
|
|
|
|
|
|
.align 2
|
|
|
|
|
.globl _callback
|
|
|
|
|
_callback:
|
|
|
|
|
; Initial shuffling of arguments
|
|
|
|
|
copy %r26, %r1 ; Closure
|
|
|
|
|
copy %r25, %r26 ; Argument
|
|
|
|
|
copy %r1, %r25
|
|
|
|
|
ldw 0(%r1), %r22 ; Code to call
|
|
|
|
|
L102:
|
|
|
|
|
; Save return address
|
|
|
|
|
stw %r2,-20(%r30)
|
|
|
|
|
ldo 256(%r30), %r30
|
|
|
|
|
; Save the callee-save registers
|
|
|
|
|
ldo -32(%r30), %r1
|
|
|
|
|
stws,ma %r3, -4(%r1)
|
|
|
|
|
stws,ma %r4, -4(%r1)
|
|
|
|
|
stws,ma %r5, -4(%r1)
|
|
|
|
|
stws,ma %r6, -4(%r1)
|
|
|
|
|
stws,ma %r7, -4(%r1)
|
|
|
|
|
stws,ma %r8, -4(%r1)
|
|
|
|
|
stws,ma %r9, -4(%r1)
|
|
|
|
|
stws,ma %r10, -4(%r1)
|
|
|
|
|
stws,ma %r11, -4(%r1)
|
|
|
|
|
stws,ma %r12, -4(%r1)
|
|
|
|
|
stws,ma %r13, -4(%r1)
|
|
|
|
|
stws,ma %r14, -4(%r1)
|
|
|
|
|
stws,ma %r15, -4(%r1)
|
|
|
|
|
stws,ma %r16, -4(%r1)
|
|
|
|
|
stws,ma %r17, -4(%r1)
|
|
|
|
|
stws,ma %r18, -4(%r1)
|
|
|
|
|
fstds,ma %fr12, -8(%r1)
|
|
|
|
|
fstds,ma %fr13, -8(%r1)
|
|
|
|
|
fstds,ma %fr14, -8(%r1)
|
|
|
|
|
fstds,ma %fr15, -8(%r1)
|
|
|
|
|
fstds,ma %fr16, -8(%r1)
|
|
|
|
|
fstds,ma %fr17, -8(%r1)
|
|
|
|
|
fstds,ma %fr18, -8(%r1)
|
|
|
|
|
fstds,ma %fr19, -8(%r1)
|
|
|
|
|
fstds,ma %fr20, -8(%r1)
|
|
|
|
|
fstds,ma %fr21, -8(%r1)
|
|
|
|
|
fstds,ma %fr22, -8(%r1)
|
|
|
|
|
fstds,ma %fr23, -8(%r1)
|
|
|
|
|
fstds,ma %fr24, -8(%r1)
|
|
|
|
|
fstds,ma %fr25, -8(%r1)
|
|
|
|
|
fstds,ma %fr26, -8(%r1)
|
|
|
|
|
fstds,ma %fr27, -8(%r1)
|
|
|
|
|
fstds,ma %fr28, -8(%r1)
|
|
|
|
|
fstds,ma %fr29, -8(%r1)
|
|
|
|
|
fstds,ma %fr30, -8(%r1)
|
|
|
|
|
fstds,ma %fr31, -8(%r1)
|
1996-01-07 08:58:44 -08:00
|
|
|
; Set up a callback link
|
|
|
|
|
ldo 8(%r30), %r30
|
|
|
|
|
ldil L`_caml_bottom_of_stack, %r1
|
|
|
|
|
ldw R`_caml_bottom_of_stack(%r1), %r1
|
|
|
|
|
stw %r1, -8(%r30)
|
|
|
|
|
ldil L`_caml_last_return_address, %r1
|
|
|
|
|
ldw R`_caml_last_return_address(%r1), %r1
|
|
|
|
|
stw %r1, -4(%r30)
|
1995-12-22 06:55:29 -08:00
|
|
|
; Set up a trap frame to catch exceptions escaping the Caml code
|
|
|
|
|
ldo 8(%r30), %r30
|
|
|
|
|
ldil L`_caml_exception_pointer, %r1
|
|
|
|
|
ldw R`_caml_exception_pointer(%r1), %r1
|
|
|
|
|
stw %r1, -8(%r30)
|
|
|
|
|
ldil L`L103, %r1
|
|
|
|
|
ldo R`L103(%r1), %r1
|
|
|
|
|
stw %r1, -4(%r30)
|
|
|
|
|
copy %r30, %r5
|
|
|
|
|
; Reload allocation pointers
|
|
|
|
|
ldil L`_young_ptr, %r1
|
|
|
|
|
ldw R`_young_ptr(%r1), %r3
|
|
|
|
|
ldil L`_young_limit, %r1
|
|
|
|
|
ldo R`_young_limit(%r1), %r4
|
|
|
|
|
; Call the Caml code
|
|
|
|
|
ble 0(4, %r22)
|
|
|
|
|
copy %r31, %r2
|
|
|
|
|
L104:
|
1996-01-07 08:58:44 -08:00
|
|
|
; Pop the trap frame
|
|
|
|
|
ldw -8(%r30), %r31
|
|
|
|
|
ldil L`_caml_exception_pointer, %r1
|
|
|
|
|
stw %r31, R`_caml_exception_pointer(%r1)
|
|
|
|
|
ldo -8(%r30), %r30
|
1995-12-22 06:55:29 -08:00
|
|
|
; Pop the callback link
|
|
|
|
|
ldw -8(%r30), %r31
|
|
|
|
|
ldil L`_caml_bottom_of_stack, %r1
|
|
|
|
|
stw %r31, R`_caml_bottom_of_stack(%r1)
|
|
|
|
|
ldw -4(%r30), %r31
|
|
|
|
|
ldil L`_caml_last_return_address, %r1
|
|
|
|
|
stw %r31, R`_caml_last_return_address(%r1)
|
|
|
|
|
ldo -8(%r30), %r30
|
|
|
|
|
; Save allocation pointer
|
|
|
|
|
ldil L`_young_ptr, %r1
|
|
|
|
|
stw %r3, R`_young_ptr(%r1)
|
|
|
|
|
; Move result where C function expects it
|
|
|
|
|
copy %r26, %r28
|
|
|
|
|
; Reload callee-save registers
|
|
|
|
|
ldo -32(%r30), %r1
|
|
|
|
|
ldws,ma -4(%r1), %r3
|
|
|
|
|
ldws,ma -4(%r1), %r4
|
|
|
|
|
ldws,ma -4(%r1), %r5
|
|
|
|
|
ldws,ma -4(%r1), %r6
|
|
|
|
|
ldws,ma -4(%r1), %r7
|
|
|
|
|
ldws,ma -4(%r1), %r8
|
|
|
|
|
ldws,ma -4(%r1), %r9
|
|
|
|
|
ldws,ma -4(%r1), %r10
|
|
|
|
|
ldws,ma -4(%r1), %r11
|
|
|
|
|
ldws,ma -4(%r1), %r12
|
|
|
|
|
ldws,ma -4(%r1), %r13
|
|
|
|
|
ldws,ma -4(%r1), %r14
|
|
|
|
|
ldws,ma -4(%r1), %r15
|
|
|
|
|
ldws,ma -4(%r1), %r16
|
|
|
|
|
ldws,ma -4(%r1), %r17
|
|
|
|
|
ldws,ma -4(%r1), %r18
|
|
|
|
|
fldds,ma -8(%r1), %fr12
|
|
|
|
|
fldds,ma -8(%r1), %fr13
|
|
|
|
|
fldds,ma -8(%r1), %fr14
|
|
|
|
|
fldds,ma -8(%r1), %fr15
|
|
|
|
|
fldds,ma -8(%r1), %fr16
|
|
|
|
|
fldds,ma -8(%r1), %fr17
|
|
|
|
|
fldds,ma -8(%r1), %fr18
|
|
|
|
|
fldds,ma -8(%r1), %fr19
|
|
|
|
|
fldds,ma -8(%r1), %fr20
|
|
|
|
|
fldds,ma -8(%r1), %fr21
|
|
|
|
|
fldds,ma -8(%r1), %fr22
|
|
|
|
|
fldds,ma -8(%r1), %fr23
|
|
|
|
|
fldds,ma -8(%r1), %fr24
|
|
|
|
|
fldds,ma -8(%r1), %fr25
|
|
|
|
|
fldds,ma -8(%r1), %fr26
|
|
|
|
|
fldds,ma -8(%r1), %fr27
|
|
|
|
|
fldds,ma -8(%r1), %fr28
|
|
|
|
|
fldds,ma -8(%r1), %fr29
|
|
|
|
|
fldds,ma -8(%r1), %fr30
|
|
|
|
|
fldds,ma -8(%r1), %fr31
|
|
|
|
|
; Return to C
|
|
|
|
|
ldo -256(%r30), %r30
|
|
|
|
|
ldw -20(%r30), %r2
|
|
|
|
|
bv 0(%r2)
|
|
|
|
|
nop
|
|
|
|
|
; The trap handler
|
|
|
|
|
L103:
|
|
|
|
|
; Pop the callback link
|
|
|
|
|
ldw -8(%r30), %r31
|
|
|
|
|
ldil L`_caml_bottom_of_stack, %r1
|
|
|
|
|
stw %r31, R`_caml_bottom_of_stack(%r1)
|
|
|
|
|
ldw -4(%r30), %r31
|
|
|
|
|
ldil L`_caml_last_return_address, %r1
|
|
|
|
|
stw %r31, R`_caml_last_return_address(%r1)
|
|
|
|
|
ldo -8(%r30), %r30
|
|
|
|
|
; Save allocation pointer and exception pointer
|
|
|
|
|
ldil L`_young_ptr, %r1
|
|
|
|
|
stw %r3, R`_young_ptr(%r1)
|
|
|
|
|
ldil L`_caml_exception_pointer, %r1
|
|
|
|
|
stw %r5, R`_caml_exception_pointer(%r1)
|
|
|
|
|
; Re-raise the exception through mlraise, to clean up local C roots
|
|
|
|
|
ldo 64(%r30), %r30
|
|
|
|
|
ldil L`_mlraise, %r1
|
|
|
|
|
ble R`_mlraise(4, %r1)
|
|
|
|
|
copy %r31, %r2 ; actually, never returns
|
|
|
|
|
|
|
|
|
|
.align 2
|
|
|
|
|
.globl _callback2
|
|
|
|
|
_callback2:
|
|
|
|
|
copy %r26, %r1 ; Closure
|
|
|
|
|
copy %r25, %r26 ; First argument
|
|
|
|
|
copy %r24, %r25 ; Second argument
|
|
|
|
|
copy %r1, %r24
|
|
|
|
|
ldil L`_caml_apply2, %r22
|
|
|
|
|
b L102
|
|
|
|
|
ldo R`_caml_apply2(%r22), %r22
|
|
|
|
|
|
|
|
|
|
.align 2
|
|
|
|
|
.globl _callback3
|
|
|
|
|
_callback3:
|
|
|
|
|
copy %r26, %r1 ; Closure
|
|
|
|
|
copy %r25, %r26 ; First argument
|
|
|
|
|
copy %r24, %r25 ; Second argument
|
|
|
|
|
copy %r23, %r24 ; Third argument
|
|
|
|
|
copy %r1, %r23
|
|
|
|
|
ldil L`_caml_apply3, %r22
|
|
|
|
|
b L102
|
|
|
|
|
ldo R`_caml_apply3(%r22), %r22
|
|
|
|
|
|
|
|
|
|
.data
|
|
|
|
|
.globl _system_frametable
|
|
|
|
|
_system_frametable:
|
|
|
|
|
.long 1 /* one descriptor */
|
|
|
|
|
.long L104 + 3 /* return address into callback */
|
|
|
|
|
.short -1 /* negative frame size => use callback link */
|
|
|
|
|
.short 0 /* no roots */
|
