2 * This software is part of the SBCL system. See the README file for
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.
13 #include <alpha/regdef.h>
17 #include <alpha/pal.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" */
30 * Function to transfer control into lisp.
39 /* Save all the C regs. */
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 */
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
83 /* End of pseudo-atomic. */
85 /* Establish lisp arguments. */
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)
104 /* a page of the following code (from call_into_lisp_LRA
105 onwards) is copied into the LRA page at arch_init() time. */
109 .globl call_into_lisp_LRA
112 .long RETURN_PC_HEADER_WIDETAG
114 /* execution resumes here*/
118 /* return value already there */
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
129 /* Back in C land. [CSP is just a handy non-zero value.] */
130 stl reg_CSP,foreign_function_call_active
132 /* Turn off pseudo-atomic and check for traps. */
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)
148 .globl call_into_lisp_end
153 * Transfering control from Lisp into C. reg_CFUNC (t10, 24) contains
154 * the address of the C function to call
162 .mask 0x0fc001fe, -12
164 mov reg_CFP, reg_OCFP
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
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 */
205 subq reg_NSP,16,reg_NSP
207 /* Clear unsaved descriptor regs */
208 mov reg_ZERO, reg_NARGS
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
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
244 mov reg_OCFP, reg_CFP
246 ret zero, (reg_NL0), 1
251 .globl 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
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 */
268 .long NIL /* arglist */
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
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
287 addq reg_CFP,24,reg_CSP
289 1: addq reg_CFP,reg_NARGS,reg_CSP
290 2: stl reg_OCFP,0(reg_CFP)
291 stl reg_LRA,4(reg_CFP)
295 .byte 4 /* what are these numbers? */
296 .byte UNDEFINED_FUN_ERROR
298 .byte (0xc0 + sc_DescriptorReg)
301 .end undefined_tramp_offset
304 /* The closure trampoline. */
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
322 .globl funcallable_instance_tramp
324 .long SIMPLE_FUN_HEADER_WIDETAG
325 funcallable_instance_tramp = . + 1
326 .long funcallable_instance_tramp
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.
345 * For an explanation of the magic involved in function-end
346 * breakpoints, see the implementation in ppc-assem.S.
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
357 mov reg_CSP, reg_OCFP
358 addl reg_CSP, 4, reg_CSP
359 addl zero, 4, reg_NARGS
367 .globl fun_end_breakpoint_trap
368 fun_end_breakpoint_trap:
370 .long trap_FunEndBreakpoint
371 br zero, fun_end_breakpoint_trap
373 .globl fun_end_breakpoint_end
374 fun_end_breakpoint_end: