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 "globals.h" */
24 * Function to transfer control into lisp.
33 /* Save all the C regs. */
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
46 /* Clear descriptor regs */
60 /* The CMUCL comment here is "Start pseudo-atomic.", but */
61 /* there's no obvious code that would have that effect */
63 /* No longer in foreign call. */
64 stl zero,foreign_function_call_active
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
77 /* End of pseudo-atomic. */
79 /* Establish lisp arguments. */
83 ldl reg_A3,12(reg_CFP)
84 ldl reg_A4,16(reg_CFP)
85 ldl reg_A5,20(reg_CFP)
87 /* This call will 'return' into the LRA page below */
88 lda reg_LRA,call_into_lisp_LRA_page+OTHER_POINTER_LOWTAG
90 /* Indirect the closure */
91 ldl reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
92 addl reg_CODE,6*4-FUN_POINTER_LOWTAG, reg_LIP
94 /* And into lisp we go. */
95 jsr reg_ZERO,(reg_LIP)
98 /* a page of the following code (from call_into_lisp_LRA
99 onwards) is copied into the LRA page at arch_init() time. */
103 .globl call_into_lisp_LRA
106 .long RETURN_PC_HEADER_WIDETAG
108 /* execution resumes here*/
112 /* return value already there */
115 /* Turn on pseudo-atomic. */
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
123 /* Back in C land. [CSP is just a handy non-zero value.] */
124 stl reg_CSP,foreign_function_call_active
126 /* Turn off pseudo-atomic and check for traps. */
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)
138 /* Restore the C stack! */
139 lda sp, framesize(sp)
142 .globl call_into_lisp_end
147 * Transfering control from Lisp into C. reg_CFUNC (t10, 24) contains
148 * the address of the C function to call
156 .mask 0x0fc001fe, -12
158 mov reg_CFP, reg_OCFP
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)
168 /* Set the pseudo-atomic flag. */
169 addq reg_ALLOC,1,reg_ALLOC
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
176 /* Save lisp state. */
177 subq reg_ALLOC,1,reg_L1
178 stq reg_L1, dynamic_space_free_pointer
180 stq reg_BSP, current_binding_stack_pointer
181 stq reg_CSP, current_control_stack_pointer
182 stq reg_CFP, current_control_frame_pointer
184 /* Mark us as in C land. */
185 stl reg_CSP, foreign_function_call_active
187 /* Were we interrupted? */
188 subq reg_ALLOC,1,reg_ALLOC
189 stl reg_ZERO,0(reg_ALLOC)
191 /* Into C land we go. */
193 mov reg_CFUNC, reg_L1 /* L1=pv: this is a hint to the cache */
199 subq reg_NSP,16,reg_NSP
201 /* Clear unsaved descriptor regs */
202 mov reg_ZERO, reg_NARGS
214 /* Turn on pseudo-atomic. */
215 lda reg_ALLOC,1(reg_ZERO)
217 /* Mark us at in Lisp land. */
218 stl reg_ZERO, foreign_function_call_active
220 /* Restore ALLOC, preserving pseudo-atomic-atomic */
221 ldq reg_NL0,dynamic_space_free_pointer
222 addq reg_ALLOC,reg_NL0,reg_ALLOC
224 /* Check for interrupt */
225 subq reg_ALLOC,1,reg_ALLOC
226 stl reg_ZERO,0(reg_ALLOC)
228 ldl reg_NULL, 12(reg_CFP)
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
238 mov reg_OCFP, reg_CFP
240 ret zero, (reg_NL0), 1
245 .globl start_of_tramps
249 * The undefined-function trampoline. Causes a trap_Error trap which
250 * sigtrap_handler catches and eventaully calls the Lisp
251 * INTERNAL-ERROR function
254 .globl start_of_tramps
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
267 undefined_tramp= call_into_lisp_LRA_page+0x140
270 .byte 4 /* what are these numbers? */
271 .byte UNDEFINED_FUN_ERROR
273 .byte (0xe0 + sc_DescriptorReg)
276 .end undefined_tramp_offset
279 /* The closure trampoline. */
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
297 * fun-end breakpoint magic.
303 .globl fun_end_breakpoint_guts
304 fun_end_breakpoint_guts:
305 .long RETURN_PC_HEADER_WIDETAG
306 br zero, fun_end_breakpoint_trap
308 mov reg_CSP, reg_OCFP
309 addl reg_CSP, 4, reg_CSP
310 addl zero, 4, reg_NARGS
318 .globl fun_end_breakpoint_trap
319 fun_end_breakpoint_trap:
321 .long trap_FunEndBreakpoint
322 br zero, fun_end_breakpoint_trap
324 .globl fun_end_breakpoint_end
325 fun_end_breakpoint_end: