Unbreak sparc build.
[sbcl.git] / src / runtime / alpha-assem.S
blobe6ad27b88a1f085b3e032729c01f903392609291
1 /*
2  * This software is part of the SBCL system. See the README file for
3  * more information.
4  *
5  * This software is derived from the CMU CL system, which was
6  * written at Carnegie Mellon University and released into the
7  * public domain. The software is in the public domain and is
8  * provided with absolutely no warranty. See the COPYING and CREDITS
9  * files for more information.
10  */
11         
12 #include "validate.h"           
13 #include <alpha/regdef.h>
14 #ifdef linux
15 #include <asm/pal.h> 
16 #else
17 #include <alpha/pal.h>
18 #endif
19 #include "sbcl.h"
20 #include "lispregs.h"
21 #include "genesis/fdefn.h"
22 #include "genesis/closure.h"
23 #include "genesis/funcallable-instance.h"
24 #include "genesis/simple-fun.h"
25 #include "genesis/static-symbols.h"
27 /* #include "globals.h" */
28         
30  * Function to transfer control into lisp.
31  */
32         .text
33         .align  4
34         .globl  call_into_lisp
35         .ent    call_into_lisp
36 call_into_lisp:
37 #define framesize 8*8
38         ldgp    gp, 0($27)                  
39         /* Save all the C regs. */
40         lda     sp,-framesize(sp)
41         stq     ra, framesize-8*8(sp)
42         stq     s0, framesize-8*7(sp)
43         stq     s1, framesize-8*6(sp)
44         stq     s2, framesize-8*5(sp)
45         stq     s3, framesize-8*4(sp)
46         stq     s4, framesize-8*3(sp)
47         stq     s5, framesize-8*2(sp)
48         stq     s6, framesize-8*1(sp)
49         .mask   0x0fc001fe, -framesize
50         .frame  sp,framesize,ra
52         /* Clear descriptor regs */
53         ldil    reg_CODE,0
54         ldil    reg_FDEFN,0
55         mov     a0,reg_LEXENV
56         sll     a2,2,reg_NARGS
57         ldil    reg_OCFP,0
58         ldil    reg_LRA,0
59         ldil    reg_L0,0
60         ldil    reg_L1,0
61         
63         /* Establish NIL. */
64         ldil    reg_NULL,NIL
66         /* The CMUCL comment here is "Start pseudo-atomic.", but */
67         /* there's no obvious code that would have that effect  */
69         /* No longer in foreign call. */
70         stl     zero,foreign_function_call_active
72         /* Load lisp state. */
73         ldq     reg_ALLOC,dynamic_space_free_pointer
74         ldq     reg_BSP,current_binding_stack_pointer
75         ldq     reg_CSP,current_control_stack_pointer
76         ldq     reg_OCFP,current_control_frame_pointer
77         mov     a1,reg_CFP
79         .set    noat
80         ldil    reg_L2,0
81         .set at
83         /* End of pseudo-atomic. */
85         /* Establish lisp arguments. */
86         ldl     reg_A0,0(reg_CFP)
87         ldl     reg_A1,4(reg_CFP)
88         ldl     reg_A2,8(reg_CFP)
89         ldl     reg_A3,12(reg_CFP)
90         ldl     reg_A4,16(reg_CFP)
91         ldl     reg_A5,20(reg_CFP)
93         /* This call will 'return' into the LRA page below */
94         lda     reg_LRA,call_into_lisp_LRA_page+OTHER_POINTER_LOWTAG
96         /* Indirect the closure */
97         ldl     reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
98         addl    reg_CODE, SIMPLE_FUN_CODE_OFFSET, reg_LIP
100         /* And into lisp we go. */
101         jsr     reg_ZERO,(reg_LIP)
103         
104         /* a page of the following code (from call_into_lisp_LRA
105         onwards) is copied into the LRA page at arch_init() time. */
106         
107         .set noreorder
108         .align  3
109         .globl  call_into_lisp_LRA
110 call_into_lisp_LRA:     
112         .long   RETURN_PC_HEADER_WIDETAG
114         /* execution resumes here*/
115         mov     reg_OCFP,reg_CSP
116         nop
118         /* return value already there */
119         mov     reg_A0,v0
121         /* Turn on pseudo-atomic. */
123         /* Save LISP registers */
124         stq     reg_ALLOC, dynamic_space_free_pointer 
125         stq     reg_BSP,current_binding_stack_pointer
126         stq     reg_CSP,current_control_stack_pointer
127         stq     reg_CFP,current_control_frame_pointer
128         
129         /* Back in C land.  [CSP is just a handy non-zero value.] */
130         stl     reg_CSP,foreign_function_call_active
131         
132         /* Turn off pseudo-atomic and check for traps. */
133         
134         /* Restore C regs */
135         ldq     ra, framesize-8*8(sp)
136         ldq     s0, framesize-8*7(sp)
137         ldq     s1, framesize-8*6(sp)
138         ldq     s2, framesize-8*5(sp)
139         ldq     s3, framesize-8*4(sp)
140         ldq     s4, framesize-8*3(sp)
141         ldq     s5, framesize-8*2(sp)
142         ldq     s6, framesize-8*1(sp)
144         /* Restore the C stack! */
145         lda     sp, framesize(sp)
147         ret     zero,(ra),1
148         .globl  call_into_lisp_end
149 call_into_lisp_end:
150         .end    call_into_lisp
153  * Transfering control from Lisp into C.  reg_CFUNC (t10, 24) contains
154  * the address of the C function to call
155  */
156         .set noreorder
157         .text
158         .align  4
159         .globl  call_into_c
160         .ent    call_into_c
161 call_into_c:
162         .mask   0x0fc001fe, -12
163         .frame  sp,12,ra
164         mov     reg_CFP, reg_OCFP
165         mov     reg_CSP, reg_CFP
166         addq    reg_CFP, 32, reg_CSP
167         stl     reg_OCFP, 0(reg_CFP)
168         subl    reg_LIP, reg_CODE, reg_L1
169         addl    reg_L1, OTHER_POINTER_LOWTAG, reg_L1
170         stl     reg_L1, 4(reg_CFP)
171         stl     reg_CODE, 8(reg_CFP)
172         stl     reg_NULL, 12(reg_CFP)
174         /* Set the pseudo-atomic flag. */
175         addq    reg_ALLOC,1,reg_ALLOC
177         /* Get the top two register args and fix the NSP to point to arg 7 */
178         ldq     reg_NL4,0(reg_NSP)
179         ldq     reg_NL5,8(reg_NSP)
180         addq    reg_NSP,16,reg_NSP
182         /* Save lisp state. */
183         subq    reg_ALLOC,1,reg_L1
184         stq     reg_L1, dynamic_space_free_pointer
185         
186         stq     reg_BSP, current_binding_stack_pointer
187         stq     reg_CSP, current_control_stack_pointer
188         stq     reg_CFP, current_control_frame_pointer
190         /* Mark us as in C land. */
191         stl     reg_CSP, foreign_function_call_active
193         /* Were we interrupted? */
194         subq    reg_ALLOC,1,reg_ALLOC
195         stl     reg_ZERO,0(reg_ALLOC)
197         /* Into C land we go. */
199         mov     reg_CFUNC, reg_L1    /* L1=pv: this is a hint to the cache */
200                                   
201         jsr     ra, (reg_CFUNC)
202         ldgp    $29,0(ra)
204         /* restore NSP */
205         subq    reg_NSP,16,reg_NSP
207         /* Clear unsaved descriptor regs */
208         mov     reg_ZERO, reg_NARGS
209         mov     reg_ZERO, reg_A0
210         mov     reg_ZERO, reg_A1
211         mov     reg_ZERO, reg_A2
212         mov     reg_ZERO, reg_A3
213         mov     reg_ZERO, reg_A4
214         mov     reg_ZERO, reg_A5
215         mov     reg_ZERO, reg_L0
216         .set noat
217         mov     reg_ZERO, reg_L2
218         .set at
219         
220         /* Turn on pseudo-atomic. */
221         lda     reg_ALLOC,1(reg_ZERO)
223         /* Mark us at in Lisp land. */
224         stl     reg_ZERO, foreign_function_call_active
226         /* Restore ALLOC, preserving pseudo-atomic-atomic */
227         ldq     reg_NL0,dynamic_space_free_pointer
228         addq    reg_ALLOC,reg_NL0,reg_ALLOC
229         
230         /* Check for interrupt */
231         subq    reg_ALLOC,1,reg_ALLOC
232         stl     reg_ZERO,0(reg_ALLOC)
234         ldl     reg_NULL, 12(reg_CFP)
236         /* Restore LRA & CODE (they may have been GC'ed) */
237         /* can you see anything here which touches LRA?  I can't ...*/
238         ldl     reg_CODE, 8(reg_CFP)
239         ldl     reg_NL0, 4(reg_CFP)
240         subq    reg_NL0, OTHER_POINTER_LOWTAG, reg_NL0
241         addq    reg_CODE, reg_NL0, reg_NL0
243         mov     reg_CFP, reg_CSP
244         mov     reg_OCFP, reg_CFP
246         ret     zero, (reg_NL0), 1
248         .end    call_into_c
250         .text
251         .globl  start_of_tramps
252 start_of_tramps:
255  * The undefined-function trampoline.  Causes a trap_Error trap which
256  * sigtrap_handler catches and eventaully calls the Lisp
257  * INTERNAL-ERROR function
258  */
259         .text
260         .globl  start_of_tramps
261         .globl  undefined_tramp
262         .globl  undefined_tramp_offset
263         .ent    undefined_tramp_offset
264         .long   SIMPLE_FUN_HEADER_WIDETAG                       /* header */
265         .long   undefined_tramp - SIMPLE_FUN_CODE_OFFSET        /* self */
266         .long   NIL                                             /* next */
267         .long   NIL                                             /* name */
268         .long   NIL                                             /* arglist */
269         .long   NIL                                             /* type */
270         .long   NIL                                             /* xref */
271 undefined_tramp_offset:
272         /* an explanation is called for here.  0x140 is the difference
273          * between undefined_tramp_offset and call_into_lisp_LRA, but
274          * the assembler is too dumb to allow that as an expression.
275          * So, change this number whenever you add or remove any code
276          * in this file */
278 undefined_tramp= call_into_lisp_LRA_page+0x15c
279         subl    reg_LIP, SIMPLE_FUN_CODE_OFFSET, reg_CODE
281         /* If we are called with stack arguments (or in a tail-call
282            scenario), we end up with an allocated stack frame, but the
283            frame link information is uninitialized.  Fix things by
284            allocating and initializing our stack frame "properly". */
285         cmpule  reg_NARGS,24,reg_NL0
286         beq     reg_NL0,1f
287         addq    reg_CFP,24,reg_CSP
288         br      reg_ZERO,2f
289 1:      addq    reg_CFP,reg_NARGS,reg_CSP
290 2:      stl     reg_OCFP,0(reg_CFP)
291         stl     reg_LRA,4(reg_CFP)
293         call_pal PAL_bugchk
294         .long    trap_Error
295         .byte    4                         /* what are these numbers? */
296         .byte    UNDEFINED_FUN_ERROR
297         .byte    254
298         .byte    (0xc0 + sc_DescriptorReg)
299         .byte    5
300         .align 2
301         .end     undefined_tramp_offset
304 /* The closure trampoline. */
305         .text
306         .globl  closure_tramp
307         .globl  closure_tramp_offset
308         .ent    closure_tramp_offset
309 closure_tramp_offset:
310 closure_tramp= call_into_lisp_LRA_page+0x18c
311         ldl     reg_LEXENV, FDEFN_FUN_OFFSET(reg_FDEFN)
312         ldl     reg_L0, CLOSURE_FUN_OFFSET(reg_LEXENV)
313         addl    reg_L0, SIMPLE_FUN_CODE_OFFSET, reg_LIP
314         jmp     reg_ZERO,(reg_LIP)
315         .end    closure_tramp_offset
317         .text
318         .globl  end_of_tramps
319 end_of_tramps:
321         .text
322         .globl funcallable_instance_tramp
323         .align 2
324         .long SIMPLE_FUN_HEADER_WIDETAG
325 funcallable_instance_tramp = . + 1
326         .long funcallable_instance_tramp
327         .long NIL
328         .long NIL
329         .long NIL
330         .long NIL
331         .long NIL
333         ldl reg_LEXENV, FUNCALLABLE_INSTANCE_FUNCTION_OFFSET(reg_LEXENV)
334         /* I think we don't actually need to use reg_CODE here, because
335            $CODE is computed from $LIP in the function itself */
336         ldl reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV) 
337         addl reg_CODE, SIMPLE_FUN_CODE_OFFSET, reg_LIP
338         jmp reg_ZERO, (reg_LIP)
341  * fun-end breakpoint magic.
342  */
345  * For an explanation of the magic involved in function-end
346  * breakpoints, see the implementation in ppc-assem.S.
347  */
349         .text
350         .align  2
351         .set    noreorder
352         .globl  fun_end_breakpoint_guts
353 fun_end_breakpoint_guts:
354         .long   RETURN_PC_HEADER_WIDETAG + 0x600
355         br      zero, fun_end_breakpoint_trap
356         nop
357         mov     reg_CSP, reg_OCFP
358         addl    reg_CSP, 4, reg_CSP
359         addl    zero, 4, reg_NARGS
360         mov     reg_NULL, reg_A1
361         mov     reg_NULL, reg_A2
362         mov     reg_NULL, reg_A3
363         mov     reg_NULL, reg_A4
364         mov     reg_NULL, reg_A5
367         .globl  fun_end_breakpoint_trap
368 fun_end_breakpoint_trap:
369         call_pal PAL_bugchk
370         .long   trap_FunEndBreakpoint
371         br      zero, fun_end_breakpoint_trap
373         .globl  fun_end_breakpoint_end
374 fun_end_breakpoint_end: