1.1.13: will be tagged as "sbcl-1.1.13"
[sbcl.git] / src / runtime / alpha-assem.S
index ed5074f..1a8928b 100644 (file)
        
 #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" */
        
 /*
@@ -61,10 +70,10 @@ call_into_lisp:
        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
@@ -86,7 +95,7 @@ call_into_lisp:
 
        /* Indirect the closure */
        ldl     reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
-       addl    reg_CODE,6*4-FUN_POINTER_LOWTAG, reg_LIP
+       addl    reg_CODE, SIMPLE_FUN_CODE_OFFSET, reg_LIP
 
        /* And into lisp we go. */
        jsr     reg_ZERO,(reg_LIP)
@@ -112,10 +121,10 @@ call_into_lisp_LRA:
        /* 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
@@ -172,10 +181,11 @@ call_into_c:
 
        /* 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
@@ -186,13 +196,7 @@ call_into_c:
 
        /* 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)
@@ -220,7 +224,7 @@ call_into_c:
        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 */
@@ -253,10 +257,18 @@ start_of_tramps:
  * 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? */
@@ -265,38 +277,60 @@ undefined_tramp_offset:
         .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:
+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
+       .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.
  */
 
+/*
+ * For an explanation of the magic involved in function-end
+ * breakpoints, see the implementation in ppc-assem.S.
+ */
+
        .text
        .align  2
        .set    noreorder
        .globl  fun_end_breakpoint_guts
 fun_end_breakpoint_guts:
-       .long   RETURN_PC_HEADER_WIDETAG
+       .long   RETURN_PC_HEADER_WIDETAG + 0x800
        br      zero, fun_end_breakpoint_trap
        nop
        mov     reg_CSP, reg_OCFP
@@ -318,4 +352,3 @@ fun_end_breakpoint_trap:
        .globl  fun_end_breakpoint_end
 fun_end_breakpoint_end:
 
-