#include "validate.h"
#include <alpha/regdef.h>
+#ifdef linux
#include <asm/pal.h>
-
+#else
+#include <alpha/pal.h>
+#endif
#include "sbcl.h"
#include "lispregs.h"
+#include "genesis/fdefn.h"
+#include "genesis/closure.h"
+#include "genesis/funcallable-instance.h"
+#include "genesis/simple-fun.h"
+#include "genesis/static-symbols.h"
+
/* #include "globals.h" */
/*
stl zero,foreign_function_call_active
/* Load lisp state. */
- ldl reg_ALLOC,dynamic_space_free_pointer
- ldl reg_BSP,current_binding_stack_pointer
- ldl reg_CSP,current_control_stack_pointer
- ldl reg_OCFP,current_control_frame_pointer
+ ldq reg_ALLOC,dynamic_space_free_pointer
+ ldq reg_BSP,current_binding_stack_pointer
+ ldq reg_CSP,current_control_stack_pointer
+ ldq reg_OCFP,current_control_frame_pointer
mov a1,reg_CFP
.set noat
ldl reg_A5,20(reg_CFP)
/* This call will 'return' into the LRA page below */
- lda reg_LRA,call_into_lisp_LRA_page+type_OtherPointer
+ lda reg_LRA,call_into_lisp_LRA_page+OTHER_POINTER_LOWTAG
/* Indirect the closure */
- ldl reg_CODE,CLOSURE_FUNCTION_OFFSET(reg_LEXENV)
- addl reg_CODE,6*4-type_FunctionPointer,reg_LIP
+ ldl reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
+ addl reg_CODE,6*4-FUN_POINTER_LOWTAG, reg_LIP
/* And into lisp we go. */
jsr reg_ZERO,(reg_LIP)
.globl call_into_lisp_LRA
call_into_lisp_LRA:
- .long type_ReturnPcHeader
+ .long RETURN_PC_HEADER_WIDETAG
/* execution resumes here*/
mov reg_OCFP,reg_CSP
/* Turn on pseudo-atomic. */
/* Save LISP registers */
- stl reg_ALLOC, dynamic_space_free_pointer
- stl reg_BSP,current_binding_stack_pointer
- stl reg_CSP,current_control_stack_pointer
- stl reg_CFP,current_control_frame_pointer
+ stq reg_ALLOC, dynamic_space_free_pointer
+ stq reg_BSP,current_binding_stack_pointer
+ stq reg_CSP,current_control_stack_pointer
+ stq reg_CFP,current_control_frame_pointer
/* Back in C land. [CSP is just a handy non-zero value.] */
stl reg_CSP,foreign_function_call_active
addq reg_CFP, 32, reg_CSP
stl reg_OCFP, 0(reg_CFP)
subl reg_LIP, reg_CODE, reg_L1
- addl reg_L1, type_OtherPointer, reg_L1
+ addl reg_L1, OTHER_POINTER_LOWTAG, reg_L1
stl reg_L1, 4(reg_CFP)
stl reg_CODE, 8(reg_CFP)
stl reg_NULL, 12(reg_CFP)
/* Save lisp state. */
subq reg_ALLOC,1,reg_L1
- stl reg_L1, dynamic_space_free_pointer
- stl reg_BSP, current_binding_stack_pointer
- stl reg_CSP, current_control_stack_pointer
- stl reg_CFP, current_control_frame_pointer
+ stq reg_L1, dynamic_space_free_pointer
+
+ stq reg_BSP, current_binding_stack_pointer
+ stq reg_CSP, current_control_stack_pointer
+ stq reg_CFP, current_control_frame_pointer
/* Mark us as in C land. */
stl reg_CSP, foreign_function_call_active
/* Into C land we go. */
- /* L1 is pv (procedure variable). The following line is */
- /* apparently a jump hint and not mysterious at all */
-
- /* <dhd> so, you have perfectly good code with comments written by */
- /* people who don't understand the Alpha :) */
-
- mov reg_CFUNC, reg_L1 /* ### This line is a mystery */
+ mov reg_CFUNC, reg_L1 /* L1=pv: this is a hint to the cache */
jsr ra, (reg_CFUNC)
ldgp $29,0(ra)
stl reg_ZERO, foreign_function_call_active
/* Restore ALLOC, preserving pseudo-atomic-atomic */
- ldl reg_NL0,dynamic_space_free_pointer
+ ldq reg_NL0,dynamic_space_free_pointer
addq reg_ALLOC,reg_NL0,reg_ALLOC
/* Check for interrupt */
/* can you see anything here which touches LRA? I can't ...*/
ldl reg_CODE, 8(reg_CFP)
ldl reg_NL0, 4(reg_CFP)
- subq reg_NL0, type_OtherPointer, reg_NL0
+ subq reg_NL0, OTHER_POINTER_LOWTAG, reg_NL0
addq reg_CODE, reg_NL0, reg_NL0
mov reg_CFP, reg_CSP
* INTERNAL-ERROR function
*/
.text
- .globl undefined_tramp
+ .globl start_of_tramps
+ .globl undefined_tramp
+ .globl undefined_tramp_offset
.ent undefined_tramp_offset
-undefined_tramp = /* ### undefined_tramp_offset-call_into_lisp_LRA*/ 0x140+call_into_lisp_LRA_page
undefined_tramp_offset:
+ /* an explanation is called for here. 0x140 is the difference
+ * between undefined_tramp_offset and call_into_lisp_LRA, but
+ * the assembler is too dumb to allow that as an expression.
+ * So, change this number whenever you add or remove any code
+ * in this file */
+
+undefined_tramp= call_into_lisp_LRA_page+0x140
call_pal PAL_bugchk
.long trap_Error
.byte 4 /* what are these numbers? */
- .byte 23
+ .byte UNDEFINED_FUN_ERROR
.byte 254
.byte (0xe0 + sc_DescriptorReg)
.byte 2
.align 2
- .end undefined_tramp
+ .end undefined_tramp_offset
-/*
- * The closure trampoline.
- */
+/* The closure trampoline. */
.text
.globl closure_tramp
+ .globl closure_tramp_offset
.ent closure_tramp_offset
-closure_tramp = /* ### */ 0x150 + call_into_lisp_LRA_page
closure_tramp_offset:
- ldl reg_LEXENV, FDEFN_FUNCTION_OFFSET(reg_FDEFN)
- ldl reg_L0, CLOSURE_FUNCTION_OFFSET(reg_LEXENV)
- addl reg_L0, FUNCTION_CODE_OFFSET, reg_LIP
+closure_tramp= call_into_lisp_LRA_page+0x150
+ ldl reg_LEXENV, FDEFN_FUN_OFFSET(reg_FDEFN)
+ ldl reg_L0, CLOSURE_FUN_OFFSET(reg_LEXENV)
+ addl reg_L0, SIMPLE_FUN_CODE_OFFSET, reg_LIP
jmp reg_ZERO,(reg_LIP)
- .end closure_tramp
+ .end closure_tramp_offset
.text
.globl end_of_tramps
end_of_tramps:
+ .text
+ .globl funcallable_instance_tramp
+ .align 2
+ .long SIMPLE_FUN_HEADER_WIDETAG
+funcallable_instance_tramp = . + 1
+ .long funcallable_instance_tramp
+ .long NIL
+ .long NIL
+ .long NIL
+ .long NIL
+
+ ldl reg_LEXENV, FUNCALLABLE_INSTANCE_FUNCTION_OFFSET(reg_LEXENV)
+ /* I think we don't actually need to use reg_CODE here, because
+ $CODE is computed from $LIP in the function itself */
+ ldl reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
+ addl reg_CODE, SIMPLE_FUN_CODE_OFFSET, reg_LIP
+ jmp reg_ZERO, (reg_LIP)
/*
* fun-end breakpoint magic.
.set noreorder
.globl fun_end_breakpoint_guts
fun_end_breakpoint_guts:
- .long type_ReturnPcHeader
+ .long RETURN_PC_HEADER_WIDETAG
br zero, fun_end_breakpoint_trap
nop
mov reg_CSP, reg_OCFP
.globl fun_end_breakpoint_end
fun_end_breakpoint_end:
-
projects / sbcl.git / blobdiff