-#define LANGUAGE_ASSEMBLY
+/*
+ * very-low-level utilities for runtime support
+ */
-#include "sbcl.h"
+/*
+ * This software is part of the SBCL system. See the README file for
+ * more information.
+ *
+ * This software is derived from the CMU CL system, which was
+ * written at Carnegie Mellon University and released into the
+ * public domain. The software is in the public domain and is
+ * provided with absolutely no warranty. See the COPYING and CREDITS
+ * files for more information.
+ */
+\f
+#include "sbcl.h"
#include "lispregs.h"
-
+#include "globals.h"
+#include "genesis/fdefn.h"
+#include "genesis/closure.h"
+#include "genesis/funcallable-instance.h"
+#include "genesis/simple-fun.h"
+#include "genesis/static-symbols.h"
+
#define zero $0
-#define at $1
+#define AT $1
#define v0 $2
#define v1 $3
#define a0 $4
#define s8 $30
#define ra $31
+/*
+ * LEAF - declare leaf routine
+ */
+#define LEAF(symbol) \
+ .globl symbol; \
+ .align 2; \
+ .type symbol,@function; \
+ .ent symbol,0; \
+symbol: .frame sp,0,ra
+
+/*
+ * NESTED - declare nested routine entry point
+ */
+#define NESTED(symbol, framesize, rpc) \
+ .globl symbol; \
+ .align 2; \
+ .type symbol,@function; \
+ .ent symbol,0; \
+symbol: .frame sp, framesize, rpc
+
+/*
+ * END - mark end of function
+ */
+#define END(function) \
+ .end function; \
+ .size function,.-function
+
+/*
+ * EXPORT - export definition of symbol
+ */
+#define EXPORT(symbol) \
+ .globl symbol; \
+symbol:
+
+/*
+ * FEXPORT - export definition of a function symbol
+ */
+#define FEXPORT(symbol) \
+ .globl symbol; \
+ .type symbol,@function; \
+symbol:
+
+
+ .text
/*
* Function to transfer control into lisp.
*/
- .text
- .globl call_into_lisp
- .ent call_into_lisp
-call_into_lisp:
-#define framesize 12*4
+#define framesize 16*4
+ NESTED(call_into_lisp, framesize, ra)
+ .set noreorder
+ .cpload t9
+ .set reorder
subu sp, framesize
- .frame sp, framesize, ra
+
/* Save all the C regs. */
- .mask 0xc0ff0000, 0
- sw ra, framesize(sp)
- sw s8, framesize-4(sp)
- sw s7, framesize-12(sp)
- sw s6, framesize-16(sp)
- sw s5, framesize-20(sp)
- sw s4, framesize-24(sp)
- sw s3, framesize-28(sp)
- sw s2, framesize-32(sp)
- sw s1, framesize-36(sp)
- sw s0, framesize-40(sp)
-
- /* Clear descriptor regs */
- move t0, zero
- move t1, zero
- move t2, zero
- move t3, zero
- move t4, zero
- move t5, zero
- move t6, zero
- move t7, zero
- move t8, zero
- move s0, zero
- move s1, zero
- move s2, zero
- move s3, zero
- move ra, zero
+ .mask 0xc0ff0000, -8
+ sw ra, framesize-8(sp)
+ sw s8, framesize-12(sp)
+ /* No .cprestore, we don't want automatic gp restauration. */
+ sw gp, framesize-16(sp)
+ sw s7, framesize-20(sp)
+ sw s6, framesize-24(sp)
+ sw s5, framesize-28(sp)
+ sw s4, framesize-32(sp)
+ sw s3, framesize-36(sp)
+ sw s2, framesize-40(sp)
+ sw s1, framesize-44(sp)
+ sw s0, framesize-48(sp)
li reg_NIL, NIL
- /* Start pseudo-atomic. */
+ /* Clear unsaved boxed descriptor regs */
+ li reg_FDEFN, 0 # t6
+ li reg_L1, 0 # t8
+
+ /* Turn on pseudo-atomic. */
.set noreorder
li reg_NL4, 0
li reg_ALLOC, 1
.set reorder
- /* No longer in foreign call. */
- sw zero, foreign_function_call_active
-
/* Load the allocation pointer, preserving the low-bit of alloc */
lw reg_BSP, dynamic_space_free_pointer
- add reg_ALLOC, reg_BSP
+ addu reg_ALLOC, reg_BSP
/* Load the rest of the LISP state. */
lw reg_BSP, current_binding_stack_pointer
/* Check for interrupt */
.set noreorder
- bgez reg_NL4, pa1
- nop
- break 0x10
-pa1:
- subu reg_ALLOC, 1
- .set reorder
+ bgez reg_NL4, 1f
+ subu reg_ALLOC, 1
+ break 0x0, 0x10
+1: .set reorder
/* Pass in args */
- move reg_LEXENV, $4
- move reg_CFP, $5
- sll reg_NARGS, $6, 2
+ move reg_LEXENV, a0
+ move reg_CFP, a1
+ sll reg_NARGS, a2, 2
lw reg_A0, 0(reg_CFP)
lw reg_A1, 4(reg_CFP)
lw reg_A2, 8(reg_CFP)
la reg_LRA, lra + OTHER_POINTER_LOWTAG
/* Indirect closure */
- lw reg_CODE, -1(reg_LEXENV)
+ lw reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
+
+ addu reg_LIP, reg_CODE, SIMPLE_FUN_CODE_OFFSET
+
+ /* Mark us as in Lisp land. */
+ sw zero, foreign_function_call_active
/* Jump into lisp land. */
- addu reg_LIP, reg_CODE, 6*4 - FUN_POINTER_LOWTAG
- j reg_LIP
+ jr reg_LIP
- .set noreorder
.align 3
-#ifdef irix
- /* This particular KLUDGE is kept here as a reminder; for more
- details, see irix-asm-munge.c from CMUCL's lisp directory.
- Other examples have been deleted from later in the file in the
- hope that they will not be needed. */
-.globl mipsmungelra /* for our munging afterwards in irix-asm-munge */
-mipsmungelra:
-#endif
-lra:
- .word RETURN_PC_HEADER_WIDETAG
-
- /* Multiple value return spot, clear stack */
+ .set noreorder
+lra: .word RETURN_PC_HEADER_WIDETAG
+
+ /* Multiple value return spot, clear stack. */
move reg_CSP, reg_OCFP
nop
- /* Set pseudo-atomic flag. */
+ /* Single value return spot. */
+
+ /* Nested lisp -> C calls may have clobbered gp. */
+ lw gp, framesize-16(sp)
+
+ /* Mark us as in C land. */
+ sw reg_CSP, foreign_function_call_active
+
+ /* Set the pseudo-atomic flag. */
li reg_NL4, 0
addu reg_ALLOC, 1
.set reorder
- /* Save LISP registers. */
+ /* Save LISP state. */
subu reg_NL0, reg_ALLOC, 1
sw reg_NL0, dynamic_space_free_pointer
sw reg_BSP, current_binding_stack_pointer
sw reg_CSP, current_control_stack_pointer
sw reg_CFP, current_control_frame_pointer
- /* Pass one return value back to C land. */
- /* v0 is reg_ALLOC in this new world, so do this after saving
- reg_ALLOC in dynamic_space_free_pointer */
- move v0, reg_A0
-
- /* Back in foreign function call */
- sw reg_CFP, foreign_function_call_active
-
/* Check for interrupt */
.set noreorder
- bgez reg_NL4, pa2
- nop
- break 0x10
-pa2:
- subu reg_ALLOC, 1
- .set reorder
+ bgez reg_NL4, 1f
+ subu reg_ALLOC, 1
+ break 0x0, 0x10
+1: .set reorder
+
+ /* Pass one return value back to C land. For a 64bit value, we may
+ need to clobber v1 aka reg_NL4. */
+ move v0, reg_A0 # reg_CFUNC
+ move v1, reg_A1 # reg_NL4
/* Restore C regs */
- lw ra, framesize(sp)
- lw s8, framesize-4(sp)
- lw s7, framesize-12(sp)
- lw s6, framesize-16(sp)
- lw s5, framesize-20(sp)
- lw s4, framesize-24(sp)
- lw s3, framesize-28(sp)
- lw s2, framesize-32(sp)
- lw s1, framesize-36(sp)
- lw s0, framesize-40(sp)
+ lw ra, framesize-8(sp)
+ lw s8, framesize-12(sp)
+ lw s7, framesize-20(sp)
+ lw s6, framesize-24(sp)
+ lw s5, framesize-28(sp)
+ lw s4, framesize-32(sp)
+ lw s3, framesize-36(sp)
+ lw s2, framesize-40(sp)
+ lw s1, framesize-44(sp)
+ lw s0, framesize-48(sp)
/* Restore C stack. */
addu sp, framesize
/* Back we go. */
- j ra
+ jr ra
- .end call_into_lisp
+ END(call_into_lisp)
/*
* Transfering control from Lisp into C
*/
- .text
- .globl call_into_c
- .ent call_into_c
-call_into_c:
- /* Set up a stack frame. */
+ NESTED(call_into_c, 0, ra)
+ /* The C stack frame was already set up from lisp, and the
+ argument registers as well. We have to fake the correct
+ gp value for this function, though. */
+ .set noreorder
+ /* reg_NL3 is AT. */
+ .set noat
+ lui gp, %hi(_gp_disp)
+ addiu gp, %lo(_gp_disp)
+ lui reg_NL3, %hi(call_into_c)
+ addiu reg_NL3, %lo(call_into_c)
+ addu gp, reg_NL3
+ .set at
+ .set reorder
+
+ /* Setup the lisp stack. */
move reg_OCFP, reg_CFP
move reg_CFP, reg_CSP
addu reg_CSP, reg_CFP, 32
- sw reg_OCFP, 0(reg_CFP)
- subu reg_NL4, reg_LIP, reg_CODE
- addu reg_NL4, OTHER_POINTER_LOWTAG
- sw reg_NL4, 4(reg_CFP)
- sw reg_CODE, 8(reg_CFP)
- sw gp, 12(reg_CFP)
- /* Note: the C stack is already set up. */
+ /* Mark us as in C land. */
+ sw reg_CSP, foreign_function_call_active
/* Set the pseudo-atomic flag. */
.set noreorder
addu reg_ALLOC, 1
.set reorder
- /* Save lisp state. */
- subu t0, reg_ALLOC, 1
- sw t0, dynamic_space_free_pointer
+ /* Convert the return address to an offset and save it on the stack. */
+ subu reg_NFP, reg_LIP, reg_CODE
+ addu reg_NFP, OTHER_POINTER_LOWTAG
+ sw reg_LRA, (reg_CFP)
+ sw reg_CODE, 4(reg_CFP)
+ sw gp, 8(reg_CFP)
+
+ /* Save LISP state. */
+ subu reg_A0, reg_ALLOC, 1
+ sw reg_A0, dynamic_space_free_pointer
sw reg_BSP, current_binding_stack_pointer
sw reg_CSP, current_control_stack_pointer
sw reg_CFP, current_control_frame_pointer
- /* Mark us as in C land. */
- sw reg_CSP, foreign_function_call_active
-
- /* Were we interrupted? */
+ /* Check for interrupt */
.set noreorder
- bgez reg_NL4, pa3
- nop
- break 0x10
-pa3:
- subu reg_ALLOC, 1
- .set reorder
+ bgez reg_NL4, 1f
+ subu reg_ALLOC, 1
+ break 0x0, 0x10
+1: .set reorder
/* Into C land we go. */
- move t9, reg_CFUNC
- jal t9
- nop
-
- lw gp, 12(reg_CFP)
-
- /* Clear unsaved descriptor regs */
- move t0, zero
- move t1, zero
- move t2, zero
- move t3, zero
- move t4, zero
- move t5, zero
- move t6, zero
- move t7, zero
- move t8, zero
- move s0, zero
- move s2, zero
- move s3, zero
- move ra, zero
+ move t9, reg_CFUNC # reg_ALLOC
+ jalr t9
+
+ lw gp, 8(reg_CFP)
+
+ /* Pass 64bit return value to lisp land. */
+ move reg_NL0, v0 # reg_CFUNC
+ move reg_NL1, v1 # reg_NL4
+
+ /*
+ * Clear boxed descriptor registers before allowing an interrupt.
+ * We can't rely on C saving some of those registers, they might
+ * have been GCed in the meanwhile.
+ */
+ li reg_A0, 0 # t0
+ li reg_A1, 0 # t1
+ li reg_A2, 0 # t2
+ li reg_A3, 0 # t3
+ li reg_A4, 0 # t4
+ li reg_A5, 0 # t5
+ li reg_FDEFN, 0 # t6
+ li reg_LEXENV, 0 # t7
+ /*
+ * reg_NFP and reg_OCFP are pointing to fixed locations and are
+ * preserved by C.
+ */
+ li reg_LRA, 0 # s2
+ li reg_L0, 0 # s3
+ li reg_L1, 0 # t8
+ li reg_CODE, 0 # s8
+ li reg_LIP, 0 # ra
/* Turn on pseudo-atomic. */
.set noreorder
li reg_ALLOC, 1
.set reorder
- /* Mark us at in Lisp land. */
- sw zero, foreign_function_call_active
+ /* Load the allocation pointer, preserving the low-bit of alloc */
+ lw reg_BSP, dynamic_space_free_pointer
+ addu reg_ALLOC, reg_BSP
+
+ lw reg_BSP, current_binding_stack_pointer
- /* Restore ALLOC, preserving pseudo-atomic-atomic */
- lw a0, dynamic_space_free_pointer
- addu reg_ALLOC, a0
+ /* Restore LRA & CODE */
+ lw reg_LRA, (reg_CFP)
+ lw reg_CODE, 4(reg_CFP)
+ subu reg_LIP, reg_NFP, OTHER_POINTER_LOWTAG
+ addu reg_LIP, reg_CODE
/* Check for interrupt */
.set noreorder
- bgez reg_NL4, pa4
- nop
- break 0x10
-pa4:
- subu reg_ALLOC, 1
- .set reorder
-
- /* Restore LRA & CODE (they may have been GC'ed) */
- lw reg_CODE, 8(reg_CFP)
- lw a0, 4(reg_CFP)
- subu a0, OTHER_POINTER_LOWTAG
- addu reg_LIP, reg_CODE, a0
+ bgez reg_NL4, 1f
+ subu reg_ALLOC, 1
+ break 0x0, 0x10
+1: .set reorder
/* Reset the lisp stack. */
/* Note: OCFP and CFP are in saved regs. */
move reg_CSP, reg_CFP
move reg_CFP, reg_OCFP
- /* Return to LISP. */
- j reg_LIP
-
- .end call_into_c
+ /* Mark us as in Lisp land. */
+ sw zero, foreign_function_call_active
- .text
- .globl start_of_tramps
-start_of_tramps:
+ /* Return to LISP. */
+ jr reg_LIP
+ END(call_into_c)
/*
+ * Trampolines follow the Lisp calling convention.
+ *
* The undefined-function trampoline.
*/
- .text
- .globl undefined_tramp
- .ent undefined_tramp
-undefined_tramp:
- break 10
- .byte 4
- .byte UNDEFINED_FUN_ERROR
- .byte 254
- .byte (0xc0 + sc_DescriptorReg)
- .byte 1
- .align 2
- .end undefined_tramp
+ .align 3 /* minimum alignment for a lisp object */
+ .word SIMPLE_FUN_HEADER_WIDETAG /* header */
+ .word undefined_tramp - SIMPLE_FUN_CODE_OFFSET /* self */
+ .word NIL /* next */
+ .word NIL /* name */
+ .word NIL /* arglist */
+ .word NIL /* type */
+ .word NIL /* xrefs */
+ LEAF(undefined_tramp)
+ /* Point reg_CODE to the header and tag it as function, since
+ the debugger regards a function pointer in reg_CODE which
+ doesn't point to a code object as undefined function. */
+ lui reg_CODE, %hi(undefined_tramp)
+ addiu reg_CODE, %lo(undefined_tramp)
+ addiu reg_CODE, -SIMPLE_FUN_CODE_OFFSET
+ .set noreorder
+ b 1f
+ break 0x0, trap_Cerror
+ /* Error data length. */
+ .byte 4
+ /* Error number. */
+ .byte UNDEFINED_FUN_ERROR
+ /* Magic value 254 means a 16bit little endian value follows.
+ See debug-var-io.lisp. */
+ .byte 254
+ /* reg_FDEFN is #14. */
+ .byte ((14 << 6) + sc_DescriptorReg) % 0x100
+ .byte ((14 << 6) + sc_DescriptorReg) / 0x100
+ .align 2
+ .set reorder
+1: lw reg_CODE, FDEFN_FUN_OFFSET(reg_FDEFN)
+ lw reg_LIP, SIMPLE_FUN_CODE_OFFSET(reg_CODE)
+ jr reg_LIP
+ END(undefined_tramp)
/*
* The closure trampoline.
*/
- .text
- .globl closure_tramp
- .ent closure_tramp
-closure_tramp:
- lw reg_LEXENV, FDEFN_FUN_OFFSET(reg_FDEFN)
- lw reg_L0, CLOSURE_FUN_OFFSET(reg_LEXENV)
- addu reg_LIP, reg_L0, SIMPLE_FUN_CODE_OFFSET
- j reg_LIP
- .end closure_tramp
+ .align 5 /* common MIPS cacheline size */
+ .word 0 /* pad 1 */
+ .word 0 /* pad 2 */
+ .word SIMPLE_FUN_HEADER_WIDETAG /* header */
+ .word closure_tramp - SIMPLE_FUN_CODE_OFFSET /* self */
+ .word NIL /* next */
+ .word NIL /* name */
+ .word NIL /* arglist */
+ .word NIL /* type */
+ .word NIL /* xrefs */
+ LEAF(closure_tramp)
+ lw reg_LEXENV, FDEFN_FUN_OFFSET(reg_FDEFN)
+ lw reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
+ addu reg_LIP, reg_CODE, SIMPLE_FUN_CODE_OFFSET
+ jr reg_LIP
+ END(closure_tramp)
- .text
- .globl end_of_tramps
-end_of_tramps:
+/*
+ * The trampoline for funcallable instances
+ */
+ .globl funcallable_instance_tramp
+ .align 3
+ .word SIMPLE_FUN_HEADER_WIDETAG
+funcallable_instance_tramp = . + 1
+ .word funcallable_instance_tramp
+ .word NIL
+ .word NIL
+ .word NIL
+ .word NIL
+ .word NIL
+
+ lw reg_LEXENV, FUNCALLABLE_INSTANCE_FUNCTION_OFFSET(reg_LEXENV)
+ lw reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
+ addu reg_LIP, reg_CODE, SIMPLE_FUN_CODE_OFFSET
+ jr reg_LIP
+ nop
+/*
+ * Function-end breakpoint magic. This is truely magic, the code is
+ * copied and has to be relocatable. It also needs a properly aligned
+ * header tag after the fun_end_breakpoint_guts symbol.
+ */
/*
- * Function-end breakpoint magic.
+ * For an explanation of the magic involved in function-end
+ * breakpoints, see the implementation in ppc-assem.S.
*/
- .text
- .align 2
- .set noreorder
- .globl function_end_breakpoint_guts
-fun_end_breakpoint_guts:
- .word RETURN_PC_HEADER_WIDETAG
-
- beq zero, zero, 1f
- nop
+ .align 3 /* minimum alignment for a lisp object */
+ LEAF(fun_end_breakpoint_guts)
+ .set noreorder
+ .word RETURN_PC_HEADER_WIDETAG + 0x800
+ b multiple_value_return
+ nop
+ .set reorder
+
+ /* single value return */
+
move reg_OCFP, reg_CSP
addu reg_CSP, 4
li reg_NARGS, 4
move reg_A3, reg_NIL
move reg_A4, reg_NIL
move reg_A5, reg_NIL
-1:
-
- .globl fun_end_breakpoint_trap
-fun_end_breakpoint_trap:
- break trap_FunEndBreakpoint
- beq zero, zero, 1b
- nop
-
- .globl fun_end_breakpoint_end
-fun_end_breakpoint_end:
- .set reorder
-
-/* FIXME: I don't think the below are actually used anywhere */
- .text
- .align 2
- .globl call_on_stack
- .ent call_on_stack
-call_on_stack:
- subu sp, a1, 16
- jal a0
- break 0
- .end call_on_stack
-
- .globl save_state
- .ent save_state
-save_state:
- subu sp, 40
- .frame sp, 40, ra
- /* Save all the C regs. */
- .mask 0xc0ff0000, 0
- sw ra, 40(sp)
- sw s8, 40-4(sp)
- sw s7, 40-8(sp)
- sw s6, 40-12(sp)
- sw s5, 40-16(sp)
- sw s4, 40-20(sp)
- sw s3, 40-24(sp)
- sw s2, 40-28(sp)
- sw s1, 40-32(sp)
- sw s0, 40-36(sp)
-
- /* Should also save the floating point state. */
-
- move t0, a0
- move a0, sp
-
- jal t0
-
-_restore_state:
-
- lw ra, 40(sp)
- lw s8, 40-4(sp)
- lw s7, 40-8(sp)
- lw s6, 40-12(sp)
- lw s5, 40-16(sp)
- lw s4, 40-20(sp)
- lw s3, 40-24(sp)
- lw s2, 40-28(sp)
- lw s1, 40-32(sp)
- lw s0, 40-36(sp)
-
- addu sp, 40
- j ra
-
- .globl restore_state
-restore_state:
- move sp, a0
- move v0, a1
- j _restore_state
- .end save_state
-
+multiple_value_return:
+ FEXPORT(fun_end_breakpoint_trap)
+ .set noreorder
+ b multiple_value_return
+ break 0x0, trap_FunEndBreakpoint
+ .set reorder
+ EXPORT(fun_end_breakpoint_end)
+ END(fun_end_breakpoint_guts)
+ .align 3 /* minimum alignment for a lisp object */
+ LEAF(do_pending_interrupt)
+ break 0x0, trap_PendingInterrupt
+ jr reg_LIP
+ END(do_pending_interrupt)
projects / sbcl.git / blobdiff