src/runtime/hppa-assem.S

   1 #define LANGUAGE_ASSEMBLY
   2
   3 #include "sbcl.h"
   4 #include "lispregs.h"
   5 #include "genesis/closure.h"
   6 #include "genesis/fdefn.h"
   7 #include "genesis/simple-fun.h"
   8 #include "genesis/return-pc.h"
   9 #include "genesis/static-symbols.h"
  10 #include "genesis/funcallable-instance.h"
  11
  12         .level  2.0
  13         .text
  14
  15         .import $global$,data
  16         .import $$dyncall,MILLICODE
  17         .import foreign_function_call_active,data
  18         .import current_control_stack_pointer,data
  19         .import current_control_frame_pointer,data
  20         .import current_binding_stack_pointer,data
  21         .import dynamic_space_free_pointer,data
  22 /*      .import return_from_lisp_function,data */
  23
  24 \f
  25 /*
  26  * Call-into-lisp
  27  */
  28
  29         .export call_into_lisp
  30 call_into_lisp:
  31         .proc
  32         .callinfo entry_gr=18,save_rp
  33         .entry
  34         /* %arg0=function, %arg1=cfp, %arg2=nargs */
  35
  36         stw     %rp,-0x14(%sr0,%sp)
  37         stwm    %r3,0x40(%sr0,%sp)
  38         stw     %r4,-0x3c(%sr0,%sp)
  39         stw     %r5,-0x38(%sr0,%sp)
  40         stw     %r6,-0x34(%sr0,%sp)
  41         stw     %r7,-0x30(%sr0,%sp)
  42         stw     %r8,-0x2c(%sr0,%sp)
  43         stw     %r9,-0x28(%sr0,%sp)
  44         stw     %r10,-0x24(%sr0,%sp)
  45         stw     %r11,-0x20(%sr0,%sp)
  46         stw     %r12,-0x1c(%sr0,%sp)
  47         stw     %r13,-0x18(%sr0,%sp)
  48         stw     %r14,-0x14(%sr0,%sp)
  49         stw     %r15,-0x10(%sr0,%sp)
  50         stw     %r16,-0xc(%sr0,%sp)
  51         stw     %r17,-0x8(%sr0,%sp)
  52         stw     %r18,-0x4(%sr0,%sp)
  53
  54         /* Clear the descriptor regs, moving in args as approporate. */
  55         copy    %r0,reg_CODE
  56         copy    %r0,reg_FDEFN
  57         copy    %arg0,reg_LEXENV
  58         zdep    %arg2,29,30,reg_NARGS
  59         copy    %r0,reg_OCFP
  60         copy    %r0,reg_LRA
  61         copy    %r0,reg_A0
  62         copy    %r0,reg_A1
  63         copy    %r0,reg_A2
  64         copy    %r0,reg_A3
  65         copy    %r0,reg_A4
  66         copy    %r0,reg_A5
  67         copy    %r0,reg_L0
  68         copy    %r0,reg_L1
  69         copy    %r0,reg_L2
  70
  71         /* Establish NIL. */
  72         ldil    L%NIL,reg_NULL
  73         ldo     R%NIL(reg_NULL),reg_NULL
  74
  75         /* Turn on pseudo-atomic. */
  76         ldo     4(%r0),reg_ALLOC
  77
  78         /* No longer in foreign function call land. */
  79         addil   L%foreign_function_call_active-$global$,%dp
  80         stw     %r0,R%foreign_function_call_active-$global$(0,%r1)
  81
  82         /* Load lisp state. */
  83         addil   L%dynamic_space_free_pointer-$global$,%dp
  84         ldw     R%dynamic_space_free_pointer-$global$(0,%r1),%r1
  85         add     reg_ALLOC,%r1,reg_ALLOC
  86         addil   L%current_binding_stack_pointer-$global$,%dp
  87         ldw     R%current_binding_stack_pointer-$global$(0,%r1),reg_BSP
  88         addil   L%current_control_stack_pointer-$global$,%dp
  89         ldw     R%current_control_stack_pointer-$global$(0,%r1),reg_CSP
  90         addil   L%current_control_frame_pointer-$global$,%dp
  91         ldw     R%current_control_frame_pointer-$global$(0,%r1),reg_OCFP
  92         copy    %arg1,reg_CFP
  93
  94         /* End of pseudo-atomic. */
  95         addit,od        -4,reg_ALLOC,reg_ALLOC
  96
  97         /* Establish lisp arguments. */
  98         ldw     0(reg_CFP),reg_A0
  99         ldw     4(reg_CFP),reg_A1
 100         ldw     8(reg_CFP),reg_A2
 101         ldw     12(reg_CFP),reg_A3
 102         ldw     16(reg_CFP),reg_A4
 103         ldw     20(reg_CFP),reg_A5
 104
 105         /* Calculate the LRA. */
 106   ldil  L%lra-RETURN_PC_RETURN_POINT_OFFSET,reg_LRA
 107   ldo R%lra-RETURN_PC_RETURN_POINT_OFFSET(reg_LRA),reg_LRA
 108
 109         /* Indirect the closure */
 110         ldw     CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_CODE
 111         addi    6*4-FUN_POINTER_LOWTAG,reg_CODE,reg_LIP
 112
 113         /* And into lisp we go. */
 114         .export break_here
 115 break_here:
 116         be,n    0(%sr5,reg_LIP)
 117
 118         break   0,0
 119
 120         .align  8
 121 lra:
 122   nop /* a few nops because we dont know where we land */
 123   nop /* the return convention would govern this */
 124   nop
 125   nop
 126
 127         /* Copy CFP (%r4) into someplace else and restore r4. */
 128         copy    reg_CFP,reg_NL1
 129   ldw -0x3c(0,%sp),%r4
 130
 131         /* Copy the return value. */
 132         copy    reg_A0,%ret0
 133
 134         /* Turn on pseudo-atomic. */
 135         addi    4,reg_ALLOC,reg_ALLOC
 136
 137         /* Store the lisp state. */
 138         copy    reg_ALLOC,reg_NL0
 139         depi    0,31,3,reg_NL0
 140         addil   L%dynamic_space_free_pointer-$global$,%dp
 141         stw     reg_NL0,R%dynamic_space_free_pointer-$global$(0,%r1)
 142         addil   L%current_binding_stack_pointer-$global$,%dp
 143         stw     reg_BSP,R%current_binding_stack_pointer-$global$(0,%r1)
 144         addil   L%current_control_stack_pointer-$global$,%dp
 145         stw     reg_CSP,R%current_control_stack_pointer-$global$(0,%r1)
 146         addil   L%current_control_frame_pointer-$global$,%dp
 147         stw     reg_NL1,R%current_control_frame_pointer-$global$(0,%r1)
 148
 149         /* Back in C land.  [CSP is just a handy non-zero value.] */
 150         addil   L%foreign_function_call_active-$global$,%dp
 151         stw     reg_CSP,R%foreign_function_call_active-$global$(0,%r1)
 152
 153         /* Turn off pseudo-atomic and check for traps. */
 154         addit,od        -4,reg_ALLOC,reg_ALLOC
 155
 156         ldw     -0x54(%sr0,%sp),%rp
 157         ldw     -0x4(%sr0,%sp),%r18
 158         ldw     -0x8(%sr0,%sp),%r17
 159         ldw     -0xc(%sr0,%sp),%r16
 160         ldw     -0x10(%sr0,%sp),%r15
 161         ldw     -0x14(%sr0,%sp),%r14
 162         ldw     -0x18(%sr0,%sp),%r13
 163         ldw     -0x1c(%sr0,%sp),%r12
 164         ldw     -0x20(%sr0,%sp),%r11
 165         ldw     -0x24(%sr0,%sp),%r10
 166         ldw     -0x28(%sr0,%sp),%r9
 167         ldw     -0x2c(%sr0,%sp),%r8
 168         ldw     -0x30(%sr0,%sp),%r7
 169         ldw     -0x34(%sr0,%sp),%r6
 170         ldw     -0x38(%sr0,%sp),%r5
 171         ldw     -0x3c(%sr0,%sp),%r4
 172         bv      %r0(%rp)
 173         ldwm    -0x40(%sr0,%sp),%r3
 174
 175         /* And thats all. */
 176         .exit
 177         .procend
 178
 179 \f
 180 /*
 181  * Call-into-C
 182  */
 183
 184         .export call_into_c
 185 call_into_c:
 186         /* Set up a lisp stack frame. */
 187         copy    reg_CFP, reg_OCFP
 188         copy    reg_CSP, reg_CFP
 189         addi    32, reg_CSP, reg_CSP
 190         stw     reg_OCFP, 0(0,reg_CFP) ; save old cfp
 191         stw     reg_CFP, 4(0,reg_CFP)  ; save old csp
 192         /* convert raw return PC into a fixnum PC-offset, because we dont
 193            have ahold of an lra object */
 194         sub     reg_LIP, reg_CODE, reg_NL5
 195         addi    3-OTHER_POINTER_LOWTAG, reg_NL5, reg_NL5
 196         stw     reg_NL5, 8(0,reg_CFP)
 197         stw     reg_CODE, 0xc(0,reg_CFP)
 198
 199         /* set pseudo-atomic flag */
 200         addi    4, reg_ALLOC, reg_ALLOC
 201
 202         /* Store the lisp state. */
 203         copy    reg_ALLOC,reg_NL5
 204         depi    0,31,3,reg_NL5
 205         addil   L%dynamic_space_free_pointer-$global$,%dp
 206         stw     reg_NL5,R%dynamic_space_free_pointer-$global$(0,%r1)
 207         addil   L%current_binding_stack_pointer-$global$,%dp
 208         stw     reg_BSP,R%current_binding_stack_pointer-$global$(0,%r1)
 209         addil   L%current_control_stack_pointer-$global$,%dp
 210         stw     reg_CSP,R%current_control_stack_pointer-$global$(0,%r1)
 211         addil   L%current_control_frame_pointer-$global$,%dp
 212         stw     reg_CFP,R%current_control_frame_pointer-$global$(0,%r1)
 213
 214         /* Back in C land.  [CSP is just a handy non-zero value.] */
 215         addil   L%foreign_function_call_active-$global$,%dp
 216         stw     reg_CSP,R%foreign_function_call_active-$global$(0,%r1)
 217
 218         /* Turn off pseudo-atomic and check for traps. */
 219         addit,od        -4,reg_ALLOC,reg_ALLOC
 220
 221         /* in order to be able to call incrementally linked (ld -A) functions,
 222            we have to do some mild trickery here */
 223         copy reg_CFUNC, %r22
 224         bl      $$dyncall,%r31
 225         copy    %r31, %r2
 226 call_into_c_return:
 227         /* Clear the callee saves descriptor regs. */
 228         copy    %r0, reg_A5
 229         copy    %r0, reg_L0
 230         copy    %r0, reg_L1
 231         copy    %r0, reg_L2
 232
 233         /* Turn on pseudo-atomic. */
 234         ldi     4, reg_ALLOC
 235
 236         /* Turn off foreign function call. */
 237         addil   L%foreign_function_call_active-$global$,%dp
 238         stw     %r0,R%foreign_function_call_active-$global$(0,%r1)
 239
 240         /* Load ALLOC. */
 241         addil   L%dynamic_space_free_pointer-$global$,%dp
 242         ldw     R%dynamic_space_free_pointer-$global$(0,%r1),%r1
 243         add     reg_ALLOC,%r1,reg_ALLOC
 244
 245         /* We don't need to load OCFP, CFP, CSP, or BSP because they are
 246          * in caller saves registers.
 247          */
 248
 249         /* End of pseudo-atomic. */
 250         addit,od        -4,reg_ALLOC,reg_ALLOC
 251
 252         /* Restore CODE.  Even though it is in a callee saves register
 253          * it might have been GC'ed.
 254          */
 255         ldw     0xc(0,reg_CFP), reg_CODE
 256
 257         /* Restore the return pc. */
 258         ldw     8(0,reg_CFP), reg_NL0
 259         addi    OTHER_POINTER_LOWTAG-3, reg_NL0, reg_NL0
 260 /*
 261         addi    -3, reg_NL0, reg_NL0
 262         ldi OTHER_POINTER_LOWTAG, reg_NL1
 263         sub     reg_NL0, reg_NL1, reg_NL0
 264 */
 265         add     reg_CODE, reg_NL0, reg_LIP
 266
 267         /* Pop the lisp stack frame, and back we go. */
 268         ldw     4(0,reg_CFP), reg_CSP
 269         ldw     0(0,reg_CFP), reg_OCFP
 270         copy    reg_OCFP, reg_CFP
 271         be      0(5,reg_LIP)
 272         nop
 273
 274 \f
 275 /*
 276  * Stuff to sanctify a block of memory for execution.
 277  * FIX why does this code work: parisc2.0 guide tells
 278  * us that we should add an sync after fdc and fic and
 279  * then let seven nops be executed before executing the
 280  * sanctified code.
 281  */
 282
 283
 284         .EXPORT sanctify_for_execution
 285 sanctify_for_execution:
 286         .proc
 287         .callinfo
 288         .entry
 289         /* %arg0=start addr, %arg1=length in bytes */
 290         add     %arg0,%arg1,%arg1
 291         ldo     -1(%arg1),%arg1
 292         depi    0,31,5,%arg0
 293         depi    0,31,5,%arg1
 294         ldsid   (%arg0),%r1
 295         mtsp    %r1,%sr1
 296         ldi     32,%r1                  ; bytes per cache line
 297 sanctify_loop:
 298         fdc     0(%sr1,%arg0)
 299         comb,<  %arg0,%arg1,sanctify_loop
 300         fic,m   %r1(%sr1,%arg0)
 301
 302         bv      %r0(%rp)
 303         nop
 304
 305         .exit
 306         .procend
 307
 308 \f
 309 /*
 310  * Core saving/restoring support
 311  */
 312
 313         .export call_on_stack
 314 call_on_stack:
 315         /* %arg0 = fn to invoke, %arg1 = new stack base */
 316
 317         /* Compute the new stack pointer. */
 318         addi    64,%arg1,%sp
 319
 320         /* Zero out the previous stack pointer. */
 321         stw     %r0,-4(0,%sp)
 322
 323         /* Invoke the function. */
 324         ble     0(4,%arg0)
 325         copy    %r31, %r2
 326
 327         /* Flame out. */
 328         break   0,0
 329
 330         .export save_state
 331 save_state:
 332         .proc
 333         .callinfo entry_gr=18,entry_fr=21,save_rp,calls
 334         .entry
 335
 336         stw     %rp,-0x14(%sr0,%sp)
 337         fstds,ma        %fr12,8(%sr0,%sp)
 338         fstds,ma        %fr13,8(%sr0,%sp)
 339         fstds,ma        %fr14,8(%sr0,%sp)
 340         fstds,ma        %fr15,8(%sr0,%sp)
 341         fstds,ma        %fr16,8(%sr0,%sp)
 342         fstds,ma        %fr17,8(%sr0,%sp)
 343         fstds,ma        %fr18,8(%sr0,%sp)
 344         fstds,ma        %fr19,8(%sr0,%sp)
 345         fstds,ma        %fr20,8(%sr0,%sp)
 346         fstds,ma        %fr21,8(%sr0,%sp)
 347         stwm    %r3,0x70(%sr0,%sp)
 348         stw     %r4,-0x6c(%sr0,%sp)
 349         stw     %r5,-0x68(%sr0,%sp)
 350         stw     %r6,-0x64(%sr0,%sp)
 351         stw     %r7,-0x60(%sr0,%sp)
 352         stw     %r8,-0x5c(%sr0,%sp)
 353         stw     %r9,-0x58(%sr0,%sp)
 354         stw     %r10,-0x54(%sr0,%sp)
 355         stw     %r11,-0x50(%sr0,%sp)
 356         stw     %r12,-0x4c(%sr0,%sp)
 357         stw     %r13,-0x48(%sr0,%sp)
 358         stw     %r14,-0x44(%sr0,%sp)
 359         stw     %r15,-0x40(%sr0,%sp)
 360         stw     %r16,-0x3c(%sr0,%sp)
 361         stw     %r17,-0x38(%sr0,%sp)
 362         stw     %r18,-0x34(%sr0,%sp)
 363
 364
 365         /* Remember the function we want to invoke */
 366         copy    %arg0,%r19
 367
 368         /* Pass the new stack pointer in as %arg0 */
 369         copy    %sp,%arg0
 370
 371         /* Leave %arg1 as %arg1. */
 372
 373         /* do the call. */
 374         ble     0(4,%r19)
 375         copy    %r31, %r2
 376
 377         .export _restore_state
 378 _restore_state:
 379
 380         ldw     -0xd4(%sr0,%sp),%rp
 381         ldw     -0x34(%sr0,%sp),%r18
 382         ldw     -0x38(%sr0,%sp),%r17
 383         ldw     -0x3c(%sr0,%sp),%r16
 384         ldw     -0x40(%sr0,%sp),%r15
 385         ldw     -0x44(%sr0,%sp),%r14
 386         ldw     -0x48(%sr0,%sp),%r13
 387         ldw     -0x4c(%sr0,%sp),%r12
 388         ldw     -0x50(%sr0,%sp),%r11
 389         ldw     -0x54(%sr0,%sp),%r10
 390         ldw     -0x58(%sr0,%sp),%r9
 391         ldw     -0x5c(%sr0,%sp),%r8
 392         ldw     -0x60(%sr0,%sp),%r7
 393         ldw     -0x64(%sr0,%sp),%r6
 394         ldw     -0x68(%sr0,%sp),%r5
 395         ldw     -0x6c(%sr0,%sp),%r4
 396         ldwm    -0x70(%sr0,%sp),%r3
 397         fldds,mb        -8(%sr0,%sp),%fr21
 398         fldds,mb        -8(%sr0,%sp),%fr20
 399         fldds,mb        -8(%sr0,%sp),%fr19
 400         fldds,mb        -8(%sr0,%sp),%fr18
 401         fldds,mb        -8(%sr0,%sp),%fr17
 402         fldds,mb        -8(%sr0,%sp),%fr16
 403         fldds,mb        -8(%sr0,%sp),%fr15
 404         fldds,mb        -8(%sr0,%sp),%fr14
 405         fldds,mb        -8(%sr0,%sp),%fr13
 406         bv      %r0(%rp)
 407         fldds,mb        -8(%sr0,%sp),%fr12
 408
 409
 410         .exit
 411         .procend
 412
 413         .export restore_state
 414 restore_state:
 415         .proc
 416         .callinfo
 417         copy    %arg0,%sp
 418         b       _restore_state
 419         copy    %arg1,%ret0
 420         .procend
 421
 422
 423
 424 /* FIX, add support for singlestep
 425         break   trap_SingleStepBreakpoint,0
 426         break   trap_SingleStepBreakpoint,0
 427 */
 428         .export SingleStepTraps
 429 SingleStepTraps:
 430
 431 /* Missing !! NOT
 432         there's a break 0,0 in the new version here!!!
 433 */
 434
 435         .align  8
 436         .export fun_end_breakpoint_guts
 437 fun_end_breakpoint_guts:
 438         .word   RETURN_PC_HEADER_WIDETAG
 439         /* multiple value return point -- just jump to trap. */
 440         b,n     fun_end_breakpoint_trap
 441         /* single value return point -- convert to multiple w/ n=1 */
 442         copy    reg_CSP, reg_OCFP
 443         addi    4, reg_CSP, reg_CSP
 444         addi    4, %r0, reg_NARGS
 445         copy    reg_NULL, reg_A1
 446         copy    reg_NULL, reg_A2
 447         copy    reg_NULL, reg_A3
 448         copy    reg_NULL, reg_A4
 449         copy    reg_NULL, reg_A5
 450
 451         .export fun_end_breakpoint_trap
 452 fun_end_breakpoint_trap:
 453         break   trap_FunEndBreakpoint,0
 454         b,n     fun_end_breakpoint_trap
 455
 456         .export fun_end_breakpoint_end
 457 fun_end_breakpoint_end:
 458
 459 /* FIX-lav: these are found in assem-rtns.lisp too, but
 460    genesis.lisp has problem referencing them, so we keep
 461    these old versions too.  Lisp code cant jump to them
 462    because it is an inter space jump but lisp do intra
 463    space jumps */
 464
 465         .align  8
 466         .EXPORT closure_tramp
 467 closure_tramp:
 468         /* reg_FDEFN holds the fdefn object. */
 469         ldw     FDEFN_FUN_OFFSET(0,reg_FDEFN),reg_LEXENV
 470         ldw     CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_L0
 471         addi    SIMPLE_FUN_CODE_OFFSET, reg_L0, reg_LIP
 472         bv,n    0(reg_LIP)
 473
 474         .align  8
 475         .EXPORT undefined_tramp
 476 undefined_tramp:
 477         break   trap_Error,0
 478         .byte   4
 479         .byte   UNDEFINED_FUN_ERROR
 480         .byte   254
 481         .byte   (0x20 + sc_DescriptorReg)
 482         .byte   1
 483         .align  4
 484