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