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_NL0)
 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  * FIX why does this code work: parisc2.0 guide tells
 282  * us that we should add an sync after fdc and fic and
 283  * then let seven nops be executed before executing the
 284  * sanctified code.
 285  */
 286
 287
 288         .EXPORT sanctify_for_execution
 289 sanctify_for_execution:
 290         .proc
 291         .callinfo
 292         .entry
 293         /* %arg0=start addr, %arg1=length in bytes */
 294         add     %arg0,%arg1,%arg1
 295         ldo     -1(%arg1),%arg1
 296         depi    0,31,5,%arg0
 297         depi    0,31,5,%arg1
 298         ldsid   (%arg0),%r1
 299         mtsp    %r1,%sr1
 300         ldi     32,%r1                  ; bytes per cache line
 301 sanctify_loop:
 302         fdc     0(%sr1,%arg0)
 303         comb,<  %arg0,%arg1,sanctify_loop
 304         fic,m   %r1(%sr1,%arg0)
 305
 306         bv      %r0(%rp)
 307         nop
 308
 309         .exit
 310         .procend
 311
 312 \f
 313 /*
 314  * Core saving/restoring support
 315  */
 316
 317         .export call_on_stack
 318 call_on_stack:
 319         /* %arg0 = fn to invoke, %arg1 = new stack base */
 320
 321         /* Compute the new stack pointer. */
 322         addi    64,%arg1,%sp
 323
 324         /* Zero out the previous stack pointer. */
 325         stw     %r0,-4(0,%sp)
 326
 327         /* Invoke the function. */
 328         ble     0(4,%arg0)
 329         copy    %r31, %r2
 330
 331         /* Flame out. */
 332         break   0,0
 333
 334         .export save_state
 335 save_state:
 336         .proc
 337         .callinfo entry_gr=18,entry_fr=21,save_rp,calls
 338         .entry
 339
 340         stw     %rp,-0x14(%sr0,%sp)
 341         fstds,ma        %fr12,8(%sr0,%sp)
 342         fstds,ma        %fr13,8(%sr0,%sp)
 343         fstds,ma        %fr14,8(%sr0,%sp)
 344         fstds,ma        %fr15,8(%sr0,%sp)
 345         fstds,ma        %fr16,8(%sr0,%sp)
 346         fstds,ma        %fr17,8(%sr0,%sp)
 347         fstds,ma        %fr18,8(%sr0,%sp)
 348         fstds,ma        %fr19,8(%sr0,%sp)
 349         fstds,ma        %fr20,8(%sr0,%sp)
 350         fstds,ma        %fr21,8(%sr0,%sp)
 351         stwm    %r3,0x70(%sr0,%sp)
 352         stw     %r4,-0x6c(%sr0,%sp)
 353         stw     %r5,-0x68(%sr0,%sp)
 354         stw     %r6,-0x64(%sr0,%sp)
 355         stw     %r7,-0x60(%sr0,%sp)
 356         stw     %r8,-0x5c(%sr0,%sp)
 357         stw     %r9,-0x58(%sr0,%sp)
 358         stw     %r10,-0x54(%sr0,%sp)
 359         stw     %r11,-0x50(%sr0,%sp)
 360         stw     %r12,-0x4c(%sr0,%sp)
 361         stw     %r13,-0x48(%sr0,%sp)
 362         stw     %r14,-0x44(%sr0,%sp)
 363         stw     %r15,-0x40(%sr0,%sp)
 364         stw     %r16,-0x3c(%sr0,%sp)
 365         stw     %r17,-0x38(%sr0,%sp)
 366         stw     %r18,-0x34(%sr0,%sp)
 367
 368
 369         /* Remember the function we want to invoke */
 370         copy    %arg0,%r19
 371
 372         /* Pass the new stack pointer in as %arg0 */
 373         copy    %sp,%arg0
 374
 375         /* Leave %arg1 as %arg1. */
 376
 377         /* do the call. */
 378         ble     0(4,%r19)
 379         copy    %r31, %r2
 380
 381         .export _restore_state
 382 _restore_state:
 383
 384         ldw     -0xd4(%sr0,%sp),%rp
 385         ldw     -0x34(%sr0,%sp),%r18
 386         ldw     -0x38(%sr0,%sp),%r17
 387         ldw     -0x3c(%sr0,%sp),%r16
 388         ldw     -0x40(%sr0,%sp),%r15
 389         ldw     -0x44(%sr0,%sp),%r14
 390         ldw     -0x48(%sr0,%sp),%r13
 391         ldw     -0x4c(%sr0,%sp),%r12
 392         ldw     -0x50(%sr0,%sp),%r11
 393         ldw     -0x54(%sr0,%sp),%r10
 394         ldw     -0x58(%sr0,%sp),%r9
 395         ldw     -0x5c(%sr0,%sp),%r8
 396         ldw     -0x60(%sr0,%sp),%r7
 397         ldw     -0x64(%sr0,%sp),%r6
 398         ldw     -0x68(%sr0,%sp),%r5
 399         ldw     -0x6c(%sr0,%sp),%r4
 400         ldwm    -0x70(%sr0,%sp),%r3
 401         fldds,mb        -8(%sr0,%sp),%fr21
 402         fldds,mb        -8(%sr0,%sp),%fr20
 403         fldds,mb        -8(%sr0,%sp),%fr19
 404         fldds,mb        -8(%sr0,%sp),%fr18
 405         fldds,mb        -8(%sr0,%sp),%fr17
 406         fldds,mb        -8(%sr0,%sp),%fr16
 407         fldds,mb        -8(%sr0,%sp),%fr15
 408         fldds,mb        -8(%sr0,%sp),%fr14
 409         fldds,mb        -8(%sr0,%sp),%fr13
 410         bv      %r0(%rp)
 411         fldds,mb        -8(%sr0,%sp),%fr12
 412
 413
 414         .exit
 415         .procend
 416
 417         .export restore_state
 418 restore_state:
 419         .proc
 420         .callinfo
 421         copy    %arg0,%sp
 422         b       _restore_state
 423         copy    %arg1,%ret0
 424         .procend
 425
 426
 427
 428 /* FIX, add support for singlestep
 429         break   trap_SingleStepBreakpoint,0
 430         break   trap_SingleStepBreakpoint,0
 431 */
 432         .export SingleStepTraps
 433 SingleStepTraps:
 434
 435 /* Missing !! NOT
 436         there's a break 0,0 in the new version here!!!
 437 */
 438
 439         .align  8
 440         .export fun_end_breakpoint_guts
 441 fun_end_breakpoint_guts:
 442         .word   RETURN_PC_HEADER_WIDETAG
 443         /* multiple value return point -- just jump to trap. */
 444         b,n     fun_end_breakpoint_trap
 445         /* single value return point -- convert to multiple w/ n=1 */
 446         copy    reg_CSP, reg_OCFP
 447         addi    4, reg_CSP, reg_CSP
 448         addi    4, %r0, reg_NARGS
 449         copy    reg_NULL, reg_A1
 450         copy    reg_NULL, reg_A2
 451         copy    reg_NULL, reg_A3
 452         copy    reg_NULL, reg_A4
 453         copy    reg_NULL, reg_A5
 454
 455         .export fun_end_breakpoint_trap
 456 fun_end_breakpoint_trap:
 457         break   trap_FunEndBreakpoint,0
 458         b,n     fun_end_breakpoint_trap
 459
 460         .export fun_end_breakpoint_end
 461 fun_end_breakpoint_end:
 462
 463 /* FIX-lav: these are found in assem-rtns.lisp too, but
 464    genesis.lisp has problem referencing them, so we keep
 465    these old versions too.  Lisp code cant jump to them
 466    because it is an inter space jump but lisp do intra
 467    space jumps */
 468
 469         .align  8
 470         .EXPORT closure_tramp
 471 closure_tramp:
 472         /* reg_FDEFN holds the fdefn object. */
 473         ldw     FDEFN_FUN_OFFSET(0,reg_FDEFN),reg_LEXENV
 474         ldw     CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_L0
 475         addi    SIMPLE_FUN_CODE_OFFSET, reg_L0, reg_LIP
 476         bv,n    0(reg_LIP)
 477
 478         .align  8
 479         .EXPORT undefined_tramp
 480 undefined_tramp:
 481         break   trap_Error,0
 482         .byte   4
 483         .byte   UNDEFINED_FUN_ERROR
 484         .byte   254
 485         .byte   (0x20 + sc_DescriptorReg)
 486         .byte   1
 487         .align  4
 488