1 #define LANGUAGE_ASSEMBLY
7 #include "genesis/closure.h"
8 #include "genesis/funcallable-instance.h"
9 #include "genesis/fdefn.h"
10 #include "genesis/static-symbols.h"
11 #include "genesis/simple-fun.h"
12 #include "genesis/symbol.h"
14 #define STATIC_SYMBOL_VALUE(sym) [reg_NULL, #(((sym)-NIL)+SYMBOL_VALUE_OFFSET)]
17 .global call_into_lisp
18 .type call_into_lisp, %function
21 @@ At this point, we have:
23 @@ R1 - pointer to args
24 @@ R2 - number of args (unboxed)
25 @@ There will be no more than three args, so we don't need to
26 @@ worry about parameters to be passed on the stack.
28 @@ All registers other than R0-R3 and R12 are callee-saves.
29 @@ Save R3 to get 8-byte alignemnt.
30 stmfd sp!, {r3-r11, lr}
33 @@ Start by finding NIL.
34 ldr reg_NULL, .known_nil
37 mov reg_NARGS, r2, lsl #2
39 @@ Move args pointer out of the way of the args to be loaded.
42 @@ Move the function to its passing location.
45 @@ Clear the boxed registers that don't already have something
50 @@ Find the lisp stack and frame pointers. We're allocating a
51 @@ new lisp stack frame, so load the stack pointer into CFP.
52 @@ And we need the frame pointer, but OCFP is in use, so use
54 ldr reg_NFP, .frame_pointer_address
55 ldr reg_CFP, .stack_pointer_address
56 ldr reg_NFP, [reg_NFP]
57 ldr reg_CFP, [reg_CFP]
59 @@ Enter PSEUDO-ATOMIC.
60 str pc, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_ATOMIC)
62 #ifndef LISP_FEATURE_GENCGC
63 @@ Copy the current allocation pointer into the symbol.
64 ldr reg_OCFP, =dynamic_space_free_pointer
65 ldr reg_OCFP, [reg_OCFP]
66 str reg_OCFP, STATIC_SYMBOL_VALUE(ALLOCATION_POINTER)
69 @@ Clear FFCA, so the runtime knows that we're "in lisp".
70 ldr reg_OCFP, =foreign_function_call_active
71 str reg_R2, [reg_OCFP]
73 @@ We need to set up the lisp stack pointer and the basics of
74 @@ our stack frame while we're still in P-A. Any sooner and
75 @@ our stack frame can be clobbered by a stray interrupt, any
76 @@ later and we can end up with a half-configured stack frame
77 @@ when we catch a stray interrupt.
79 @@ Allocate our frame and set up the Lisp stack pointer
80 add reg_OCFP, reg_CFP, #8
81 str reg_OCFP, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
83 @@ Set up the "frame link"
84 str reg_NFP, [reg_OCFP, #-8]
86 @@ Set up the return address
88 str reg_NL3, [reg_OCFP, #-4]
90 @@ Leave PSEUDO-ATOMIC and check for interrupts.
91 str reg_NULL, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_ATOMIC)
92 ldr reg_OCFP, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_INTERRUPTED)
96 @@ Load our function args. Cleverness abounds!
97 rsb reg_NL3, reg_NARGS, #8
99 ldr reg_R2, [reg_R8, #8]
100 ldr reg_R1, [reg_R8, #4]
103 @@ Load the closure-fun (or simple-fun-self), in case we're
104 @@ trying to call a closure.
105 ldr reg_CODE, [reg_LEXENV, #CLOSURE_FUN_OFFSET]
107 @@ And, finally, call into Lisp!
108 add reg_PC, reg_CODE, #SIMPLE_FUN_CODE_OFFSET
111 .equ .lra, .+OTHER_POINTER_LOWTAG
112 .word RETURN_PC_HEADER_WIDETAG
114 @@ Correct stack pointer for return processing.
115 streq reg_OCFP, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
117 @@ Enter PSEUDO-ATOMIC.
118 str pc, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_ATOMIC)
120 @@ Save the lisp stack and frame pointers.
121 ldr reg_NFP, .frame_pointer_address
122 str reg_CFP, [reg_NFP]
123 ldr reg_NFP, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
124 ldr reg_OCFP, .stack_pointer_address
125 str reg_NFP, [reg_OCFP]
127 @@ Set FFCA, so the runtime knows that we're not "in lisp".
128 ldr reg_OCFP, =foreign_function_call_active
131 #ifndef LISP_FEATURE_GENCGC
132 @@ Copy the current allocation pointer out from the symbol.
133 ldr reg_OCFP, =dynamic_space_free_pointer
134 ldr reg_NFP, STATIC_SYMBOL_VALUE(ALLOCATION_POINTER)
135 str reg_NFP, [reg_OCFP]
138 @@ Leave PSEUDO-ATOMIC and check for interrupts.
139 str reg_NULL, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_ATOMIC)
140 ldr reg_OCFP, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_INTERRUPTED)
144 @@ Restore saved registers.
145 fldmfdd sp!, {d8-d15}
146 ldmfd sp!, {r3-r11, lr}
148 .size call_into_lisp, .-call_into_lisp
149 .frame_pointer_address: .word current_control_frame_pointer
150 .stack_pointer_address: .word current_control_stack_pointer
155 .type call_into_c, %function
157 @@ At this point, we have:
158 @@ R8 -- C function to call. This routine doesn't support
159 @@ thumb interworking, but linkage-table does, so we
161 @@ LR -- Return address within the code component.
162 @@ OCFP -- First C register argument.
163 @@ NARGS -- Second C register argument.
164 @@ NL2 -- Third C register argument.
165 @@ NL3 -- Fourth C register argument.
166 @@ All other C arguments are already stashed on the C stack.
168 @@ We need to convert our return address to a GC-safe format,
169 @@ build a stack frame to count for the "foreign" frame,
170 @@ switch to C mode, move the register arguments to the
171 @@ correct locations, call the C function, move the result to
172 @@ the correct location, switch back to Lisp mode, tear down
173 @@ our stack frame, restore the return address, and return to
176 @@ We have ONE unboxed scratch register: NFP. Use it as a
177 @@ temporary while we convert the (unboxed) return address to
178 @@ a (fixnum) offset within the component.
179 sub reg_NFP, reg_LR, reg_CODE
180 add reg_NFP, reg_NFP, #OTHER_POINTER_LOWTAG
182 @@ Build a Lisp stack frame. We need to stash our frame link,
183 @@ the code component, and our return offset. Frame link goes
184 @@ in slot 0 (OCFP-SAVE-OFFSET), the offset (a FIXNUM) goes in
185 @@ slot 1 (LRA-SAVE-OFFSET), and reg_CODE goes in slot 2. The
186 @@ debugger knows about this layout (see COMPUTE-CALLING-FRAME
187 @@ in SYS:SRC;CODE;DEBUG-INT.LISP). The stack is aligned, so
188 @@ we can use R0 (a boxed register) as our temporary.
189 ldr reg_R0, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
190 add reg_R0, reg_R0, #12
191 str reg_R0, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
192 str reg_CFP, [reg_R0, #-12]
193 str reg_NFP, [reg_R0, #-8]
194 str reg_CODE, [reg_R0, #-4]
196 @@ Enter PSEUDO-ATOMIC.
197 str pc, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_ATOMIC)
199 @@ Save the lisp stack and frame pointers.
200 ldr reg_NFP, .stack_pointer_address
201 str reg_R0, [reg_NFP]
202 sub reg_R0, reg_R0, #12
203 ldr reg_NFP, .frame_pointer_address
204 str reg_R0, [reg_NFP]
206 @@ We're done with R0, and we need to use OCFP when leaving
207 @@ pseudo-atomic, so move the first of the C register
208 @@ arguments to its final resting place now.
211 @@ Set FFCA, so the runtime knows that we're not "in lisp".
212 ldr reg_NFP, =foreign_function_call_active
215 #ifndef LISP_FEATURE_GENCGC
216 @@ Copy the current allocation pointer out from the symbol.
217 ldr reg_OCFP, =dynamic_space_free_pointer
218 ldr reg_NFP, STATIC_SYMBOL_VALUE(ALLOCATION_POINTER)
219 str reg_NFP, [reg_OCFP]
222 @@ Leave PSEUDO-ATOMIC and check for interrupts.
223 str reg_NULL, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_ATOMIC)
224 ldr reg_OCFP, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_INTERRUPTED)
228 @@ Now that we're in C mode, move the remaining register args
234 @@ And call the C function. We don't support interworking
235 @@ here because we have to be able to pass the function
236 @@ pointer in a boxed register, but the linkage-table is quite
237 @@ capable of doing a tail-call to a Thumb routine.
239 @@ R8 is important for undefined_alien_function.
242 @@ We're back. Our main tasks are to move the C return value
243 @@ to where Lisp expects it, and to re-establish the Lisp
246 @@ Stash the return value into NARGS for Lisp.
248 @@ For returning long-long, and doubles with softfp.
252 ldr reg_NULL, .known_nil
254 @@ Blank the boxed registers.
262 @@ Enter PSEUDO-ATOMIC.
263 str pc, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_ATOMIC)
265 @@ Clear FFCA, so the runtime knows that we're "in lisp".
266 ldr reg_OCFP, =foreign_function_call_active
267 str reg_R2, [reg_OCFP]
269 #ifndef LISP_FEATURE_GENCGC
270 @@ Copy the current allocation pointer into the symbol.
271 ldr reg_OCFP, =dynamic_space_free_pointer
272 ldr reg_OCFP, [reg_OCFP]
273 str reg_OCFP, STATIC_SYMBOL_VALUE(ALLOCATION_POINTER)
276 @@ Restore the Lisp stack and frame pointers, but store the
277 @@ control frame pointer in reg_NFP (saving a register move
279 ldr reg_NFP, .stack_pointer_address
280 ldr reg_CFP, [reg_NFP]
281 str reg_CFP, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
282 ldr reg_NFP, .frame_pointer_address
283 ldr reg_NFP, [reg_NFP]
285 @@ Leave PSEUDO-ATOMIC and check for interrupts.
286 str reg_NULL, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_ATOMIC)
287 ldr reg_OCFP, STATIC_SYMBOL_VALUE(PSEUDO_ATOMIC_INTERRUPTED)
291 @@ Restore our caller state from our stack frame.
292 ldr reg_CODE, [reg_NFP, #8]
293 ldr reg_NL2, [reg_NFP, #4]
294 ldr reg_CFP, [reg_NFP]
295 str reg_NFP, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
297 @@ Restore our return address... into the program counter.
298 sub reg_NL2, reg_NL2, #OTHER_POINTER_LOWTAG
299 add reg_PC, reg_NL2, reg_CODE
301 .size call_into_c, .-call_into_c
304 /* Trampolines, like on SPARC, use Lisp calling conventions. */
306 .global undefined_tramp
307 .type undefined_tramp, %object
308 .word SIMPLE_FUN_HEADER_WIDETAG
309 .equ undefined_tramp, .+1
310 .word undefined_tramp
318 @@ As in ppc-assem.S, point reg_CODE to the header with a
319 @@ function lowtag... Which the address already has.
320 ldr reg_CODE, =undefined_tramp
322 @@ The magic (undefined) "BREAK_POINT" instruction.
323 #if defined(LISP_FEATURE_LINUX)
325 #elif defined(LISP_FEATURE_NETBSD)
328 @@ Error arguments for an undefined function.
330 .byte .error_args_end - . - 1
331 .byte UNDEFINED_FUN_ERROR
332 @@ Need to indicate reg_LEXENV here, which is R3. Encoding
333 @@ rules are to produce an "sc-offset" with the SC number in
334 @@ the low six bits and the offset (3 in our case) in the
335 @@ high $n$ bits. sc_DescriptorReg happens to be 5, but we
336 @@ should use the constant for it. So long as the overall
337 @@ value of the sc-offset is less than 254, we can use a
338 @@ single byte. Overflowing that will take having the SC
339 @@ number being 30 or 31, and as of this writing the highest
340 @@ SC number is sc_CatchBlock at 16. It would also take an
341 @@ offset of 7, not the 3 that we use for LEXENV.
342 .byte sc_DescriptorReg + (0x40 * 3)
346 .global undefined_alien_function
347 .type undefined_alien_function, %object
348 .word SIMPLE_FUN_HEADER_WIDETAG
349 .equ undefined_alien_function, .+1
350 .word undefined_alien_function
356 undefined_alien_function:
357 ldr reg_CODE, = undefined_alien_function
359 @@ The magic (undefined) "BREAK_POINT" instruction.
360 #if defined(LISP_FEATURE_LINUX)
362 #elif defined(LISP_FEATURE_NETBSD)
366 @@ Error arguments for an undefined function.
369 .byte UNDEFINED_ALIEN_FUN_ERROR
370 @@ Encode unsigned R8, which comes from call_into_c
376 .global closure_tramp
377 .type closure_tramp, %object
378 .word SIMPLE_FUN_HEADER_WIDETAG
379 .equ closure_tramp, .+1
387 ldr reg_LEXENV, [reg_LEXENV, #FDEFN_FUN_OFFSET]
388 ldr reg_CODE, [reg_LEXENV, #CLOSURE_FUN_OFFSET]
389 add reg_PC, reg_CODE, #SIMPLE_FUN_CODE_OFFSET
392 .global funcallable_instance_tramp
393 .type funcallable_instance_tramp, %object
394 .word SIMPLE_FUN_HEADER_WIDETAG
395 .equ funcallable_instance_tramp, .+1
396 .word funcallable_instance_tramp
403 ldr reg_LEXENV, [reg_LEXENV, #FUNCALLABLE_INSTANCE_FUNCTION_OFFSET]
404 ldr reg_CODE, [reg_LEXENV, #CLOSURE_FUN_OFFSET]
405 add reg_PC, reg_CODE, #SIMPLE_FUN_CODE_OFFSET
407 @@ FIXME-ARM: The following is random garbage, to make
408 @@ code/debug-int compile. To get the debugger working, this
409 @@ needs to be implemented.
411 .global fun_end_breakpoint_guts
412 .type fun_end_breakpoint_guts, %object
413 fun_end_breakpoint_guts:
414 .global fun_end_breakpoint_trap
415 .type fun_end_breakpoint_trap, %function
416 fun_end_breakpoint_trap:
417 b fun_end_breakpoint_trap
418 .global fun_end_breakpoint_end
419 fun_end_breakpoint_end:
421 #ifdef LISP_FEATURE_GENCGC
424 .type alloc_tramp, %function
426 stmfd sp!, {r4, r6, r12, lr}
428 ldr r4, =foreign_function_call_active
431 ldr r4, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
433 str r6, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
435 @@ Create a new frame and save descriptor regs on the stack
436 @@ for the GC to see.
437 str reg_CFP, [r4, #0]
438 str reg_NULL, [r4, #4]
439 str reg_CODE, [r4, #8]
441 stmea r4, {r0-reg_LEXENV, r8}
451 ldr r4, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
452 ldmea r4, {r0-reg_LEXENV, r8}
454 str r4, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
456 ldr r4, =foreign_function_call_active
460 ldmfd sp!, {r4, r6, r12, lr}
465 .type fpu_save, %function
472 .type fpu_restore, %function
479 .global do_pending_interrupt
480 .type do_pending_interrupt, %function
481 do_pending_interrupt:
482 #if defined(LISP_FEATURE_LINUX)
484 #elif defined(LISP_FEATURE_NETBSD)
487 .byte trap_PendingInterrupt