X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=src%2Fvm%2Fjit%2Fmips%2Fasmpart.S;h=20d546af36324ba274bb4d1f7afc63f3db04b67d;hb=0902c5271401a01d4f4a80bf5841c6ba77b28f46;hp=d4d60f4fe223e1fe4ba6ce52ef0a092dc366502e;hpb=e87e75f3a7421c91d2bc6fb6b11c526e7c65fec0;p=cacao.git diff --git a/src/vm/jit/mips/asmpart.S b/src/vm/jit/mips/asmpart.S index d4d60f4fe..20d546af3 100644 --- a/src/vm/jit/mips/asmpart.S +++ b/src/vm/jit/mips/asmpart.S @@ -1,9 +1,9 @@ -/* src/vm/jit/mips/asmpart.S - Java-C interface functions for mips +/* src/vm/jit/mips/asmpart.S - Java-C interface functions for MIPS - Copyright (C) 1996-2005 R. Grafl, A. Krall, C. Kruegel, C. Oates, - R. Obermaisser, M. Platter, M. Probst, S. Ring, E. Steiner, - C. Thalinger, D. Thuernbeck, P. Tomsich, C. Ullrich, J. Wenninger, - Institut f. Computersprachen - TU Wien + Copyright (C) 1996-2005, 2006 R. Grafl, A. Krall, C. Kruegel, + C. Oates, R. Obermaisser, M. Platter, M. Probst, S. Ring, + E. Steiner, C. Thalinger, D. Thuernbeck, P. Tomsich, C. Ullrich, + J. Wenninger, Institut f. Computersprachen - TU Wien This file is part of CACAO. @@ -19,25 +19,28 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA - 02111-1307, USA. + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + 02110-1301, USA. - Contact: cacao@complang.tuwien.ac.at + Contact: cacao@cacaojvm.org Authors: Andreas Krall Changes: Christian Thalinger + Edwin Steiner - $Id: asmpart.S 3510 2005-10-27 10:49:57Z twisti $ + $Id: asmpart.S 4654 2006-03-19 19:46:11Z edwin $ */ #include "config.h" -#include "vm/jit/mips/offsets.h" +#include "vm/jit/mips/md-abi.h" #include "vm/jit/mips/md-asm.h" +#include "vm/jit/mips/offsets.h" +#include "vm/jit/abi.h" #include "vm/jit/methodheader.h" @@ -45,16 +48,13 @@ .set noat -/* exported functions and variables *******************************************/ +/* export functions ***********************************************************/ - .globl asm_calljavafunction - .globl asm_calljavafunction_int - - .globl asm_calljavafunction2 - .globl asm_calljavafunction2int - .globl asm_calljavafunction2long - .globl asm_calljavafunction2float - .globl asm_calljavafunction2double + .globl asm_vm_call_method + .globl asm_vm_call_method_int + .globl asm_vm_call_method_long + .globl asm_vm_call_method_float + .globl asm_vm_call_method_double .globl asm_call_jit_compiler .globl asm_handle_exception @@ -62,6 +62,9 @@ .globl asm_wrapper_patcher + .globl asm_replacement_out + .globl asm_replacement_in + .globl asm_perform_threadswitch .globl asm_initialize_thread_stack .globl asm_switchstackandcall @@ -90,127 +93,42 @@ * * *******************************************************************************/ - .ent asm_calljavafunction + .ent asm_vm_call_method .align 3 - .dword 0 /* catch type all */ - .dword calljava_xhandler /* handler pc */ - .dword calljava_xhandler /* end pc */ - .dword asm_calljavafunction /* start pc */ - .word 1 /* extable size */ - .word 0 /* 4-byte ALIGNMENT PADDING */ - .dword 0 /* line number table start */ - .dword 0 /* line number table size */ - .word 0 /* 4-byte ALIGNMENT PADDING */ - .word 0 /* fltsave */ - .word 0 /* intsave */ - .word 0 /* isleaf */ - .word 0 /* IsSync */ - .word 10*8 /* frame size */ - .dword 0 /* method pointer (pointer to name) */ - -asm_calljavafunction: -asm_calljavafunction_int: - aaddiu sp,sp,-10*8 /* allocate stack space */ - ast ra,0(sp) /* save return address */ - - .set noreorder - - bal call_java_pc - ast pv,3*8(sp) /* procedure vector (delay slot) */ -call_java_pc: - aaddiu pv,ra,-4*4 - - .set reorder - - sdc1 fss0,4*8(sp) /* save non JavaABI saved flt registers */ - sdc1 fss1,5*8(sp) - sdc1 fss2,6*8(sp) - sdc1 fss3,7*8(sp) - sdc1 fss4,8*8(sp) - sdc1 fss5,9*8(sp) - - move itmp1,a0 /* pass method pointer via tmp1 */ - - move a0,a1 /* pass the remaining parameters */ - move a1,a2 - move a2,a3 - move a3,a4 - - ala mptr,asm_call_jit_compiler/* fake virtual function call (2 instr) */ - ast mptr,1*8(sp) /* store function address */ - move mptr,sp /* set method pointer */ - - .set noreorder - - ald pv,1*8(mptr) /* method call as in Java */ - jalr pv /* call JIT compiler */ - nop - aaddiu pv,ra,-22*4 /* recompute procedure vector */ - - .set reorder - -calljava_return: - ald ra,0(sp) /* restore return address */ - ald pv,3*8(sp) /* restore procedure vector */ - - ldc1 fss0,4*8(sp) /* restore non JavaABI saved flt regs */ - ldc1 fss1,5*8(sp) - ldc1 fss2,6*8(sp) - ldc1 fss3,7*8(sp) - ldc1 fss4,8*8(sp) - ldc1 fss5,9*8(sp) - - aaddiu sp,sp,10*8 /* free stack space */ - j ra /* return */ - -calljava_xhandler: - move a0,itmp1 - jal builtin_throw_exception - move v0,zero /* clear return value for exception */ - b calljava_return - - .end asm_calljavafunction - - - .ent asm_calljavafunction2 - - .align 3 + .dword 0 /* catch type all */ + .dword calljava_xhandler2 /* handler pc */ + .dword calljava_xhandler2 /* end pc */ + .dword asm_vm_call_method /* start pc */ + .word 1 /* extable size */ + .word 0 /* 4-byte ALIGNMENT PADDING */ + .dword 0 /* line number table start */ + .dword 0 /* line number table size */ + .word 0 /* 4-byte ALIGNMENT PADDING */ + .word 0 /* fltsave */ + .word 0 /* intsave */ + .word 0 /* isleaf */ + .word 0 /* IsSync */ + .word 0 /* frame size */ + .dword 0 /* method pointer (pointer to name) */ + +asm_vm_call_method: +asm_vm_call_method_int: +asm_vm_call_method_long: +asm_vm_call_method_float: +asm_vm_call_method_double: + .set noreorder /* XXX we need to recompute pv */ - .dword 0 /* catch type all */ - .dword calljava_xhandler2 /* handler pc */ - .dword calljava_xhandler2 /* end pc */ - .dword asm_calljavafunction2 /* start pc */ - .word 1 /* extable size */ - .word 0 /* 4-byte ALIGNMENT PADDING */ - .dword 0 /* line number table start */ - .dword 0 /* line number table size */ - .word 0 /* 4-byte ALIGNMENT PADDING */ - .word 0 /* fltsave */ - .word 1 /* intsave */ - .word 0 /* isleaf */ - .word 0 /* IsSync */ - .word 12*8 /* frame size */ - .dword 0 /* method pointer (pointer to name) */ - -asm_calljavafunction2: -asm_calljavafunction2int: -asm_calljavafunction2long: -asm_calljavafunction2float: -asm_calljavafunction2double: aaddiu sp,sp,-12*8 /* allocate stack space (only 11 needed)*/ ast ra,0(sp) /* save return address */ - .set noreorder - bal call_java_pc2 + bal L_asm_vm_call_method_compute_pv ast pv,1*8(sp) /* procedure vector */ -call_java_pc2: +L_asm_vm_call_method_compute_pv: aaddiu pv,ra,-4*4 ast s7,3*8(sp) - .set reorder - sdc1 fss0,5*8(sp) /* save non JavaABI saved flt registers */ sdc1 fss1,6*8(sp) sdc1 fss2,7*8(sp) @@ -220,64 +138,74 @@ call_java_pc2: ast a0,4*8(sp) /* save method pointer for compiler */ - move t0,a3 + move t0,a2 move s7,a1 blez s7,calljava_argsloaded + nop - ald a0,offjniitem(t0) - ldc1 fa0,offjniitem(t0) + ald a0,offvmargdata(t0) + ldc1 fa0,offvmargdata(t0) daddi s7,s7,-1 blez s7,calljava_argsloaded + nop - ald a1,offjniitem+sizejniblock*1(t0) - ldc1 fa1,offjniitem+sizejniblock*1(t0) + ald a1,offvmargdata+sizevmarg*1(t0) + ldc1 fa1,offvmargdata+sizevmarg*1(t0) daddi s7,s7,-1 blez s7,calljava_argsloaded + nop - ald a2,offjniitem+sizejniblock*2(t0) - ldc1 fa2,offjniitem+sizejniblock*2(t0) + ald a2,offvmargdata+sizevmarg*2(t0) + ldc1 fa2,offvmargdata+sizevmarg*2(t0) daddi s7,s7,-1 blez s7,calljava_argsloaded + nop - ald a3,offjniitem+sizejniblock*3(t0) - ldc1 fa3,offjniitem+sizejniblock*3(t0) + ald a3,offvmargdata+sizevmarg*3(t0) + ldc1 fa3,offvmargdata+sizevmarg*3(t0) daddi s7,s7,-1 blez s7,calljava_argsloaded + nop - ald a4,offjniitem+sizejniblock*4(t0) - ldc1 fa4,offjniitem+sizejniblock*4(t0) + ald a4,offvmargdata+sizevmarg*4(t0) + ldc1 fa4,offvmargdata+sizevmarg*4(t0) daddi s7,s7,-1 blez s7,calljava_argsloaded + nop - ald a5,offjniitem+sizejniblock*5(t0) - ldc1 fa5,offjniitem+sizejniblock*5(t0) + ald a5,offvmargdata+sizevmarg*5(t0) + ldc1 fa5,offvmargdata+sizevmarg*5(t0) daddi s7,s7,-1 blez s7,calljava_argsloaded + nop - ald a6,offjniitem+sizejniblock*6(t0) - ldc1 fa6,offjniitem+sizejniblock*6(t0) + ald a6,offvmargdata+sizevmarg*6(t0) + ldc1 fa6,offvmargdata+sizevmarg*6(t0) daddi s7,s7,-1 blez s7,calljava_argsloaded + nop - ald a7,offjniitem+sizejniblock*7(t0) - ldc1 fa7,offjniitem+sizejniblock*7(t0) + ald a7,offvmargdata+sizevmarg*7(t0) + ldc1 fa7,offvmargdata+sizevmarg*7(t0) daddi s7,s7,-1 calljava_argsloaded: move t8,sp /* save stack pointer */ blez s7,calljava_nocopy + nop subu t1,zero,s7 sll t2,t1,3 aaddu sp,sp,t2 aaddu t2,t2,t8 calljava_copyloop: - ald t3,offjniitem+sizejniblock*8(t0) + ald t3,offvmargdata+sizevmarg*8(t0) ast t3,0(t2) ala t1,1(t1) - ala t0,sizejniblock(t0) + ala t0,sizevmarg(t0) ala t2,8(t2) bnez t1,calljava_copyloop + nop calljava_nocopy: ald itmp1,4*8(t8) /* pass method pointer via itmp1 */ @@ -286,14 +214,14 @@ calljava_nocopy: ast mptr,2*8(t8) /* store function address */ ala mptr,1*8(t8) /* set method pointer */ - .set noreorder - ald pv,1*8(mptr) /* method call as in Java */ jalr pv /* call JIT compiler */ nop +L_asm_vm_call_method_recompute_pv: +/* aaddiu pv,ra,(asm_vm_call_method - L_asm_vm_call_method_recompute_pv)*/ aaddiu pv,ra,-76*4 /* recompute procedure vector */ - .set reorder + .set reorder /* XXX we need to recompute pv */ calljava_return2: ald ra,0(sp) /* restore return address */ @@ -317,7 +245,7 @@ calljava_xhandler2: jal builtin_throw_exception b calljava_return2 - .end asm_calljavafunction2 + .end asm_vm_call_method /****************** function asm_call_jit_compiler ***************************** @@ -407,255 +335,137 @@ L_asm_call_jit_compiler_exception: .end asm_call_jit_compiler -/********************* function asm_handle_exception *************************** -* * -* This function handles an exception. It does not use the usual calling * -* conventions. The exception pointer is passed in REG_ITMP1 and the * -* pc from the exception raising position is passed in REG_ITMP2. It searches * -* the local exception table for a handler. If no one is found, it unwinds * -* stacks and continues searching the callers. * -* * -* void asm_handle_exception (exceptionptr, exceptionpc); * -* * +/* asm_handle_exception ******************************************************** + + This function handles an exception. It does not use the usual calling + conventions. The exception pointer is passed in REG_ITMP1 and the + pc from the exception raising position is passed in REG_ITMP2. It searches + the local exception table for a handler. If no one is found, it unwinds + stacks and continues searching the callers. + *******************************************************************************/ .ent asm_handle_nat_exception asm_handle_nat_exception: - lw t0,0(ra) /* load instruction LDA PV,xxx(RA) */ - sll t0,t0,16 - sra t0,t0,16 /* isolate offset */ - aaddu pv,t0,ra /* compute update address */ +L_asm_handle_exception_stack_loop: + aaddiu sp,sp,-6*8 /* allocate stack */ + ast xptr,0*8(sp) /* save exception pointer */ + ast xpc,1*8(sp) /* save exception pc */ + ast ra,3*8(sp) /* save return address */ + ast zero,4*8(sp) /* save maybe-leaf flag (cleared) */ + + move a0,ra /* pass return address */ + jal md_codegen_findmethod /* get PV from RA */ + ast v0,2*8(sp) /* save data segment pointer */ + + ald a0,0*8(sp) /* pass exception pointer */ + ald a1,1*8(sp) /* pass exception pc */ + move a2,v0 /* pass data segment pointer */ + aaddiu a3,sp,6*8 /* pass Java stack pointer */ + + b L_asm_handle_exception_continue .aent asm_handle_exception asm_handle_exception: - aaddiu sp,sp,-14*8 /* allocate stack */ - - sd v0,0*8(sp) /* save possible used registers */ - sd t0,1*8(sp) /* also registers used by trace_exception */ - sd t1,2*8(sp) - sd t2,3*8(sp) - sd t3,4*8(sp) - sd t8,5*8(sp) - sd a0,6*8(sp) - sd a1,7*8(sp) - sd a2,8*8(sp) - sd a3,9*8(sp) - sd a4,10*8(sp) - sd a5,11*8(sp) - sd a6,12*8(sp) - sd a7,13*8(sp) - - addu t3,zero,1 /* set no unwind flag */ -ex_stack_loop: - aaddiu sp,sp,-6*8 /* allocate stack */ - sd xptr,0*8(sp) /* save used registers */ - sd xpc,1*8(sp) - sd pv,2*8(sp) - sd ra,3*8(sp) - sd t3,4*8(sp) - - move a0,xptr - ald a1,MethodPointer(pv) - move a2,xpc -/* move a3,t3 */ - move a3,zero - addu a4,zero,1 - jal builtin_trace_exception /* trace_exception(xptr,methodptr) */ + aaddiu sp,sp,-(ARG_CNT+TMP_CNT)*8 /* create maybe-leaf stackframe */ + + SAVE_ARGUMENT_REGISTERS(0) /* we save arg and temp registers in */ + SAVE_TEMPORARY_REGISTERS(ARG_CNT) /* case this is a leaf method */ + + aaddiu sp,sp,-6*8 /* allocate stack */ + ast xptr,0*8(sp) /* save exception pointer */ + ast xpc,1*8(sp) /* save exception pc */ + ast pv,2*8(sp) /* save data segment pointer */ + ast ra,3*8(sp) /* save return address */ + addu t0,zero,1 /* set maybe-leaf flag */ + ast t0,4*8(sp) /* save maybe-leaf flag */ + + move a0,xptr /* pass exception pointer */ + move a1,xpc /* pass exception pc */ + move a2,pv /* pass data segment pointer */ + aaddiu a3,sp,(ARG_CNT+TMP_CNT+6)*8 /* pass Java stack pointer */ + +L_asm_handle_exception_continue: + jal exceptions_handle_exception - ld xptr,0*8(sp) /* restore used register */ - ld xpc,1*8(sp) - ld pv,2*8(sp) - ld ra,3*8(sp) - ld t3,4*8(sp) - aaddiu sp,sp,6*8 /* deallocate stack */ - - lw t0,ExTableSize(pv) /* t0 = exception table size */ - beqz t0,empty_table /* if empty table skip */ - aaddiu t1,pv,ExTableStart /* t1 = start of exception table */ - -ex_table_loop: - ald t2,ExStartPC(t1) /* t2 = exception start pc */ - sle t2,t2,xpc /* t2 = (startpc <= xpc) */ - beqz t2,ex_table_cont /* if (false) continue */ - ald t2,ExEndPC(t1) /* t2 = exception end pc */ - slt t2,xpc,t2 /* t2 = (xpc < endpc) */ - beqz t2,ex_table_cont /* if (false) continue */ - ald a1,ExCatchType(t1) /* arg1 = exception catch type */ - beqz a1,ex_handle_it /* NULL catches everything */ - - lw itmp3,offclassloaded(a1) - bnez itmp3,L_class_loaded - - aaddiu sp,sp,-8*8 /* allocate stack */ - sd t0,0*8(sp) /* save used register */ - sd t1,1*8(sp) - sd t3,2*8(sp) - sd xptr,3*8(sp) - sd xpc,4*8(sp) - sd pv,5*8(sp) - sd ra,6*8(sp) - sd a1,7*8(sp) - - move a0,a1 - jal load_class_bootstrap - - ld t0,0*8(sp) /* restore used register */ - ld t1,1*8(sp) - ld t3,2*8(sp) - ld xptr,3*8(sp) - ld xpc,4*8(sp) - ld pv,5*8(sp) - ld ra,6*8(sp) - ld a1,7*8(sp) - aaddiu sp,sp,8*8 /* deallocate stack */ + beqz v0,L_asm_handle_exception_not_catched + + move xpc,v0 /* move handlerpc into xpc */ + ald xptr,0*8(sp) /* restore exception pointer */ + ald pv,2*8(sp) /* restore data segment pointer */ + ald ra,3*8(sp) /* restore return address */ + ald t0,4*8(sp) /* get maybe-leaf flag */ + aaddiu sp,sp,6*8 /* free stackframe */ -L_class_loaded: - lw itmp3,offclasslinked(a1) - aaddiu sp,sp,-8*8 /* allocate stack */ - sd a1,7*8(sp) - bnez itmp3,L_class_linked - - sd t0,0*8(sp) /* save used register */ - sd t1,1*8(sp) - sd t3,2*8(sp) - sd xptr,3*8(sp) - sd xpc,4*8(sp) - sd pv,5*8(sp) - sd ra,6*8(sp) - - move a0,a1 - jal link_class - - ld t0,0*8(sp) /* restore used register */ - ld t1,1*8(sp) - ld t3,2*8(sp) - ld xptr,3*8(sp) - ld xpc,4*8(sp) - ld pv,5*8(sp) - ld ra,6*8(sp) - -L_class_linked: -_crit_restart1: - ld a1,7*8(sp) -_crit_begin1: - ald a0,offobjvftbl(xptr) /* a0 = vftblptr(xptr) */ - ald a1,offclassvftbl(a1) /* a1 = vftblptr(catchtype) class (not obj) */ - lw a0,offbaseval(a0) /* a0 = baseval(xptr) */ - lw v0,offbaseval(a1) /* a2 = baseval(catchtype) */ - lw a1,offdiffval(a1) /* a1 = diffval(catchtype) */ -_crit_end1: - subu a0,a0,v0 /* a0 = baseval(xptr) - baseval(catchtype) */ - sltu v0,a1,a0 /* v0 = xptr is instanceof catchtype */ - aaddiu sp,sp,8*8 /* deallocate stack */ - bnez v0,ex_table_cont /* if (false) continue */ - -ex_handle_it: - ald xpc,ExHandlerPC(t1) /* xpc = exception handler pc */ - - beqz t3,ex_jump /* if (!(no stack unwinding) skip */ - - ld v0,0*8(sp) /* restore possible used registers */ - ld t0,1*8(sp) /* also registers used by trace_exception */ - ld t1,2*8(sp) - ld t2,3*8(sp) - ld t3,4*8(sp) - ld t8,5*8(sp) - ld a0,6*8(sp) - ld a1,7*8(sp) - ld a2,8*8(sp) - ld a3,9*8(sp) - ld a4,10*8(sp) - ld a5,11*8(sp) - ld a6,12*8(sp) - ld a7,13*8(sp) - - aaddiu sp,sp,14*8 /* deallocate stack */ - -ex_jump: - jr xpc /* jump to the handler */ - -ex_table_cont: - aaddiu t1,t1,ExEntrySize /* next exception table entry */ - addiu t0,t0,-1 /* decrement entry counter */ - bgtz t0,ex_table_loop /* if (t0 > 0) next entry */ - -empty_table: - beqz t3,ex_already_cleared /* if here the first time, then */ - aaddiu sp,sp,14*8 /* deallocate stack and */ - move t3,zero /* clear the no unwind flag */ -ex_already_cleared: - lw t0,IsSync(pv) /* t0 = SyncOffset */ - beqz t0,no_monitor_exit /* if zero no monitorexit */ - -#if defined(USE_THREADS) - aaddu t0,sp,t0 /* add stackptr to Offset */ - ald a0,-8(t0) /* load monitorexit pointer */ - - aaddiu sp,sp,-8*8 /* allocate stack */ - sd t0,0*8(sp) /* save used register */ - sd t1,1*8(sp) - sd t3,2*8(sp) - sd xptr,3*8(sp) - sd xpc,4*8(sp) - sd pv,5*8(sp) - sd ra,6*8(sp) - - jal builtin_monitorexit /* builtin_monitorexit(objectptr) */ + beqz t0,L_asm_handle_exception_no_leaf + + RESTORE_ARGUMENT_REGISTERS(0) /* if this is a leaf method, we have */ + RESTORE_TEMPORARY_REGISTERS(ARG_CNT)/* to restore arg and temp registers */ - ld t0,0*8(sp) /* restore used register */ - ld t1,1*8(sp) - ld t3,2*8(sp) - ld xptr,3*8(sp) - ld xpc,4*8(sp) - ld pv,5*8(sp) - ld ra,6*8(sp) - aaddiu sp,sp,8*8 /* deallocate stack */ -#endif + aaddiu sp,sp,(ARG_CNT+TMP_CNT)*8 /* remove maybe-leaf stackframe */ + +L_asm_handle_exception_no_leaf: + jr xpc /* jump to the handler */ -no_monitor_exit: - lw t0,FrameSize(pv) /* t0 = frame size */ - aaddu sp,sp,t0 /* unwind stack */ - move t0,sp /* t0 = pointer to save area */ - lw t1,IsLeaf(pv) /* t1 = is leaf procedure */ - bnez t1,ex_no_restore /* if (leaf) skip */ - ld ra,-8(t0) /* restore ra */ - aaddiu t0,t0,-8 /* t0-- */ -ex_no_restore: - move xpc,ra /* the new xpc is ra */ - lw t1,IntSave(pv) /* t1 = saved int register count */ - ala t2,ex_int2 /* t2 = current pc */ - sll t1,t1,2 /* t1 = register count * 4 */ - asubu t2,t2,t1 /* t2 = ex_int_sav - 4 * register count */ - jr t2 /* jump to save position */ - ld s0,-8*8(t0) - ld s1,-7*8(t0) - ld s2,-6*8(t0) - ld s3,-5*8(t0) - ld s4,-4*8(t0) - ld s5,-3*8(t0) - ld s6,-2*8(t0) - ld s7,-1*8(t0) +L_asm_handle_exception_not_catched: + ald xptr,0*8(sp) /* restore exception pointer */ + ald pv,2*8(sp) /* restore data segment pointer */ + ald ra,3*8(sp) /* restore return address */ + ald t0,4*8(sp) /* get maybe-leaf flag */ + aaddiu sp,sp,6*8 /* free stackframe */ + + beqz t0,L_asm_handle_exception_no_leaf_stack + + aaddiu sp,sp,(ARG_CNT+TMP_CNT)*8 /* remove maybe-leaf stackframe */ + move t0,zero /* clear the maybe-leaf flag */ + +L_asm_handle_exception_no_leaf_stack: + lw t1,FrameSize(pv) /* get frame size */ + aaddu t1,sp,t1 /* pointer to save area */ + + lw t2,IsLeaf(pv) /* is leaf procedure */ + bnez t2,L_asm_handle_exception_no_ra_restore + + ald ra,-1*8(t1) /* restore ra */ + aaddiu t1,t1,-8 /* t1-- */ + +L_asm_handle_exception_no_ra_restore: + move xpc,ra /* the new xpc is ra */ + lw t2,IntSave(pv) /* t1 = saved int register count */ + ala t3,ex_int2 /* t3 = current pc */ + sll t2,t2,2 /* t2 = register count * 4 */ + asubu t3,t3,t2 /* t3 = IntSave - 4 * register count */ + jr t3 /* jump to save position */ + + ald s0,-8*8(t1) + ald s1,-7*8(t1) + ald s2,-6*8(t1) + ald s3,-5*8(t1) + ald s4,-4*8(t1) + ald s5,-3*8(t1) + ald s6,-2*8(t1) + ald s7,-1*8(t1) ex_int2: - sll t1,t1,1 /* t1 = register count * 4 * 2 */ - asubu t0,t0,t1 /* t0 = t0 - 8 * register count */ - - lw t1,FltSave(pv) /* t1 = saved flt register count */ - ala t2,ex_flt2 /* t2 = current pc */ - sll t1,t1,2 /* t1 = register count * 4 */ - asubu t2,t2,t1 /* t2 = ex_int_sav - 4 * register count */ - jr t2 /* jump to save position */ - ldc1 fs0,-4*8(t0) - ldc1 fs1,-3*8(t0) - ldc1 fs2,-2*8(t0) - ldc1 fs3,-1*8(t0) + sll t2,t2,1 /* t2 = register count * 4 * 2 */ + asubu t1,t1,t2 /* t1 = t0 - 8 * register count */ + + lw t2,FltSave(pv) /* t2 = saved flt register count */ + ala t3,ex_flt2 /* t3 = current pc */ + sll t2,t2,2 /* t2 = register count * 4 */ + asubu t3,t3,t2 /* t3 = ex_int_sav - 4 * register count */ + jr t3 /* jump to save position */ + + ldc1 fs0,-4*8(t1) + ldc1 fs1,-3*8(t1) + ldc1 fs2,-2*8(t1) + ldc1 fs3,-1*8(t1) + ex_flt2: - lw t0,0(ra) /* load instruction LDA PV,xxx(RA) */ - sll t0,t0,16 - sra t0,t0,16 /* isolate offset */ - aaddu pv,t0,ra /* compute update address */ - b ex_stack_loop + lw t1,FrameSize(pv) /* get frame size */ + aaddu sp,sp,t1 /* unwind stack */ + b L_asm_handle_exception_stack_loop .end asm_handle_nat_exception @@ -746,6 +556,221 @@ L_asm_wrapper_patcher_exception: .end asm_wrapper_patcher +/* asm_replacement_out ********************************************************* + + This code is jumped to from the replacement-out stubs that are executed + when a thread reaches an activated replacement point. + + The purpose of asm_replacement_out is to read out the parts of the + execution state that cannot be accessed from C code, store this state, + and then call the C function replace_me. + + Stack layout: + 16 start of stack inside method to replace + 0 rplpoint * info on the replacement point that was reached + + NOTE: itmp3 has been clobbered by the replacement-out stub! + +*******************************************************************************/ + +/* some room to accomodate changes of the stack frame size during replacement */ + /* XXX we should find a cleaner solution here */ +#define REPLACEMENT_ROOM 512 + +#define REPLACEMENT_STACK_OFFSET ((sizeexecutionstate + REPLACEMENT_ROOM + 0xf) & ~0xf) + + .ent asm_replacement_out + +asm_replacement_out: + /* create stack frame */ + daddiu sp,sp,-REPLACEMENT_STACK_OFFSET + + /* save registers in execution state */ + sd $0 ,( 0*8+offes_intregs)(sp) + sd $1 ,( 1*8+offes_intregs)(sp) + sd $2 ,( 2*8+offes_intregs)(sp) + sd $3 ,( 3*8+offes_intregs)(sp) + sd $4 ,( 4*8+offes_intregs)(sp) + sd $5 ,( 5*8+offes_intregs)(sp) + sd $6 ,( 6*8+offes_intregs)(sp) + sd $7 ,( 7*8+offes_intregs)(sp) + sd $8 ,( 8*8+offes_intregs)(sp) + sd $9 ,( 9*8+offes_intregs)(sp) + sd $10,(10*8+offes_intregs)(sp) + sd $11,(11*8+offes_intregs)(sp) + sd $12,(12*8+offes_intregs)(sp) + sd $13,(13*8+offes_intregs)(sp) + sd $14,(14*8+offes_intregs)(sp) + sd $15,(15*8+offes_intregs)(sp) + sd $16,(16*8+offes_intregs)(sp) + sd $17,(17*8+offes_intregs)(sp) + sd $18,(18*8+offes_intregs)(sp) + sd $19,(19*8+offes_intregs)(sp) + sd $20,(20*8+offes_intregs)(sp) + sd $21,(21*8+offes_intregs)(sp) + sd $22,(22*8+offes_intregs)(sp) + sd $23,(23*8+offes_intregs)(sp) + sd $24,(24*8+offes_intregs)(sp) + sd $25,(25*8+offes_intregs)(sp) + sd $26,(26*8+offes_intregs)(sp) + sd $27,(27*8+offes_intregs)(sp) + sd $28,(28*8+offes_intregs)(sp) + sd $29,(29*8+offes_intregs)(sp) + sd $30,(30*8+offes_intregs)(sp) + sd $31,(31*8+offes_intregs)(sp) + + sdc1 $f0 ,( 0*8+offes_fltregs)(sp) + sdc1 $f1 ,( 1*8+offes_fltregs)(sp) + sdc1 $f2 ,( 2*8+offes_fltregs)(sp) + sdc1 $f3 ,( 3*8+offes_fltregs)(sp) + sdc1 $f4 ,( 4*8+offes_fltregs)(sp) + sdc1 $f5 ,( 5*8+offes_fltregs)(sp) + sdc1 $f6 ,( 6*8+offes_fltregs)(sp) + sdc1 $f7 ,( 7*8+offes_fltregs)(sp) + sdc1 $f8 ,( 8*8+offes_fltregs)(sp) + sdc1 $f9 ,( 9*8+offes_fltregs)(sp) + sdc1 $f10,(10*8+offes_fltregs)(sp) + sdc1 $f11,(11*8+offes_fltregs)(sp) + sdc1 $f12,(12*8+offes_fltregs)(sp) + sdc1 $f13,(13*8+offes_fltregs)(sp) + sdc1 $f14,(14*8+offes_fltregs)(sp) + sdc1 $f15,(15*8+offes_fltregs)(sp) + sdc1 $f16,(16*8+offes_fltregs)(sp) + sdc1 $f17,(17*8+offes_fltregs)(sp) + sdc1 $f18,(18*8+offes_fltregs)(sp) + sdc1 $f19,(19*8+offes_fltregs)(sp) + sdc1 $f20,(20*8+offes_fltregs)(sp) + sdc1 $f21,(21*8+offes_fltregs)(sp) + sdc1 $f22,(22*8+offes_fltregs)(sp) + sdc1 $f23,(23*8+offes_fltregs)(sp) + sdc1 $f24,(24*8+offes_fltregs)(sp) + sdc1 $f25,(25*8+offes_fltregs)(sp) + sdc1 $f26,(26*8+offes_fltregs)(sp) + sdc1 $f27,(27*8+offes_fltregs)(sp) + sdc1 $f28,(28*8+offes_fltregs)(sp) + sdc1 $f29,(29*8+offes_fltregs)(sp) + sdc1 $f30,(30*8+offes_fltregs)(sp) + sdc1 $f31,(31*8+offes_fltregs)(sp) + + /* calculate sp of method */ + daddiu itmp1,sp,(REPLACEMENT_STACK_OFFSET + 2*8) + sd itmp1,(offes_sp)(sp) + + /* store pv */ + sd pv,(offes_pv)(sp) + + /* call replace_me */ + ld a0,-(2*8)(itmp1) /* arg0: rplpoint * */ + move a1,sp /* arg1: execution state */ + jal replace_me /* call C function replace_me */ + jal abort /* NEVER REACHED */ + + .end asm_replacement_out + +/* asm_replacement_in ********************************************************** + + This code writes the given execution state and jumps to the replacement + code. + + This function never returns! + + NOTE: itmp3 is not restored! + + C prototype: + void asm_replacement_in(executionstate *es); + +*******************************************************************************/ + + .ent asm_replacement_in + +asm_replacement_in: + /* a0 == executionstate *es */ + + /* set new sp and pv */ + ld sp,(offes_sp)(a0) + ld pv,(offes_pv)(a0) + + /* copy registers from execution state */ + /* $0 is zero */ + ld $1 ,( 1*8+offes_intregs)(a0) + ld $2 ,( 2*8+offes_intregs)(a0) + ld $3 ,( 2*8+offes_intregs)(a0) + /* a0 is loaded below */ + ld $5 ,( 5*8+offes_intregs)(a0) + ld $6 ,( 6*8+offes_intregs)(a0) + ld $7 ,( 7*8+offes_intregs)(a0) + ld $8 ,( 8*8+offes_intregs)(a0) + ld $9 ,( 9*8+offes_intregs)(a0) + ld $10,(10*8+offes_intregs)(a0) + ld $11,(11*8+offes_intregs)(a0) + ld $12,(12*8+offes_intregs)(a0) + ld $13,(13*8+offes_intregs)(a0) + ld $14,(14*8+offes_intregs)(a0) + ld $15,(15*8+offes_intregs)(a0) + ld $16,(16*8+offes_intregs)(a0) + ld $17,(17*8+offes_intregs)(a0) + ld $18,(18*8+offes_intregs)(a0) + ld $19,(19*8+offes_intregs)(a0) + ld $20,(20*8+offes_intregs)(a0) + ld $21,(21*8+offes_intregs)(a0) + ld $22,(22*8+offes_intregs)(a0) + ld $23,(23*8+offes_intregs)(a0) + ld $24,(24*8+offes_intregs)(a0) + ld $25,(25*8+offes_intregs)(a0) + ld $26,(26*8+offes_intregs)(a0) + ld $27,(27*8+offes_intregs)(a0) + ld $28,(28*8+offes_intregs)(a0) + /* $29 is sp */ + /* $30 is pv */ + ld $31,(31*8+offes_intregs)(a0) + + ldc1 $f0 ,( 0*8+offes_fltregs)(a0) + ldc1 $f1 ,( 1*8+offes_fltregs)(a0) + ldc1 $f2 ,( 2*8+offes_fltregs)(a0) + ldc1 $f3 ,( 3*8+offes_fltregs)(a0) + ldc1 $f4 ,( 4*8+offes_fltregs)(a0) + ldc1 $f5 ,( 5*8+offes_fltregs)(a0) + ldc1 $f6 ,( 6*8+offes_fltregs)(a0) + ldc1 $f7 ,( 7*8+offes_fltregs)(a0) + ldc1 $f8 ,( 8*8+offes_fltregs)(a0) + ldc1 $f9 ,( 9*8+offes_fltregs)(a0) + ldc1 $f10,(10*8+offes_fltregs)(a0) + ldc1 $f11,(11*8+offes_fltregs)(a0) + ldc1 $f12,(12*8+offes_fltregs)(a0) + ldc1 $f13,(13*8+offes_fltregs)(a0) + ldc1 $f14,(14*8+offes_fltregs)(a0) + ldc1 $f15,(15*8+offes_fltregs)(a0) + ldc1 $f16,(16*8+offes_fltregs)(a0) + ldc1 $f17,(17*8+offes_fltregs)(a0) + ldc1 $f18,(18*8+offes_fltregs)(a0) + ldc1 $f19,(19*8+offes_fltregs)(a0) + ldc1 $f20,(20*8+offes_fltregs)(a0) + ldc1 $f21,(21*8+offes_fltregs)(a0) + ldc1 $f22,(22*8+offes_fltregs)(a0) + ldc1 $f23,(23*8+offes_fltregs)(a0) + ldc1 $f24,(24*8+offes_fltregs)(a0) + ldc1 $f25,(25*8+offes_fltregs)(a0) + ldc1 $f26,(26*8+offes_fltregs)(a0) + ldc1 $f27,(27*8+offes_fltregs)(a0) + ldc1 $f28,(28*8+offes_fltregs)(a0) + ldc1 $f29,(29*8+offes_fltregs)(a0) + ldc1 $f30,(30*8+offes_fltregs)(a0) + ldc1 $f31,(31*8+offes_fltregs)(a0) + + /* load new pc */ + + ld itmp3,offes_pc(a0) + + /* load a0 */ + + ld a0,(4*8+offes_intregs)(a0) + + /* jump to new code */ + + jr itmp3 + + .end asm_replacement_in + /******************* function asm_initialize_thread_stack ********************** * * * u1* asm_initialize_thread_stack (void *func, u1 *stack); * @@ -863,12 +888,12 @@ asm_switchstackandcall: .ent asm_getclassvalues_atomic asm_getclassvalues_atomic: -_crit_restart2: -_crit_begin2: +_crit_restart: +_crit_begin: lw t0,offbaseval(a0) lw t1,offdiffval(a0) lw t2,offbaseval(a1) -_crit_end2: +_crit_end: sw t0,offcast_super_baseval(a2) sw t1,offcast_super_diffval(a2) sw t2,offcast_sub_baseval(a2) @@ -880,12 +905,9 @@ _crit_end2: asm_criticalsections: #if defined(USE_THREADS) && defined(NATIVE_THREADS) - .dword _crit_begin1 - .dword _crit_end1 - .dword _crit_restart1 - .dword _crit_begin2 - .dword _crit_end2 - .dword _crit_restart2 + .dword _crit_begin + .dword _crit_end + .dword _crit_restart #endif .dword 0 @@ -908,6 +930,13 @@ compare_and_swap: .end compare_and_swap +/* Disable exec-stacks, required for Gentoo ***********************************/ + +#if defined(__GCC__) && defined(__ELF__) + .section .note.GNU-stack,"",@progbits +#endif + + /* * These are local overrides for various environment variables in Emacs. * Please do not remove this and leave it at the end of the file, where @@ -919,4 +948,5 @@ compare_and_swap: * c-basic-offset: 4 * tab-width: 4 * End: + * vim:noexpandtab:sw=4:ts=4: */