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.
283 .EXPORT sanctify_for_execution
284 sanctify_for_execution:
288 /* %arg0=start addr, %arg1=length in bytes */
289 add %arg0,%arg1,%arg1
296 ldi 32,%r1 ; bytes per cache line
297 /* parisc 1.1 and 2.0 manuals say to flush the dcache, SYNC,
298 * flush the icache, SYNC again, and burn seven instructions
299 * before executing modified code. */
301 comb,< %arg0,%arg1,sanctify_loop
302 fdc,m %r1(%sr1,%arg0)
305 comb,< %arg2,%arg1,sanctify_loop_2
306 fic,m %r1(%sr1,%arg2)
317 * Core saving/restoring support
320 .export call_on_stack
322 /* %arg0 = fn to invoke, %arg1 = new stack base */
324 /* Compute the new stack pointer. */
327 /* Zero out the previous stack pointer. */
330 /* Invoke the function. */
340 .callinfo entry_gr=18,entry_fr=21,save_rp,calls
343 stw %rp,-0x14(%sr0,%sp)
344 fstds,ma %fr12,8(%sr0,%sp)
345 fstds,ma %fr13,8(%sr0,%sp)
346 fstds,ma %fr14,8(%sr0,%sp)
347 fstds,ma %fr15,8(%sr0,%sp)
348 fstds,ma %fr16,8(%sr0,%sp)
349 fstds,ma %fr17,8(%sr0,%sp)
350 fstds,ma %fr18,8(%sr0,%sp)
351 fstds,ma %fr19,8(%sr0,%sp)
352 fstds,ma %fr20,8(%sr0,%sp)
353 fstds,ma %fr21,8(%sr0,%sp)
354 stwm %r3,0x70(%sr0,%sp)
355 stw %r4,-0x6c(%sr0,%sp)
356 stw %r5,-0x68(%sr0,%sp)
357 stw %r6,-0x64(%sr0,%sp)
358 stw %r7,-0x60(%sr0,%sp)
359 stw %r8,-0x5c(%sr0,%sp)
360 stw %r9,-0x58(%sr0,%sp)
361 stw %r10,-0x54(%sr0,%sp)
362 stw %r11,-0x50(%sr0,%sp)
363 stw %r12,-0x4c(%sr0,%sp)
364 stw %r13,-0x48(%sr0,%sp)
365 stw %r14,-0x44(%sr0,%sp)
366 stw %r15,-0x40(%sr0,%sp)
367 stw %r16,-0x3c(%sr0,%sp)
368 stw %r17,-0x38(%sr0,%sp)
369 stw %r18,-0x34(%sr0,%sp)
372 /* Remember the function we want to invoke */
375 /* Pass the new stack pointer in as %arg0 */
378 /* Leave %arg1 as %arg1. */
384 .export _restore_state
387 ldw -0xd4(%sr0,%sp),%rp
388 ldw -0x34(%sr0,%sp),%r18
389 ldw -0x38(%sr0,%sp),%r17
390 ldw -0x3c(%sr0,%sp),%r16
391 ldw -0x40(%sr0,%sp),%r15
392 ldw -0x44(%sr0,%sp),%r14
393 ldw -0x48(%sr0,%sp),%r13
394 ldw -0x4c(%sr0,%sp),%r12
395 ldw -0x50(%sr0,%sp),%r11
396 ldw -0x54(%sr0,%sp),%r10
397 ldw -0x58(%sr0,%sp),%r9
398 ldw -0x5c(%sr0,%sp),%r8
399 ldw -0x60(%sr0,%sp),%r7
400 ldw -0x64(%sr0,%sp),%r6
401 ldw -0x68(%sr0,%sp),%r5
402 ldw -0x6c(%sr0,%sp),%r4
403 ldwm -0x70(%sr0,%sp),%r3
404 fldds,mb -8(%sr0,%sp),%fr21
405 fldds,mb -8(%sr0,%sp),%fr20
406 fldds,mb -8(%sr0,%sp),%fr19
407 fldds,mb -8(%sr0,%sp),%fr18
408 fldds,mb -8(%sr0,%sp),%fr17
409 fldds,mb -8(%sr0,%sp),%fr16
410 fldds,mb -8(%sr0,%sp),%fr15
411 fldds,mb -8(%sr0,%sp),%fr14
412 fldds,mb -8(%sr0,%sp),%fr13
414 fldds,mb -8(%sr0,%sp),%fr12
420 .export restore_state
431 /* FIX, add support for singlestep
432 break trap_SingleStepBreakpoint,0
433 break trap_SingleStepBreakpoint,0
435 .export SingleStepTraps
439 there's a break 0,0 in the new version here!!!
443 * For an explanation of the magic involved in function-end
444 * breakpoints, see the implementation in ppc-assem.S.
448 .export fun_end_breakpoint_guts
449 fun_end_breakpoint_guts:
450 .word RETURN_PC_HEADER_WIDETAG + 0x600
451 /* multiple value return point -- just jump to trap. */
452 b,n fun_end_breakpoint_trap
453 /* single value return point -- convert to multiple w/ n=1 */
454 copy reg_CSP, reg_OCFP
455 addi 4, reg_CSP, reg_CSP
456 addi 4, %r0, reg_NARGS
457 copy reg_NULL, reg_A1
458 copy reg_NULL, reg_A2
459 copy reg_NULL, reg_A3
460 copy reg_NULL, reg_A4
461 copy reg_NULL, reg_A5
463 .export fun_end_breakpoint_trap
464 fun_end_breakpoint_trap:
465 break trap_FunEndBreakpoint,0
466 b,n fun_end_breakpoint_trap
468 .export fun_end_breakpoint_end
469 fun_end_breakpoint_end:
471 /* FIX-lav: these are found in assem-rtns.lisp too, but
472 genesis.lisp has problem referencing them, so we keep
473 these old versions too. Lisp code cant jump to them
474 because it is an inter space jump but lisp do intra
478 .EXPORT closure_tramp
480 /* reg_FDEFN holds the fdefn object. */
481 ldw FDEFN_FUN_OFFSET(0,reg_FDEFN),reg_LEXENV
482 ldw CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_L0
483 addi SIMPLE_FUN_CODE_OFFSET, reg_L0, reg_LIP
487 .EXPORT undefined_tramp
491 .byte UNDEFINED_FUN_ERROR
493 .byte (0x40 + sc_DescriptorReg)