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 #include "validate.h"
  13 #include <alpha/regdef.h>
  14 #ifdef linux
  15 #include <asm/pal.h>
  16 #else
  17 #include <alpha/pal.h>
  18 #endif
  19 #include "sbcl.h"
  20 #include "lispregs.h"
  21 #include "genesis/fdefn.h"
  22 #include "genesis/closure.h"
  23 #include "genesis/funcallable-instance.h"
  24 #include "genesis/simple-fun.h"
  25 #include "genesis/static-symbols.h"
  26
  27 /* #include "globals.h" */
  28
  29 /*
  30  * Function to transfer control into lisp.
  31  */
  32         .text
  33         .align  4
  34         .globl  call_into_lisp
  35         .ent    call_into_lisp
  36 call_into_lisp:
  37 #define framesize 8*8
  38         ldgp    gp, 0($27)
  39         /* Save all the C regs. */
  40         lda     sp,-framesize(sp)
  41         stq     ra, framesize-8*8(sp)
  42         stq     s0, framesize-8*7(sp)
  43         stq     s1, framesize-8*6(sp)
  44         stq     s2, framesize-8*5(sp)
  45         stq     s3, framesize-8*4(sp)
  46         stq     s4, framesize-8*3(sp)
  47         stq     s5, framesize-8*2(sp)
  48         stq     s6, framesize-8*1(sp)
  49         .mask   0x0fc001fe, -framesize
  50         .frame  sp,framesize,ra
  51
  52         /* Clear descriptor regs */
  53         ldil    reg_CODE,0
  54         ldil    reg_FDEFN,0
  55         mov     a0,reg_LEXENV
  56         sll     a2,2,reg_NARGS
  57         ldil    reg_OCFP,0
  58         ldil    reg_LRA,0
  59         ldil    reg_L0,0
  60         ldil    reg_L1,0
  61
  62
  63         /* Establish NIL. */
  64         ldil    reg_NULL,NIL
  65
  66         /* The CMUCL comment here is "Start pseudo-atomic.", but */
  67         /* there's no obvious code that would have that effect  */
  68
  69         /* No longer in foreign call. */
  70         stl     zero,foreign_function_call_active
  71
  72         /* Load lisp state. */
  73         ldq     reg_ALLOC,dynamic_space_free_pointer
  74         ldq     reg_BSP,current_binding_stack_pointer
  75         ldq     reg_CSP,current_control_stack_pointer
  76         ldq     reg_OCFP,current_control_frame_pointer
  77         mov     a1,reg_CFP
  78
  79         .set    noat
  80         ldil    reg_L2,0
  81         .set at
  82
  83         /* End of pseudo-atomic. */
  84
  85         /* Establish lisp arguments. */
  86         ldl     reg_A0,0(reg_CFP)
  87         ldl     reg_A1,4(reg_CFP)
  88         ldl     reg_A2,8(reg_CFP)
  89         ldl     reg_A3,12(reg_CFP)
  90         ldl     reg_A4,16(reg_CFP)
  91         ldl     reg_A5,20(reg_CFP)
  92
  93         /* This call will 'return' into the LRA page below */
  94         lda     reg_LRA,call_into_lisp_LRA_page+OTHER_POINTER_LOWTAG
  95
  96         /* Indirect the closure */
  97         ldl     reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
  98         addl    reg_CODE, SIMPLE_FUN_CODE_OFFSET, reg_LIP
  99
 100         /* And into lisp we go. */
 101         jsr     reg_ZERO,(reg_LIP)
 102
 103
 104         /* a page of the following code (from call_into_lisp_LRA
 105         onwards) is copied into the LRA page at arch_init() time. */
 106
 107         .set noreorder
 108         .align  3
 109         .globl  call_into_lisp_LRA
 110 call_into_lisp_LRA:
 111
 112         .long   RETURN_PC_HEADER_WIDETAG
 113
 114         /* execution resumes here*/
 115         mov     reg_OCFP,reg_CSP
 116         nop
 117
 118         /* return value already there */
 119         mov     reg_A0,v0
 120
 121         /* Turn on pseudo-atomic. */
 122
 123         /* Save LISP registers */
 124         stq     reg_ALLOC, dynamic_space_free_pointer
 125         stq     reg_BSP,current_binding_stack_pointer
 126         stq     reg_CSP,current_control_stack_pointer
 127         stq     reg_CFP,current_control_frame_pointer
 128
 129         /* Back in C land.  [CSP is just a handy non-zero value.] */
 130         stl     reg_CSP,foreign_function_call_active
 131
 132         /* Turn off pseudo-atomic and check for traps. */
 133
 134         /* Restore C regs */
 135         ldq     ra, framesize-8*8(sp)
 136         ldq     s0, framesize-8*7(sp)
 137         ldq     s1, framesize-8*6(sp)
 138         ldq     s2, framesize-8*5(sp)
 139         ldq     s3, framesize-8*4(sp)
 140         ldq     s4, framesize-8*3(sp)
 141         ldq     s5, framesize-8*2(sp)
 142         ldq     s6, framesize-8*1(sp)
 143
 144         /* Restore the C stack! */
 145         lda     sp, framesize(sp)
 146
 147         ret     zero,(ra),1
 148         .globl  call_into_lisp_end
 149 call_into_lisp_end:
 150         .end    call_into_lisp
 151
 152 /*
 153  * Transfering control from Lisp into C.  reg_CFUNC (t10, 24) contains
 154  * the address of the C function to call
 155  */
 156         .set noreorder
 157         .text
 158         .align  4
 159         .globl  call_into_c
 160         .ent    call_into_c
 161 call_into_c:
 162         .mask   0x0fc001fe, -12
 163         .frame  sp,12,ra
 164         mov     reg_CFP, reg_OCFP
 165         mov     reg_CSP, reg_CFP
 166         addq    reg_CFP, 32, reg_CSP
 167         stl     reg_OCFP, 0(reg_CFP)
 168         subl    reg_LIP, reg_CODE, reg_L1
 169         addl    reg_L1, OTHER_POINTER_LOWTAG, reg_L1
 170         stl     reg_L1, 4(reg_CFP)
 171         stl     reg_CODE, 8(reg_CFP)
 172         stl     reg_NULL, 12(reg_CFP)
 173
 174         /* Set the pseudo-atomic flag. */
 175         addq    reg_ALLOC,1,reg_ALLOC
 176
 177         /* Get the top two register args and fix the NSP to point to arg 7 */
 178         ldq     reg_NL4,0(reg_NSP)
 179         ldq     reg_NL5,8(reg_NSP)
 180         addq    reg_NSP,16,reg_NSP
 181
 182         /* Save lisp state. */
 183         subq    reg_ALLOC,1,reg_L1
 184         stq     reg_L1, dynamic_space_free_pointer
 185
 186         stq     reg_BSP, current_binding_stack_pointer
 187         stq     reg_CSP, current_control_stack_pointer
 188         stq     reg_CFP, current_control_frame_pointer
 189
 190         /* Mark us as in C land. */
 191         stl     reg_CSP, foreign_function_call_active
 192
 193         /* Were we interrupted? */
 194         subq    reg_ALLOC,1,reg_ALLOC
 195         stl     reg_ZERO,0(reg_ALLOC)
 196
 197         /* Into C land we go. */
 198
 199         mov     reg_CFUNC, reg_L1    /* L1=pv: this is a hint to the cache */
 200
 201         jsr     ra, (reg_CFUNC)
 202         ldgp    $29,0(ra)
 203
 204         /* restore NSP */
 205         subq    reg_NSP,16,reg_NSP
 206
 207         /* Clear unsaved descriptor regs */
 208         mov     reg_ZERO, reg_NARGS
 209         mov     reg_ZERO, reg_A0
 210         mov     reg_ZERO, reg_A1
 211         mov     reg_ZERO, reg_A2
 212         mov     reg_ZERO, reg_A3
 213         mov     reg_ZERO, reg_A4
 214         mov     reg_ZERO, reg_A5
 215         mov     reg_ZERO, reg_L0
 216         .set noat
 217         mov     reg_ZERO, reg_L2
 218         .set at
 219
 220         /* Turn on pseudo-atomic. */
 221         lda     reg_ALLOC,1(reg_ZERO)
 222
 223         /* Mark us at in Lisp land. */
 224         stl     reg_ZERO, foreign_function_call_active
 225
 226         /* Restore ALLOC, preserving pseudo-atomic-atomic */
 227         ldq     reg_NL0,dynamic_space_free_pointer
 228         addq    reg_ALLOC,reg_NL0,reg_ALLOC
 229
 230         /* Check for interrupt */
 231         subq    reg_ALLOC,1,reg_ALLOC
 232         stl     reg_ZERO,0(reg_ALLOC)
 233
 234         ldl     reg_NULL, 12(reg_CFP)
 235
 236         /* Restore LRA & CODE (they may have been GC'ed) */
 237         /* can you see anything here which touches LRA?  I can't ...*/
 238         ldl     reg_CODE, 8(reg_CFP)
 239         ldl     reg_NL0, 4(reg_CFP)
 240         subq    reg_NL0, OTHER_POINTER_LOWTAG, reg_NL0
 241         addq    reg_CODE, reg_NL0, reg_NL0
 242
 243         mov     reg_CFP, reg_CSP
 244         mov     reg_OCFP, reg_CFP
 245
 246         ret     zero, (reg_NL0), 1
 247
 248         .end    call_into_c
 249
 250         .text
 251         .globl  start_of_tramps
 252 start_of_tramps:
 253
 254 /*
 255  * The undefined-function trampoline.  Causes a trap_Error trap which
 256  * sigtrap_handler catches and eventaully calls the Lisp
 257  * INTERNAL-ERROR function
 258  */
 259         .text
 260         .globl  start_of_tramps
 261         .globl  undefined_tramp
 262         .globl  undefined_tramp_offset
 263         .ent    undefined_tramp_offset
 264 undefined_tramp_offset:
 265         /* an explanation is called for here.  0x140 is the difference
 266          * between undefined_tramp_offset and call_into_lisp_LRA, but
 267          * the assembler is too dumb to allow that as an expression.
 268          * So, change this number whenever you add or remove any code
 269          * in this file */
 270
 271 undefined_tramp= call_into_lisp_LRA_page+0x140
 272         call_pal PAL_bugchk
 273         .long    trap_Error
 274         .byte    4                         /* what are these numbers? */
 275         .byte    UNDEFINED_FUN_ERROR
 276         .byte    254
 277         .byte    (0xe0 + sc_DescriptorReg)
 278         .byte    2
 279         .align 2
 280         .end     undefined_tramp_offset
 281
 282
 283 /* The closure trampoline. */
 284         .text
 285         .globl  closure_tramp
 286         .globl  closure_tramp_offset
 287         .ent    closure_tramp_offset
 288 closure_tramp_offset:
 289 closure_tramp= call_into_lisp_LRA_page+0x150
 290         ldl     reg_LEXENV, FDEFN_FUN_OFFSET(reg_FDEFN)
 291         ldl     reg_L0, CLOSURE_FUN_OFFSET(reg_LEXENV)
 292         addl    reg_L0, SIMPLE_FUN_CODE_OFFSET, reg_LIP
 293         jmp     reg_ZERO,(reg_LIP)
 294         .end    closure_tramp_offset
 295
 296         .text
 297         .globl  end_of_tramps
 298 end_of_tramps:
 299
 300         .text
 301         .globl funcallable_instance_tramp
 302         .align 2
 303         .long SIMPLE_FUN_HEADER_WIDETAG
 304 funcallable_instance_tramp = . + 1
 305         .long funcallable_instance_tramp
 306         .long NIL
 307         .long NIL
 308         .long NIL
 309         .long NIL
 310         .long NIL
 311
 312         ldl reg_LEXENV, FUNCALLABLE_INSTANCE_FUNCTION_OFFSET(reg_LEXENV)
 313         /* I think we don't actually need to use reg_CODE here, because
 314            $CODE is computed from $LIP in the function itself */
 315         ldl reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
 316         addl reg_CODE, SIMPLE_FUN_CODE_OFFSET, reg_LIP
 317         jmp reg_ZERO, (reg_LIP)
 318
 319 /*
 320  * fun-end breakpoint magic.
 321  */
 322
 323         .text
 324         .align  2
 325         .set    noreorder
 326         .globl  fun_end_breakpoint_guts
 327 fun_end_breakpoint_guts:
 328         .long   RETURN_PC_HEADER_WIDETAG
 329         br      zero, fun_end_breakpoint_trap
 330         nop
 331         mov     reg_CSP, reg_OCFP
 332         addl    reg_CSP, 4, reg_CSP
 333         addl    zero, 4, reg_NARGS
 334         mov     reg_NULL, reg_A1
 335         mov     reg_NULL, reg_A2
 336         mov     reg_NULL, reg_A3
 337         mov     reg_NULL, reg_A4
 338         mov     reg_NULL, reg_A5
 339 1:
 340
 341         .globl  fun_end_breakpoint_trap
 342 fun_end_breakpoint_trap:
 343         call_pal PAL_bugchk
 344         .long   trap_FunEndBreakpoint
 345         br      zero, fun_end_breakpoint_trap
 346
 347         .globl  fun_end_breakpoint_end
 348 fun_end_breakpoint_end:
 349