1.0.22.22: (SETF FIND-CLASSOID) to drop DEFTYPE lambda-lists and source-locations
[sbcl/tcr.git] / src / runtime / hppa-assem.S
blob107140affefecbed145ba493922bf57b43105c6d
1 #define LANGUAGE_ASSEMBLY
3 #include "sbcl.h"
4 #include "lispregs.h"
6         .import $global$,data
7         .import foreign_function_call_active,data
8         .import current_control_stack_pointer,data
9         .import current_control_frame_pointer,data
10         .import current_binding_stack_pointer,data
11         .import dynamic_space_free_pointer,data
13 /*      .space  $TEXT$
14         .subspace       $CODE$
15         .import $$dyncall,MILLICODE
19  * Call-into-lisp
20  */
22         .export call_into_lisp
23 call_into_lisp: 
24         .proc
25         .callinfo entry_gr=18,save_rp
26         .entry
27         /* %arg0=function, %arg1=cfp, %arg2=nargs */
29         stw     %rp,-0x14(%sr0,%sp)
30         stwm    %r3,0x40(%sr0,%sp)
31         stw     %r4,-0x3c(%sr0,%sp)
32         stw     %r5,-0x38(%sr0,%sp)
33         stw     %r6,-0x34(%sr0,%sp)
34         stw     %r7,-0x30(%sr0,%sp)
35         stw     %r8,-0x2c(%sr0,%sp)
36         stw     %r9,-0x28(%sr0,%sp)
37         stw     %r10,-0x24(%sr0,%sp)
38         stw     %r11,-0x20(%sr0,%sp)
39         stw     %r12,-0x1c(%sr0,%sp)
40         stw     %r13,-0x18(%sr0,%sp)
41         stw     %r14,-0x14(%sr0,%sp)
42         stw     %r15,-0x10(%sr0,%sp)
43         stw     %r16,-0xc(%sr0,%sp)
44         stw     %r17,-0x8(%sr0,%sp)
45         stw     %r18,-0x4(%sr0,%sp)
47         /* Clear the descriptor regs, moving in args as approporate. */
48         copy    %r0,reg_CODE
49         copy    %r0,reg_FDEFN
50         copy    %arg0,reg_LEXENV
51         zdep    %arg2,29,30,reg_NARGS
52         copy    %r0,reg_OCFP
53         copy    %r0,reg_LRA
54         copy    %r0,reg_A0
55         copy    %r0,reg_A1
56         copy    %r0,reg_A2
57         copy    %r0,reg_A3
58         copy    %r0,reg_A4
59         copy    %r0,reg_A5
60         copy    %r0,reg_L0
61         copy    %r0,reg_L1
62         copy    %r0,reg_L2
64         /* Establish NIL. */
65         ldil    L%NIL,reg_NULL
66         ldo     R%NIL(reg_NULL),reg_NULL
68         /* Turn on pseudo-atomic. */
69         ldo     4(%r0),reg_ALLOC
71         /* No longer in foreign function call land. */
72         addil   L%foreign_function_call_active-$global$,%dp
73         stw     %r0,R%foreign_function_call_active-$global$(0,%r1)
75         /* Load lisp state. */
76         addil   L%dynamic_space_free_pointer-$global$,%dp
77         ldw     R%dynamic_space_free_pointer-$global$(0,%r1),%r1
78         add     reg_ALLOC,%r1,reg_ALLOC
79         addil   L%current_binding_stack_pointer-$global$,%dp
80         ldw     R%current_binding_stack_pointer-$global$(0,%r1),reg_BSP
81         addil   L%current_control_stack_pointer-$global$,%dp
82         ldw     R%current_control_stack_pointer-$global$(0,%r1),reg_CSP
83         addil   L%current_control_frame_pointer-$global$,%dp
84         ldw     R%current_control_frame_pointer-$global$(0,%r1),reg_OCFP
85         copy    %arg1,reg_CFP
87         /* End of pseudo-atomic. */
88         addit,od        -4,reg_ALLOC,reg_ALLOC
90         /* Establish lisp arguments. */
91         ldw     0(reg_CFP),reg_A0
92         ldw     4(reg_CFP),reg_A1
93         ldw     8(reg_CFP),reg_A2
94         ldw     12(reg_CFP),reg_A3
95         ldw     16(reg_CFP),reg_A4
96         ldw     20(reg_CFP),reg_A5
98         /* Calculate the LRA. */
99         ldil    L%lra+OTHER_POINTER_LOWTAG,reg_LRA
100         ldo     R%lra+OTHER_POINTER_LOWTAG(reg_LRA),reg_LRA
102         /* Indirect the closure */
103         ldw     CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_CODE
104         addi    6*4-FUN_POINTER_LOWTAG,reg_CODE,reg_LIP
106         /* And into lisp we go. */
107         .export break_here
108 break_here:     
109         be,n    0(%sr5,reg_LIP)
111         break   0,0
113         .align  8
114 lra:    
115         .word   RETURN_PC_HEADER_WIDETAG
116         copy    reg_OCFP,reg_CSP
118         /* Copy CFP (%r4) into someplace else and restore r4. */
119         copy    reg_CFP,reg_NL1
120         ldw     -64(0,%sp),%r4
122         /* Copy the return value. */
123         copy    reg_A0,%ret0
125         /* Turn on pseudo-atomic. */
126         addi    4,reg_ALLOC,reg_ALLOC
128         /* Store the lisp state. */
129         copy    reg_ALLOC,reg_NL0
130         depi    0,31,3,reg_NL0
131         addil   L%dynamic_space_free_pointer-$global$,%dp
132         stw     reg_NL0,R%dynamic_space_free_pointer-$global$(0,%r1)
133         addil   L%current_binding_stack_pointer-$global$,%dp
134         stw     reg_BSP,R%current_binding_stack_pointer-$global$(0,%r1)
135         addil   L%current_control_stack_pointer-$global$,%dp
136         stw     reg_CSP,R%current_control_stack_pointer-$global$(0,%r1)
137         addil   L%current_control_frame_pointer-$global$,%dp
138         stw     reg_NL1,R%current_control_frame_pointer-$global$(0,%r1)
140         /* Back in C land.  [CSP is just a handy non-zero value.] */
141         addil   L%foreign_function_call_active-$global$,%dp
142         stw     reg_CSP,R%foreign_function_call_active-$global$(0,%r1)
144         /* Turn off pseudo-atomic and check for traps. */
145         addit,od        -4,reg_ALLOC,reg_ALLOC
148         ldw     -0x54(%sr0,%sp),%rp
149         ldw     -0x4(%sr0,%sp),%r18
150         ldw     -0x8(%sr0,%sp),%r17
151         ldw     -0xc(%sr0,%sp),%r16
152         ldw     -0x10(%sr0,%sp),%r15
153         ldw     -0x14(%sr0,%sp),%r14
154         ldw     -0x18(%sr0,%sp),%r13
155         ldw     -0x1c(%sr0,%sp),%r12
156         ldw     -0x20(%sr0,%sp),%r11
157         ldw     -0x24(%sr0,%sp),%r10
158         ldw     -0x28(%sr0,%sp),%r9
159         ldw     -0x2c(%sr0,%sp),%r8
160         ldw     -0x30(%sr0,%sp),%r7
161         ldw     -0x34(%sr0,%sp),%r6
162         ldw     -0x38(%sr0,%sp),%r5
163         ldw     -0x3c(%sr0,%sp),%r4
164         bv      %r0(%rp)
165         ldwm    -0x40(%sr0,%sp),%r3
168         /* And thats all. */
169         .exit
170         .procend
174  * Call-into-C
175  */
177         
178         .export call_into_c
179 call_into_c:    
180         /* Set up a lisp stack frame.  Note: we convert the raw return pc into
181          * a fixnum pc-offset because we don't have ahold of an lra object.
182          */
183         copy    reg_CFP, reg_OCFP
184         copy    reg_CSP, reg_CFP
185         addi    32, reg_CSP, reg_CSP
186         stw     reg_OCFP, 0(0,reg_CFP)
187         sub     reg_LIP, reg_CODE, reg_NL5
188         addi    3-OTHER_POINTER_LOWTAG, reg_NL5, reg_NL5
189         stw     reg_NL5, 4(0,reg_CFP)
190         stw     reg_CODE, 8(0,reg_CFP)
192         /* Turn on pseudo-atomic. */
193         addi    4, reg_ALLOC, reg_ALLOC
195         /* Store the lisp state. */
196         copy    reg_ALLOC,reg_NL5
197         depi    0,31,3,reg_NL5
198         addil   L%dynamic_space_free_pointer-$global$,%dp
199         stw     reg_NL5,R%dynamic_space_free_pointer-$global$(0,%r1)
200         addil   L%current_binding_stack_pointer-$global$,%dp
201         stw     reg_BSP,R%current_binding_stack_pointer-$global$(0,%r1)
202         addil   L%current_control_stack_pointer-$global$,%dp
203         stw     reg_CSP,R%current_control_stack_pointer-$global$(0,%r1)
204         addil   L%current_control_frame_pointer-$global$,%dp
205         stw     reg_CFP,R%current_control_frame_pointer-$global$(0,%r1)
207         /* Back in C land.  [CSP is just a handy non-zero value.] */
208         addil   L%foreign_function_call_active-$global$,%dp
209         stw     reg_CSP,R%foreign_function_call_active-$global$(0,%r1)
211         /* Turn off pseudo-atomic and check for traps. */
212         addit,od        -4,reg_ALLOC,reg_ALLOC
214         /* in order to be able to call incrementally linked (ld -A) functions,
215            we have to do some mild trickery here */
216         copy    reg_CFUNC,%r22
217         bl      $$dyncall,%r31
218         copy    %r31, %r2
220         /* Clear the callee saves descriptor regs. */
221         copy    %r0, reg_A5
222         copy    %r0, reg_L0
223         copy    %r0, reg_L1
224         copy    %r0, reg_L2
226         /* Turn on pseudo-atomic. */
227         ldi     4, reg_ALLOC
229         /* Turn off foreign function call. */
230         addil   L%foreign_function_call_active-$global$,%dp
231         stw     %r0,R%foreign_function_call_active-$global$(0,%r1)
233         /* Load ALLOC. */
234         addil   L%dynamic_space_free_pointer-$global$,%dp
235         ldw     R%dynamic_space_free_pointer-$global$(0,%r1),%r1
236         add     reg_ALLOC,%r1,reg_ALLOC
238         /* We don't need to load OCFP, CFP, CSP, or BSP because they are
239          * in caller saves registers.
240          */
242         /* End of pseudo-atomic. */
243         addit,od        -4,reg_ALLOC,reg_ALLOC
245         /* Restore CODE.  Even though it is in a callee saves register
246          * it might have been GC'ed.
247          */
248         ldw     8(0,reg_CFP), reg_CODE
250         /* Restore the return pc. */
251         ldw     4(0,reg_CFP), reg_NL0
252         addi    OTHER_POINTER_LOWTAG-3, reg_NL0, reg_NL0
253         add     reg_CODE, reg_NL0, reg_LIP
255         /* Pop the lisp stack frame, and back we go. */
256         copy    reg_CFP, reg_CSP
257         be      0(4,reg_LIP)
258         copy    reg_OCFP, reg_CFP
263  * Stuff to sanctify a block of memory for execution.
264  */
266         .EXPORT sanctify_for_execution
267 sanctify_for_execution: 
268         .proc
269         .callinfo
270         .entry
271         /* %arg0=start addr, %arg1=length in bytes */
272         add     %arg0,%arg1,%arg1
273         ldo     -1(%arg1),%arg1
274         depi    0,31,5,%arg0
275         depi    0,31,5,%arg1
276         ldsid   (%arg0),%r1
277         mtsp    %r1,%sr1
278         ldi     32,%r1                  ; bytes per cache line
279 sanctify_loop:  
280         fdc     0(%sr1,%arg0)
281         comb,<  %arg0,%arg1,sanctify_loop
282         fic,m   %r1(%sr1,%arg0)
284         bv      %r0(%rp)
285         nop
287         .exit
288         .procend
292  * Trampolines.
293  */
295         .EXPORT closure_tramp
296 closure_tramp:  
297         /* reg_FDEFN holds the fdefn object. */
298         ldw     FDEFN_FUN_OFFSET(0,reg_FDEFN),reg_LEXENV
299         ldw     CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_L0
300         addi    SIMPLE_FUN_CODE_OFFSET, reg_L0, reg_LIP
301         bv,n    0(reg_LIP)
303         .EXPORT undefined_tramp
304 undefined_tramp:        
305         break   trap_Error,0
306         .byte   4
307         .byte   UNDEFINED_FUN_ERROR
308         .byte   254
309         .byte   (0x20 + sc_DescriptorReg)
310         .byte   1
311         .align  4
315  * Core saving/restoring support
316  */
318         .export call_on_stack
319 call_on_stack:  
320         /* %arg0 = fn to invoke, %arg1 = new stack base */
322         /* Compute the new stack pointer. */
323         addi    64,%arg1,%sp
325         /* Zero out the previous stack pointer. */
326         stw     %r0,-4(0,%sp)
328         /* Invoke the function. */
329         ble     0(4,%arg0)
330         copy    %r31, %r2
332         /* Flame out. */
333         break   0,0
335         .export save_state
336 save_state:     
337         .proc
338         .callinfo entry_gr=18,entry_fr=21,save_rp,calls
339         .entry
341         stw     %rp,-0x14(%sr0,%sp)
342         fstds,ma        %fr12,8(%sr0,%sp)
343         fstds,ma        %fr13,8(%sr0,%sp)
344         fstds,ma        %fr14,8(%sr0,%sp)
345         fstds,ma        %fr15,8(%sr0,%sp)
346         fstds,ma        %fr16,8(%sr0,%sp)
347         fstds,ma        %fr17,8(%sr0,%sp)
348         fstds,ma        %fr18,8(%sr0,%sp)
349         fstds,ma        %fr19,8(%sr0,%sp)
350         fstds,ma        %fr20,8(%sr0,%sp)
351         fstds,ma        %fr21,8(%sr0,%sp)
352         stwm    %r3,0x70(%sr0,%sp)
353         stw     %r4,-0x6c(%sr0,%sp)
354         stw     %r5,-0x68(%sr0,%sp)
355         stw     %r6,-0x64(%sr0,%sp)
356         stw     %r7,-0x60(%sr0,%sp)
357         stw     %r8,-0x5c(%sr0,%sp)
358         stw     %r9,-0x58(%sr0,%sp)
359         stw     %r10,-0x54(%sr0,%sp)
360         stw     %r11,-0x50(%sr0,%sp)
361         stw     %r12,-0x4c(%sr0,%sp)
362         stw     %r13,-0x48(%sr0,%sp)
363         stw     %r14,-0x44(%sr0,%sp)
364         stw     %r15,-0x40(%sr0,%sp)
365         stw     %r16,-0x3c(%sr0,%sp)
366         stw     %r17,-0x38(%sr0,%sp)
367         stw     %r18,-0x34(%sr0,%sp)
370         /* Remember the function we want to invoke */
371         copy    %arg0,%r19
373         /* Pass the new stack pointer in as %arg0 */
374         copy    %sp,%arg0
376         /* Leave %arg1 as %arg1. */
378         /* do the call. */
379         ble     0(4,%r19)
380         copy    %r31, %r2
382         .export _restore_state
383 _restore_state: 
385         ldw     -0xd4(%sr0,%sp),%rp
386         ldw     -0x34(%sr0,%sp),%r18
387         ldw     -0x38(%sr0,%sp),%r17
388         ldw     -0x3c(%sr0,%sp),%r16
389         ldw     -0x40(%sr0,%sp),%r15
390         ldw     -0x44(%sr0,%sp),%r14
391         ldw     -0x48(%sr0,%sp),%r13
392         ldw     -0x4c(%sr0,%sp),%r12
393         ldw     -0x50(%sr0,%sp),%r11
394         ldw     -0x54(%sr0,%sp),%r10
395         ldw     -0x58(%sr0,%sp),%r9
396         ldw     -0x5c(%sr0,%sp),%r8
397         ldw     -0x60(%sr0,%sp),%r7
398         ldw     -0x64(%sr0,%sp),%r6
399         ldw     -0x68(%sr0,%sp),%r5
400         ldw     -0x6c(%sr0,%sp),%r4
401         ldwm    -0x70(%sr0,%sp),%r3
402         fldds,mb        -8(%sr0,%sp),%fr21
403         fldds,mb        -8(%sr0,%sp),%fr20
404         fldds,mb        -8(%sr0,%sp),%fr19
405         fldds,mb        -8(%sr0,%sp),%fr18
406         fldds,mb        -8(%sr0,%sp),%fr17
407         fldds,mb        -8(%sr0,%sp),%fr16
408         fldds,mb        -8(%sr0,%sp),%fr15
409         fldds,mb        -8(%sr0,%sp),%fr14
410         fldds,mb        -8(%sr0,%sp),%fr13
411         bv      %r0(%rp)
412         fldds,mb        -8(%sr0,%sp),%fr12
415         .exit
416         .procend
418         .export restore_state
419 restore_state:  
420         .proc
421         .callinfo
422         copy    %arg0,%sp
423         b       _restore_state
424         copy    %arg1,%ret0
425         .procend
429         .export SingleStepTraps
430 SingleStepTraps:        
431         break   trap_SingleStepBreakpoint,0
432         break   trap_SingleStepBreakpoint,0
433 /* Missing !! NOT
434         there's a break 0,0 in the new version here!!!
437         .align  8
438         .export fun_end_breakpoint_guts
439 fun_end_breakpoint_guts:        
440         .word   RETURN_PC_HEADER_WIDETAG
441         /* multiple value return point -- just jump to trap. */
442         b,n     fun_end_breakpoint_trap
443         /* single value return point -- convert to multiple w/ n=1 */
444         copy    reg_CSP, reg_OCFP
445         addi    4, reg_CSP, reg_CSP
446         addi    4, %r0, reg_NARGS
447         copy    reg_NULL, reg_A1
448         copy    reg_NULL, reg_A2
449         copy    reg_NULL, reg_A3
450         copy    reg_NULL, reg_A4
451         copy    reg_NULL, reg_A5
453         .export fun_end_breakpoint_trap
454 fun_end_breakpoint_trap:        
455         break   trap_FunEndBreakpoint,0
456         b,n     fun_end_breakpoint_trap
458         .export fun_end_breakpoint_end
459 fun_end_breakpoint_end: