ocaml/asmrun/hppa.S

642 lines
19 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 suntime system for the HP PA-RISC processor.
; Must be preprocessed by cpp
#ifdef SYS_hpux
#define G(x) x
#define CODESPACE .code
#define CODE_ALIGN 4
#define EXPORT_CODE(x) .export x, entry, priv_lev=3
#define EXPORT_DATA(x) .export x, data
#define STARTPROC .proc ! .callinfo frame=0, no_calls ! .entry
#define ENDPROC .exit ! .procend
#define LOADHIGH(x) addil LR%x-$global$, %r27
#define LOW(x) RR%x-$global$
#define LOADHIGHLABEL(x) ldil LR%x, %r1
#define LOWLABEL(x) RR%x
#endif
#ifdef SYS_nextstep
#define G(x) _##x
#define CODESPACE .text
#define CODE_ALIGN 2
#define EXPORT_CODE(x) .globl x
#define EXPORT_DATA(x) .globl x
#define STARTPROC
#define ENDPROC
#define LOADHIGH(x) ldil L`x, %r1
#define LOW(x) R`x
#define LOADHIGHLABEL(x) ldil L`x, %r1
#define LOWLABEL(x) R`x
#endif
#ifdef SYS_hpux
.space $PRIVATE$
.subspa $DATA$,quad=1,align=8,access=31
.subspa $BSS$,quad=1,align=8,access=31,zero,sort=82
.space $TEXT$
.subspa $LIT$,quad=0,align=8,access=44
.subspa $CODE$,quad=0,align=8,access=44,code_only
.import $global$, data
.import $$dyncall, millicode
.import garbage_collection, code
.import caml_program, code
.import mlraise, code
.import caml_apply2, code
.import caml_apply3, code
young_limit .comm 8
young_ptr .comm 8
gc_entry_regs .comm 32 * 4
gc_entry_float_regs .comm 32 * 8
caml_top_of_stack .comm 8
caml_bottom_of_stack .comm 8
caml_last_return_address .comm 8
caml_exception_pointer .comm 8
caml_required_size .comm 8
#endif
#ifdef SYS_nextstep
.comm G(young_limit), 8
.comm G(young_ptr), 8
.comm G(gc_entry_regs), 32 * 4
.comm G(gc_entry_float_regs), 32 * 8
.comm G(caml_top_of_stack), 8
.comm G(caml_bottom_of_stack), 8
.comm G(caml_last_return_address), 8
.comm G(caml_exception_pointer), 8
.comm G(caml_required_size), 8
#endif
; Allocation functions
CODESPACE
.align CODE_ALIGN
EXPORT_CODE(G(caml_alloc))
G(caml_alloc):
STARTPROC
; Required size in %r1
ldw 0(%r4), %r31
sub %r3, %r1, %r3
comb,<<,n %r3, %r31, G(caml_call_gc) ; nullify if taken (forward br.)
bv 0(%r2)
nop
ENDPROC
EXPORT_CODE(G(caml_call_gc))
G(caml_call_gc):
STARTPROC
; Save required size (%r1)
copy %r1, %r31
LOADHIGH(G(caml_required_size))
stw %r31, LOW(G(caml_required_size))(%r1)
; Save current allocation pointer for debugging purposes
LOADHIGH(G(young_ptr))
stw %r3, LOW(G(young_ptr))(%r1)
; Record lowest stack address
LOADHIGH(G(caml_bottom_of_stack))
stw %r30, LOW(G(caml_bottom_of_stack))(%r1)
; Record return address
LOADHIGH(G(caml_last_return_address))
stw %r2, LOW(G(caml_last_return_address))(%r1)
; Save the exception handler (if e.g. a sighandler raises)
LOADHIGH(G(caml_exception_pointer))
stw %r5, LOW(G(caml_exception_pointer))(%r1)
; Save all regs used by the code generator
LOADHIGH(G(gc_entry_regs))
ldo LOW(G(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)
LOADHIGH(G(gc_entry_float_regs))
ldo LOW(G(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
#ifdef SYS_nextstep
ldil L`G(garbage_collection), %r1
ble R`G(garbage_collection)(4, %r1)
copy %r31, %r2
#else
bl G(garbage_collection), %r2
nop
#endif
ldo -64(%r30), %r30
; Restore all regs used by the code generator
LOADHIGH(G(gc_entry_regs))
ldo LOW(G(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
LOADHIGH(G(gc_entry_float_regs))
ldo LOW(G(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
LOADHIGH(G(young_ptr))
ldw LOW(G(young_ptr))(%r1), %r3
; Allocate space for block
LOADHIGH(G(caml_required_size))
ldw LOW(G(caml_required_size))(%r1), %r1
sub %r3, %r1, %r3
; Return to caller
LOADHIGH(G(caml_last_return_address))
ldw LOW(G(caml_last_return_address))(%r1), %r2
bv 0(%r2)
nop
ENDPROC
; Call a C function from Caml
; Function to call is in %r22
.align CODE_ALIGN
#ifdef SYS_hpux
.export G(caml_c_call), ENTRY, ARGW0=GR, ARGW1=GR, ARGW2=GR, ARGW3=GR
#else
EXPORT_CODE(G(caml_c_call))
#endif
G(caml_c_call):
STARTPROC
; Record lowest stack address
LOADHIGH(G(caml_bottom_of_stack))
stw %r30, LOW(G(caml_bottom_of_stack))(%r1)
; Record return address
LOADHIGH(G(caml_last_return_address))
stw %r2, LOW(G(caml_last_return_address))(%r1)
; Save the exception handler
LOADHIGH(G(caml_exception_pointer))
stw %r5, LOW(G(caml_exception_pointer))(%r1)
; Save the allocation pointer
LOADHIGH(G(young_ptr))
; Call the C function
#ifdef SYS_hpux
bl $$dyncall, %r2
stw %r3, LOW(G(young_ptr))(%r1) ; in delay slot
#else
stw %r3, LOW(G(young_ptr))(%r1)
ble 0(4, %r22)
copy %r31, %r2
#endif
; Reload return address
LOADHIGH(G(caml_last_return_address))
ldw LOW(G(caml_last_return_address))(%r1), %r2
; Reload allocation pointer
LOADHIGH(G(young_ptr))
; Return to caller
bv 0(%r2)
ldw LOW(G(young_ptr))(%r1), %r3 ; in delay slot
ENDPROC
; Start the Caml program
.align CODE_ALIGN
EXPORT_CODE(G(caml_start_program))
G(caml_start_program):
STARTPROC
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
LOADHIGH(G(caml_top_of_stack))
stw %r30, LOW(G(caml_top_of_stack))(%r1)
; Initialize allocation registers
LOADHIGH(G(young_ptr))
ldw LOW(G(young_ptr))(%r1), %r3
LOADHIGH(G(young_limit))
ldo LOW(G(young_limit))(%r1), %r4
; Go for it
#ifdef SYS_nextstep
ldil L`G(caml_program), %r1
ble R`G(caml_program)(4, %r1)
copy %r31, %r2
#else
bl G(caml_program), %r2
nop
#endif
; 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
ENDPROC
; Raise an exception from C
.align CODE_ALIGN
EXPORT_CODE(G(raise_caml_exception))
G(raise_caml_exception):
STARTPROC
; Cut the stack
LOADHIGH(G(caml_exception_pointer))
ldw LOW(G(caml_exception_pointer))(%r1), %r30
; Reload allocation registers
LOADHIGH(G(young_ptr))
ldw LOW(G(young_ptr))(%r1), %r3
LOADHIGH(G(young_limit))
ldo LOW(G(young_limit))(%r1), %r4
; Raise the exception
ldw -4(%r30), %r1
ldw -8(%r30), %r5
bv 0(%r1)
ldo -8(%r30), %r30 ; in delay slot
ENDPROC
; Callbacks C -> ML
.align CODE_ALIGN
EXPORT_CODE(G(callback))
G(callback):
STARTPROC
; 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)
; Set up a callback link
ldo 8(%r30), %r30
LOADHIGH(G(caml_bottom_of_stack))
ldw LOW(G(caml_bottom_of_stack))(%r1), %r1
stw %r1, -8(%r30)
LOADHIGH(G(caml_last_return_address))
ldw LOW(G(caml_last_return_address))(%r1), %r1
stw %r1, -4(%r30)
; Set up a trap frame to catch exceptions escaping the Caml code
ldo 8(%r30), %r30
LOADHIGH(G(caml_exception_pointer))
ldw LOW(G(caml_exception_pointer))(%r1), %r1
stw %r1, -8(%r30)
LOADHIGHLABEL(L103)
ldo LOWLABEL(L103)(%r1), %r1
stw %r1, -4(%r30)
copy %r30, %r5
; Reload allocation pointers
LOADHIGH(G(young_ptr))
ldw LOW(G(young_ptr))(%r1), %r3
LOADHIGH(G(young_limit))
ldo LOW(G(young_limit))(%r1), %r4
; Call the Caml code
ble 0(4, %r22)
copy %r31, %r2
L104:
; Pop the trap frame
ldw -8(%r30), %r31
LOADHIGH(G(caml_exception_pointer))
stw %r31, LOW(G(caml_exception_pointer))(%r1)
ldo -8(%r30), %r30
; Pop the callback link
ldw -8(%r30), %r31
LOADHIGH(G(caml_bottom_of_stack))
stw %r31, LOW(G(caml_bottom_of_stack))(%r1)
ldw -4(%r30), %r31
LOADHIGH(G(caml_last_return_address))
stw %r31, LOW(G(caml_last_return_address))(%r1)
ldo -8(%r30), %r30
; Save allocation pointer
LOADHIGH(G(young_ptr))
stw %r3, LOW(G(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
LOADHIGH(G(caml_bottom_of_stack))
stw %r31, LOW(G(caml_bottom_of_stack))(%r1)
ldw -4(%r30), %r31
LOADHIGH(G(caml_last_return_address))
stw %r31, LOW(G(caml_last_return_address))(%r1)
ldo -8(%r30), %r30
; Save allocation pointer and exception pointer
LOADHIGH(G(young_ptr))
stw %r3, LOW(G(young_ptr))(%r1)
LOADHIGH(G(caml_exception_pointer))
stw %r5, LOW(G(caml_exception_pointer))(%r1)
; Re-raise the exception through mlraise, to clean up local C roots
ldo 64(%r30), %r30
#ifdef SYS_nextstep
ldil L`G(mlraise), %r1
ble R`G(mlraise)(4, %r1)
copy %r31, %r2
#else
bl G(mlraise), %r2
nop
#endif
ENDPROC
.align CODE_ALIGN
EXPORT_CODE(G(callback2))
G(callback2):
STARTPROC
copy %r26, %r1 ; Closure
copy %r25, %r26 ; First argument
copy %r24, %r25 ; Second argument
copy %r1, %r24
LOADHIGH(G(caml_apply2))
b L102
ldo LOW(G(caml_apply2))(%r1), %r22
ENDPROC
.align CODE_ALIGN
EXPORT_CODE(G(callback3))
G(callback3):
STARTPROC
copy %r26, %r1 ; Closure
copy %r25, %r26 ; First argument
copy %r24, %r25 ; Second argument
copy %r23, %r24 ; Third argument
copy %r1, %r23
LOADHIGH(G(caml_apply3))
b L102
ldo LOW(G(caml_apply3))(%r1), %r22
ENDPROC
.data
EXPORT_DATA(G(system_frametable))
G(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 */