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  SIMPLE_FUN_CODE_OFFSET,reg_CODE,reg_LIP
 112
 113 #ifdef LISP_FEATURE_HPUX
 114   /*  Get the stub address, ie assembly-routine return-from-lisp */
 115   addil   L%return_from_lisp_stub-$global$,%dp
 116   ldw     R%return_from_lisp_stub-$global$(0,%r1),reg_NL0
 117   be,n  0(%sr5,reg_NL0)
 118 #else
 119   be,n  0(%sr5,reg_LIP)
 120 #endif
 121
 122         break   0,0
 123
 124         .align  8
 125 lra:
 126   nop /* a few nops because we dont know where we land */
 127   nop /* the return convention would govern this */
 128   nop
 129   nop
 130
 131         /* Copy CFP (%r4) into someplace else and restore r4. */
 132         copy    reg_CFP,reg_NL1
 133   ldw -0x3c(0,%sp),%r4
 134
 135         /* Copy the return value. */
 136         copy    reg_A0,%ret0
 137
 138         /* Turn on pseudo-atomic. */
 139         addi    4,reg_ALLOC,reg_ALLOC
 140
 141         /* Store the lisp state. */
 142         copy    reg_ALLOC,reg_NL0
 143         depi    0,31,3,reg_NL0
 144         addil   L%dynamic_space_free_pointer-$global$,%dp
 145         stw     reg_NL0,R%dynamic_space_free_pointer-$global$(0,%r1)
 146         addil   L%current_binding_stack_pointer-$global$,%dp
 147         stw     reg_BSP,R%current_binding_stack_pointer-$global$(0,%r1)
 148         addil   L%current_control_stack_pointer-$global$,%dp
 149         stw     reg_CSP,R%current_control_stack_pointer-$global$(0,%r1)
 150         addil   L%current_control_frame_pointer-$global$,%dp
 151         stw     reg_NL1,R%current_control_frame_pointer-$global$(0,%r1)
 152
 153         /* Back in C land.  [CSP is just a handy non-zero value.] */
 154         addil   L%foreign_function_call_active-$global$,%dp
 155         stw     reg_CSP,R%foreign_function_call_active-$global$(0,%r1)
 156
 157         /* Turn off pseudo-atomic and check for traps. */
 158         addit,od        -4,reg_ALLOC,reg_ALLOC
 159
 160         ldw     -0x54(%sr0,%sp),%rp
 161         ldw     -0x4(%sr0,%sp),%r18
 162         ldw     -0x8(%sr0,%sp),%r17
 163         ldw     -0xc(%sr0,%sp),%r16
 164         ldw     -0x10(%sr0,%sp),%r15
 165         ldw     -0x14(%sr0,%sp),%r14
 166         ldw     -0x18(%sr0,%sp),%r13
 167         ldw     -0x1c(%sr0,%sp),%r12
 168         ldw     -0x20(%sr0,%sp),%r11
 169         ldw     -0x24(%sr0,%sp),%r10
 170         ldw     -0x28(%sr0,%sp),%r9
 171         ldw     -0x2c(%sr0,%sp),%r8
 172         ldw     -0x30(%sr0,%sp),%r7
 173         ldw     -0x34(%sr0,%sp),%r6
 174         ldw     -0x38(%sr0,%sp),%r5
 175         ldw     -0x3c(%sr0,%sp),%r4
 176         bv      %r0(%rp)
 177         ldwm    -0x40(%sr0,%sp),%r3
 178
 179         /* And thats all. */
 180         .exit
 181         .procend
 182
 183 \f
 184 /*
 185  * Call-into-C
 186  */
 187
 188         .export call_into_c
 189 call_into_c:
 190         /* Set up a lisp stack frame. */
 191         copy    reg_CFP, reg_OCFP
 192         copy    reg_CSP, reg_CFP
 193         addi    32, reg_CSP, reg_CSP
 194         stw     reg_OCFP, 0(0,reg_CFP) ; save old cfp
 195         stw     reg_CFP, 4(0,reg_CFP)  ; save old csp
 196         /* convert raw return PC into a fixnum PC-offset, because we dont
 197            have ahold of an lra object */
 198         sub     reg_LIP, reg_CODE, reg_NL5
 199         addi    3-OTHER_POINTER_LOWTAG, reg_NL5, reg_NL5
 200         stw     reg_NL5, 8(0,reg_CFP)
 201         stw     reg_CODE, 0xc(0,reg_CFP)
 202
 203         /* set pseudo-atomic flag */
 204         addi    4, reg_ALLOC, reg_ALLOC
 205
 206         /* Store the lisp state. */
 207         copy    reg_ALLOC,reg_NL5
 208         depi    0,31,3,reg_NL5
 209         addil   L%dynamic_space_free_pointer-$global$,%dp
 210         stw     reg_NL5,R%dynamic_space_free_pointer-$global$(0,%r1)
 211         addil   L%current_binding_stack_pointer-$global$,%dp
 212         stw     reg_BSP,R%current_binding_stack_pointer-$global$(0,%r1)
 213         addil   L%current_control_stack_pointer-$global$,%dp
 214         stw     reg_CSP,R%current_control_stack_pointer-$global$(0,%r1)
 215         addil   L%current_control_frame_pointer-$global$,%dp
 216         stw     reg_CFP,R%current_control_frame_pointer-$global$(0,%r1)
 217
 218         /* Back in C land.  [CSP is just a handy non-zero value.] */
 219         addil   L%foreign_function_call_active-$global$,%dp
 220         stw     reg_CSP,R%foreign_function_call_active-$global$(0,%r1)
 221
 222         /* Turn off pseudo-atomic and check for traps. */
 223         addit,od        -4,reg_ALLOC,reg_ALLOC
 224
 225         /* in order to be able to call incrementally linked (ld -A) functions,
 226            we have to do some mild trickery here */
 227         copy reg_CFUNC, %r22
 228         bl      $$dyncall,%r31
 229         copy    %r31, %r2
 230 call_into_c_return:
 231         /* Clear the callee saves descriptor regs. */
 232         copy    %r0, reg_A5
 233         copy    %r0, reg_L0
 234         copy    %r0, reg_L1
 235         copy    %r0, reg_L2
 236
 237         /* Turn on pseudo-atomic. */
 238         ldi     4, reg_ALLOC
 239
 240         /* Turn off foreign function call. */
 241         addil   L%foreign_function_call_active-$global$,%dp
 242         stw     %r0,R%foreign_function_call_active-$global$(0,%r1)
 243
 244         /* Load ALLOC. */
 245         addil   L%dynamic_space_free_pointer-$global$,%dp
 246         ldw     R%dynamic_space_free_pointer-$global$(0,%r1),%r1
 247         add     reg_ALLOC,%r1,reg_ALLOC
 248
 249         /* We don't need to load OCFP, CFP, CSP, or BSP because they are
 250          * in caller saves registers.
 251          */
 252
 253         /* End of pseudo-atomic. */
 254         addit,od        -4,reg_ALLOC,reg_ALLOC
 255
 256         /* Restore CODE.  Even though it is in a callee saves register
 257          * it might have been GC'ed.
 258          */
 259         ldw     0xc(0,reg_CFP), reg_CODE
 260
 261         /* Restore the return pc. */
 262         ldw     8(0,reg_CFP), reg_NL0
 263         addi    OTHER_POINTER_LOWTAG-3, reg_NL0, reg_NL0
 264 /*
 265         addi    -3, reg_NL0, reg_NL0
 266         ldi OTHER_POINTER_LOWTAG, reg_NL1
 267         sub     reg_NL0, reg_NL1, reg_NL0
 268 */
 269         add     reg_CODE, reg_NL0, reg_LIP
 270
 271         /* Pop the lisp stack frame, and back we go. */
 272         ldw     4(0,reg_CFP), reg_CSP
 273         ldw     0(0,reg_CFP), reg_OCFP
 274         copy    reg_OCFP, reg_CFP
 275         be      0(5,reg_LIP)
 276         nop
 277
 278 \f
 279 /*
 280  * Stuff to sanctify a block of memory for execution.
 281  */
 282
 283         .EXPORT sanctify_for_execution
 284 sanctify_for_execution:
 285         .proc
 286         .callinfo
 287         .entry
 288         /* %arg0=start addr, %arg1=length in bytes */
 289         add     %arg0,%arg1,%arg1
 290         copy    %arg0,%arg2
 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         /* parisc 1.1 and 2.0 manuals say to flush the dcache, SYNC,
 298          * flush the icache, SYNC again, and burn seven instructions
 299          * before executing modified code. */
 300 sanctify_loop:
 301         comb,<  %arg0,%arg1,sanctify_loop
 302         fdc,m   %r1(%sr1,%arg0)
 303         sync
 304 sanctify_loop_2:
 305         comb,<  %arg2,%arg1,sanctify_loop_2
 306         fic,m   %r1(%sr1,%arg2)
 307         sync
 308
 309         bv      %r0(%rp)
 310         nop
 311
 312         .exit
 313         .procend
 314
 315 \f
 316 /*
 317  * Core saving/restoring support
 318  */
 319
 320         .export call_on_stack
 321 call_on_stack:
 322         /* %arg0 = fn to invoke, %arg1 = new stack base */
 323
 324         /* Compute the new stack pointer. */
 325         addi    64,%arg1,%sp
 326
 327         /* Zero out the previous stack pointer. */
 328         stw     %r0,-4(0,%sp)
 329
 330         /* Invoke the function. */
 331         ble     0(4,%arg0)
 332         copy    %r31, %r2
 333
 334         /* Flame out. */
 335         break   0,0
 336
 337         .export save_state
 338 save_state:
 339         .proc
 340         .callinfo entry_gr=18,entry_fr=21,save_rp,calls
 341         .entry
 342
 343         stw     %rp,-0x14(%sr0,%sp)
 344         fstds,ma        %fr12,8(%sr0,%sp)
 345         fstds,ma        %fr13,8(%sr0,%sp)
 346         fstds,ma        %fr14,8(%sr0,%sp)
 347         fstds,ma        %fr15,8(%sr0,%sp)
 348         fstds,ma        %fr16,8(%sr0,%sp)
 349         fstds,ma        %fr17,8(%sr0,%sp)
 350         fstds,ma        %fr18,8(%sr0,%sp)
 351         fstds,ma        %fr19,8(%sr0,%sp)
 352         fstds,ma        %fr20,8(%sr0,%sp)
 353         fstds,ma        %fr21,8(%sr0,%sp)
 354         stwm    %r3,0x70(%sr0,%sp)
 355         stw     %r4,-0x6c(%sr0,%sp)
 356         stw     %r5,-0x68(%sr0,%sp)
 357         stw     %r6,-0x64(%sr0,%sp)
 358         stw     %r7,-0x60(%sr0,%sp)
 359         stw     %r8,-0x5c(%sr0,%sp)
 360         stw     %r9,-0x58(%sr0,%sp)
 361         stw     %r10,-0x54(%sr0,%sp)
 362         stw     %r11,-0x50(%sr0,%sp)
 363         stw     %r12,-0x4c(%sr0,%sp)
 364         stw     %r13,-0x48(%sr0,%sp)
 365         stw     %r14,-0x44(%sr0,%sp)
 366         stw     %r15,-0x40(%sr0,%sp)
 367         stw     %r16,-0x3c(%sr0,%sp)
 368         stw     %r17,-0x38(%sr0,%sp)
 369         stw     %r18,-0x34(%sr0,%sp)
 370
 371
 372         /* Remember the function we want to invoke */
 373         copy    %arg0,%r19
 374
 375         /* Pass the new stack pointer in as %arg0 */
 376         copy    %sp,%arg0
 377
 378         /* Leave %arg1 as %arg1. */
 379
 380         /* do the call. */
 381         ble     0(4,%r19)
 382         copy    %r31, %r2
 383
 384         .export _restore_state
 385 _restore_state:
 386
 387         ldw     -0xd4(%sr0,%sp),%rp
 388         ldw     -0x34(%sr0,%sp),%r18
 389         ldw     -0x38(%sr0,%sp),%r17
 390         ldw     -0x3c(%sr0,%sp),%r16
 391         ldw     -0x40(%sr0,%sp),%r15
 392         ldw     -0x44(%sr0,%sp),%r14
 393         ldw     -0x48(%sr0,%sp),%r13
 394         ldw     -0x4c(%sr0,%sp),%r12
 395         ldw     -0x50(%sr0,%sp),%r11
 396         ldw     -0x54(%sr0,%sp),%r10
 397         ldw     -0x58(%sr0,%sp),%r9
 398         ldw     -0x5c(%sr0,%sp),%r8
 399         ldw     -0x60(%sr0,%sp),%r7
 400         ldw     -0x64(%sr0,%sp),%r6
 401         ldw     -0x68(%sr0,%sp),%r5
 402         ldw     -0x6c(%sr0,%sp),%r4
 403         ldwm    -0x70(%sr0,%sp),%r3
 404         fldds,mb        -8(%sr0,%sp),%fr21
 405         fldds,mb        -8(%sr0,%sp),%fr20
 406         fldds,mb        -8(%sr0,%sp),%fr19
 407         fldds,mb        -8(%sr0,%sp),%fr18
 408         fldds,mb        -8(%sr0,%sp),%fr17
 409         fldds,mb        -8(%sr0,%sp),%fr16
 410         fldds,mb        -8(%sr0,%sp),%fr15
 411         fldds,mb        -8(%sr0,%sp),%fr14
 412         fldds,mb        -8(%sr0,%sp),%fr13
 413         bv      %r0(%rp)
 414         fldds,mb        -8(%sr0,%sp),%fr12
 415
 416
 417         .exit
 418         .procend
 419
 420         .export restore_state
 421 restore_state:
 422         .proc
 423         .callinfo
 424         copy    %arg0,%sp
 425         b       _restore_state
 426         copy    %arg1,%ret0
 427         .procend
 428
 429
 430
 431 /* FIX, add support for singlestep
 432         break   trap_SingleStepBreakpoint,0
 433         break   trap_SingleStepBreakpoint,0
 434 */
 435         .export SingleStepTraps
 436 SingleStepTraps:
 437
 438 /* Missing !! NOT
 439         there's a break 0,0 in the new version here!!!
 440 */
 441
 442 /*
 443  * For an explanation of the magic involved in function-end
 444  * breakpoints, see the implementation in ppc-assem.S.
 445  */
 446
 447         .align  8
 448         .export fun_end_breakpoint_guts
 449 fun_end_breakpoint_guts:
 450         .word   RETURN_PC_HEADER_WIDETAG + 0x600
 451         /* multiple value return point -- just jump to trap. */
 452         b,n     fun_end_breakpoint_trap
 453         /* single value return point -- convert to multiple w/ n=1 */
 454         copy    reg_CSP, reg_OCFP
 455         addi    4, reg_CSP, reg_CSP
 456         addi    4, %r0, reg_NARGS
 457         copy    reg_NULL, reg_A1
 458         copy    reg_NULL, reg_A2
 459         copy    reg_NULL, reg_A3
 460         copy    reg_NULL, reg_A4
 461         copy    reg_NULL, reg_A5
 462
 463         .export fun_end_breakpoint_trap
 464 fun_end_breakpoint_trap:
 465         break   trap_FunEndBreakpoint,0
 466         b,n     fun_end_breakpoint_trap
 467
 468         .export fun_end_breakpoint_end
 469 fun_end_breakpoint_end:
 470
 471 /* FIX-lav: these are found in assem-rtns.lisp too, but
 472    genesis.lisp has problem referencing them, so we keep
 473    these old versions too.  Lisp code cant jump to them
 474    because it is an inter space jump but lisp do intra
 475    space jumps */
 476
 477         .align  8
 478         .EXPORT closure_tramp
 479 closure_tramp:
 480         /* reg_FDEFN holds the fdefn object. */
 481         ldw     FDEFN_FUN_OFFSET(0,reg_FDEFN),reg_LEXENV
 482         ldw     CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_L0
 483         addi    SIMPLE_FUN_CODE_OFFSET, reg_L0, reg_LIP
 484         bv,n    0(reg_LIP)
 485
 486         .align  8
 487         .EXPORT undefined_tramp
 488 undefined_tramp:
 489         break   trap_Error,0
 490         .byte   4
 491         .byte   UNDEFINED_FUN_ERROR
 492         .byte   254
 493         .byte   (0x40 + sc_DescriptorReg)
 494         .byte   2
 495         .align  4
 496