1 #define LANGUAGE_ASSEMBLY
5 #include "genesis/closure.h"
6 #include "genesis/fdefn.h"
7 #include "genesis/simple-fun.h"
8 #include "genesis/return-pc.h"
9 #include "genesis/static-symbols.h"
10 #include "genesis/funcallable-instance.h"
16 .import $$dyncall,MILLICODE
17 .import foreign_function_call_active,data
18 .import current_control_stack_pointer,data
19 .import current_control_frame_pointer,data
20 .import current_binding_stack_pointer,data
21 .import dynamic_space_free_pointer,data
22 /* .import return_from_lisp_function,data */
29 .export call_into_lisp
32 .callinfo entry_gr=18,save_rp
34 /* %arg0=function, %arg1=cfp, %arg2=nargs */
36 stw %rp,-0x14(%sr0,%sp)
37 stwm %r3,0x40(%sr0,%sp)
38 stw %r4,-0x3c(%sr0,%sp)
39 stw %r5,-0x38(%sr0,%sp)
40 stw %r6,-0x34(%sr0,%sp)
41 stw %r7,-0x30(%sr0,%sp)
42 stw %r8,-0x2c(%sr0,%sp)
43 stw %r9,-0x28(%sr0,%sp)
44 stw %r10,-0x24(%sr0,%sp)
45 stw %r11,-0x20(%sr0,%sp)
46 stw %r12,-0x1c(%sr0,%sp)
47 stw %r13,-0x18(%sr0,%sp)
48 stw %r14,-0x14(%sr0,%sp)
49 stw %r15,-0x10(%sr0,%sp)
50 stw %r16,-0xc(%sr0,%sp)
51 stw %r17,-0x8(%sr0,%sp)
52 stw %r18,-0x4(%sr0,%sp)
54 /* Clear the descriptor regs, moving in args as approporate. */
58 zdep %arg2,29,30,reg_NARGS
73 ldo R%NIL(reg_NULL),reg_NULL
75 /* Turn on pseudo-atomic. */
78 /* No longer in foreign function call land. */
79 addil L%foreign_function_call_active-$global$,%dp
80 stw %r0,R%foreign_function_call_active-$global$(0,%r1)
82 /* Load lisp state. */
83 addil L%dynamic_space_free_pointer-$global$,%dp
84 ldw R%dynamic_space_free_pointer-$global$(0,%r1),%r1
85 add reg_ALLOC,%r1,reg_ALLOC
86 addil L%current_binding_stack_pointer-$global$,%dp
87 ldw R%current_binding_stack_pointer-$global$(0,%r1),reg_BSP
88 addil L%current_control_stack_pointer-$global$,%dp
89 ldw R%current_control_stack_pointer-$global$(0,%r1),reg_CSP
90 addil L%current_control_frame_pointer-$global$,%dp
91 ldw R%current_control_frame_pointer-$global$(0,%r1),reg_OCFP
94 /* End of pseudo-atomic. */
95 addit,od -4,reg_ALLOC,reg_ALLOC
97 /* Establish lisp arguments. */
100 ldw 8(reg_CFP),reg_A2
101 ldw 12(reg_CFP),reg_A3
102 ldw 16(reg_CFP),reg_A4
103 ldw 20(reg_CFP),reg_A5
105 /* Calculate the LRA. */
106 ldil L%lra-RETURN_PC_RETURN_POINT_OFFSET,reg_LRA
107 ldo R%lra-RETURN_PC_RETURN_POINT_OFFSET(reg_LRA),reg_LRA
109 /* Indirect the closure */
110 ldw CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_CODE
111 addi SIMPLE_FUN_CODE_OFFSET,reg_CODE,reg_LIP
113 #ifdef LISP_FEATURE_HPUX
114 /* Get the stub address, ie assembly-routine return-from-lisp */
115 addil L%return_from_lisp_stub-$global$,%dp
116 ldw R%return_from_lisp_stub-$global$(0,%r1),reg_NL0
126 nop /* a few nops because we dont know where we land */
127 nop /* the return convention would govern this */
131 /* Copy CFP (%r4) into someplace else and restore r4. */
135 /* Copy the return value. */
138 /* Turn on pseudo-atomic. */
139 addi 4,reg_ALLOC,reg_ALLOC
141 /* Store the lisp state. */
142 copy reg_ALLOC,reg_NL0
144 addil L%dynamic_space_free_pointer-$global$,%dp
145 stw reg_NL0,R%dynamic_space_free_pointer-$global$(0,%r1)
146 addil L%current_binding_stack_pointer-$global$,%dp
147 stw reg_BSP,R%current_binding_stack_pointer-$global$(0,%r1)
148 addil L%current_control_stack_pointer-$global$,%dp
149 stw reg_CSP,R%current_control_stack_pointer-$global$(0,%r1)
150 addil L%current_control_frame_pointer-$global$,%dp
151 stw reg_NL1,R%current_control_frame_pointer-$global$(0,%r1)
153 /* Back in C land. [CSP is just a handy non-zero value.] */
154 addil L%foreign_function_call_active-$global$,%dp
155 stw reg_CSP,R%foreign_function_call_active-$global$(0,%r1)
157 /* Turn off pseudo-atomic and check for traps. */
158 addit,od -4,reg_ALLOC,reg_ALLOC
160 ldw -0x54(%sr0,%sp),%rp
161 ldw -0x4(%sr0,%sp),%r18
162 ldw -0x8(%sr0,%sp),%r17
163 ldw -0xc(%sr0,%sp),%r16
164 ldw -0x10(%sr0,%sp),%r15
165 ldw -0x14(%sr0,%sp),%r14
166 ldw -0x18(%sr0,%sp),%r13
167 ldw -0x1c(%sr0,%sp),%r12
168 ldw -0x20(%sr0,%sp),%r11
169 ldw -0x24(%sr0,%sp),%r10
170 ldw -0x28(%sr0,%sp),%r9
171 ldw -0x2c(%sr0,%sp),%r8
172 ldw -0x30(%sr0,%sp),%r7
173 ldw -0x34(%sr0,%sp),%r6
174 ldw -0x38(%sr0,%sp),%r5
175 ldw -0x3c(%sr0,%sp),%r4
177 ldwm -0x40(%sr0,%sp),%r3
190 /* Set up a lisp stack frame. */
191 copy reg_CFP, reg_OCFP
192 copy reg_CSP, reg_CFP
193 addi 32, reg_CSP, reg_CSP
194 stw reg_OCFP, 0(0,reg_CFP) ; save old cfp
195 stw reg_CFP, 4(0,reg_CFP) ; save old csp
196 /* convert raw return PC into a fixnum PC-offset, because we dont
197 have ahold of an lra object */
198 sub reg_LIP, reg_CODE, reg_NL5
199 addi 3-OTHER_POINTER_LOWTAG, reg_NL5, reg_NL5
200 stw reg_NL5, 8(0,reg_CFP)
201 stw reg_CODE, 0xc(0,reg_CFP)
203 /* set pseudo-atomic flag */
204 addi 4, reg_ALLOC, reg_ALLOC
206 /* Store the lisp state. */
207 copy reg_ALLOC,reg_NL5
209 addil L%dynamic_space_free_pointer-$global$,%dp
210 stw reg_NL5,R%dynamic_space_free_pointer-$global$(0,%r1)
211 addil L%current_binding_stack_pointer-$global$,%dp
212 stw reg_BSP,R%current_binding_stack_pointer-$global$(0,%r1)
213 addil L%current_control_stack_pointer-$global$,%dp
214 stw reg_CSP,R%current_control_stack_pointer-$global$(0,%r1)
215 addil L%current_control_frame_pointer-$global$,%dp
216 stw reg_CFP,R%current_control_frame_pointer-$global$(0,%r1)
218 /* Back in C land. [CSP is just a handy non-zero value.] */
219 addil L%foreign_function_call_active-$global$,%dp
220 stw reg_CSP,R%foreign_function_call_active-$global$(0,%r1)
222 /* Turn off pseudo-atomic and check for traps. */
223 addit,od -4,reg_ALLOC,reg_ALLOC
225 /* in order to be able to call incrementally linked (ld -A) functions,
226 we have to do some mild trickery here */
231 /* Clear the callee saves descriptor regs. */
237 /* Turn on pseudo-atomic. */
240 /* Turn off foreign function call. */
241 addil L%foreign_function_call_active-$global$,%dp
242 stw %r0,R%foreign_function_call_active-$global$(0,%r1)
245 addil L%dynamic_space_free_pointer-$global$,%dp
246 ldw R%dynamic_space_free_pointer-$global$(0,%r1),%r1
247 add reg_ALLOC,%r1,reg_ALLOC
249 /* We don't need to load OCFP, CFP, CSP, or BSP because they are
250 * in caller saves registers.
253 /* End of pseudo-atomic. */
254 addit,od -4,reg_ALLOC,reg_ALLOC
256 /* Restore CODE. Even though it is in a callee saves register
257 * it might have been GC'ed.
259 ldw 0xc(0,reg_CFP), reg_CODE
261 /* Restore the return pc. */
262 ldw 8(0,reg_CFP), reg_NL0
263 addi OTHER_POINTER_LOWTAG-3, reg_NL0, reg_NL0
265 addi -3, reg_NL0, reg_NL0
266 ldi OTHER_POINTER_LOWTAG, reg_NL1
267 sub reg_NL0, reg_NL1, reg_NL0
269 add reg_CODE, reg_NL0, reg_LIP
271 /* Pop the lisp stack frame, and back we go. */
272 ldw 4(0,reg_CFP), reg_CSP
273 ldw 0(0,reg_CFP), reg_OCFP
274 copy reg_OCFP, reg_CFP
280 * Stuff to sanctify a block of memory for execution.
281 * FIX why does this code work: parisc2.0 guide tells
282 * us that we should add an sync after fdc and fic and
283 * then let seven nops be executed before executing the
288 .EXPORT sanctify_for_execution
289 sanctify_for_execution:
293 /* %arg0=start addr, %arg1=length in bytes */
294 add %arg0,%arg1,%arg1
300 ldi 32,%r1 ; bytes per cache line
303 comb,< %arg0,%arg1,sanctify_loop
304 fic,m %r1(%sr1,%arg0)
314 * Core saving/restoring support
317 .export call_on_stack
319 /* %arg0 = fn to invoke, %arg1 = new stack base */
321 /* Compute the new stack pointer. */
324 /* Zero out the previous stack pointer. */
327 /* Invoke the function. */
337 .callinfo entry_gr=18,entry_fr=21,save_rp,calls
340 stw %rp,-0x14(%sr0,%sp)
341 fstds,ma %fr12,8(%sr0,%sp)
342 fstds,ma %fr13,8(%sr0,%sp)
343 fstds,ma %fr14,8(%sr0,%sp)
344 fstds,ma %fr15,8(%sr0,%sp)
345 fstds,ma %fr16,8(%sr0,%sp)
346 fstds,ma %fr17,8(%sr0,%sp)
347 fstds,ma %fr18,8(%sr0,%sp)
348 fstds,ma %fr19,8(%sr0,%sp)
349 fstds,ma %fr20,8(%sr0,%sp)
350 fstds,ma %fr21,8(%sr0,%sp)
351 stwm %r3,0x70(%sr0,%sp)
352 stw %r4,-0x6c(%sr0,%sp)
353 stw %r5,-0x68(%sr0,%sp)
354 stw %r6,-0x64(%sr0,%sp)
355 stw %r7,-0x60(%sr0,%sp)
356 stw %r8,-0x5c(%sr0,%sp)
357 stw %r9,-0x58(%sr0,%sp)
358 stw %r10,-0x54(%sr0,%sp)
359 stw %r11,-0x50(%sr0,%sp)
360 stw %r12,-0x4c(%sr0,%sp)
361 stw %r13,-0x48(%sr0,%sp)
362 stw %r14,-0x44(%sr0,%sp)
363 stw %r15,-0x40(%sr0,%sp)
364 stw %r16,-0x3c(%sr0,%sp)
365 stw %r17,-0x38(%sr0,%sp)
366 stw %r18,-0x34(%sr0,%sp)
369 /* Remember the function we want to invoke */
372 /* Pass the new stack pointer in as %arg0 */
375 /* Leave %arg1 as %arg1. */
381 .export _restore_state
384 ldw -0xd4(%sr0,%sp),%rp
385 ldw -0x34(%sr0,%sp),%r18
386 ldw -0x38(%sr0,%sp),%r17
387 ldw -0x3c(%sr0,%sp),%r16
388 ldw -0x40(%sr0,%sp),%r15
389 ldw -0x44(%sr0,%sp),%r14
390 ldw -0x48(%sr0,%sp),%r13
391 ldw -0x4c(%sr0,%sp),%r12
392 ldw -0x50(%sr0,%sp),%r11
393 ldw -0x54(%sr0,%sp),%r10
394 ldw -0x58(%sr0,%sp),%r9
395 ldw -0x5c(%sr0,%sp),%r8
396 ldw -0x60(%sr0,%sp),%r7
397 ldw -0x64(%sr0,%sp),%r6
398 ldw -0x68(%sr0,%sp),%r5
399 ldw -0x6c(%sr0,%sp),%r4
400 ldwm -0x70(%sr0,%sp),%r3
401 fldds,mb -8(%sr0,%sp),%fr21
402 fldds,mb -8(%sr0,%sp),%fr20
403 fldds,mb -8(%sr0,%sp),%fr19
404 fldds,mb -8(%sr0,%sp),%fr18
405 fldds,mb -8(%sr0,%sp),%fr17
406 fldds,mb -8(%sr0,%sp),%fr16
407 fldds,mb -8(%sr0,%sp),%fr15
408 fldds,mb -8(%sr0,%sp),%fr14
409 fldds,mb -8(%sr0,%sp),%fr13
411 fldds,mb -8(%sr0,%sp),%fr12
417 .export restore_state
428 /* FIX, add support for singlestep
429 break trap_SingleStepBreakpoint,0
430 break trap_SingleStepBreakpoint,0
432 .export SingleStepTraps
436 there's a break 0,0 in the new version here!!!
440 * For an explanation of the magic involved in function-end
441 * breakpoints, see the implementation in ppc-assem.S.
445 .export fun_end_breakpoint_guts
446 fun_end_breakpoint_guts:
447 .word RETURN_PC_HEADER_WIDETAG + 0x800
448 /* multiple value return point -- just jump to trap. */
449 b,n fun_end_breakpoint_trap
450 /* single value return point -- convert to multiple w/ n=1 */
451 copy reg_CSP, reg_OCFP
452 addi 4, reg_CSP, reg_CSP
453 addi 4, %r0, reg_NARGS
454 copy reg_NULL, reg_A1
455 copy reg_NULL, reg_A2
456 copy reg_NULL, reg_A3
457 copy reg_NULL, reg_A4
458 copy reg_NULL, reg_A5
460 .export fun_end_breakpoint_trap
461 fun_end_breakpoint_trap:
462 break trap_FunEndBreakpoint,0
463 b,n fun_end_breakpoint_trap
465 .export fun_end_breakpoint_end
466 fun_end_breakpoint_end:
468 /* FIX-lav: these are found in assem-rtns.lisp too, but
469 genesis.lisp has problem referencing them, so we keep
470 these old versions too. Lisp code cant jump to them
471 because it is an inter space jump but lisp do intra
475 .EXPORT closure_tramp
477 /* reg_FDEFN holds the fdefn object. */
478 ldw FDEFN_FUN_OFFSET(0,reg_FDEFN),reg_LEXENV
479 ldw CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_L0
480 addi SIMPLE_FUN_CODE_OFFSET, reg_L0, reg_LIP
484 .EXPORT undefined_tramp
488 .byte UNDEFINED_FUN_ERROR
490 .byte (0x20 + sc_DescriptorReg)