src/runtime/alpha-assem.S

   1 /*
   2  * This software is part of the SBCL system. See the README file for
   3  * more information.
   4  *
   5  * This software is derived from the CMU CL system, which was
   6  * written at Carnegie Mellon University and released into the
   7  * public domain. The software is in the public domain and is
   8  * provided with absolutely no warranty. See the COPYING and CREDITS
   9  * files for more information.
  10  */
  11
  12 #ifdef __ELF__
  13 // Mark the object as not requiring an executable stack.
  14 .section .note.GNU-stack,"",%progbits
  15 #endif
  16
  17 #include "validate.h"
  18 #include <alpha/regdef.h>
  19 #ifdef linux
  20 #include <asm/pal.h>
  21 #else
  22 #include <alpha/pal.h>
  23 #endif
  24 #include "sbcl.h"
  25 #include "lispregs.h"
  26 #include "genesis/fdefn.h"
  27 #include "genesis/closure.h"
  28 #include "genesis/funcallable-instance.h"
  29 #include "genesis/simple-fun.h"
  30 #include "genesis/static-symbols.h"
  31
  32 /* #include "globals.h" */
  33
  34 /*
  35  * Function to transfer control into lisp.
  36  */
  37         .text
  38         .align  4
  39         .globl  call_into_lisp
  40         .ent    call_into_lisp
  41 call_into_lisp:
  42 #define framesize 8*8
  43         ldgp    gp, 0($27)
  44         /* Save all the C regs. */
  45         lda     sp,-framesize(sp)
  46         stq     ra, framesize-8*8(sp)
  47         stq     s0, framesize-8*7(sp)
  48         stq     s1, framesize-8*6(sp)
  49         stq     s2, framesize-8*5(sp)
  50         stq     s3, framesize-8*4(sp)
  51         stq     s4, framesize-8*3(sp)
  52         stq     s5, framesize-8*2(sp)
  53         stq     s6, framesize-8*1(sp)
  54         .mask   0x0fc001fe, -framesize
  55         .frame  sp,framesize,ra
  56
  57         /* Clear descriptor regs */
  58         ldil    reg_CODE,0
  59         ldil    reg_FDEFN,0
  60         mov     a0,reg_LEXENV
  61         sll     a2,2,reg_NARGS
  62         ldil    reg_OCFP,0
  63         ldil    reg_LRA,0
  64         ldil    reg_L0,0
  65         ldil    reg_L1,0
  66
  67
  68         /* Establish NIL. */
  69         ldil    reg_NULL,NIL
  70
  71         /* The CMUCL comment here is "Start pseudo-atomic.", but */
  72         /* there's no obvious code that would have that effect  */
  73
  74         /* No longer in foreign call. */
  75         stl     zero,foreign_function_call_active
  76
  77         /* Load lisp state. */
  78         ldq     reg_ALLOC,dynamic_space_free_pointer
  79         ldq     reg_BSP,current_binding_stack_pointer
  80         ldq     reg_CSP,current_control_stack_pointer
  81         ldq     reg_OCFP,current_control_frame_pointer
  82         mov     a1,reg_CFP
  83
  84         .set    noat
  85         ldil    reg_L2,0
  86         .set at
  87
  88         /* End of pseudo-atomic. */
  89
  90         /* Establish lisp arguments. */
  91         ldl     reg_A0,0(reg_CFP)
  92         ldl     reg_A1,4(reg_CFP)
  93         ldl     reg_A2,8(reg_CFP)
  94         ldl     reg_A3,12(reg_CFP)
  95         ldl     reg_A4,16(reg_CFP)
  96         ldl     reg_A5,20(reg_CFP)
  97
  98         /* This call will 'return' into the LRA page below */
  99         lda     reg_LRA,call_into_lisp_LRA_page+OTHER_POINTER_LOWTAG
 100
 101         /* Indirect the closure */
 102         ldl     reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
 103         addl    reg_CODE, SIMPLE_FUN_CODE_OFFSET, reg_LIP
 104
 105         /* And into lisp we go. */
 106         jsr     reg_ZERO,(reg_LIP)
 107
 108
 109         /* a page of the following code (from call_into_lisp_LRA
 110         onwards) is copied into the LRA page at arch_init() time. */
 111
 112         .set noreorder
 113         .align  3
 114         .globl  call_into_lisp_LRA
 115 call_into_lisp_LRA:
 116
 117         .long   RETURN_PC_WIDETAG
 118
 119         /* execution resumes here*/
 120         mov     reg_OCFP,reg_CSP
 121         nop
 122
 123         /* return value already there */
 124         mov     reg_A0,v0
 125
 126         /* Turn on pseudo-atomic. */
 127
 128         /* Save LISP registers */
 129         stq     reg_ALLOC, dynamic_space_free_pointer
 130         stq     reg_BSP,current_binding_stack_pointer
 131         stq     reg_CSP,current_control_stack_pointer
 132         stq     reg_CFP,current_control_frame_pointer
 133
 134         /* Back in C land.  [CSP is just a handy non-zero value.] */
 135         stl     reg_CSP,foreign_function_call_active
 136
 137         /* Turn off pseudo-atomic and check for traps. */
 138
 139         /* Restore C regs */
 140         ldq     ra, framesize-8*8(sp)
 141         ldq     s0, framesize-8*7(sp)
 142         ldq     s1, framesize-8*6(sp)
 143         ldq     s2, framesize-8*5(sp)
 144         ldq     s3, framesize-8*4(sp)
 145         ldq     s4, framesize-8*3(sp)
 146         ldq     s5, framesize-8*2(sp)
 147         ldq     s6, framesize-8*1(sp)
 148
 149         /* Restore the C stack! */
 150         lda     sp, framesize(sp)
 151
 152         ret     zero,(ra),1
 153         .globl  call_into_lisp_end
 154 call_into_lisp_end:
 155         .end    call_into_lisp
 156
 157 /*
 158  * Transfering control from Lisp into C.  reg_CFUNC (t10, 24) contains
 159  * the address of the C function to call
 160  */
 161         .set noreorder
 162         .text
 163         .align  4
 164         .globl  call_into_c
 165         .ent    call_into_c
 166 call_into_c:
 167         .mask   0x0fc001fe, -12
 168         .frame  sp,12,ra
 169         mov     reg_CFP, reg_OCFP
 170         mov     reg_CSP, reg_CFP
 171         addq    reg_CFP, 32, reg_CSP
 172         stl     reg_OCFP, 0(reg_CFP)
 173         subl    reg_LIP, reg_CODE, reg_L1
 174         addl    reg_L1, OTHER_POINTER_LOWTAG, reg_L1
 175         stl     reg_L1, 4(reg_CFP)
 176         stl     reg_CODE, 8(reg_CFP)
 177         stl     reg_NULL, 12(reg_CFP)
 178
 179         /* Set the pseudo-atomic flag. */
 180         addq    reg_ALLOC,1,reg_ALLOC
 181
 182         /* Get the top two register args and fix the NSP to point to arg 7 */
 183         ldq     reg_NL4,0(reg_NSP)
 184         ldq     reg_NL5,8(reg_NSP)
 185         addq    reg_NSP,16,reg_NSP
 186
 187         /* Save lisp state. */
 188         subq    reg_ALLOC,1,reg_L1
 189         stq     reg_L1, dynamic_space_free_pointer
 190
 191         stq     reg_BSP, current_binding_stack_pointer
 192         stq     reg_CSP, current_control_stack_pointer
 193         stq     reg_CFP, current_control_frame_pointer
 194
 195         /* Mark us as in C land. */
 196         stl     reg_CSP, foreign_function_call_active
 197
 198         /* Were we interrupted? */
 199         subq    reg_ALLOC,1,reg_ALLOC
 200         stl     reg_ZERO,0(reg_ALLOC)
 201
 202         /* Into C land we go. */
 203
 204         mov     reg_CFUNC, reg_L1    /* L1=pv: this is a hint to the cache */
 205
 206         jsr     ra, (reg_CFUNC)
 207         ldgp    $29,0(ra)
 208
 209         /* restore NSP */
 210         subq    reg_NSP,16,reg_NSP
 211
 212         /* Clear unsaved descriptor regs */
 213         mov     reg_ZERO, reg_NARGS
 214         mov     reg_ZERO, reg_A0
 215         mov     reg_ZERO, reg_A1
 216         mov     reg_ZERO, reg_A2
 217         mov     reg_ZERO, reg_A3
 218         mov     reg_ZERO, reg_A4
 219         mov     reg_ZERO, reg_A5
 220         mov     reg_ZERO, reg_L0
 221         .set noat
 222         mov     reg_ZERO, reg_L2
 223         .set at
 224
 225         /* Turn on pseudo-atomic. */
 226         lda     reg_ALLOC,1(reg_ZERO)
 227
 228         /* Mark us at in Lisp land. */
 229         stl     reg_ZERO, foreign_function_call_active
 230
 231         /* Restore ALLOC, preserving pseudo-atomic-atomic */
 232         ldq     reg_NL0,dynamic_space_free_pointer
 233         addq    reg_ALLOC,reg_NL0,reg_ALLOC
 234
 235         /* Check for interrupt */
 236         subq    reg_ALLOC,1,reg_ALLOC
 237         stl     reg_ZERO,0(reg_ALLOC)
 238
 239         ldl     reg_NULL, 12(reg_CFP)
 240
 241         /* Restore LRA & CODE (they may have been GC'ed) */
 242         /* can you see anything here which touches LRA?  I can't ...*/
 243         ldl     reg_CODE, 8(reg_CFP)
 244         ldl     reg_NL0, 4(reg_CFP)
 245         subq    reg_NL0, OTHER_POINTER_LOWTAG, reg_NL0
 246         addq    reg_CODE, reg_NL0, reg_NL0
 247
 248         mov     reg_CFP, reg_CSP
 249         mov     reg_OCFP, reg_CFP
 250
 251         ret     zero, (reg_NL0), 1
 252
 253         .end    call_into_c
 254
 255         .text
 256         .globl  start_of_tramps
 257 start_of_tramps:
 258
 259         .text
 260         .globl  end_of_tramps
 261 end_of_tramps:
 262
 263
 264 /*
 265  * fun-end breakpoint magic.
 266  */
 267
 268 /*
 269  * For an explanation of the magic involved in function-end
 270  * breakpoints, see the implementation in ppc-assem.S.
 271  */
 272
 273         .text
 274         .align  2
 275         .set    noreorder
 276         .globl  fun_end_breakpoint_guts
 277 fun_end_breakpoint_guts:
 278         .long   RETURN_PC_WIDETAG + 0x600
 279         br      zero, fun_end_breakpoint_trap
 280         nop
 281         mov     reg_CSP, reg_OCFP
 282         addl    reg_CSP, 4, reg_CSP
 283         addl    zero, 4, reg_NARGS
 284         mov     reg_NULL, reg_A1
 285         mov     reg_NULL, reg_A2
 286         mov     reg_NULL, reg_A3
 287         mov     reg_NULL, reg_A4
 288         mov     reg_NULL, reg_A5
 289 1:
 290
 291         .globl  fun_end_breakpoint_trap
 292 fun_end_breakpoint_trap:
 293         call_pal PAL_bugchk
 294         .long   trap_FunEndBreakpoint
 295         br      zero, fun_end_breakpoint_trap
 296
 297         .globl  fun_end_breakpoint_end
 298 fun_end_breakpoint_end:
 299