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>
18 /* #include "globals.h" */
21 * Function to transfer control into lisp.
30 /* Save all the C regs. */
32 stq ra, framesize-8*8(sp)
33 stq s0, framesize-8*7(sp)
34 stq s1, framesize-8*6(sp)
35 stq s2, framesize-8*5(sp)
36 stq s3, framesize-8*4(sp)
37 stq s4, framesize-8*3(sp)
38 stq s5, framesize-8*2(sp)
39 stq s6, framesize-8*1(sp)
40 .mask 0x0fc001fe, -framesize
41 .frame sp,framesize,ra
43 /* Clear descriptor regs */
57 /* The CMUCL comment here is "Start pseudo-atomic.", but */
58 /* there's no obvious code that would have that effect */
60 /* No longer in foreign call. */
61 stl zero,foreign_function_call_active
63 /* Load lisp state. */
64 ldl reg_ALLOC,dynamic_space_free_pointer
65 ldl reg_BSP,current_binding_stack_pointer
66 ldl reg_CSP,current_control_stack_pointer
67 ldl reg_OCFP,current_control_frame_pointer
74 /* End of pseudo-atomic. */
76 /* Establish lisp arguments. */
80 ldl reg_A3,12(reg_CFP)
81 ldl reg_A4,16(reg_CFP)
82 ldl reg_A5,20(reg_CFP)
84 /* This call will 'return' into the LRA page below */
85 lda reg_LRA,call_into_lisp_LRA_page+OTHER_POINTER_LOWTAG
87 /* Indirect the closure */
88 ldl reg_CODE, CLOSURE_FUN_OFFSET(reg_LEXENV)
89 addl reg_CODE,6*4-FUN_POINTER_LOWTAG, reg_LIP
91 /* And into lisp we go. */
92 jsr reg_ZERO,(reg_LIP)
95 /* a page of the following code (from call_into_lisp_LRA
96 onwards) is copied into the LRA page at arch_init() time. */
100 .globl call_into_lisp_LRA
103 .long RETURN_PC_HEADER_WIDETAG
105 /* execution resumes here*/
109 /* return value already there */
112 /* Turn on pseudo-atomic. */
114 /* Save LISP registers */
115 stl reg_ALLOC, dynamic_space_free_pointer
116 stl reg_BSP,current_binding_stack_pointer
117 stl reg_CSP,current_control_stack_pointer
118 stl reg_CFP,current_control_frame_pointer
120 /* Back in C land. [CSP is just a handy non-zero value.] */
121 stl reg_CSP,foreign_function_call_active
123 /* Turn off pseudo-atomic and check for traps. */
126 ldq ra, framesize-8*8(sp)
127 ldq s0, framesize-8*7(sp)
128 ldq s1, framesize-8*6(sp)
129 ldq s2, framesize-8*5(sp)
130 ldq s3, framesize-8*4(sp)
131 ldq s4, framesize-8*3(sp)
132 ldq s5, framesize-8*2(sp)
133 ldq s6, framesize-8*1(sp)
135 /* Restore the C stack! */
136 lda sp, framesize(sp)
139 .globl call_into_lisp_end
144 * Transfering control from Lisp into C. reg_CFUNC (t10, 24) contains
145 * the address of the C function to call
153 .mask 0x0fc001fe, -12
155 mov reg_CFP, reg_OCFP
157 addq reg_CFP, 32, reg_CSP
158 stl reg_OCFP, 0(reg_CFP)
159 subl reg_LIP, reg_CODE, reg_L1
160 addl reg_L1, OTHER_POINTER_LOWTAG, reg_L1
161 stl reg_L1, 4(reg_CFP)
162 stl reg_CODE, 8(reg_CFP)
163 stl reg_NULL, 12(reg_CFP)
165 /* Set the pseudo-atomic flag. */
166 addq reg_ALLOC,1,reg_ALLOC
168 /* Get the top two register args and fix the NSP to point to arg 7 */
169 ldq reg_NL4,0(reg_NSP)
170 ldq reg_NL5,8(reg_NSP)
171 addq reg_NSP,16,reg_NSP
173 /* Save lisp state. */
174 subq reg_ALLOC,1,reg_L1
175 stl reg_L1, dynamic_space_free_pointer
176 stl reg_BSP, current_binding_stack_pointer
177 stl reg_CSP, current_control_stack_pointer
178 stl reg_CFP, current_control_frame_pointer
180 /* Mark us as in C land. */
181 stl reg_CSP, foreign_function_call_active
183 /* Were we interrupted? */
184 subq reg_ALLOC,1,reg_ALLOC
185 stl reg_ZERO,0(reg_ALLOC)
187 /* Into C land we go. */
189 /* L1 is pv (procedure variable). The following line is */
190 /* apparently a jump hint and not mysterious at all */
192 /* <dhd> so, you have perfectly good code with comments written by */
193 /* people who don't understand the Alpha :) */
195 mov reg_CFUNC, reg_L1 /* ### This line is a mystery */
201 subq reg_NSP,16,reg_NSP
203 /* Clear unsaved descriptor regs */
204 mov reg_ZERO, reg_NARGS
216 /* Turn on pseudo-atomic. */
217 lda reg_ALLOC,1(reg_ZERO)
219 /* Mark us at in Lisp land. */
220 stl reg_ZERO, foreign_function_call_active
222 /* Restore ALLOC, preserving pseudo-atomic-atomic */
223 ldl reg_NL0,dynamic_space_free_pointer
224 addq reg_ALLOC,reg_NL0,reg_ALLOC
226 /* Check for interrupt */
227 subq reg_ALLOC,1,reg_ALLOC
228 stl reg_ZERO,0(reg_ALLOC)
230 ldl reg_NULL, 12(reg_CFP)
232 /* Restore LRA & CODE (they may have been GC'ed) */
233 /* can you see anything here which touches LRA? I can't ...*/
234 ldl reg_CODE, 8(reg_CFP)
235 ldl reg_NL0, 4(reg_CFP)
236 subq reg_NL0, OTHER_POINTER_LOWTAG, reg_NL0
237 addq reg_CODE, reg_NL0, reg_NL0
240 mov reg_OCFP, reg_CFP
242 ret zero, (reg_NL0), 1
247 .globl start_of_tramps
251 * The undefined-function trampoline. Causes a trap_Error trap which
252 * sigtrap_handler catches and eventaully calls the Lisp
253 * INTERNAL-ERROR function
256 .globl undefined_tramp
257 .ent undefined_tramp_offset
258 undefined_tramp = /* ### undefined_tramp_offset-call_into_lisp_LRA*/ 0x140+call_into_lisp_LRA_page
259 undefined_tramp_offset:
262 .byte 4 /* what are these numbers? */
263 .byte UNDEFINED_FUN_ERROR
265 .byte (0xe0 + sc_DescriptorReg)
272 * The closure trampoline.
276 .ent closure_tramp_offset
277 closure_tramp = /* ### */ 0x150 + call_into_lisp_LRA_page
278 closure_tramp_offset:
279 ldl reg_LEXENV, FDEFN_FUN_OFFSET(reg_FDEFN)
280 ldl reg_L0, CLOSURE_FUN_OFFSET(reg_LEXENV)
281 addl reg_L0, SIMPLE_FUN_CODE_OFFSET, reg_LIP
282 jmp reg_ZERO,(reg_LIP)
291 * fun-end breakpoint magic.
297 .globl fun_end_breakpoint_guts
298 fun_end_breakpoint_guts:
299 .long RETURN_PC_HEADER_WIDETAG
300 br zero, fun_end_breakpoint_trap
302 mov reg_CSP, reg_OCFP
303 addl reg_CSP, 4, reg_CSP
304 addl zero, 4, reg_NARGS
312 .globl fun_end_breakpoint_trap
313 fun_end_breakpoint_trap:
315 .long trap_FunEndBreakpoint
316 br zero, fun_end_breakpoint_trap
318 .globl fun_end_breakpoint_end
319 fun_end_breakpoint_end: