1.0.25.30: INTERRUPT-THREAD without RT signals
[sbcl.git] / 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