0.8.5.47:
[sbcl.git] / src / runtime / alpha-assem.S
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/simple-fun.h"
24 #include "genesis/static-symbols.h"
25
26 /* #include "globals.h" */
27         
28 /*
29  * Function to transfer control into lisp.
30  */
31         .text
32         .align  4
33         .globl  call_into_lisp
34         .ent    call_into_lisp
35 call_into_lisp:
36 #define framesize 8*8
37         ldgp    gp, 0($27)                  
38         /* Save all the C regs. */
39         lda     sp,-framesize(sp)
40         stq     ra, framesize-8*8(sp)
41         stq     s0, framesize-8*7(sp)
42         stq     s1, framesize-8*6(sp)
43         stq     s2, framesize-8*5(sp)
44         stq     s3, framesize-8*4(sp)
45         stq     s4, framesize-8*3(sp)
46         stq     s5, framesize-8*2(sp)
47         stq     s6, framesize-8*1(sp)
48         .mask   0x0fc001fe, -framesize
49         .frame  sp,framesize,ra
50
51         /* Clear descriptor regs */
52         ldil    reg_CODE,0
53         ldil    reg_FDEFN,0
54         mov     a0,reg_LEXENV
55         sll     a2,2,reg_NARGS
56         ldil    reg_OCFP,0
57         ldil    reg_LRA,0
58         ldil    reg_L0,0
59         ldil    reg_L1,0
60         
61
62         /* Establish NIL. */
63         ldil    reg_NULL,NIL
64
65         /* The CMUCL comment here is "Start pseudo-atomic.", but */
66         /* there's no obvious code that would have that effect  */
67
68         /* No longer in foreign call. */
69         stl     zero,foreign_function_call_active
70
71         /* Load lisp state. */
72         ldq     reg_ALLOC,dynamic_space_free_pointer
73         ldq     reg_BSP,current_binding_stack_pointer
74         ldq     reg_CSP,current_control_stack_pointer
75         ldq     reg_OCFP,current_control_frame_pointer
76         mov     a1,reg_CFP
77
78         .set    noat
79         ldil    reg_L2,0
80         .set at
81
82         /* End of pseudo-atomic. */
83
84         /* Establish lisp arguments. */
85         ldl     reg_A0,0(reg_CFP)
86         ldl     reg_A1,4(reg_CFP)
87         ldl     reg_A2,8(reg_CFP)
88         ldl     reg_A3,12(reg_CFP)
89         ldl     reg_A4,16(reg_CFP)
90         ldl     reg_A5,20(reg_CFP)
91
92         /* This call will 'return' into the LRA page below */
93         lda     reg_LRA,call_into_lisp_LRA_page+OTHER_POINTER_LOWTAG
94
95         /* Indirect the closure */
96         ldl     reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
97         addl    reg_CODE,6*4-FUN_POINTER_LOWTAG, reg_LIP
98
99         /* And into lisp we go. */
100         jsr     reg_ZERO,(reg_LIP)
101
102         
103         /* a page of the following code (from call_into_lisp_LRA
104         onwards) is copied into the LRA page at arch_init() time. */
105         
106         .set noreorder
107         .align  3
108         .globl  call_into_lisp_LRA
109 call_into_lisp_LRA:     
110
111         .long   RETURN_PC_HEADER_WIDETAG
112
113         /* execution resumes here*/
114         mov     reg_OCFP,reg_CSP
115         nop
116
117         /* return value already there */
118         mov     reg_A0,v0
119
120         /* Turn on pseudo-atomic. */
121
122         /* Save LISP registers */
123         stq     reg_ALLOC, dynamic_space_free_pointer 
124         stq     reg_BSP,current_binding_stack_pointer
125         stq     reg_CSP,current_control_stack_pointer
126         stq     reg_CFP,current_control_frame_pointer
127         
128         /* Back in C land.  [CSP is just a handy non-zero value.] */
129         stl     reg_CSP,foreign_function_call_active
130         
131         /* Turn off pseudo-atomic and check for traps. */
132         
133         /* Restore C regs */
134         ldq     ra, framesize-8*8(sp)
135         ldq     s0, framesize-8*7(sp)
136         ldq     s1, framesize-8*6(sp)
137         ldq     s2, framesize-8*5(sp)
138         ldq     s3, framesize-8*4(sp)
139         ldq     s4, framesize-8*3(sp)
140         ldq     s5, framesize-8*2(sp)
141         ldq     s6, framesize-8*1(sp)
142
143         /* Restore the C stack! */
144         lda     sp, framesize(sp)
145
146         ret     zero,(ra),1
147         .globl  call_into_lisp_end
148 call_into_lisp_end:
149         .end    call_into_lisp
150
151 /*
152  * Transfering control from Lisp into C.  reg_CFUNC (t10, 24) contains
153  * the address of the C function to call
154  */
155         .set noreorder
156         .text
157         .align  4
158         .globl  call_into_c
159         .ent    call_into_c
160 call_into_c:
161         .mask   0x0fc001fe, -12
162         .frame  sp,12,ra
163         mov     reg_CFP, reg_OCFP
164         mov     reg_CSP, reg_CFP
165         addq    reg_CFP, 32, reg_CSP
166         stl     reg_OCFP, 0(reg_CFP)
167         subl    reg_LIP, reg_CODE, reg_L1
168         addl    reg_L1, OTHER_POINTER_LOWTAG, reg_L1
169         stl     reg_L1, 4(reg_CFP)
170         stl     reg_CODE, 8(reg_CFP)
171         stl     reg_NULL, 12(reg_CFP)
172
173         /* Set the pseudo-atomic flag. */
174         addq    reg_ALLOC,1,reg_ALLOC
175
176         /* Get the top two register args and fix the NSP to point to arg 7 */
177         ldq     reg_NL4,0(reg_NSP)
178         ldq     reg_NL5,8(reg_NSP)
179         addq    reg_NSP,16,reg_NSP
180
181         /* Save lisp state. */
182         subq    reg_ALLOC,1,reg_L1
183         stq     reg_L1, dynamic_space_free_pointer
184         
185         stq     reg_BSP, current_binding_stack_pointer
186         stq     reg_CSP, current_control_stack_pointer
187         stq     reg_CFP, current_control_frame_pointer
188
189         /* Mark us as in C land. */
190         stl     reg_CSP, foreign_function_call_active
191
192         /* Were we interrupted? */
193         subq    reg_ALLOC,1,reg_ALLOC
194         stl     reg_ZERO,0(reg_ALLOC)
195
196         /* Into C land we go. */
197
198         mov     reg_CFUNC, reg_L1    /* L1=pv: this is a hint to the cache */
199                                   
200         jsr     ra, (reg_CFUNC)
201         ldgp    $29,0(ra)
202
203         /* restore NSP */
204         subq    reg_NSP,16,reg_NSP
205
206         /* Clear unsaved descriptor regs */
207         mov     reg_ZERO, reg_NARGS
208         mov     reg_ZERO, reg_A0
209         mov     reg_ZERO, reg_A1
210         mov     reg_ZERO, reg_A2
211         mov     reg_ZERO, reg_A3
212         mov     reg_ZERO, reg_A4
213         mov     reg_ZERO, reg_A5
214         mov     reg_ZERO, reg_L0
215         .set noat
216         mov     reg_ZERO, reg_L2
217         .set at
218         
219         /* Turn on pseudo-atomic. */
220         lda     reg_ALLOC,1(reg_ZERO)
221
222         /* Mark us at in Lisp land. */
223         stl     reg_ZERO, foreign_function_call_active
224
225         /* Restore ALLOC, preserving pseudo-atomic-atomic */
226         ldq     reg_NL0,dynamic_space_free_pointer
227         addq    reg_ALLOC,reg_NL0,reg_ALLOC
228         
229         /* Check for interrupt */
230         subq    reg_ALLOC,1,reg_ALLOC
231         stl     reg_ZERO,0(reg_ALLOC)
232
233         ldl     reg_NULL, 12(reg_CFP)
234
235         /* Restore LRA & CODE (they may have been GC'ed) */
236         /* can you see anything here which touches LRA?  I can't ...*/
237         ldl     reg_CODE, 8(reg_CFP)
238         ldl     reg_NL0, 4(reg_CFP)
239         subq    reg_NL0, OTHER_POINTER_LOWTAG, reg_NL0
240         addq    reg_CODE, reg_NL0, reg_NL0
241
242         mov     reg_CFP, reg_CSP
243         mov     reg_OCFP, reg_CFP
244
245         ret     zero, (reg_NL0), 1
246
247         .end    call_into_c
248
249         .text
250         .globl  start_of_tramps
251 start_of_tramps:
252
253 /*
254  * The undefined-function trampoline.  Causes a trap_Error trap which
255  * sigtrap_handler catches and eventaully calls the Lisp
256  * INTERNAL-ERROR function
257  */
258         .text
259         .globl  start_of_tramps
260         .globl  closure_tramp
261         .globl  undefined_tramp
262         .globl  closure_tramp_offset
263         .globl  undefined_tramp_offset
264         .ent    undefined_tramp_offset
265 undefined_tramp_offset:
266         /* an explanation is called for here.  0x140 is the difference
267          * between undefined_tramp_offset and call_into_lisp_LRA, but
268          * the assembler is too dumb to allow that as an expression.
269          * So, change this number whenever you add or remove any code
270          * in this file */
271
272 undefined_tramp= call_into_lisp_LRA_page+0x140
273         call_pal PAL_bugchk
274         .long    trap_Error
275         .byte    4                         /* what are these numbers? */
276         .byte    UNDEFINED_FUN_ERROR
277         .byte    254
278         .byte    (0xe0 + sc_DescriptorReg)
279         .byte    2
280         .align 2
281         .end     undefined_tramp_offset
282
283
284 /* The closure trampoline. */
285         .text
286         .globl  closure_tramp
287         .ent    closure_tramp_offset
288 closure_tramp= call_into_lisp_LRA_page+0x150
289 closure_tramp_offset:
290         ldl     reg_LEXENV, FDEFN_FUN_OFFSET(reg_FDEFN)
291         ldl     reg_L0, CLOSURE_FUN_OFFSET(reg_LEXENV)
292         addl    reg_L0, SIMPLE_FUN_CODE_OFFSET, reg_LIP
293         jmp     reg_ZERO,(reg_LIP)
294         .end    closure_tramp_offset
295
296         .text
297         .globl  end_of_tramps
298 end_of_tramps:
299
300
301 /*
302  * fun-end breakpoint magic.
303  */
304
305         .text
306         .align  2
307         .set    noreorder
308         .globl  fun_end_breakpoint_guts
309 fun_end_breakpoint_guts:
310         .long   RETURN_PC_HEADER_WIDETAG
311         br      zero, fun_end_breakpoint_trap
312         nop
313         mov     reg_CSP, reg_OCFP
314         addl    reg_CSP, 4, reg_CSP
315         addl    zero, 4, reg_NARGS
316         mov     reg_NULL, reg_A1
317         mov     reg_NULL, reg_A2
318         mov     reg_NULL, reg_A3
319         mov     reg_NULL, reg_A4
320         mov     reg_NULL, reg_A5
321 1:
322
323         .globl  fun_end_breakpoint_trap
324 fun_end_breakpoint_trap:
325         call_pal PAL_bugchk
326         .long   trap_FunEndBreakpoint
327         br      zero, fun_end_breakpoint_trap
328
329         .globl  fun_end_breakpoint_end
330 fun_end_breakpoint_end:
331