2 #include <alpha/regdef.h>
7 /* #include "globals.h" */
10 * Function to transfer control into lisp.
19 /* Save all the C regs. */
21 stq ra, framesize-8*8(sp)
22 stq s0, framesize-8*7(sp)
23 stq s1, framesize-8*6(sp)
24 stq s2, framesize-8*5(sp)
25 stq s3, framesize-8*4(sp)
26 stq s4, framesize-8*3(sp)
27 stq s5, framesize-8*2(sp)
28 stq s6, framesize-8*1(sp)
29 .mask 0x0fc001fe, -framesize
30 .frame sp,framesize,ra
32 /* Clear descriptor regs */
46 /* The CMUCL comment here is "Start pseudo-atomic.", but */
47 /* there's no obvious code that would have that effect */
49 /* No longer in foreign call. */
50 stl zero,foreign_function_call_active
52 /* Load lisp state. */
53 ldl reg_ALLOC,dynamic_space_free_pointer
54 ldl reg_BSP,current_binding_stack_pointer
55 ldl reg_CSP,current_control_stack_pointer
56 ldl reg_OCFP,current_control_frame_pointer
63 /* End of pseudo-atomic. */
65 /* Establish lisp arguments. */
69 ldl reg_A3,12(reg_CFP)
70 ldl reg_A4,16(reg_CFP)
71 ldl reg_A5,20(reg_CFP)
73 /* This call will 'return' into the LRA page below */
74 lda reg_LRA,call_into_lisp_LRA_page+type_OtherPointer
76 /* Indirect the closure */
77 ldl reg_CODE,CLOSURE_FUNCTION_OFFSET(reg_LEXENV)
78 addl reg_CODE,6*4-type_FunctionPointer,reg_LIP
80 /* And into lisp we go. */
81 jsr reg_ZERO,(reg_LIP)
84 /* a page of the following code (from call_into_lisp_LRA
85 onwards) is copied into the LRA page at arch_init() time. */
89 .globl call_into_lisp_LRA
92 .long type_ReturnPcHeader
94 /* execution resumes here*/
98 /* return value already there */
101 /* Turn on pseudo-atomic. */
103 /* Save LISP registers */
104 stl reg_ALLOC, dynamic_space_free_pointer
105 stl reg_BSP,current_binding_stack_pointer
106 stl reg_CSP,current_control_stack_pointer
107 stl reg_CFP,current_control_frame_pointer
109 /* Back in C land. [CSP is just a handy non-zero value.] */
110 stl reg_CSP,foreign_function_call_active
112 /* Turn off pseudo-atomic and check for traps. */
115 ldq ra, framesize-8*8(sp)
116 ldq s0, framesize-8*7(sp)
117 ldq s1, framesize-8*6(sp)
118 ldq s2, framesize-8*5(sp)
119 ldq s3, framesize-8*4(sp)
120 ldq s4, framesize-8*3(sp)
121 ldq s5, framesize-8*2(sp)
122 ldq s6, framesize-8*1(sp)
124 /* Restore the C stack! */
125 lda sp, framesize(sp)
128 .globl call_into_lisp_end
133 * Transfering control from Lisp into C. reg_CFUNC (t10, 24) contains
134 * the address of the C function to call
142 .mask 0x0fc001fe, -12
144 mov reg_CFP, reg_OCFP
146 addq reg_CFP, 32, reg_CSP
147 stl reg_OCFP, 0(reg_CFP)
148 subl reg_LIP, reg_CODE, reg_L1
149 addl reg_L1, type_OtherPointer, reg_L1
150 stl reg_L1, 4(reg_CFP)
151 stl reg_CODE, 8(reg_CFP)
152 stl reg_NULL, 12(reg_CFP)
154 /* Set the pseudo-atomic flag. */
155 addq reg_ALLOC,1,reg_ALLOC
157 /* Get the top two register args and fix the NSP to point to arg 7 */
158 ldq reg_NL4,0(reg_NSP)
159 ldq reg_NL5,8(reg_NSP)
160 addq reg_NSP,16,reg_NSP
162 /* Save lisp state. */
163 subq reg_ALLOC,1,reg_L1
164 stl reg_L1, dynamic_space_free_pointer
165 stl reg_BSP, current_binding_stack_pointer
166 stl reg_CSP, current_control_stack_pointer
167 stl reg_CFP, current_control_frame_pointer
169 /* Mark us as in C land. */
170 stl reg_CSP, foreign_function_call_active
172 /* Were we interrupted? */
173 subq reg_ALLOC,1,reg_ALLOC
174 stl reg_ZERO,0(reg_ALLOC)
176 /* Into C land we go. */
178 /* L1 is pv (procedure variable). The following line is */
179 /* apparently a jump hint and not mysterious at all */
181 /* <dhd> so, you have perfectly good code with comments written by */
182 /* people who don't understand the Alpha :) */
184 mov reg_CFUNC, reg_L1 /* ### This line is a mystery */
190 subq reg_NSP,16,reg_NSP
192 /* Clear unsaved descriptor regs */
193 mov reg_ZERO, reg_NARGS
205 /* Turn on pseudo-atomic. */
206 lda reg_ALLOC,1(reg_ZERO)
208 /* Mark us at in Lisp land. */
209 stl reg_ZERO, foreign_function_call_active
211 /* Restore ALLOC, preserving pseudo-atomic-atomic */
212 ldl reg_NL0,dynamic_space_free_pointer
213 addq reg_ALLOC,reg_NL0,reg_ALLOC
215 /* Check for interrupt */
216 subq reg_ALLOC,1,reg_ALLOC
217 stl reg_ZERO,0(reg_ALLOC)
219 ldl reg_NULL, 12(reg_CFP)
221 /* Restore LRA & CODE (they may have been GC'ed) */
222 /* can you see anything here which touches LRA? I can't ...*/
223 ldl reg_CODE, 8(reg_CFP)
224 ldl reg_NL0, 4(reg_CFP)
225 subq reg_NL0, type_OtherPointer, reg_NL0
226 addq reg_CODE, reg_NL0, reg_NL0
229 mov reg_OCFP, reg_CFP
231 ret zero, (reg_NL0), 1
236 .globl start_of_tramps
240 * The undefined-function trampoline. Causes a trap_Error trap which
241 * sigtrap_handler catches and eventaully calls the Lisp
242 * INTERNAL-ERROR function
245 .globl undefined_tramp
246 .ent undefined_tramp_offset
247 undefined_tramp = /* ### undefined_tramp_offset-call_into_lisp_LRA*/ 0x140+call_into_lisp_LRA_page
248 undefined_tramp_offset:
251 .byte 4 /* what are these numbers? */
254 .byte (0xe0 + sc_DescriptorReg)
261 * The closure trampoline.
265 .ent closure_tramp_offset
266 closure_tramp = /* ### */ 0x150 + call_into_lisp_LRA_page
267 closure_tramp_offset:
268 ldl reg_LEXENV, FDEFN_FUNCTION_OFFSET(reg_FDEFN)
269 ldl reg_L0, CLOSURE_FUNCTION_OFFSET(reg_LEXENV)
270 addl reg_L0, FUNCTION_CODE_OFFSET, reg_LIP
271 jmp reg_ZERO,(reg_LIP)
280 * Function-end breakpoint magic.
286 .globl function_end_breakpoint_guts
287 function_end_breakpoint_guts:
288 .long type_ReturnPcHeader
289 br zero, function_end_breakpoint_trap
291 mov reg_CSP, reg_OCFP
292 addl reg_CSP, 4, reg_CSP
293 addl zero, 4, reg_NARGS
301 .globl function_end_breakpoint_trap
302 function_end_breakpoint_trap:
304 .long trap_FunctionEndBreakpoint
305 br zero, function_end_breakpoint_trap
307 .globl function_end_breakpoint_end
308 function_end_breakpoint_end: